diff --git a/metadata/metadata b/metadata/metadata --- a/metadata/metadata +++ b/metadata/metadata @@ -1,11227 +1,11227 @@ [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 +author = Manuel Eberl topic = Mathematics/Number theory date = 2018-06-23 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This article gives the basic theory of Pell's equation x2 = 1 + Dy2, 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 +author = Manuel Eberl topic = Mathematics/Geometry, Mathematics/Number theory date = 2017-07-13 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

Minkowski's theorem relates a subset of ℝn, the Lebesgue measure, and the integer lattice ℤn: It states that any convex subset of ℝn with volume greater than 2n contains at least one lattice point from ℤn\{0}, i. e. a non-zero point with integer coefficients.

A related theorem which directly implies this is Blichfeldt's theorem, which states that any subset of ℝn with a volume greater than 1 contains two different points whose difference vector has integer components.

The entry contains a proof of both theorems.

[Name_Carrying_Type_Inference] title = Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus author = Michael Rawson 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) [2021-01-27] Addition of new theorems throughout, particularly for prisms. New "chantype" command allows the definition of an algebraic datatype with generated prisms. New "dataspace" command allows the definition of a local-based state space, including lenses and prisms. Addition of various examples for the above. (revision 89cf045a) [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 +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 +author = Manuel Eberl topic = Computer science/Algorithms date = 2017-03-15 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This article contains a formal proof of the well-known fact that number of comparisons that a comparison-based sorting algorithm needs to perform to sort a list of length n is at least log2 (n!) in the worst case, i. e. Ω(n log n).

For this purpose, a shallow embedding for comparison-based sorting algorithms is defined: a sorting algorithm is a recursive datatype containing either a HOL function or a query of a comparison oracle with a continuation containing the remaining computation. This makes it possible to force the algorithm to use only comparisons and to track the number of comparisons made.

[Quick_Sort_Cost] title = The number of comparisons in QuickSort -author = Manuel Eberl +author = Manuel Eberl topic = Computer science/Algorithms date = 2017-03-15 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

We give a formal proof of the well-known results about the number of comparisons performed by two variants of QuickSort: first, the expected number of comparisons of randomised QuickSort (i. e. QuickSort with random pivot choice) is 2 (n+1) Hn - 4 n, which is asymptotically equivalent to 2 n ln n; second, the number of comparisons performed by the classic non-randomised QuickSort has the same distribution in the average case as the randomised one.

[Random_BSTs] title = Expected Shape of Random Binary Search Trees -author = Manuel Eberl +author = Manuel Eberl topic = Computer science/Data structures date = 2017-04-04 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This entry contains proofs for the textbook results about the distributions of the height and internal path length of random binary search trees (BSTs), i. e. BSTs that are formed by taking an empty BST and inserting elements from a fixed set in random order.

In particular, we prove a logarithmic upper bound on the expected height and the Θ(n log n) closed-form solution for the expected internal path length in terms of the harmonic numbers. We also show how the internal path length relates to the average-case cost of a lookup in a BST.

[Randomised_BSTs] title = Randomised Binary Search Trees -author = Manuel Eberl +author = Manuel Eberl topic = Computer science/Data structures date = 2018-10-19 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This work is a formalisation of the Randomised Binary Search Trees introduced by Martínez and Roura, including definitions and correctness proofs.

Like randomised treaps, they are a probabilistic data structure that behaves exactly as if elements were inserted into a non-balancing BST in random order. However, unlike treaps, they only use discrete probability distributions, but their use of randomness is more complicated.

[E_Transcendental] title = The Transcendence of e -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Analysis, Mathematics/Number theory date = 2017-01-12 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This work contains a proof that Euler's number e is transcendental. The proof follows the standard approach of assuming that e is algebraic and then using a specific integer polynomial to derive two inconsistent bounds, leading to a contradiction.

This kind of approach can be found in many different sources; this formalisation mostly follows a PlanetMath article by Roger Lipsett.

[Pi_Transcendental] title = The Transcendence of π -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Number theory date = 2018-09-28 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This entry shows the transcendence of π based on the classic proof using the fundamental theorem of symmetric polynomials first given by von Lindemann in 1882, but the formalisation mostly follows the version by Niven. The proof reuses much of the machinery developed in the AFP entry on the transcendence of e.

[Hermite_Lindemann] title = The Hermite–Lindemann–Weierstraß Transcendence Theorem -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Number theory date = 2021-03-03 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This article provides a formalisation of the Hermite-Lindemann-Weierstraß Theorem (also known as simply Hermite-Lindemann or Lindemann-Weierstraß). This theorem is one of the crowning achievements of 19th century number theory.

The theorem states that if $\alpha_1, \ldots, \alpha_n\in\mathbb{C}$ are algebraic numbers that are linearly independent over $\mathbb{Z}$, then $e^{\alpha_1},\ldots,e^{\alpha_n}$ are algebraically independent over $\mathbb{Q}$.

Like the previous formalisation in Coq by Bernard, I proceeded by formalising Baker's version of the theorem and proof and then deriving the original one from that. Baker's version states that for any algebraic numbers $\beta_1, \ldots, \beta_n\in\mathbb{C}$ and distinct algebraic numbers $\alpha_i, \ldots, \alpha_n\in\mathbb{C}$, we have $\beta_1 e^{\alpha_1} + \ldots + \beta_n e^{\alpha_n} = 0$ if and only if all the $\beta_i$ are zero.

This has a number of direct corollaries, e.g.:

  • $e$ and $\pi$ are transcendental
  • $e^z$, $\sin z$, $\tan z$, etc. are transcendental for algebraic $z\in\mathbb{C}\setminus\{0\}$
  • $\ln z$ is transcendental for algebraic $z\in\mathbb{C}\setminus\{0, 1\}$
[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.

Revisions made subsequent to the first version of this article added material on equivalence of categories, cartesian categories, categories with pullbacks, categories with finite limits, and cartesian closed categories. A construction was given of the category of hereditarily finite sets and functions between them, and it was shown that this category is cartesian closed.

extra-history = Change history: [2018-05-29]: Revised axioms for the category locale. Introduced notation for composition and "in hom". (revision 8318366d4575)
[2020-02-15]: Move ConcreteCategory.thy from Bicategory to Category3 and use it systematically. Make other minor improvements throughout. (revision a51840d36867)
[2020-07-10]: Added new material, mostly centered around cartesian categories. (revision 06640f317a79)
[2020-11-04]: Minor modifications and extensions made in conjunction with the addition of new material to Bicategory. (revision 472cb2268826)
[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.

Revisions made subsequent to the first version of this article added material on cartesian monoidal categories; showing that the underlying category of a cartesian monoidal category is a cartesian category, and that every cartesian category extends to a cartesian monoidal category.

extra-history = Change history: [2017-05-18]: Integrated material from MonoidalCategory/Category3Adapter into Category3/ and deleted adapter. (revision 015543cdd069)
[2018-05-29]: Modifications required due to 'Category3' changes. Introduced notation for "in hom". (revision 8318366d4575)
[2020-02-15]: Cosmetic improvements. (revision a51840d36867)
[2020-07-10]: Added new material on cartesian monoidal categories. (revision 06640f317a79)
[Card_Multisets] title = Cardinality of Multisets author = Lukas Bulwahn 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 operation on discrete distributions from finite version of the max-flow min-cut theorem (revision a7a198f5bab0)
[2020-12-19]: simpler proof of linkability for bounded unhindered bipartite webs, leading to a simpler proof for networks with bounded out-capacities (revision 93ca33f4d915)
[2021-08-13]: generalize the derivation of the characterisation for the relator of discrete probability distributions to work for the bounded and unbounded MFMC theorem (revision 3c85bb52bbe6)
[Liouville_Numbers] title = Liouville numbers -author = Manuel Eberl +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 +notify = manuel@pruvisto.org [Triangle] title = Basic Geometric Properties of Triangles -author = Manuel Eberl +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 +notify = manuel@pruvisto.org [Prime_Harmonic_Series] title = The Divergence of the Prime Harmonic Series -author = Manuel Eberl +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 +notify = manuel@pruvisto.org [Descartes_Sign_Rule] title = Descartes' Rule of Signs -author = Manuel Eberl +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 +notify = manuel@pruvisto.org [Euler_MacLaurin] title = The Euler–MacLaurin Formula -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Analysis date = 2017-03-10 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

The Euler-MacLaurin formula relates the value of a discrete sum to that of the corresponding integral in terms of the derivatives at the borders of the summation and a remainder term. Since the remainder term is often very small as the summation bounds grow, this can be used to compute asymptotic expansions for sums.

This entry contains a proof of this formula for functions from the reals to an arbitrary Banach space. Two variants of the formula are given: the standard textbook version and a variant outlined in Concrete Mathematics that is more useful for deriving asymptotic estimates.

As example applications, we use that formula to derive the full asymptotic expansion of the harmonic numbers and the sum of inverse squares.

[Card_Partitions] title = Cardinality of Set Partitions author = Lukas Bulwahn 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 = [Relational_Method] title = The Relational Method with Message Anonymity for the Verification of Cryptographic Protocols author = Pasquale Noce topic = Computer science/Security date = 2020-12-05 notify = pasquale.noce.lavoro@gmail.com abstract = This paper introduces a new method for the formal verification of cryptographic protocols, the relational method, derived from Paulson's inductive method by means of some enhancements aimed at streamlining formal definitions and proofs, specially for protocols using public key cryptography. Moreover, this paper proposes a method to formalize a further security property, message anonymity, in addition to message confidentiality and authenticity. The relational method, including message anonymity, is then applied to the verification of a sample authentication protocol, comprising Password Authenticated Connection Establishment (PACE) with Chip Authentication Mapping followed by the explicit verification of an additional password over the PACE secure channel. [List_Interleaving] title = Reasoning about Lists via List Interleaving author = Pasquale Noce 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 [IsaGeoCoq] title = Tarski's Parallel Postulate implies the 5th Postulate of Euclid, the Postulate of Playfair and the original Parallel Postulate of Euclid author = Roland Coghetto topic = Mathematics/Geometry license = LGPL date = 2021-01-31 notify = roland_coghetto@hotmail.com abstract =

The GeoCoq library contains a formalization of geometry using the Coq proof assistant. It contains both proofs about the foundations of geometry and high-level proofs in the same style as in high school. We port a part of the GeoCoq 2.4.0 library to Isabelle/HOL: more precisely, the files Chap02.v to Chap13_3.v, suma.v as well as the associated definitions and some useful files for the demonstration of certain parallel postulates. The synthetic approach of the demonstrations is directly inspired by those contained in GeoCoq. The names of the lemmas and theorems used are kept as far as possible as well as the definitions.

It should be noted that T.J.M. Makarios has done some proofs in Tarski's Geometry. It uses a definition that does not quite coincide with the definition used in Geocoq and here. Furthermore, corresponding definitions in the Poincaré Disc Model development are not identical to those defined in GeoCoq.

In the last part, it is formalized that, in the neutral/absolute space, the axiom of the parallels of Tarski's system implies the Playfair axiom, the 5th postulate of Euclid and Euclid's original parallel postulate. These proofs, which are not constructive, are directly inspired by Pierre Boutry, Charly Gries, Julien Narboux and Pascal Schreck.

[General-Triangle] title = The General Triangle Is Unique author = Joachim Breitner 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 +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 +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. [2020-11-20]: Additional theory Natural_Mergesort that developes an efficient mergesort algorithm without key-functions for educational purposes. notify = c.sternagel@gmail.com [SATSolverVerification] title = Formal Verification of Modern SAT Solvers author = Filip Marić 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 = [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 = [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 = [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: Completeness of Modal Logics 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). The extensions of system K (T, KB, K4, S4, S5) and their completeness proofs are based on the textbook "Modal Logic" by Blackburn, de Rijke and Venema (Cambridge University Press 2001). extra-history = Change history: [2021-04-15]: Added completeness of modal logics T, KB, K4, S4 and S5. [SequentInvertibility] title = Invertibility in Sequent Calculi author = Peter Chapman <> date = 2009-08-28 topic = Logic/Proof theory license = LGPL abstract = The invertibility of the rules of a sequent calculus is important for guiding proof search and can be used in some formalised proofs of Cut admissibility. We present sufficient conditions for when a rule is invertible with respect to a calculus. We illustrate the conditions with examples. It must be noted we give purely syntactic criteria; no guarantees are given as to the suitability of the rules. notify = pc@cs.st-andrews.ac.uk, nipkow@in.tum.de [LinearQuantifierElim] title = Quantifier Elimination for Linear Arithmetic author = Tobias Nipkow 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 [Finitely_Generated_Abelian_Groups] title = Finitely Generated Abelian Groups -author = Joseph Thommes<>, Manuel Eberl +author = Joseph Thommes<>, Manuel Eberl topic = Mathematics/Algebra date = 2021-07-07 -notify = joseph-thommes@gmx.de, eberlm@in.tum.de +notify = joseph-thommes@gmx.de, manuel@pruvisto.org abstract = This article deals with the formalisation of some group-theoretic results including the fundamental theorem of finitely generated abelian groups characterising the structure of these groups as a uniquely determined product of cyclic groups. Both the invariant factor decomposition and the primary decomposition are covered. Additional work includes results about the direct product, the internal direct product and more group-theoretic lemmas. [Group-Ring-Module] title = Groups, Rings and Modules author = Hidetsune Kobayashi <>, L. Chen <>, H. Murao <> date = 2004-05-18 topic = Mathematics/Algebra abstract = The theory of groups, rings and modules is developed to a great depth. Group theory results include Zassenhaus's theorem and the Jordan-Hoelder theorem. The ring theory development includes ideals, quotient rings and the Chinese remainder theorem. The module development includes the Nakayama lemma, exact sequences and Tensor products. notify = lp15@cam.ac.uk [Robbins-Conjecture] title = A Complete Proof of the Robbins Conjecture author = Matthew Wampler-Doty <> date = 2010-05-22 topic = Mathematics/Algebra abstract = This document gives a formalization of the proof of the Robbins conjecture, following A. Mann, A Complete Proof of the Robbins Conjecture, 2003. notify = nipkow@in.tum.de [Valuation] title = Fundamental Properties of Valuation Theory and Hensel's Lemma author = Hidetsune Kobayashi <> date = 2007-08-08 topic = Mathematics/Algebra abstract = Convergence with respect to a valuation is discussed as convergence of a Cauchy sequence. Cauchy sequences of polynomials are defined. They are used to formalize Hensel's lemma. notify = lp15@cam.ac.uk [Rank_Nullity_Theorem] title = Rank-Nullity Theorem in Linear Algebra author = Jose Divasón , 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 +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 +notify = manuel@pruvisto.org [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 +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 , Thomas Bauereiss date = 2014-04-22 topic = Computer science/Security abstract = This is a formalization of bounded-deducibility security (BD security), a flexible notion of information-flow security applicable to arbitrary transition systems. It generalizes Sutherland's classic notion of nondeducibility by factoring in declassification bounds and trigger, whereas nondeducibility states that, in a system, information cannot flow between specified sources and sinks, BD security indicates upper bounds for the flow and triggers under which these upper bounds are no longer guaranteed. notify = uuomul@yahoo.com, lammich@in.tum.de, thomas@bauereiss.name extra-history = Change history: [2021-08-12]: Generalised BD Security from I/O automata to nondeterministic transition systems, with the former retained as an instance of the latter (renaming locale BD_Security to BD_Security_IO). Generalise unwinding conditions to allow making more than one transition at a time when constructing alternative traces. Add results about the expressivity of declassification triggers vs. bounds, due to Thomas Bauereiss (added as author). [Network_Security_Policy_Verification] title = Network Security Policy Verification author = Cornelius Diekmann 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 +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 +notify = manuel@pruvisto.org [Error_Function] title = The Error Function -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Analysis date = 2018-02-06 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This entry provides the definitions and basic properties of the complex and real error function erf and the complementary error function erfc. Additionally, it gives their full asymptotic expansions.

[Akra_Bazzi] title = The Akra-Bazzi theorem and the Master theorem -author = Manuel Eberl +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 +notify = manuel@pruvisto.org [Dirichlet_Series] title = Dirichlet Series -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Number theory date = 2017-10-12 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract = This entry is a formalisation of much of Chapters 2, 3, and 11 of Apostol's “Introduction to Analytic Number Theory”. This includes:

  • 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 +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 +author = Manuel Eberl topic = Mathematics/Number theory, Mathematics/Analysis date = 2017-10-12 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This entry builds upon the results about formal and analytic Dirichlet series to define the Hurwitz ζ function ζ(a,s) and, based on that, the Riemann ζ function ζ(s). This is done by first defining them for ℜ(z) > 1 and then successively extending the domain to the left using the Euler–MacLaurin formula.

Apart from the most basic facts such as analyticity, the following results are provided:

  • 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 +author = Manuel Eberl topic = Mathematics/Analysis date = 2017-10-12 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

Linear recurrences with constant coefficients are an interesting class of recurrence equations that can be solved explicitly. The most famous example are certainly the Fibonacci numbers with the equation f(n) = f(n-1) + f(n - 2) and the quite non-obvious closed form (φn - (-φ)-n) / √5 where φ is the golden ratio.

In this work, I build on existing tools in Isabelle – such as formal power series and polynomial factorisation algorithms – to develop a theory of these recurrences and derive a fully executable solver for them that can be exported to programming languages like Haskell.

[Van_der_Waerden] title = Van der Waerden's Theorem -author = Katharina Kreuzer , Manuel Eberl +author = Katharina Kreuzer , Manuel Eberl topic = Mathematics/Combinatorics date = 2021-06-22 -notify = kreuzerk@in.tum.de, eberlm@in.tum.de +notify = kreuzerk@in.tum.de, manuel@pruvisto.org abstract = This article formalises the proof of Van der Waerden's Theorem from Ramsey theory. Van der Waerden's Theorem states that for integers $k$ and $l$ there exists a number $N$ which guarantees that if an integer interval of length at least $N$ is coloured with $k$ colours, there will always be an arithmetic progression of length $l$ of the same colour in said interval. The proof goes along the lines of \cite{Swan}. The smallest number $N_{k,l}$ fulfilling Van der Waerden's Theorem is then called the Van der Waerden Number. Finding the Van der Waerden Number is still an open problem for most values of $k$ and $l$. [Lambert_W] title = The Lambert W Function on the Reals -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Analysis date = 2020-04-24 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

The Lambert W function is a multi-valued function defined as the inverse function of xx 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 -contributors = Manuel Eberl +contributors = Manuel Eberl 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 -contributors = Manuel Eberl +contributors = Manuel Eberl 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 [Cubic_Quartic_Equations] title = Solving Cubic and Quartic Equations author = René Thiemann topic = Mathematics/Analysis date = 2021-09-03 notify = rene.thiemann@uibk.ac.at abstract =

We formalize Cardano's formula to solve a cubic equation $$ax^3 + bx^2 + cx + d = 0,$$ as well as Ferrari's formula to solve a quartic equation. We further turn both formulas into executable algorithms based on the algebraic number implementation in the AFP. To this end we also slightly extended this library, namely by making the minimal polynomial of an algebraic number executable, and by defining and implementing $n$-th roots of complex numbers.

[Perron_Frobenius] title = Perron-Frobenius Theorem for Spectral Radius Analysis author = Jose Divasón , 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 [Schutz_Spacetime] title = Schutz' Independent Axioms for Minkowski Spacetime author = Richard Schmoetten , Jake Palmer , Jacques Fleuriot topic = Mathematics/Physics, Mathematics/Geometry date = 2021-07-27 notify = s1311325@sms.ed.ac.uk abstract = This is a formalisation of Schutz' system of axioms for Minkowski spacetime published under the name "Independent axioms for Minkowski space-time" in 1997, as well as most of the results in the third chapter ("Temporal Order on a Path") of the above monograph. Many results are proven here that cannot be found in Schutz, either preceding the theorem they are needed for, or within their own thematic section. [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 +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 +notify = manuel@pruvisto.org [SDS_Impossibility] title = The Incompatibility of SD-Efficiency and SD-Strategy-Proofness -author = Manuel Eberl +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 +notify = manuel@pruvisto.org [Median_Of_Medians_Selection] title = The Median-of-Medians Selection Algorithm -author = Manuel Eberl +author = Manuel Eberl topic = Computer science/Algorithms date = 2017-12-21 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This entry provides an executable functional implementation of the Median-of-Medians algorithm for selecting the k-th smallest element of an unsorted list deterministically in linear time. The size bounds for the recursive call that lead to the linear upper bound on the run-time of the algorithm are also proven.

[Mason_Stothers] title = The Mason–Stothers Theorem -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Algebra date = 2017-12-21 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This article provides a formalisation of Snyder’s simple and elegant proof of the Mason–Stothers theorem, which is the polynomial analogue of the famous abc Conjecture for integers. Remarkably, Snyder found this very elegant proof when he was still a high-school student.

In short, the statement of the theorem is that three non-zero coprime polynomials A, B, C over a field which sum to 0 and do not all have vanishing derivatives fulfil max{deg(A), deg(B), deg(C)} < deg(rad(ABC)) where the rad(P) denotes the radical of P, i. e. the product of all unique irreducible factors of P.

This theorem also implies a kind of polynomial analogue of Fermat’s Last Theorem for polynomials: except for trivial cases, An + Bn + Cn = 0 implies n ≤ 2 for coprime polynomials A, B, C over a field.

[FLP] title = A Constructive Proof for FLP author = Benjamin Bisping , 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 +author = Manuel Eberl +notify = manuel@pruvisto.org date = 2016-06-21 topic = Mathematics/Combinatorics abstract =

In this work, we define the Catalan numbers Cn and prove several equivalent definitions (including some closed-form formulae). We also show one of their applications (counting the number of binary trees of size n), prove the asymptotic growth approximation Cn ∼ 4n / (√π · n1.5), and provide reasonably efficient executable code to compute them.

The derivation of the closed-form formulae uses algebraic manipulations of the ordinary generating function of the Catalan numbers, and the asymptotic approximation is then done using generalised binomial coefficients and the Gamma function. Thanks to these highly non-elementary mathematical tools, the proofs are very short and simple.

[Fisher_Yates] title = Fisher–Yates shuffle -author = Manuel Eberl -notify = eberlm@in.tum.de +author = Manuel Eberl +notify = manuel@pruvisto.org date = 2016-09-30 topic = Computer science/Algorithms abstract =

This work defines and proves the correctness of the Fisher–Yates algorithm for shuffling – i.e. producing a random permutation – of a list. The algorithm proceeds by traversing the list and in each step swapping the current element with a random element from the remaining list.

[Bertrands_Postulate] title = Bertrand's postulate -author = Julian Biendarra<>, Manuel Eberl +author = Julian Biendarra<>, Manuel Eberl contributors = Lawrence C. Paulson topic = Mathematics/Number theory date = 2017-01-17 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

Bertrand's postulate is an early result on the distribution of prime numbers: For every positive integer n, there exists a prime number that lies strictly between n and 2n. The proof is ported from John Harrison's formalisation in HOL Light. It proceeds by first showing that the property is true for all n greater than or equal to 600 and then showing that it also holds for all n below 600 by case distinction.

[Rewriting_Z] title = The Z Property author = Bertram Felgenhauer<>, Julian Nagele<>, Vincent van Oostrom<>, Christian Sternagel 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 +author = Manuel Eberl +notify = manuel@pruvisto.org date = 2016-09-01 topic = Mathematics/Analysis abstract =

This work contains a proof of Stirling's formula both for the factorial $n! \sim \sqrt{2\pi n} (n/e)^n$ on natural numbers and the real Gamma function $\Gamma(x)\sim \sqrt{2\pi/x} (x/e)^x$. The proof is based on work by 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 +author = Manuel Eberl topic = Mathematics/Probability theory, Mathematics/Geometry date = 2017-06-06 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract = In the 18th century, Georges-Louis Leclerc, Comte de Buffon posed and later solved the following problem, which is often called the first problem ever solved in geometric probability: Given a floor divided into vertical strips of the same width, what is the probability that a needle thrown onto the floor randomly will cross two strips? This entry formally defines the problem in the case where the needle's position is chosen uniformly at random in a single strip around the origin (which is equivalent to larger arrangements due to symmetry). It then provides proofs of the simple solution in the case where the needle's length is no greater than the width of the strips and the more complicated solution in the opposite case. [SPARCv8] title = A formal model for the SPARCv8 ISA and a proof of non-interference for the LEON3 processor author = Zhe Hou , 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 +author = Lukas Bulwahn, Manuel Eberl topic = Mathematics/Analysis, Mathematics/Number theory date = 2017-01-24 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

Bernoulli numbers were first discovered in the closed-form expansion of the sum 1m + 2m + … + nm for a fixed m and appear in many other places. This entry provides three different definitions for them: a recursive one, an explicit one, and one through their exponential generating function.

In addition, we prove some basic facts, e.g. their relation to sums of powers of integers and that all odd Bernoulli numbers except the first are zero, and some advanced facts like their relationship to the Riemann zeta function on positive even integers.

We also prove the correctness of the Akiyama–Tanigawa algorithm for computing Bernoulli numbers with reasonable efficiency, and we define the periodic Bernoulli polynomials (which appear e.g. in the Euler–MacLaurin summation formula and the expansion of the log-Gamma function) and prove their basic properties.

[Stone_Relation_Algebras] title = Stone Relation Algebras author = Walter Guttmann topic = Mathematics/Algebra date = 2017-02-07 notify = walter.guttmann@canterbury.ac.nz abstract = We develop Stone relation algebras, which generalise relation algebras by replacing the underlying Boolean algebra structure with a Stone algebra. We show that finite matrices over extended real numbers form an instance. As a consequence, relation-algebraic concepts and methods can be used for reasoning about weighted graphs. We also develop a fixpoint calculus and apply it to compare different definitions of reflexive-transitive closures in semirings. extra-history = Change history: [2017-07-05]: generalised extended reals to linear orders (revision b8e703159177) [Stone_Kleene_Relation_Algebras] title = Stone-Kleene Relation Algebras author = Walter Guttmann 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. [Syntax_Independent_Logic] title = Syntax-Independent Logic Infrastructure author = Andrei Popescu , Dmitriy Traytel topic = Logic/Proof theory date = 2020-09-16 notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk abstract = We formalize a notion of logic whose terms and formulas are kept abstract. In particular, logical connectives, substitution, free variables, and provability are not defined, but characterized by their general properties as locale assumptions. Based on this abstract characterization, we develop further reusable reasoning infrastructure. For example, we define parallel substitution (along with proving its characterizing theorems) from single-point substitution. Similarly, we develop a natural deduction style proof system starting from the abstract Hilbert-style one. These one-time efforts benefit different concrete logics satisfying our locales' assumptions. We instantiate the syntax-independent logic infrastructure to Robinson arithmetic (also known as Q) in the AFP entry Robinson_Arithmetic and to hereditarily finite set theory in the AFP entries Goedel_HFSet_Semantic and Goedel_HFSet_Semanticless, which are part of our formalization of Gödel's Incompleteness Theorems described in our CADE-27 paper A Formally Verified Abstract Account of Gödel's Incompleteness Theorems. [Goedel_Incompleteness] title = An Abstract Formalization of Gödel's Incompleteness Theorems author = Andrei Popescu , Dmitriy Traytel topic = Logic/Proof theory date = 2020-09-16 notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk abstract = We present an abstract formalization of Gödel's incompleteness theorems. We analyze sufficient conditions for the theorems' applicability to a partially specified logic. Our abstract perspective enables a comparison between alternative approaches from the literature. These include Rosser's variation of the first theorem, Jeroslow's variation of the second theorem, and the Swierczkowski–Paulson semantics-based approach. This AFP entry is the main entry point to the results described in our CADE-27 paper A Formally Verified Abstract Account of Gödel's Incompleteness Theorems. As part of our abstract formalization's validation, we instantiate our locales twice in the separate AFP entries Goedel_HFSet_Semantic and Goedel_HFSet_Semanticless. [Goedel_HFSet_Semantic] title = From Abstract to Concrete Gödel's Incompleteness Theorems—Part I author = Andrei Popescu , Dmitriy Traytel topic = Logic/Proof theory date = 2020-09-16 notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk abstract = We validate an abstract formulation of Gödel's First and Second Incompleteness Theorems from a separate AFP entry by instantiating them to the case of finite sound extensions of the Hereditarily Finite (HF) Set theory, i.e., FOL theories extending the HF Set theory with a finite set of axioms that are sound in the standard model. The concrete results had been previously formalised in an AFP entry by Larry Paulson; our instantiation reuses the infrastructure developed in that entry. [Goedel_HFSet_Semanticless] title = From Abstract to Concrete Gödel's Incompleteness Theorems—Part II author = Andrei Popescu , Dmitriy Traytel topic = Logic/Proof theory date = 2020-09-16 notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk abstract = We validate an abstract formulation of Gödel's Second Incompleteness Theorem from a separate AFP entry by instantiating it to the case of finite consistent extensions of the Hereditarily Finite (HF) Set theory, i.e., consistent FOL theories extending the HF Set theory with a finite set of axioms. The instantiation draws heavily on infrastructure previously developed by Larry Paulson in his direct formalisation of the concrete result. It strengthens Paulson's formalization of Gödel's Second from that entry by not assuming soundness, and in fact not relying on any notion of model or semantic interpretation. The strengthening was obtained by first replacing some of Paulson’s semantic arguments with proofs within his HF calculus, and then plugging in some of Paulson's (modified) lemmas to instantiate our soundness-free Gödel's Second locale. [Robinson_Arithmetic] title = Robinson Arithmetic author = Andrei Popescu , Dmitriy Traytel topic = Logic/Proof theory date = 2020-09-16 notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk abstract = We instantiate our syntax-independent logic infrastructure developed in a separate AFP entry to the FOL theory of Robinson arithmetic (also known as Q). The latter was formalised using Nominal Isabelle by adapting Larry Paulson’s formalization of the Hereditarily Finite Set theory. [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 , Ujkan Sulejmani<> topic = Computer science/Algorithms/Approximation date = 2020-01-16 notify = nipkow@in.tum.de abstract = We present the first formal verification of approximation algorithms for NP-complete optimization problems: vertex cover, set cover, independent set, center selection, load balancing, and bin packing. The proofs correct incompletenesses in existing proofs and improve the approximation ratio in one case. A detailed description of our work (excluding center selection) has been published in the proceedings of IJCAR 2020. [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 +author = Manuel Eberl topic = Mathematics/Number theory, Mathematics/Algebra date = 2017-12-21 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This article provides a formalisation of Dirichlet characters and Dirichlet L-functions including proofs of their basic properties – most notably their analyticity, their areas of convergence, and their non-vanishing for ℜ(s) ≥ 1. All of this is built in a very high-level style using Dirichlet series. The proof of the non-vanishing follows a very short and elegant proof by Newman, which we attempt to reproduce faithfully in a similar level of abstraction in Isabelle.

This also leads to a relatively short proof of Dirichlet’s Theorem, which states that, if h and n are coprime, there are infinitely many primes p with ph (mod n).

[Symmetric_Polynomials] title = Symmetric Polynomials -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Algebra date = 2018-09-25 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

A symmetric polynomial is a polynomial in variables X1,…,Xn that does not discriminate between its variables, i. e. it is invariant under any permutation of them. These polynomials are important in the study of the relationship between the coefficients of a univariate polynomial and its roots in its algebraic closure.

This article provides a definition of symmetric polynomials and the elementary symmetric polynomials e1,…,en and proofs of their basic properties, including three notable ones:

  • 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. [AI_Planning_Languages_Semantics] title = AI Planning Languages Semantics author = Mohammad Abdulaziz , Peter Lammich topic = Computer science/Artificial intelligence date = 2020-10-29 notify = mohammad.abdulaziz8@gmail.com abstract = This is an Isabelle/HOL formalisation of the semantics of the multi-valued planning tasks language that is used by the planning system Fast-Downward, the STRIPS fragment of the Planning Domain Definition Language (PDDL), and the STRIPS soundness meta-theory developed by Vladimir Lifschitz. It also contains formally verified checkers for checking the well-formedness of problems specified in either language as well the correctness of potential solutions. The formalisation in this entry was described in an earlier publication. [Verified_SAT_Based_AI_Planning] title = Verified SAT-Based AI Planning author = Mohammad Abdulaziz , Friedrich Kurz <> topic = Computer science/Artificial intelligence date = 2020-10-29 notify = mohammad.abdulaziz8@gmail.com abstract = We present an executable formally verified SAT encoding of classical AI planning that is based on the encodings by Kautz and Selman and the one by Rintanen et al. The encoding was experimentally tested and shown to be usable for reasonably sized standard AI planning benchmarks. We also use it as a reference to test a state-of-the-art SAT-based planner, showing that it sometimes falsely claims that problems have no solutions of certain lengths. The formalisation in this submission was described in an independent publication. [Gromov_Hyperbolicity] title = Gromov Hyperbolicity author = Sebastien Gouezel<> topic = Mathematics/Geometry date = 2018-01-16 notify = sebastien.gouezel@univ-rennes1.fr abstract = A geodesic metric space is Gromov hyperbolic if all its geodesic triangles are thin, i.e., every side is contained in a fixed thickening of the two other sides. While this definition looks innocuous, it has proved extremely important and versatile in modern geometry since its introduction by Gromov. We formalize the basic classical properties of Gromov hyperbolic spaces, notably the Morse lemma asserting that quasigeodesics are close to geodesics, the invariance of hyperbolicity under quasi-isometries, we define and study the Gromov boundary and its associated distance, and prove that a quasi-isometry between Gromov hyperbolic spaces extends to a homeomorphism of the boundaries. We also prove a less classical theorem, by Bonk and Schramm, asserting that a Gromov hyperbolic space embeds isometrically in a geodesic Gromov-hyperbolic space. As the original proof uses a transfinite sequence of Cauchy completions, this is an interesting formalization exercise. Along the way, we introduce basic material on isometries, quasi-isometries, Lipschitz maps, geodesic spaces, the Hausdorff distance, the Cauchy completion of a metric space, and the exponential on extended real numbers. [Ordered_Resolution_Prover] title = Formalization of Bachmair and Ganzinger's Ordered Resolution Prover author = Anders Schlichtkrull , 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 +notify = manuel@pruvisto.org abstract =

A Treap is a binary tree whose nodes contain pairs consisting of some payload and an associated priority. It must have the search-tree property w.r.t. the payloads and the heap property w.r.t. the priorities. Treaps are an interesting data structure that is related to binary search trees (BSTs) in the following way: if one forgets all the priorities of a treap, the resulting BST is exactly the same as if one had inserted the elements into an empty BST in order of ascending priority. This means that a treap behaves like a BST where we can pretend the elements were inserted in a different order from the one in which they were actually inserted.

In particular, by choosing these priorities at random upon insertion of an element, we can pretend that we inserted the elements in random order, so that the shape of the resulting tree is that of a random BST no matter in what order we insert the elements. This is the main result of this formalisation.

[Skip_Lists] title = Skip Lists -author = Max W. Haslbeck , Manuel Eberl +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 +author = Manuel Eberl topic = Mathematics/Number theory date = 2020-01-17 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This article provides formal proofs of basic properties of Mersenne numbers, i. e. numbers of the form 2n - 1, and especially of Mersenne primes.

In particular, an efficient, verified, and executable version of the Lucas–Lehmer test is developed. This test decides primality for Mersenne numbers in time polynomial in n.

[Hoare_Time] title = Hoare Logics for Time Bounds author = Maximilian P. L. Haslbeck , 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 +author = Felix Brandt , Manuel Eberl , Christian Saile , Christian Stricker topic = Mathematics/Games and economics date = 2018-03-22 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This formalisation contains the proof that there is no anonymous Social Choice Function for at least three agents and alternatives that fulfils both Pareto-Efficiency and Fishburn-Strategyproofness. It was derived from a proof of 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. extra-history = Change history: [2020-12-09]: moved Hoare logic to HOL-Hoare, moved spanning trees to Relational_Minimum_Spanning_Trees (revision dbb9bfaf4283) [Prime_Number_Theorem] title = The Prime Number Theorem -author = Manuel Eberl , Lawrence C. Paulson +author = Manuel Eberl , Lawrence C. Paulson topic = Mathematics/Number theory date = 2018-09-19 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This article provides a short proof of the Prime Number Theorem in several equivalent forms, most notably π(x) ~ x/ln x where π(x) is the number of primes no larger than x. It also defines other basic number-theoretic functions related to primes like Chebyshev's functions ϑ and ψ and the “n-th prime number” function pn. We also show various bounds and relationship between these functions are shown. Lastly, we derive Mertens' First and Second Theorem, i. e. ∑px ln p/p = ln x + O(1) and ∑px 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 ∑px 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 +notify = manuel@pruvisto.org abstract =

This article defines the combinatorial structures known as Independence Systems and Matroids and provides basic concepts and theorems related to them. These structures play an important role in combinatorial optimisation, e. g. greedy algorithms such as Kruskal's algorithm. The development is based on Oxley's `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. [Core_SC_DOM] title = The Safely Composable DOM author = Achim D. Brucker , Michael Herzberg topic = Computer science/Data structures date = 2020-09-28 notify = adbrucker@0x5f.org, mail@michael-herzberg.de abstract = In this AFP entry, we formalize the core of the Safely Composable Document Object Model (SC DOM). The SC DOM improve the standard DOM (as formalized in the AFP entry "Core DOM") by strengthening the tree boundaries set by shadow roots: in the SC DOM, the shadow root is a sub-class of the document class (instead of a base class). This modifications also results in changes to some API methods (e.g., getOwnerDocument) to return the nearest shadow root rather than the document root. As a result, many API methods that, when called on a node inside a shadow tree, would previously ``break out'' and return or modify nodes that are possibly outside the shadow tree, now stay within its boundaries. This change in behavior makes programs that operate on shadow trees more predictable for the developer and allows them to make more assumptions about other code accessing the DOM. [Shadow_SC_DOM] title = A Formal Model of the Safely Composable Document Object Model with Shadow Roots author = Achim D. Brucker , Michael Herzberg topic = Computer science/Data structures date = 2020-09-28 notify = adbrucker@0x5f.org, mail@michael-herzberg.de abstract = In this AFP entry, we extend our formalization of the safely composable DOM with Shadow Roots. This is a proposal for Shadow Roots with stricter safety guarantess than the standard compliant formalization (see "Shadow DOM"). Shadow Roots are a recent proposal of the web community to support a component-based development approach for client-side web applications. Shadow roots are a significant extension to the DOM standard and, as web standards are condemned to be backward compatible, such extensions often result in complex specification that may contain unwanted subtleties that can be detected by a formalization. Our Isabelle/HOL formalization is, in the sense of object-orientation, an extension of our formalization of the core DOM and enjoys the same basic properties, i.e., it is extensible, i.e., can be extended without the need of re-proving already proven properties and executable, i.e., we can generate executable code from our specification. We exploit the executability to show that our formalization complies to the official standard of the W3C, respectively, the WHATWG. [SC_DOM_Components] title = A Formalization of Safely Composable Web Components author = Achim D. Brucker , Michael Herzberg topic = Computer science/Data structures date = 2020-09-28 notify = adbrucker@0x5f.org, mail@michael-herzberg.de abstract = While the (safely composable) DOM with shadow trees provide the technical basis for defining web components, it does neither defines the concept of web components nor specifies the safety properties that web components should guarantee. Consequently, the standard also does not discuss how or even if the methods for modifying the DOM respect component boundaries. In AFP entry, we present a formally verified model of safely composable web components and define safety properties which ensure that different web components can only interact with each other using well-defined interfaces. Moreover, our verification of the application programming interface (API) of the DOM revealed numerous invariants that implementations of the DOM API need to preserve to ensure the integrity of components. In comparison to the strict standard compliance formalization of Web Components in the AFP entry "DOM_Components", the notion of components in this entry (based on "SC_DOM" and "Shadow_SC_DOM") provides much stronger safety guarantees. [Store_Buffer_Reduction] title = A Reduction Theorem for Store Buffers author = Ernie Cohen , 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 +author = Daniel Stüwe<>, Manuel Eberl topic = Mathematics/Number theory date = 2019-02-11 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

The most efficient known primality tests are probabilistic in the sense that they use randomness and may, with some probability, mistakenly classify a composite number as prime – but never a prime number as composite. Examples of this are the Miller–Rabin test, the Solovay–Strassen test, and (in most cases) Fermat's test.

This entry defines these three tests and proves their correctness. It also develops some of the number-theoretic foundations, such as Carmichael numbers and the Jacobi symbol with an efficient executable algorithm to compute it.

[Kruskal] title = Kruskal's Algorithm for Minimum Spanning Forest author = Maximilian P.L. Haslbeck , 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 +author = Manuel Eberl topic = Computer science/Algorithms date = 2019-02-01 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This entry defines the set of inversions of a list, i.e. the pairs of indices that violate sortedness. It also proves the correctness of the well-known O(n log n) divide-and-conquer algorithm to compute the number of inversions.

[Prime_Distribution_Elementary] title = Elementary Facts About the Distribution of Primes -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Number theory date = 2019-02-21 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org 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 an ITP'19 paper. [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. [BenOr_Kozen_Reif] title = The BKR Decision Procedure for Univariate Real Arithmetic author = Katherine Cordwell , Yong Kiam Tan , André Platzer topic = Computer science/Algorithms/Mathematical date = 2021-04-24 notify = kcordwel@cs.cmu.edu, yongkiat@cs.cmu.edu, aplatzer@cs.cmu.edu abstract = We formalize the univariate case of Ben-Or, Kozen, and Reif's decision procedure for first-order real arithmetic (the BKR algorithm). We also formalize the univariate case of Renegar's variation of the BKR algorithm. The two formalizations differ mathematically in minor ways (that have significant impact on the multivariate case), but are quite similar in proof structure. Both rely on sign-determination (finding the set of consistent sign assignments for a set of polynomials). The method used for sign-determination is similar to Tarski's original quantifier elimination algorithm (it stores key information in a matrix equation), but with a reduction step to keep complexity low. [Complete_Non_Orders] title = Complete Non-Orders and Fixed Points author = Akihisa Yamada , 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 = Order Extension and Szpilrajn's Extension Theorem author = Peter Zeller , Lukas Stevens topic = Mathematics/Order date = 2019-07-27 notify = p_zeller@cs.uni-kl.de abstract = This entry is concerned with the principle of order extension, i.e. the extension of an order relation to a total order relation. To this end, we prove a more general version of Szpilrajn's extension theorem employing terminology from the book "Consistency, Choice, and Rationality" by Bossert and Suzumura. We also formalize theorem 2.7 of their book. extra-history = Change history: [2021-03-22]: (by Lukas Stevens) generalise Szpilrajn's extension theorem and add material from the book "Consistency, Choice, and Rationality" [TESL_Language] title = A Formal Development of a Polychronous Polytimed Coordination Language author = Hai Nguyen Van , 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 +author = Manuel Eberl topic = Mathematics/Misc date = 2019-08-05 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This entry contains formalisations of the answers to three of the six problem of the International Mathematical Olympiad 2019, namely Q1, Q4, and Q5.

The reason why these problems were chosen is that they are particularly amenable to formalisation: they can be solved with minimal use of libraries. The remaining three concern geometry and graph theory, which, in the author's opinion, are more difficult to formalise resp. require a more complex library.

[Adaptive_State_Counting] title = Formalisation of an Adaptive State Counting Algorithm author = Robert Sachtleben 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. extra-history = Change history: [2020-12-13]: added components based on Kleene algebras with tests. These implement differential Hoare logic (dH) and a Morgan-style differential refinement calculus (dR) for verification of hybrid programs. [Generic_Join] title = Formalization of Multiway-Join Algorithms author = Thibault Dardinier<> topic = Computer science/Algorithms date = 2019-09-16 notify = tdardini@student.ethz.ch, traytel@inf.ethz.ch abstract = Worst-case optimal multiway-join algorithms are recent seminal achievement of the database community. These algorithms compute the natural join of multiple relational databases and improve in the worst case over traditional query plan optimizations of nested binary joins. In 2014, 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 +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.

Revisions made subsequent to the first version of this article added additional material on pseudofunctors, pseudonatural transformations, modifications, and equivalence of bicategories; the main thrust being to give a proof that a pseudofunctor is a biequivalence if and only if it can be extended to an equivalence of bicategories.

extra-history = Change history: [2020-02-15]: Move ConcreteCategory.thy from Bicategory to Category3 and use it systematically. Make other minor improvements throughout. (revision a51840d36867)
[2020-11-04]: Added new material on equivalence of bicategories, with associated changes. (revision 472cb2268826)
[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 +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 +author = Manuel Eberl topic = Mathematics/Algebra date = 2020-04-24 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

This article provides a formalisation of the symmetric multivariate polynomials known as power sum polynomials. These are of the form pn(X1,…, Xk) = X1n + … + Xkn. A formal proof of the Girard–Newton Theorem is also given. This theorem relates the power sum polynomials to the elementary symmetric polynomials sk in the form of a recurrence relation (-1)k k sk = ∑i∈[0,k) (-1)i si pk-i .

As an application, this is then used to solve a generalised form of a puzzle given as an exercise in Dummit and Foote's Abstract Algebra: For k complex unknowns x1, …, xk, define pj := x1j + … + xkj. Then for each vector a ∈ ℂk, show that there is exactly one solution to the system p1 = a1, …, pk = ak up to permutation of the xi and determine the value of pi for i>k.

[Formal_Puiseux_Series] title = Formal Puiseux Series -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Algebra date = 2021-02-17 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

Formal Puiseux series are generalisations of formal power series and formal Laurent series that also allow for fractional exponents. They have the following general form: \[\sum_{i=N}^\infty a_{i/d} X^{i/d}\] where N is an integer and d is a positive integer.

This entry defines these series including their basic algebraic properties. Furthermore, it proves the Newton–Puiseux Theorem, namely that the Puiseux series over an algebraically closed field of characteristic 0 are also algebraically closed.

[Gaussian_Integers] title = Gaussian Integers -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Number theory date = 2020-04-24 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

The Gaussian integers are the subring ℤ[i] of the complex numbers, i. e. the ring of all complex numbers with integral real and imaginary part. This article provides a definition of this ring as well as proofs of various basic properties, such as that they form a Euclidean ring and a full classification of their primes. An executable (albeit not very efficient) factorisation algorithm is also provided.

Lastly, this Gaussian integer formalisation is used in two short applications:

  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. [Delta_System_Lemma] title = Cofinality and the Delta System Lemma author = Pedro Sánchez Terraf topic = Mathematics/Combinatorics, Logic/Set theory date = 2020-12-27 notify = sterraf@famaf.unc.edu.ar abstract = We formalize the basic results on cofinality of linearly ordered sets and ordinals and Šanin’s Lemma for uncountable families of finite sets. This last result is used to prove the countable chain condition for Cohen posets. We work in the set theory framework of Isabelle/ZF, using the Axiom of Choice as needed. [Recursion-Addition] title = Recursion Theorem in ZF author = Georgy Dunaev 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 = 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 = 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 = We give a simple relation-algebraic semantics of read and write operations on associative arrays. The array operations seamlessly integrate with assignments in the Hoare-logic library. Using relation algebras and Kleene algebras we verify the correctness of an array-based implementation of disjoint-set forests with a naive union operation and a find operation with path compression. extra-history = Change history: [2021-06-19]: added path halving, path splitting, relational Peano structures, union by rank (revision 98c7aa03457d) [PAC_Checker] title = Practical Algebraic Calculus Checker author = Mathias Fleury , 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. [Extended_Finite_State_Machines] title = A Formal Model of Extended Finite State Machines author = Michael Foster , Achim D. Brucker , Ramsay G. Taylor , John Derrick topic = Computer science/Automata and formal languages date = 2020-09-07 notify = jmafoster1@sheffield.ac.uk, adbrucker@0x5f.org abstract = In this AFP entry, we provide a formalisation of extended finite state machines (EFSMs) where models are represented as finite sets of transitions between states. EFSMs execute traces to produce observable outputs. We also define various simulation and equality metrics for EFSMs in terms of traces and prove their strengths in relation to each other. Another key contribution is a framework of function definitions such that LTL properties can be phrased over EFSMs. Finally, we provide a simple example case study in the form of a drinks machine. [Extended_Finite_State_Machine_Inference] title = Inference of Extended Finite State Machines author = Michael Foster , Achim D. Brucker , Ramsay G. Taylor , John Derrick topic = Computer science/Automata and formal languages date = 2020-09-07 notify = jmafoster1@sheffield.ac.uk, adbrucker@0x5f.org abstract = In this AFP entry, we provide a formal implementation of a state-merging technique to infer extended finite state machines (EFSMs), complete with output and update functions, from black-box traces. In particular, we define the subsumption in context relation as a means of determining whether one transition is able to account for the behaviour of another. Building on this, we define the direct subsumption relation, which lifts the subsumption in context relation to EFSM level such that we can use it to determine whether it is safe to merge a given pair of transitions. Key proofs include the conditions necessary for subsumption to occur and that subsumption and direct subsumption are preorder relations. We also provide a number of different heuristics which can be used to abstract away concrete values into registers so that more states and transitions can be merged and provide proofs of the various conditions which must hold for these abstractions to subsume their ungeneralised counterparts. A Code Generator setup to create executable Scala code is also defined. [Physical_Quantities] title = A Sound Type System for Physical Quantities, Units, and Measurements author = Simon Foster , Burkhart Wolff topic = Mathematics/Physics, Computer science/Programming languages/Type systems date = 2020-10-20 notify = simon.foster@york.ac.uk, wolff@lri.fr abstract = The present Isabelle theory builds a formal model for both the International System of Quantities (ISQ) and the International System of Units (SI), which are both fundamental for physics and engineering. Both the ISQ and the SI are deeply integrated into Isabelle's type system. Quantities are parameterised by dimension types, which correspond to base vectors, and thus only quantities of the same dimension can be equated. Since the underlying "algebra of quantities" induces congruences on quantity and SI types, specific tactic support is developed to capture these. Our construction is validated by a test-set of known equivalences between both quantities and SI units. Moreover, the presented theory can be used for type-safe conversions between the SI system and others, like the British Imperial System (BIS). [Shadow_DOM] title = A Formal Model of the Document Object Model with Shadow Roots author = Achim D. Brucker , Michael Herzberg topic = Computer science/Data structures date = 2020-09-28 notify = adbrucker@0x5f.org, mail@michael-herzberg.de abstract = In this AFP entry, we extend our formalization of the core DOM with Shadow Roots. Shadow roots are a recent proposal of the web community to support a component-based development approach for client-side web applications. Shadow roots are a significant extension to the DOM standard and, as web standards are condemned to be backward compatible, such extensions often result in complex specification that may contain unwanted subtleties that can be detected by a formalization. Our Isabelle/HOL formalization is, in the sense of object-orientation, an extension of our formalization of the core DOM and enjoys the same basic properties, i.e., it is extensible, i.e., can be extended without the need of re-proving already proven properties and executable, i.e., we can generate executable code from our specification. We exploit the executability to show that our formalization complies to the official standard of the W3C, respectively, the WHATWG. [DOM_Components] title = A Formalization of Web Components author = Achim D. Brucker , Michael Herzberg topic = Computer science/Data structures date = 2020-09-28 notify = adbrucker@0x5f.org, mail@michael-herzberg.de abstract = While the DOM with shadow trees provide the technical basis for defining web components, the DOM standard neither defines the concept of web components nor specifies the safety properties that web components should guarantee. Consequently, the standard also does not discuss how or even if the methods for modifying the DOM respect component boundaries. In AFP entry, we present a formally verified model of web components and define safety properties which ensure that different web components can only interact with each other using well-defined interfaces. Moreover, our verification of the application programming interface (API) of the DOM revealed numerous invariants that implementations of the DOM API need to preserve to ensure the integrity of components. [Interpreter_Optimizations] title = Inline Caching and Unboxing Optimization for Interpreters author = Martin Desharnais topic = Computer science/Programming languages/Misc date = 2020-12-07 notify = martin.desharnais@unibw.de abstract = This Isabelle/HOL formalization builds on the VeriComp entry of the Archive of Formal Proofs to provide the following contributions:
  • an operational semantics for a realistic virtual machine (Std) for dynamically typed programming languages;
  • the formalization of an inline caching optimization (Inca), a proof of bisimulation with (Std), and a compilation function;
  • the formalization of an unboxing optimization (Ubx), a proof of bisimulation with (Inca), and a simple compilation function.
This formalization was described in the CPP 2021 paper Towards Efficient and Verified Virtual Machines for Dynamic Languages extra-history = Change history: [2021-06-14]: refactored function definitions to contain explicit basic blocks
[2021-06-25]: proved conditional completeness of compilation
[Isabelle_Marries_Dirac] title = Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information author = Anthony Bordg , Hanna Lachnitt, Yijun He topic = Computer science/Algorithms/Quantum computing, Mathematics/Physics/Quantum information date = 2020-11-22 notify = apdb3@cam.ac.uk, lachnitt@stanford.edu abstract = This work is an effort to formalise some quantum algorithms and results in quantum information theory. Formal methods being critical for the safety and security of algorithms and protocols, we foresee their widespread use for quantum computing in the future. We have developed a large library for quantum computing in Isabelle based on a matrix representation for quantum circuits, successfully formalising the no-cloning theorem, quantum teleportation, Deutsch's algorithm, the Deutsch-Jozsa algorithm and the quantum Prisoner's Dilemma. [Projective_Measurements] title = Quantum projective measurements and the CHSH inequality author = Mnacho Echenim topic = Computer science/Algorithms/Quantum computing, Mathematics/Physics/Quantum information date = 2021-03-03 notify = mnacho.echenim@univ-grenoble-alpes.fr abstract = This work contains a formalization of quantum projective measurements, also known as von Neumann measurements, which are based on elements of spectral theory. We also formalized the CHSH inequality, an inequality involving expectations in a probability space that is violated by quantum measurements, thus proving that quantum mechanics cannot be modeled with an underlying local hidden-variable theory. [Finite-Map-Extras] title = Finite Map Extras author = Javier Díaz topic = Computer science/Data structures date = 2020-10-12 notify = javier.diaz.manzi@gmail.com abstract = This entry includes useful syntactic sugar, new operators and functions, and their associated lemmas for finite maps which currently are not present in the standard Finite_Map theory. [Relational_Minimum_Spanning_Trees] title = Relational Minimum Spanning Tree Algorithms author = Walter Guttmann , Nicolas Robinson-O'Brien<> topic = Computer science/Algorithms/Graph date = 2020-12-08 notify = walter.guttmann@canterbury.ac.nz abstract = We verify the correctness of Prim's, Kruskal's and Borůvka's minimum spanning tree algorithms based on algebras for aggregation and minimisation. [Topological_Semantics] title = Topological semantics for paraconsistent and paracomplete logics author = David Fuenmayor topic = Logic/General logic date = 2020-12-17 notify = davfuenmayor@gmail.com abstract = We introduce a generalized topological semantics for paraconsistent and paracomplete logics by drawing upon early works on topological Boolean algebras (cf. works by Kuratowski, Zarycki, McKinsey & Tarski, etc.). In particular, this work exemplarily illustrates the shallow semantical embeddings approach (SSE) employing the proof assistant Isabelle/HOL. By means of the SSE technique we can effectively harness theorem provers, model finders and 'hammers' for reasoning with quantified non-classical logics. [CSP_RefTK] title = The HOL-CSP Refinement Toolkit author = Safouan Taha , Burkhart Wolff , Lina Ye topic = Computer science/Concurrency/Process calculi, Computer science/Semantics date = 2020-11-19 notify = wolff@lri.fr abstract = We use a formal development for CSP, called HOL-CSP2.0, to analyse a family of refinement notions, comprising classic and new ones. This analysis enables to derive a number of properties that allow to deepen the understanding of these notions, in particular with respect to specification decomposition principles for the case of infinite sets of events. The established relations between the refinement relations help to clarify some obscure points in the CSP literature, but also provide a weapon for shorter refinement proofs. Furthermore, we provide a framework for state-normalisation allowing to formally reason on parameterised process architectures. As a result, we have a modern environment for formal proofs of concurrent systems that allow for the combination of general infinite processes with locally finite ones in a logically safe way. We demonstrate these verification-techniques for classical, generalised examples: The CopyBuffer for arbitrary data and the Dijkstra's Dining Philosopher Problem of arbitrary size. [Hood_Melville_Queue] title = Hood-Melville Queue author = Alejandro Gómez-Londoño topic = Computer science/Data structures date = 2021-01-18 notify = nipkow@in.tum.de abstract = This is a verified implementation of a constant time queue. The original design is due to Hood and Melville. This formalization follows the presentation in Purely Functional Data Structuresby Okasaki. [JinjaDCI] title = JinjaDCI: a Java semantics with dynamic class initialization author = Susannah Mansky topic = Computer science/Programming languages/Language definitions date = 2021-01-11 notify = sjohnsn2@illinois.edu, susannahej@gmail.com abstract = We extend Jinja to include static fields, methods, and instructions, and dynamic class initialization, based on the Java SE 8 specification. This includes extension of definitions and proofs. This work is partially described in Mansky and Gunter's paper at CPP 2019 and Mansky's doctoral thesis (UIUC, 2020). [Blue_Eyes] title = Solution to the xkcd Blue Eyes puzzle author = Jakub Kądziołka topic = Logic/General logic/Logics of knowledge and belief date = 2021-01-30 notify = kuba@kadziolka.net abstract = In a puzzle published by Randall Munroe, perfect logicians forbidden from communicating are stranded on an island, and may only leave once they have figured out their own eye color. We present a method of modeling the behavior of perfect logicians and formalize a solution of the puzzle. [Laws_of_Large_Numbers] title = The Laws of Large Numbers -author = Manuel Eberl +author = Manuel Eberl topic = Mathematics/Probability theory date = 2021-02-10 -notify = eberlm@in.tum.de +notify = manuel@pruvisto.org abstract =

The Law of Large Numbers states that, informally, if one performs a random experiment $X$ many times and takes the average of the results, that average will be very close to the expected value $E[X]$.

More formally, let $(X_i)_{i\in\mathbb{N}}$ be a sequence of independently identically distributed random variables whose expected value $E[X_1]$ exists. Denote the running average of $X_1, \ldots, X_n$ as $\overline{X}_n$. Then:

  • The Weak Law of Large Numbers states that $\overline{X}_{n} \longrightarrow E[X_1]$ in probability for $n\to\infty$, i.e. $\mathcal{P}(|\overline{X}_{n} - E[X_1]| > \varepsilon) \longrightarrow 0$ as $n\to\infty$ for any $\varepsilon > 0$.
  • The Strong Law of Large Numbers states that $\overline{X}_{n} \longrightarrow E[X_1]$ almost surely for $n\to\infty$, i.e. $\mathcal{P}(\overline{X}_{n} \longrightarrow E[X_1]) = 1$.

In this entry, I formally prove the strong law and from it the weak law. The approach used for the proof of the strong law is a particularly quick and slick one based on ergodic theory, which was formalised by Gouëzel in another AFP entry.

[BTree] title = A Verified Imperative Implementation of B-Trees author = Niels Mündler topic = Computer science/Data structures date = 2021-02-24 notify = n.muendler@tum.de abstract = In this work, we use the interactive theorem prover Isabelle/HOL to verify an imperative implementation of the classical B-tree data structure invented by Bayer and McCreight [ACM 1970]. The implementation supports set membership, insertion and deletion queries with efficient binary search for intra-node navigation. This is accomplished by first specifying the structure abstractly in the functional modeling language HOL and proving functional correctness. Using manual refinement, we derive an imperative implementation in Imperative/HOL. We show the validity of this refinement using the separation logic utilities from the Isabelle Refinement Framework . The code can be exported to the programming languages SML, OCaml and Scala. We examine the runtime of all operations indirectly by reproducing results of the logarithmic relationship between height and the number of nodes. The results are discussed in greater detail in the corresponding Bachelor's Thesis. extra-history = Change history: [2021-05-02]: Add implementation and proof of correctness of imperative deletion operations. Further add the option to export code to OCaml.
[Sunflowers] title = The Sunflower Lemma of Erdős and Rado author = René Thiemann topic = Mathematics/Combinatorics date = 2021-02-25 notify = rene.thiemann@uibk.ac.at abstract = We formally define sunflowers and provide a formalization of the sunflower lemma of Erdős and Rado: whenever a set of size-k-sets has a larger cardinality than (r - 1)k · k!, then it contains a sunflower of cardinality r. [Mereology] title = Mereology author = Ben Blumson topic = Logic/Philosophical aspects date = 2021-03-01 notify = benblumson@gmail.com abstract = We use Isabelle/HOL to verify elementary theorems and alternative axiomatizations of classical extensional mereology. [Modular_arithmetic_LLL_and_HNF_algorithms] title = Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation author = Ralph Bottesch <>, Jose Divasón , René Thiemann topic = Computer science/Algorithms/Mathematical date = 2021-03-12 notify = rene.thiemann@uibk.ac.at abstract = We verify two algorithms for which modular arithmetic plays an essential role: Storjohann's variant of the LLL lattice basis reduction algorithm and Kopparty's algorithm for computing the Hermite normal form of a matrix. To do this, we also formalize some facts about the modulo operation with symmetric range. Our implementations are based on the original papers, but are otherwise efficient. For basis reduction we formalize two versions: one that includes all of the optimizations/heuristics from Storjohann's paper, and one excluding a heuristic that we observed to often decrease efficiency. We also provide a fast, self-contained certifier for basis reduction, based on the efficient Hermite normal form algorithm. [Constructive_Cryptography_CM] title = Constructive Cryptography in HOL: the Communication Modeling Aspect author = Andreas Lochbihler , S. Reza Sefidgar <> topic = Computer science/Security/Cryptography, Mathematics/Probability theory date = 2021-03-17 notify = mail@andreas-lochbihler.de, reza.sefidgar@inf.ethz.ch abstract = Constructive Cryptography (CC) [ICS 2011, TOSCA 2011, TCC 2016] introduces an abstract approach to composable security statements that allows one to focus on a particular aspect of security proofs at a time. Instead of proving the properties of concrete systems, CC studies system classes, i.e., the shared behavior of similar systems, and their transformations. Modeling of systems communication plays a crucial role in composability and reusability of security statements; yet, this aspect has not been studied in any of the existing CC results. We extend our previous CC formalization [Constructive_Cryptography, CSF 2019] with a new semantic domain called Fused Resource Templates (FRT) that abstracts over the systems communication patterns in CC proofs. This widens the scope of cryptography proof formalizations in the CryptHOL library [CryptHOL, ESOP 2016, J Cryptol 2020]. This formalization is described in Abstract Modeling of Systems Communication in Constructive Cryptography using CryptHOL. [IFC_Tracking] title = Information Flow Control via Dependency Tracking author = Benedikt Nordhoff topic = Computer science/Security date = 2021-04-01 notify = b.n@wwu.de abstract = We provide a characterisation of how information is propagated by program executions based on the tracking data and control dependencies within executions themselves. The characterisation might be used for deriving approximative safety properties to be targeted by static analyses or checked at runtime. We utilise a simple yet versatile control flow graph model as a program representation. As our model is not assumed to be finite it can be instantiated for a broad class of programs. The targeted security property is indistinguishable security where executions produce sequences of observations and only non-terminating executions are allowed to drop a tail of those. A very crude approximation of our characterisation is slicing based on program dependence graphs, which we use as a minimal example and derive a corresponding soundness result. For further details and applications refer to the authors upcoming dissertation. [Grothendieck_Schemes] title = Grothendieck's Schemes in Algebraic Geometry author = Anthony Bordg , Lawrence Paulson , Wenda Li topic = Mathematics/Algebra, Mathematics/Geometry date = 2021-03-29 notify = apdb3@cam.ac.uk, lp15@cam.ac.uk abstract = We formalize mainstream structures in algebraic geometry culminating in Grothendieck's schemes: presheaves of rings, sheaves of rings, ringed spaces, locally ringed spaces, affine schemes and schemes. We prove that the spectrum of a ring is a locally ringed space, hence an affine scheme. Finally, we prove that any affine scheme is a scheme. [Progress_Tracking] title = Formalization of Timely Dataflow's Progress Tracking Protocol author = Matthias Brun<>, Sára Decova<>, Andrea Lattuada, Dmitriy Traytel topic = Computer science/Algorithms/Distributed date = 2021-04-13 notify = matthias.brun@inf.ethz.ch, traytel@di.ku.dk abstract = Large-scale stream processing systems often follow the dataflow paradigm, which enforces a program structure that exposes a high degree of parallelism. The Timely Dataflow distributed system supports expressive cyclic dataflows for which it offers low-latency data- and pipeline-parallel stream processing. To achieve high expressiveness and performance, Timely Dataflow uses an intricate distributed protocol for tracking the computation’s progress. We formalize this progress tracking protocol and verify its safety. Our formalization is described in detail in our forthcoming ITP'21 paper. [GaleStewart_Games] title = Gale-Stewart Games author = Sebastiaan Joosten topic = Mathematics/Games and economics date = 2021-04-23 notify = sjcjoosten@gmail.com abstract = This is a formalisation of the main result of Gale and Stewart from 1953, showing that closed finite games are determined. This property is now known as the Gale Stewart Theorem. While the original paper shows some additional theorems as well, we only formalize this main result, but do so in a somewhat general way. We formalize games of a fixed arbitrary length, including infinite length, using co-inductive lists, and show that defensive strategies exist unless the other player is winning. For closed games, defensive strategies are winning for the closed player, proving that such games are determined. For finite games, which are a special case in our formalisation, all games are closed. [Metalogic_ProofChecker] title = Isabelle's Metalogic: Formalization and Proof Checker author = Tobias Nipkow , Simon Roßkopf topic = Logic/General logic date = 2021-04-27 notify = rosskops@in.tum.de abstract = In this entry we formalize Isabelle's metalogic in Isabelle/HOL. Furthermore, we define a language of proof terms and an executable proof checker and prove its soundness wrt. the metalogic. The formalization is intentionally kept close to the Isabelle implementation(for example using de Brujin indices) to enable easy integration of generated code with the Isabelle system without a complicated translation layer. The formalization is described in our CADE 28 paper. [Regression_Test_Selection] title = Regression Test Selection author = Susannah Mansky topic = Computer science/Algorithms date = 2021-04-30 notify = sjohnsn2@illinois.edu, susannahej@gmail.com abstract = This development provides a general definition for safe Regression Test Selection (RTS) algorithms. RTS algorithms select which tests to rerun on revised code, reducing the time required to check for newly introduced errors. An RTS algorithm is considered safe if and only if all deselected tests would have unchanged results. This definition is instantiated with two class-collection-based RTS algorithms run over the JVM as modeled by JinjaDCI. This is achieved with a general definition for Collection Semantics, small-step semantics instrumented to collect information during execution. As the RTS definition mandates safety, these instantiations include proofs of safety. This work is described in Mansky and Gunter's LSFA 2020 paper and Mansky's doctoral thesis (UIUC, 2020). [Padic_Ints] title = Hensel's Lemma for the p-adic Integers author = Aaron Crighton topic = Mathematics/Number theory date = 2021-03-23 notify = crightoa@mcmaster.ca abstract = We formalize the ring of p-adic integers within the framework of the HOL-Algebra library. The carrier of the ring is formalized as the inverse limit of quotients of the integers by powers of a fixed prime p. We define an integer-valued valuation, as well as an extended-integer valued valuation which sends 0 to the infinite element. Basic topological facts about the p-adic integers are formalized, including completeness and sequential compactness. Taylor expansions of polynomials over a commutative ring are defined, culminating in the formalization of Hensel's Lemma based on a proof due to Keith Conrad. [Combinatorics_Words] title = Combinatorics on Words Basics author = Štěpán Holub , Martin Raška<>, Štěpán Starosta topic = Computer science/Automata and formal languages date = 2021-05-24 notify = holub@karlin.mff.cuni.cz, stepan.starosta@fit.cvut.cz abstract = We formalize basics of Combinatorics on Words. This is an extension of existing theories on lists. We provide additional properties related to prefix, suffix, factor, length and rotation. The topics include prefix and suffix comparability, mismatch, word power, total and reversed morphisms, border, periods, primitivity and roots. We also formalize basic, mostly folklore results related to word equations: equidivisibility, commutation and conjugation. Slightly advanced properties include the Periodicity lemma (often cited as the Fine and Wilf theorem) and the variant of the Lyndon-Schützenberger theorem for words. We support the algebraic point of view which sees words as generators of submonoids of a free monoid. This leads to the concepts of the (free) hull, the (free) basis (or code). [Combinatorics_Words_Lyndon] title = Lyndon words author = Štěpán Holub , Štěpán Starosta topic = Computer science/Automata and formal languages date = 2021-05-24 notify = holub@karlin.mff.cuni.cz, stepan.starosta@fit.cvut.cz abstract = Lyndon words are words lexicographically minimal in their conjugacy class. We formalize their basic properties and characterizations, in particular the concepts of the longest Lyndon suffix and the Lyndon factorization. Most of the work assumes a fixed lexicographical order. Nevertheless we also define the smallest relation guaranteeing lexicographical minimality of a given word (in its conjugacy class). [Combinatorics_Words_Graph_Lemma] title = Graph Lemma author = Štěpán Holub , Štěpán Starosta topic = Computer science/Automata and formal languages date = 2021-05-24 notify = holub@karlin.mff.cuni.cz, stepan.starosta@fit.cvut.cz abstract = Graph lemma quantifies the defect effect of a system of word equations. That is, it provides an upper bound on the rank of the system. We formalize the proof based on the decomposition of a solution into its free basis. A direct application is an alternative proof of the fact that two noncommuting words form a code. [Lifting_the_Exponent] title = Lifting the Exponent author = Jakub Kądziołka topic = Mathematics/Number theory date = 2021-04-27 notify = kuba@kadziolka.net abstract = We formalize the Lifting the Exponent Lemma, which shows how to find the largest power of $p$ dividing $a^n \pm b^n$, for a prime $p$ and positive integers $a$ and $b$. The proof follows Amir Hossein Parvardi's. [IMP_Compiler] title = A Shorter Compiler Correctness Proof for Language IMP author = Pasquale Noce topic = Computer science/Programming languages/Compiling date = 2021-06-04 notify = pasquale.noce.lavoro@gmail.com abstract = This paper presents a compiler correctness proof for the didactic imperative programming language IMP, introduced in Nipkow and Klein's book on formal programming language semantics (version of March 2021), whose size is just two thirds of the book's proof in the number of formal text lines. As such, it promises to constitute a further enhanced reference for the formal verification of compilers meant for larger, real-world programming languages. The presented proof does not depend on language determinism, so that the proposed approach can be applied to non-deterministic languages as well. As a confirmation, this paper extends IMP with an additional non-deterministic choice command, and proves compiler correctness, viz. the simulation of compiled code execution by source code, for such extended language. [Public_Announcement_Logic] title = Public Announcement Logic author = Asta Halkjær From topic = Logic/General logic/Logics of knowledge and belief date = 2021-06-17 notify = ahfrom@dtu.dk abstract = This work is a formalization of public announcement logic with countably many agents. It includes proofs of soundness and completeness for a variant of the axiom system PA + DIST! + NEC!. The completeness proof builds on the Epistemic Logic theory. [MiniSail] title = MiniSail - A kernel language for the ISA specification language SAIL author = Mark Wassell topic = Computer science/Programming languages/Type systems date = 2021-06-18 notify = mpwassell@gmail.com abstract = MiniSail is a kernel language for Sail, an instruction set architecture (ISA) specification language. Sail is an imperative language with a light-weight dependent type system similar to refinement type systems. From an ISA specification, the Sail compiler can generate theorem prover code and C (or OCaml) to give an executable emulator for an architecture. The idea behind MiniSail is to capture the key and novel features of Sail in terms of their syntax, typing rules and operational semantics, and to confirm that they work together by proving progress and preservation lemmas. We use the Nominal2 library to handle binding. [SpecCheck] title = SpecCheck - Specification-Based Testing for Isabelle/ML author = Kevin Kappelmann , Lukas Bulwahn , Sebastian Willenbrink topic = Tools date = 2021-07-01 notify = kevin.kappelmann@tum.de abstract = SpecCheck is a QuickCheck-like testing framework for Isabelle/ML. You can use it to write specifications for ML functions. SpecCheck then checks whether your specification holds by testing your function against a given number of generated inputs. It helps you to identify bugs by printing counterexamples on failure and provides you timing information. SpecCheck is customisable and allows you to specify your own input generators, test output formats, as well as pretty printers and shrinking functions for counterexamples among other things. [Relational_Forests] title = Relational Forests author = Walter Guttmann topic = Mathematics/Graph theory date = 2021-08-03 notify = walter.guttmann@canterbury.ac.nz abstract = We study second-order formalisations of graph properties expressed as first-order formulas in relation algebras extended with a Kleene star. The formulas quantify over relations while still avoiding quantification over elements of the base set. We formalise the property of undirected graphs being acyclic this way. This involves a study of various kinds of orientation of graphs. We also verify basic algorithms to constructively prove several second-order properties. [Fresh_Identifiers] title = Fresh identifiers author = Andrei Popescu , Thomas Bauereiss topic = Computer science/Data structures date = 2021-08-16 notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk abstract = This entry defines a type class with an operator returning a fresh identifier, given a set of already used identifiers and a preferred identifier. The entry provides a default instantiation for any infinite type, as well as executable instantiations for natural numbers and strings. [CoCon] title = CoCon: A Confidentiality-Verified Conference Management System author = Andrei Popescu , Peter Lammich , Thomas Bauereiss topic = Computer science/Security date = 2021-08-16 notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk abstract = This entry contains the confidentiality verification of the (functional kernel of) the CoCon conference management system [1, 2]. The confidentiality properties refer to the documents managed by the system, namely papers, reviews, discussion logs and acceptance/rejection decisions, and also to the assignment of reviewers to papers. They have all been formulated as instances of BD Security [3, 4] and verified using the BD Security unwinding technique. [BD_Security_Compositional] title = Compositional BD Security author = Thomas Bauereiss , Andrei Popescu topic = Computer science/Security date = 2021-08-16 notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk abstract = Building on a previous AFP entry that formalizes the Bounded-Deducibility Security (BD Security) framework [1], we formalize compositionality and transport theorems for information flow security. These results allow lifting BD Security properties from individual components specified as transition systems, to a composition of systems specified as communicating products of transition systems. The underlying ideas of these results are presented in the papers [1] and [2]. The latter paper also describes a major case study where these results have been used: on verifying the CoSMeDis distributed social media platform (itself formalized as an AFP entry that builds on this entry). [CoSMed] title = CoSMed: A confidentiality-verified social media platform author = Thomas Bauereiss , Andrei Popescu topic = Computer science/Security date = 2021-08-16 notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk abstract = This entry contains the confidentiality verification of the (functional kernel of) the CoSMed social media platform. The confidentiality properties are formalized as instances of BD Security [1, 2]. An innovation in the deployment of BD Security compared to previous work is the use of dynamic declassification triggers, incorporated as part of inductive bounds, for providing stronger guarantees that account for the repeated opening and closing of access windows. To further strengthen the confidentiality guarantees, we also prove "traceback" properties about the accessibility decisions affecting the information managed by the system. [CoSMeDis] title = CoSMeDis: A confidentiality-verified distributed social media platform author = Thomas Bauereiss , Andrei Popescu topic = Computer science/Security date = 2021-08-16 notify = thomas@bauereiss.name, a.popescu@sheffield.ac.uk abstract = This entry contains the confidentiality verification of the (functional kernel of) the CoSMeDis distributed social media platform presented in [1]. CoSMeDis is a multi-node extension the CoSMed prototype social media platform [2, 3, 4]. The confidentiality properties are formalized as instances of BD Security [5, 6]. The lifting of confidentiality properties from single nodes to the entire CoSMeDis network is performed using compositionality and transport theorems for BD Security, which are described in [1] and formalized in a separate AFP entry. [Three_Circles] title = The Theorem of Three Circles author = Fox Thomson , Wenda Li topic = Mathematics/Analysis date = 2021-08-21 notify = foxthomson0@gmail.com, wl302@cam.ac.uk abstract = The Descartes test based on Bernstein coefficients and Descartes’ rule of signs effectively (over-)approximates the number of real roots of a univariate polynomial over an interval. In this entry we formalise the theorem of three circles, which gives sufficient conditions for when the Descartes test returns 0 or 1. This is the first step for efficient root isolation. [Design_Theory] title = Combinatorial Design Theory author = Chelsea Edmonds , Lawrence Paulson topic = Mathematics/Combinatorics date = 2021-08-13 notify = cle47@cam.ac.uk abstract = Combinatorial design theory studies incidence set systems with certain balance and symmetry properties. It is closely related to hypergraph theory. This formalisation presents a general library for formal reasoning on incidence set systems, designs and their applications, including formal definitions and proofs for many key properties, operations, and theorems on the construction and existence of designs. Notably, this includes formalising t-designs, balanced incomplete block designs (BIBD), group divisible designs (GDD), pairwise balanced designs (PBD), design isomorphisms, and the relationship between graphs and designs. A locale-centric approach has been used to manage the relationships between the many different types of designs. Theorems of particular interest include the necessary conditions for existence of a BIBD, Wilson's construction on GDDs, and Bose's inequality on resolvable designs. Parts of this formalisation are explored in the paper "A Modular First Formalisation of Combinatorial Design Theory", presented at CICM 2021. [Logging_Independent_Anonymity] title = Logging-independent Message Anonymity in the Relational Method author = Pasquale Noce topic = Computer science/Security date = 2021-08-26 notify = pasquale.noce.lavoro@gmail.com abstract = In the context of formal cryptographic protocol verification, logging-independent message anonymity is the property for a given message to remain anonymous despite the attacker's capability of mapping messages of that sort to agents based on some intrinsic feature of such messages, rather than by logging the messages exchanged by legitimate agents as with logging-dependent message anonymity. This paper illustrates how logging-independent message anonymity can be formalized according to the relational method for formal protocol verification by considering a real-world protocol, namely the Restricted Identification one by the BSI. This sample model is used to verify that the pseudonymous identifiers output by user identification tokens remain anonymous under the expected conditions. [Dominance_CHK] title = A data flow analysis algorithm for computing dominators author = Nan Jiang<> topic = Computer science/Programming languages/Static analysis date = 2021-09-05 notify = nanjiang@whu.edu.cn abstract = This entry formalises the fast iterative algorithm for computing dominators due to Cooper, Harvey and Kennedy. It gives a specification of computing dominators on a control flow graph where each node refers to its reverse post order number. A semilattice of reversed-ordered list which represents dominators is built and a Kildall-style algorithm on the semilattice is defined for computing dominators. Finally the soundness and completeness of the algorithm are proved w.r.t. the specification. [Conditional_Simplification] title = Conditional Simplification author = Mihails Milehins topic = Tools date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = The article provides a collection of experimental general-purpose proof methods for the object logic Isabelle/HOL of the formal proof assistant Isabelle. The methods in the collection offer functionality that is similar to certain aspects of the functionality provided by the standard proof methods of Isabelle that combine classical reasoning and rewriting, such as the method auto, but use a different approach for rewriting. More specifically, these methods allow for the side conditions of the rewrite rules to be solved via intro-resolution. [Intro_Dest_Elim] title = IDE: Introduction, Destruction, Elimination author = Mihails Milehins topic = Tools date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = The article provides the command mk_ide for the object logic Isabelle/HOL of the formal proof assistant Isabelle. The command mk_ide enables the automated synthesis of the introduction, destruction and elimination rules from arbitrary definitions of constant predicates stated in Isabelle/HOL. [CZH_Foundations] title = Category Theory for ZFC in HOL I: Foundations: Design Patterns, Set Theory, Digraphs, Semicategories author = Mihails Milehins topic = Mathematics/Category theory, Logic/Set theory date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = This article provides a foundational framework for the formalization of category theory in the object logic ZFC in HOL of the formal proof assistant Isabelle. More specifically, this article provides a formalization of canonical set-theoretic constructions internalized in the type V associated with the ZFC in HOL, establishes a design pattern for the formalization of mathematical structures using sequences and locales, and showcases the developed infrastructure by providing formalizations of the elementary theories of digraphs and semicategories. The methodology chosen for the formalization of the theories of digraphs and semicategories (and categories in future articles) rests on the ideas that were originally expressed in the article Set-Theoretical Foundations of Category Theory written by Solomon Feferman and Georg Kreisel. Thus, in the context of this work, each of the aforementioned mathematical structures is represented as a term of the type V embedded into a stage of the von Neumann hierarchy. [CZH_Elementary_Categories] title = Category Theory for ZFC in HOL II: Elementary Theory of 1-Categories author = Mihails Milehins topic = Mathematics/Category theory date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = This article provides a formalization of the foundations of the theory of 1-categories in the object logic ZFC in HOL of the formal proof assistant Isabelle. The article builds upon the foundations that were established in the AFP entry Category Theory for ZFC in HOL I: Foundations: Design Patterns, Set Theory, Digraphs, Semicategories. [CZH_Universal_Constructions] title = Category Theory for ZFC in HOL III: Universal Constructions author = Mihails Milehins topic = Mathematics/Category theory date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = The article provides a formalization of elements of the theory of universal constructions for 1-categories (such as limits, adjoints and Kan extensions) in the object logic ZFC in HOL of the formal proof assistant Isabelle. The article builds upon the foundations established in the AFP entry Category Theory for ZFC in HOL II: Elementary Theory of 1-Categories. [Conditional_Transfer_Rule] title = Conditional Transfer Rule author = Mihails Milehins topic = Tools date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = This article provides a collection of experimental utilities for unoverloading of definitions and synthesis of conditional transfer rules for the object logic Isabelle/HOL of the formal proof assistant Isabelle written in Isabelle/ML. [Types_To_Sets_Extension] title = Extension of Types-To-Sets author = Mihails Milehins topic = Tools date = 2021-09-06 notify = mihailsmilehins@gmail.com abstract = In their article titled From Types to Sets by Local Type Definitions in Higher-Order Logic and published in the proceedings of the conference Interactive Theorem Proving in 2016, Ondřej Kunčar and Andrei Popescu propose an extension of the logic Isabelle/HOL and an associated algorithm for the relativization of the type-based theorems to more flexible set-based theorems, collectively referred to as Types-To-Sets. One of the aims of their work was to open an opportunity for the development of a software tool for applied relativization in the implementation of the logic Isabelle/HOL of the proof assistant Isabelle. In this article, we provide a prototype of a software framework for the interactive automated relativization of theorems in Isabelle/HOL, developed as an extension of the proof language Isabelle/Isar. The software framework incorporates the implementation of the proposed extension of the logic, and builds upon some of the ideas for further work expressed in the original article on Types-To-Sets by Ondřej Kunčar and Andrei Popescu and the subsequent article Smooth Manifolds and Types to Sets for Linear Algebra in Isabelle/HOL that was written by Fabian Immler and Bohua Zhan and published in the proceedings of the International Conference on Certified Programs and Proofs in 2019. [Complex_Bounded_Operators] title = Complex Bounded Operators author = Jose Manuel Rodriguez Caballero , Dominique Unruh topic = Mathematics/Analysis date = 2021-09-18 notify = unruh@ut.ee abstract = We present a formalization of bounded operators on complex vector spaces. Our formalization contains material on complex vector spaces (normed spaces, Banach spaces, Hilbert spaces) that complements and goes beyond the developments of real vectors spaces in the Isabelle/HOL standard library. We define the type of bounded operators between complex vector spaces (cblinfun) and develop the theory of unitaries, projectors, extension of bounded linear functions (BLT theorem), adjoints, Loewner order, closed subspaces and more. For the finite-dimensional case, we provide code generation support by identifying finite-dimensional operators with matrices as formalized in the Jordan_Normal_Form AFP entry. [Weighted_Path_Order] title = A Formalization of Weighted Path Orders and Recursive Path Orders author = Christian Sternagel , René Thiemann , Akihisa Yamada topic = Logic/Rewriting date = 2021-09-16 notify = rene.thiemann@uibk.ac.at abstract = We define the weighted path order (WPO) and formalize several properties such as strong normalization, the subterm property, and closure properties under substitutions and contexts. Our definition of WPO extends the original definition by also permitting multiset comparisons of arguments instead of just lexicographic extensions. Therefore, our WPO not only subsumes lexicographic path orders (LPO), but also recursive path orders (RPO). We formally prove these subsumptions and therefore all of the mentioned properties of WPO are automatically transferable to LPO and RPO as well. Such a transformation is not required for Knuth–Bendix orders (KBO), since they have already been formalized. Nevertheless, we still provide a proof that WPO subsumes KBO and thereby underline the generality of WPO. [FOL_Axiomatic] title = Soundness and Completeness of an Axiomatic System for First-Order Logic author = Asta Halkjær From topic = Logic/General logic/Classical first-order logic, Logic/Proof theory date = 2021-09-24 notify = ahfrom@dtu.dk abstract = This work is a formalization of the soundness and completeness of an axiomatic system for first-order logic. The proof system is based on System Q1 by Smullyan and the completeness proof follows his textbook "First-Order Logic" (Springer-Verlag 1968). The completeness proof is in the Henkin style where a consistent set is extended to a maximal consistent set using Lindenbaum's construction and Henkin witnesses are added during the construction to ensure saturation as well. The resulting set is a Hintikka set which, by the model existence theorem, is satisfiable in the Herbrand universe. [Virtual_Substitution] title = Verified Quadratic Virtual Substitution for Real Arithmetic author = Matias Scharager , Katherine Cordwell , Stefan Mitsch , André Platzer topic = Computer science/Algorithms/Mathematical date = 2021-10-02 notify = mscharag@cs.cmu.edu, kcordwel@cs.cmu.edu, smitsch@cs.cmu.edu, aplatzer@cs.cmu.edu abstract = This paper presents a formally verified quantifier elimination (QE) algorithm for first-order real arithmetic by linear and quadratic virtual substitution (VS) in Isabelle/HOL. The Tarski-Seidenberg theorem established that the first-order logic of real arithmetic is decidable by QE. However, in practice, QE algorithms are highly complicated and often combine multiple methods for performance. VS is a practically successful method for QE that targets formulas with low-degree polynomials. To our knowledge, this is the first work to formalize VS for quadratic real arithmetic including inequalities. The proofs necessitate various contributions to the existing multivariate polynomial libraries in Isabelle/HOL. Our framework is modularized and easily expandable (to facilitate integrating future optimizations), and could serve as a basis for developing practical general-purpose QE algorithms. Further, as our formalization is designed with practicality in mind, we export our development to SML and test the resulting code on 378 benchmarks from the literature, comparing to Redlog, Z3, Wolfram Engine, and SMT-RAT. This identified inconsistencies in some tools, underscoring the significance of a verified approach for the intricacies of real arithmetic. diff --git a/thys/Akra_Bazzi/Akra_Bazzi.thy b/thys/Akra_Bazzi/Akra_Bazzi.thy --- a/thys/Akra_Bazzi/Akra_Bazzi.thy +++ b/thys/Akra_Bazzi/Akra_Bazzi.thy @@ -1,1033 +1,1033 @@ (* File: Akra_Bazzi.thy - Author: Manuel Eberl + Author: Manuel Eberl The Akra-Bazzi theorem for functions on the naturals. *) section \The discrete Akra-Bazzi theorem\ theory Akra_Bazzi imports Complex_Main "HOL-Library.Landau_Symbols" Akra_Bazzi_Real begin lemma ex_mono: "(\x. P x) \ (\x. P x \ Q x) \ (\x. Q x)" by blast lemma x_over_ln_mono: assumes "(e::real) > 0" assumes "x > exp e" assumes "x \ y" shows "x / ln x powr e \ y / ln y powr e" proof (rule DERIV_nonneg_imp_mono[of _ _ "\x. x / ln x powr e"]) fix t assume t: "t \ {x..y}" from assms(1) have "1 < exp e" by simp from this and assms(2) have "x > 1" by (rule less_trans) with t have t': "t > 1" by simp from \x > exp e\ and t have "t > exp e" by simp with t' have "ln t > ln (exp e)" by (subst ln_less_cancel_iff) simp_all hence t'': "ln t > e" by simp show "((\x. x / ln x powr e) has_real_derivative (ln t - e) / ln t powr (e+1)) (at t)" using assms t t' t'' by (force intro!: derivative_eq_intros simp: powr_diff field_simps powr_add) from t'' show "(ln t - e) / ln t powr (e + 1) \ 0" by (intro divide_nonneg_nonneg) simp_all qed (simp_all add: assms) definition akra_bazzi_term :: "nat \ nat \ real \ (nat \ nat) \ bool" where "akra_bazzi_term x\<^sub>0 x\<^sub>1 b t = (\e h. e > 0 \ (\x. h x) \ O(\x. real x / ln (real x) powr (1+e)) \ (\x\x\<^sub>1. t x \ x\<^sub>0 \ t x < x \ b*x + h x = real (t x)))" lemma akra_bazzi_termI [intro?]: assumes "e > 0" "(\x. h x) \ O(\x. real x / ln (real x) powr (1+e))" "\x. x \ x\<^sub>1 \ t x \ x\<^sub>0" "\x. x \ x\<^sub>1 \ t x < x" "\x. x \ x\<^sub>1 \ b*x + h x = real (t x)" shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b t" using assms unfolding akra_bazzi_term_def by blast lemma akra_bazzi_term_imp_less: assumes "akra_bazzi_term x\<^sub>0 x\<^sub>1 b t" "x \ x\<^sub>1" shows "t x < x" using assms unfolding akra_bazzi_term_def by blast lemma akra_bazzi_term_imp_less': assumes "akra_bazzi_term x\<^sub>0 (Suc x\<^sub>1) b t" "x > x\<^sub>1" shows "t x < x" using assms unfolding akra_bazzi_term_def by force locale akra_bazzi_recursion = fixes x\<^sub>0 x\<^sub>1 k :: nat and as bs :: "real list" and ts :: "(nat \ nat) list" and f :: "nat \ real" assumes k_not_0: "k \ 0" and length_as: "length as = k" and length_bs: "length bs = k" and length_ts: "length ts = k" and a_ge_0: "a \ set as \ a \ 0" and b_bounds: "b \ set bs \ b \ {0<..<1}" and ts: "i < length bs \ akra_bazzi_term x\<^sub>0 x\<^sub>1 (bs!i) (ts!i)" begin sublocale akra_bazzi_params k as bs using length_as length_bs k_not_0 a_ge_0 b_bounds by unfold_locales lemma ts_nonempty: "ts \ []" using length_ts k_not_0 by (cases ts) simp_all definition e_hs :: "real \ (nat \ real) list" where "e_hs = (SOME (e,hs). e > 0 \ length hs = k \ (\h\set hs. (\x. h x) \ O(\x. real x / ln (real x) powr (1+e))) \ (\t\set ts. \x\x\<^sub>1. t x \ x\<^sub>0 \ t x < x) \ (\ix\x\<^sub>1. (bs!i)*x + (hs!i) x = real ((ts!i) x)) )" definition "e = (case e_hs of (e,_) \ e)" definition "hs = (case e_hs of (_,hs) \ hs)" lemma filterlim_powr_zero_cong: "filterlim (\x. P (x::real) (x powr (0::real))) F at_top = filterlim (\x. P x 1) F at_top" apply (rule filterlim_cong[OF refl refl]) using eventually_gt_at_top[of "0::real"] by eventually_elim simp_all lemma e_hs_aux: "0 < e \ length hs = k \ (\h\set hs. (\x. h x) \ O(\x. real x / ln (real x) powr (1 + e))) \ (\t\set ts. \x\x\<^sub>1. x\<^sub>0 \ t x \ t x < x) \ (\ix\x\<^sub>1. (bs!i)*x + (hs!i) x = real ((ts!i) x))" proof- have "Ex (\(e,hs). e > 0 \ length hs = k \ (\h\set hs. (\x. h x) \ O(\x. real x / ln (real x) powr (1+e))) \ (\t\set ts. \x\x\<^sub>1. t x \ x\<^sub>0 \ t x < x) \ (\ix\x\<^sub>1. (bs!i)*x + (hs!i) x = real ((ts!i) x)))" proof- from ts have A: "\i\{..0 x\<^sub>1 (bs!i) (ts!i)" by (auto simp: length_bs) hence "\e h. (\i 0 \ (\x. h i x) \ O(\x. real x / ln (real x) powr (1+e i)) \ (\x\x\<^sub>1. (ts!i) x \ x\<^sub>0 \ (ts!i) x < x) \ (\ix\x\<^sub>1. (bs!i)*real x + h i x = real ((ts!i) x)))" unfolding akra_bazzi_term_def by (subst (asm) bchoice_iff, subst (asm) bchoice_iff) blast then guess ee :: "_ \ real" and hh :: "_ \ nat \ real" by (elim exE conjE) note eh = this define e where "e = Min {ee i |i. i < k}" define hs where "hs = map hh (upt 0 k)" have e_pos: "e > 0" unfolding e_def using eh k_not_0 by (subst Min_gr_iff) auto moreover have "length hs = k" unfolding hs_def by (simp_all add: length_ts) moreover have hs_growth: "\h\set hs. (\x. h x) \ O(\x. real x / ln (real x) powr (1+e))" proof fix h assume "h \ set hs" then obtain i where t: "i < k" "h = hh i" unfolding hs_def by force hence "(\x. h x) \ O(\x. real x / ln (real x) powr (1+ee i))" using eh by blast also from t k_not_0 have "e \ ee i" unfolding e_def by (subst Min_le_iff) auto hence "(\x::nat. real x / ln (real x) powr (1+ee i)) \ O(\x. real x / ln (real x) powr (1+e))" by (intro bigo_real_nat_transfer) auto finally show "(\x. h x) \ O(\x. real x / ln (real x) powr (1+e))" . qed moreover have "\t\set ts. (\x\x\<^sub>1. t x \ x\<^sub>0 \ t x < x)" proof (rule ballI) fix t assume "t \ set ts" then obtain i where "i < k" "t = ts!i" using length_ts by (subst (asm) in_set_conv_nth) auto with eh show "\x\x\<^sub>1. t x \ x\<^sub>0 \ t x < x" unfolding hs_def by force qed moreover have "\ix\x\<^sub>1. (bs!i)*x + (hs!i) x = real ((ts!i) x)" proof (rule allI, rule impI) fix i assume i: "i < k" with eh show "\x\x\<^sub>1. (bs!i)*x + (hs!i) x = real ((ts!i) x)" using length_ts unfolding hs_def by fastforce qed ultimately show ?thesis by blast qed from someI_ex[OF this, folded e_hs_def] show ?thesis unfolding e_def hs_def by (intro conjI) fastforce+ qed lemma e_pos: "e > 0" and length_hs: "length hs = k" and hs_growth: "\h. h \ set hs \ (\x. h x) \ O(\x. real x / ln (real x) powr (1 + e))" and step_ge_x0: "\t x. t \ set ts \ x \ x\<^sub>1 \ x\<^sub>0 \ t x" and step_less: "\t x. t \ set ts \ x \ x\<^sub>1 \ t x < x" and decomp: "\i x. i < k \ x \ x\<^sub>1 \ (bs!i)*x + (hs!i) x = real ((ts!i) x)" by (insert e_hs_aux) simp_all lemma h_in_hs [intro, simp]: "i < k \ hs ! i \ set hs" by (rule nth_mem) (simp add: length_hs) lemma t_in_ts [intro, simp]: "i < k \ ts ! i \ set ts" by (rule nth_mem) (simp add: length_ts) lemma x0_less_x1: "x\<^sub>0 < x\<^sub>1" and x0_le_x1: "x\<^sub>0 \ x\<^sub>1" proof- from ts_nonempty have "x\<^sub>0 \ hd ts x\<^sub>1" using step_ge_x0[of "hd ts" x\<^sub>1] by simp also from ts_nonempty have "... < x\<^sub>1" by (intro step_less) simp_all finally show "x\<^sub>0 < x\<^sub>1" by simp thus "x\<^sub>0 \ x\<^sub>1" by simp qed lemma akra_bazzi_induct [consumes 1, case_names base rec]: assumes "x \ x\<^sub>0" assumes base: "\x. x \ x\<^sub>0 \ x < x\<^sub>1 \ P x" assumes rec: "\x. x \ x\<^sub>1 \ (\t. t \ set ts \ P (t x)) \ P x" shows "P x" proof (insert assms(1), induction x rule: less_induct) case (less x) with assms step_less step_ge_x0 show "P x" by (cases "x < x\<^sub>1") auto qed end locale akra_bazzi_function = akra_bazzi_recursion + fixes integrable integral assumes integral: "akra_bazzi_integral integrable integral" fixes g :: "nat \ real" assumes f_nonneg_base: "x \ x\<^sub>0 \ x < x\<^sub>1 \ f x \ 0" and f_rec: "x \ x\<^sub>1 \ f x = g x + (\i x\<^sub>1 \ g x \ 0" and ex_pos_a: "\a\set as. a > 0" begin lemma ex_pos_a': "\i 0" using ex_pos_a by (auto simp: in_set_conv_nth length_as) sublocale akra_bazzi_params_nonzero using length_as length_bs ex_pos_a a_ge_0 b_bounds by unfold_locales definition g_real :: "real \ real" where "g_real x = g (nat \x\)" lemma g_real_real[simp]: "g_real (real x) = g x" unfolding g_real_def by simp lemma f_nonneg: "x \ x\<^sub>0 \ f x \ 0" proof (induction x rule: akra_bazzi_induct) case (base x) with f_nonneg_base show "f x \ 0" by simp next case (rec x) from rec.hyps have "g x \ 0" by (intro g_nonneg) simp moreover have "(\i 0" using rec.hyps length_ts length_as by (intro sum_nonneg ballI mult_nonneg_nonneg[OF a_ge_0 rec.IH]) simp_all ultimately show "f x \ 0" using rec.hyps by (simp add: f_rec) qed definition "hs' = map (\h x. h (nat \x::real\)) hs" lemma length_hs': "length hs' = k" unfolding hs'_def by (simp add: length_hs) lemma hs'_real: "i < k \ (hs'!i) (real x) = (hs!i) x" unfolding hs'_def by (simp add: length_hs) lemma h_bound: obtains hb where "hb > 0" and "eventually (\x. \h\set hs'. \h x\ \ hb * x / ln x powr (1 + e)) at_top" proof- have "\h\set hs. \c>0. eventually (\x. \h x\ \ c * real x / ln (real x) powr (1 + e)) at_top" proof fix h assume h: "h \ set hs" hence "(\x. h x) \ O(\x. real x / ln (real x) powr (1 + e))" by (rule hs_growth) thus "\c>0. eventually (\x. \h x\ \ c * x / ln x powr (1 + e)) at_top" unfolding bigo_def by auto qed from bchoice[OF this] obtain hb where hb: "\h\set hs. hb h > 0 \ eventually (\x. \h x\ \ hb h * real x / ln (real x) powr (1 + e)) at_top" by blast define hb' where "hb' = max 1 (Max {hb h |h. h \ set hs})" have "hb' > 0" unfolding hb'_def by simp moreover have "\h\set hs. eventually (\x. \h (nat \x\)\ \ hb' * x / ln x powr (1 + e)) at_top" proof (intro ballI, rule eventually_mp[OF always_eventually eventually_conj], clarify) fix h assume h: "h \ set hs" with hb have hb_pos: "hb h > 0" by auto show "eventually (\x. x > exp (1 + e) + 1) at_top" by (rule eventually_gt_at_top) from h hb have e: "eventually (\x. \h (nat \x :: real\)\ \ hb h * real (nat \x\) / ln (real (nat \x\)) powr (1 + e)) at_top" by (intro eventually_natfloor) blast show "eventually (\x. \h (nat \x :: real\)\ \ hb' * x / ln x powr (1 + e)) at_top" using e eventually_gt_at_top proof eventually_elim fix x :: real assume x: "x > exp (1 + e) + 1" have x': "x > 0" by (rule le_less_trans[OF _ x]) simp_all assume "\h (nat \x\)\ \ hb h*real (nat \x\)/ln (real (nat \x\)) powr (1 + e)" also { from x have "exp (1 + e) < real (nat \x\)" by linarith moreover have "x > 0" by (rule le_less_trans[OF _ x]) simp_all hence "real (nat \x\) \ x" by simp ultimately have "real (nat \x\)/ln (real (nat \x\)) powr (1+e) \ x/ln x powr (1+e)" using e_pos by (intro x_over_ln_mono) simp_all from hb_pos mult_left_mono[OF this, of "hb h"] have "hb h * real (nat \x\)/ln (real (nat \x\)) powr (1+e) \ hb h * x / ln x powr (1+e)" by (simp add: algebra_simps) } also from h have "hb h \ hb'" unfolding hb'_def f_rec by (intro order.trans[OF Max.coboundedI max.cobounded2]) auto with x' have "hb h*x/ln x powr (1+e) \ hb'*x/ln x powr (1+e)" by (intro mult_right_mono divide_right_mono) simp_all finally show "\h (nat \x\)\ \ hb' * x / ln x powr (1 + e)" . qed qed hence "\h\set hs'. eventually (\x. \h x\ \ hb' * x / ln x powr (1 + e)) at_top" by (auto simp: hs'_def) hence "eventually (\x. \h\set hs'. \h x\ \ hb' * x / ln x powr (1 + e)) at_top" by (intro eventually_ball_finite) simp_all ultimately show ?thesis by (rule that) qed lemma C_bound: assumes "\b. b \ set bs \ C < b" "hb > 0" shows "eventually (\x::real. \b\set bs. C*x \ b*x - hb*x/ln x powr (1+e)) at_top" proof- from e_pos have "((\x. hb * ln x powr -(1+e)) \ 0) at_top" by (intro tendsto_mult_right_zero tendsto_neg_powr ln_at_top) simp_all with assms have "\b\set bs. eventually (\x. \hb * ln x powr -(1+e)\ < b - C) at_top" by (force simp: tendsto_iff dist_real_def) hence "eventually (\x. \b\set bs. \hb * ln x powr -(1+e)\ < b - C) at_top" by (intro eventually_ball_finite) simp_all note A = eventually_conj[OF this eventually_gt_at_top] show ?thesis using A apply eventually_elim proof clarify fix x b :: real assume x: "x > 0" and b: "b \ set bs" assume A: "\b\set bs. \hb * ln x powr -(1+e)\ < b - C" from b A assms have "hb * ln x powr -(1+e) < b - C" by simp with x have "x * (hb * ln x powr -(1+e)) < x * (b - C)" by (intro mult_strict_left_mono) thus "C*x \ b*x - hb*x / ln x powr (1+e)" by (subst (asm) powr_minus) (simp_all add: field_simps) qed qed end locale akra_bazzi_lower = akra_bazzi_function + fixes g' :: "real \ real" assumes f_pos: "eventually (\x. f x > 0) at_top" and g_growth2: "\C c2. c2 > 0 \ C < Min (set bs) \ eventually (\x. \u\{C*x..x}. g' u \ c2 * g' x) at_top" and g'_integrable: "\a. \b\a. integrable (\u. g' u / u powr (p + 1)) a b" and g'_bounded: "eventually (\a::real. (\b>a. \c. \x\{a..b}. g' x \ c)) at_top" and g_bigomega: "g \ \(\x. g' (real x))" and g'_nonneg: "eventually (\x. g' x \ 0) at_top" begin definition "gc2 \ SOME gc2. gc2 > 0 \ eventually (\x. g x \ gc2 * g' (real x)) at_top" lemma gc2: "gc2 > 0" "eventually (\x. g x \ gc2 * g' (real x)) at_top" proof- from g_bigomega guess c by (elim landau_omega.bigE) note c = this from g'_nonneg have "eventually (\x::nat. g' (real x) \ 0) at_top" by (rule eventually_nat_real) with c(2) have "eventually (\x. g x \ c * g' (real x)) at_top" using eventually_ge_at_top[of x\<^sub>1] by eventually_elim (insert g_nonneg, simp_all) with c(1) have "\gc2. gc2 > 0 \ eventually (\x. g x \ gc2 * g' (real x)) at_top" by blast from someI_ex[OF this] show "gc2 > 0" "eventually (\x. g x \ gc2 * g' (real x)) at_top" unfolding gc2_def by blast+ qed definition "gx0 \ max x\<^sub>1 (SOME gx0. \x\gx0. g x \ gc2 * g' (real x) \ f x > 0 \ g' (real x) \ 0)" definition "gx1 \ max gx0 (SOME gx1. \x\gx1. \i gx0)" lemma gx0: assumes "x \ gx0" shows "g x \ gc2 * g' (real x)" "f x > 0" "g' (real x) \ 0" proof- from eventually_conj[OF gc2(2) eventually_conj[OF f_pos eventually_nat_real[OF g'_nonneg]]] have "\gx0. \x\gx0. g x \ gc2 * g' (real x) \ f x > 0 \ g' (real x) \ 0" by (simp add: eventually_at_top_linorder) note someI_ex[OF this] moreover have "x \ (SOME gx0. \x\gx0. g x \ gc2 * g' (real x) \f x > 0 \ g' (real x) \ 0)" using assms unfolding gx0_def by simp ultimately show "g x \ gc2 * g' (real x)" "f x > 0" "g' (real x) \ 0" unfolding gx0_def by blast+ qed lemma gx1: assumes "x \ gx1" "i < k" shows "(ts!i) x \ gx0" proof- define mb where "mb = Min (set bs)/2" from b_bounds bs_nonempty have mb_pos: "mb > 0" unfolding mb_def by simp from h_bound guess hb . note hb = this from e_pos have "((\x. hb * ln x powr -(1 + e)) \ 0) at_top" by (intro tendsto_mult_right_zero tendsto_neg_powr ln_at_top) simp_all moreover note mb_pos ultimately have "eventually (\x. hb * ln x powr -(1 + e) < mb) at_top" using hb(1) by (subst (asm) tendsto_iff) (simp_all add: dist_real_def) from eventually_nat_real[OF hb(2)] eventually_nat_real[OF this] eventually_ge_at_top eventually_ge_at_top have "eventually (\x. \i gx0) at_top" apply eventually_elim proof clarify fix i x :: nat assume A: "hb * ln (real x) powr -(1+e) < mb" and i: "i < k" assume B: "\h\set hs'. \h (real x)\ \ hb * real x / ln (real x) powr (1+e)" with i have B': "\(hs'!i) (real x)\ \ hb * real x / ln (real x) powr (1+e)" using length_hs'[symmetric] by auto assume C: "x \ nat \gx0/mb\" hence C': "real gx0/mb \ real x" by linarith assume D: "x \ x\<^sub>1" from mb_pos have "real gx0 = mb * (real gx0/mb)" by simp also from i bs_nonempty have "mb \ bs!i/2" unfolding mb_def by simp hence "mb * (real gx0/mb) \ bs!i/2 * x" using C' i b_bounds[of "bs!i"] mb_pos by (intro mult_mono) simp_all also have "... = bs!i*x + -bs!i/2 * x" by simp also { have "-(hs!i) x \ \(hs!i) x\" by simp also from i B' length_hs have "\(hs!i) x\ \ hb * real x / ln (real x) powr (1+e)" by (simp add: hs'_def) also from A have "hb / ln x powr (1+e) \ mb" by (subst (asm) powr_minus) (simp add: field_simps) hence "hb / ln x powr (1+e) * x \ mb * x" by (intro mult_right_mono) simp_all hence "hb * x / ln x powr (1+e) \ mb * x" by simp also from i have "... \ (bs!i/2) * x" unfolding mb_def by (intro mult_right_mono) simp_all finally have "-bs!i/2 * x \ (hs!i) x" by simp } also have "bs!i*real x + (hs!i) x = real ((ts!i) x)" using i D decomp by simp finally show "(ts!i) x \ gx0" by simp qed hence "\gx1. \x\gx1. \i (ts!i) x" (is "Ex ?P") by (simp add: eventually_at_top_linorder) from someI_ex[OF this] have "?P (SOME x. ?P x)" . moreover have "\x. x \ gx1 \ x \ (SOME x. ?P x)" unfolding gx1_def by simp ultimately have "?P gx1" by blast with assms show ?thesis by blast qed lemma gx0_ge_x1: "gx0 \ x\<^sub>1" unfolding gx0_def by simp lemma gx0_le_gx1: "gx0 \ gx1" unfolding gx1_def by simp function f2' :: "nat \ real" where "x < gx1 \ f2' x = max 0 (f x / gc2)" | "x \ gx1 \ f2' x = g' (real x) + (\ix. x)") (insert gx0_le_gx1 gx0_ge_x1, simp_all add: step_less) lemma f2'_nonneg: "x \ gx0 \ f2' x \ 0" by (induction x rule: f2'.induct) (auto intro!: add_nonneg_nonneg sum_nonneg gx0 gx1 mult_nonneg_nonneg[OF a_ge_0]) lemma f2'_le_f: "x \ x\<^sub>0 \ gc2 * f2' x \ f x" proof (induction rule: f2'.induct) case (1 x) with gc2 f_nonneg show ?case by (simp add: max_def field_simps) next case prems: (2 x) with gx0 gx0_le_gx1 have "gc2 * g' (real x) \ g x" by force moreover from step_ge_x0 prems(1) gx0_ge_x1 gx0_le_gx1 have "\i. i < k \ x\<^sub>0 \ (ts!i) x" by simp hence "\i. i < k \ as!i * (gc2 * f2' ((ts!i) x)) \ as!i * f ((ts!i) x)" using prems(1) by (intro mult_left_mono a_ge_0 prems(2)) auto hence "gc2 * (\i (\ix. f2' x > 0) at_top" proof (subst eventually_at_top_linorder, intro exI allI impI) fix x :: nat assume "x \ gx0" thus "f2' x > 0" proof (induction x rule: f2'.induct) case (1 x) with gc2 gx0(2)[of x] show ?case by (simp add: max_def field_simps) next case prems: (2 x) have "(\i 0" proof (rule sum_pos') from ex_pos_a' guess i by (elim exE conjE) note i = this with prems(1) gx0 gx1 have "as!i * f2' ((ts!i) x) > 0" by (intro mult_pos_pos prems(2)) simp_all with i show "\i\{.. 0" by blast next fix i assume i: "i \ {.. 0" by (intro prems(2) gx1) simp_all with i show "as!i * f2' ((ts!i) x) \ 0" by (intro mult_nonneg_nonneg[OF a_ge_0]) simp_all qed simp_all with prems(1) gx0_le_gx1 show ?case by (auto intro!: add_nonneg_pos gx0) qed qed lemma bigomega_f_aux: obtains a where "a \ A" "\a'\a. a' \ \ \ f \ \(\x. x powr p *(1 + integral (\u. g' u / u powr (p + 1)) a' x))" proof- from g'_integrable guess a0 by (elim exE) note a0 = this from h_bound guess hb . note hb = this moreover from g_growth2 guess C c2 by (elim conjE exE) note C = this hence "eventually (\x. \b\set bs. C*x \ b*x - hb*x/ln x powr (1 + e)) at_top" using hb(1) bs_nonempty by (intro C_bound) simp_all moreover from b_bounds hb(1) e_pos have "eventually (\x. \b\set bs. akra_bazzi_asymptotics b hb e p x) at_top" by (rule akra_bazzi_asymptotics) moreover note g'_bounded C(3) g'_nonneg eventually_natfloor[OF f2'_pos] eventually_natfloor[OF gc2(2)] ultimately have "eventually (\x. (\h\set hs'. \h x\ \ hb*x/ln x powr (1+e)) \ (\b\set bs. C*x \ b*x - hb*x/ln x powr (1+e)) \ (\b\set bs. akra_bazzi_asymptotics b hb e p x) \ (\b>x. \c. \x\{x..b}. g' x \ c) \ f2' (nat \x\) > 0 \ (\u\{C * x..x}. g' u \ c2 * g' x) \ g' x \ 0) at_top" by (intro eventually_conj) (force elim!: eventually_conjE)+ then have "\X. (\x\X. (\h\set hs'. \h x\ \ hb*x/ln x powr (1+e)) \ (\b\set bs. C*x \ b*x - hb*x/ln x powr (1+e)) \ (\b\set bs. akra_bazzi_asymptotics b hb e p x) \ (\b>x. \c. \x\{x..b}. g' x \ c) \ (\u\{C * x..x}. g' u \ c2 * g' x) \ f2' (nat \x\) > 0 \ g' x \ 0)" by (subst (asm) eventually_at_top_linorder) (erule ex_mono, blast) then guess X by (elim exE conjE) note X = this define x\<^sub>0'_min where "x\<^sub>0'_min = max A (max X (max a0 (max gx1 (max 1 (real x\<^sub>1 + 1)))))" { fix x\<^sub>0' :: real assume x0'_props: "x\<^sub>0' \ x\<^sub>0'_min" "x\<^sub>0' \ \" hence x0'_ge_x1: "x\<^sub>0' \ real (x\<^sub>1+1)" and x0'_ge_1: "x\<^sub>0' \ 1" and x0'_ge_X: "x\<^sub>0' \ X" unfolding x\<^sub>0'_min_def by linarith+ hence x0'_pos: "x\<^sub>0' > 0" and x0'_nonneg: "x\<^sub>0' \ 0" by simp_all have x0': "\x\x\<^sub>0'. (\h\set hs'. \h x\ \ hb*x/ln x powr (1+e))" "\x\x\<^sub>0'. (\b\set bs. C*x \ b*x - hb*x/ln x powr (1+e))" "\x\x\<^sub>0'. (\b\set bs. akra_bazzi_asymptotics b hb e p x)" "\a\x\<^sub>0'. \b>a. \c. \x\{a..b}. g' x \ c" "\x\x\<^sub>0'. \u\{C * x..x}. g' u \ c2 * g' x" "\x\x\<^sub>0'. f2' (nat \x\) > 0" "\x\x\<^sub>0'. g' x \ 0" using X x0'_ge_X by auto from x0'_props(2) have x0'_int: "real (nat \x\<^sub>0'\) = x\<^sub>0'" by (rule real_natfloor_nat) from x0'_props have x0'_ge_gx1: "x\<^sub>0' \ gx1" and x0'_ge_a0: "x\<^sub>0' \ a0" unfolding x\<^sub>0'_min_def by simp_all with gx0_le_gx1 have f2'_nonneg: "\x. x \ x\<^sub>0' \ f2' x \ 0" by (force intro!: f2'_nonneg) define bm where "bm = Min (set bs)" define x\<^sub>1' where "x\<^sub>1' = 2 * x\<^sub>0' * inverse bm" define fb2 where "fb2 = Min {f2' x |x. x \ {x\<^sub>0'..x\<^sub>1'}}" define gb2 where "gb2 = (SOME c. \x\{x\<^sub>0'..x\<^sub>1'}. g' x \ c)" from b_bounds bs_nonempty have "bm > 0" "bm < 1" unfolding bm_def by auto hence "1 < 2 * inverse bm" by (simp add: field_simps) from mult_strict_left_mono[OF this x0'_pos] have x0'_lt_x1': "x\<^sub>0' < x\<^sub>1'" and x0'_le_x1': "x\<^sub>0' \ x\<^sub>1'" unfolding x\<^sub>1'_def by simp_all from x0_le_x1 x0'_ge_x1 have ge_x0'D: "\x. x\<^sub>0' \ real x \ x\<^sub>0 \ x" by simp from x0'_ge_x1 x0'_le_x1' have gt_x1'D: "\x. x\<^sub>1' < real x \ x\<^sub>1 \ x" by simp have x0'_x1': "\b\set bs. 2 * x\<^sub>0' * inverse b \ x\<^sub>1'" proof fix b assume b: "b \ set bs" hence "bm \ b" by (simp add: bm_def) moreover from b bs_nonempty b_bounds have "bm > 0" "b > 0" unfolding bm_def by auto ultimately have "inverse b \ inverse bm" by simp with x0'_nonneg show "2 * x\<^sub>0' * inverse b \ x\<^sub>1'" unfolding x\<^sub>1'_def by (intro mult_left_mono) simp_all qed note f_nonneg' = f_nonneg have "\x. real x \ x\<^sub>0' \ x \ nat \x\<^sub>0'\" "\x. real x \ x\<^sub>1' \ x \ nat \x\<^sub>1'\" by linarith+ hence "{x |x. real x \ {x\<^sub>0'..x\<^sub>1'}} \ {x |x. x \ {nat \x\<^sub>0'\..nat \x\<^sub>1'\}}" by auto hence "finite {x |x::nat. real x \ {x\<^sub>0'..x\<^sub>1'}}" by (rule finite_subset) auto hence fin: "finite {f2' x |x::nat. real x \ {x\<^sub>0'..x\<^sub>1'}}" by force note facts = hs'_real e_pos length_hs' length_as length_bs k_not_0 a_ge_0 p_props x0'_ge_1 f2'_nonneg f_rec[OF gt_x1'D] x0' x0'_int x0'_x1' gc2(1) decomp from b_bounds x0'_le_x1' x0'_ge_gx1 gx0_le_gx1 x0'_ge_x1 interpret abr: akra_bazzi_nat_to_real as bs hs' k x\<^sub>0' x\<^sub>1' hb e p f2' g' by (unfold_locales) (auto simp: facts simp del: f2'.simps intro!: f2'.simps(2)) have f'_nat: "\x::nat. abr.f' (real x) = f2' x" proof- fix x :: nat show "abr.f' (real (x::nat)) = f2' x" proof (induction "real x" arbitrary: x rule: abr.f'.induct) case (2 x) note x = this(1) and IH = this(2) from x have "abr.f' (real x) = g' (real x) + (\iii0' x\<^sub>1' hb e p integrable integral abr.f' g' C fb2 gb2 c2 proof unfold_locales fix x assume "x \ x\<^sub>0'" "x \ x\<^sub>1'" thus "abr.f' x \ 0" by (intro abr.f'_base) simp_all next fix x assume x:"x \ x\<^sub>0'" show "integrable (\x. g' x / x powr (p + 1)) x\<^sub>0' x" by (rule integrable_subinterval[of _ a0 x]) (insert a0 x0'_ge_a0 x, auto) next fix x assume x: "x \ x\<^sub>0'" "x \ x\<^sub>1'" have "x\<^sub>0' = real (nat \x\<^sub>0'\)" by (simp add: x0'_int) also from x have "... \ real (nat \x\)" by (auto intro!: nat_mono floor_mono) finally have "x\<^sub>0' \ real (nat \x\)" . moreover have "real (nat \x\) \ x\<^sub>1'" using x x0'_ge_1 by linarith ultimately have "f2' (nat \x\) \ {f2' x |x. real x \ {x\<^sub>0'..x\<^sub>1'}}" by force from fin and this have "f2' (nat \x\) \ fb2" unfolding fb2_def by (rule Min_le) with x show "abr.f' x \ fb2" by simp next from x0'_int x0'_le_x1' have "\x::nat. real x \ x\<^sub>0' \ real x \ x\<^sub>1'" by (intro exI[of _ "nat \x\<^sub>0'\"]) simp_all moreover { fix x :: nat assume "real x \ x\<^sub>0' \ real x \ x\<^sub>1'" with x0'(6) have "f2' (nat \real x\) > 0" by blast hence "f2' x > 0" by simp } ultimately show "fb2 > 0" unfolding fb2_def using fin by (subst Min_gr_iff) auto next fix x assume x: "x\<^sub>0' \ x" "x \ x\<^sub>1'" with x0'(4) x0'_lt_x1' have "\c. \x\{x\<^sub>0'..x\<^sub>1'}. g' x \ c" by force from someI_ex[OF this] x show "g' x \ gb2" unfolding gb2_def by simp qed (insert g_nonneg integral x0'(2) C x0'_le_x1' x0'_ge_x1, simp_all add: facts) from akra_bazzi_lower guess c5 . note c5 = this have "eventually (\x. \f x\ \ gc2 * c5 * \f_approx (real x)\) at_top" proof (unfold eventually_at_top_linorder, intro exI allI impI) fix x :: nat assume "x \ nat \x\<^sub>0'\" hence x: "real x \ x\<^sub>0'" by linarith note c5(1)[OF x] also have "abr.f' (real x) = f2' x" by (rule f'_nat) also have "gc2 * ... \ f x" using x x0'_ge_x1 x0_le_x1 by (intro f2'_le_f) simp_all also have "f x = \f x\" using x f_nonneg' x0'_ge_x1 x0_le_x1 by simp finally show "gc2 * c5 * \f_approx (real x)\ \ \f x\" using gc2 f_approx_nonneg[OF x] by (simp add: algebra_simps) qed hence "f \ \(\x. f_approx (real x))" using gc2(1) f_nonneg' f_approx_nonneg by (intro landau_omega.bigI[of "gc2 * c5"] eventually_conj mult_pos_pos c5 eventually_nat_real) (auto simp: eventually_at_top_linorder) note this[unfolded f_approx_def] } moreover have "x\<^sub>0'_min \ A" unfolding x\<^sub>0'_min_def gx0_ge_x1 by simp ultimately show ?thesis by (intro that) auto qed lemma bigomega_f: obtains a where "a \ A" "f \ \(\x. x powr p *(1 + integral (\u. g' u / u powr (p+1)) a x))" proof- from bigomega_f_aux[of A] guess a . note a = this define a' where "a' = real (max (nat \a\) 0) + 1" note a moreover have "a' \ \" by (auto simp: max_def a'_def) moreover have *: "a' \ a + 1" unfolding a'_def by linarith moreover from * and a have "a' \ A" by simp ultimately show ?thesis by (intro that[of a']) auto qed end locale akra_bazzi_upper = akra_bazzi_function + fixes g' :: "real \ real" assumes g'_integrable: "\a. \b\a. integrable (\u. g' u / u powr (p + 1)) a b" and g_growth1: "\C c1. c1 > 0 \ C < Min (set bs) \ eventually (\x. \u\{C*x..x}. g' u \ c1 * g' x) at_top" and g_bigo: "g \ O(g')" and g'_nonneg: "eventually (\x. g' x \ 0) at_top" begin definition "gc1 \ SOME gc1. gc1 > 0 \ eventually (\x. g x \ gc1 * g' (real x)) at_top" lemma gc1: "gc1 > 0" "eventually (\x. g x \ gc1 * g' (real x)) at_top" proof- from g_bigo guess c by (elim landau_o.bigE) note c = this from g'_nonneg have "eventually (\x::nat. g' (real x) \ 0) at_top" by (rule eventually_nat_real) with c(2) have "eventually (\x. g x \ c * g' (real x)) at_top" using eventually_ge_at_top[of x\<^sub>1] by eventually_elim (insert g_nonneg, simp_all) with c(1) have "\gc1. gc1 > 0 \ eventually (\x. g x \ gc1 * g' (real x)) at_top" by blast from someI_ex[OF this] show "gc1 > 0" "eventually (\x. g x \ gc1 * g' (real x)) at_top" unfolding gc1_def by blast+ qed definition "gx3 \ max x\<^sub>1 (SOME gx0. \x\gx0. g x \ gc1 * g' (real x))" lemma gx3: assumes "x \ gx3" shows "g x \ gc1 * g' (real x)" proof- from gc1(2) have "\gx3. \x\gx3. g x \ gc1 * g' (real x)" by (simp add: eventually_at_top_linorder) note someI_ex[OF this] moreover have "x \ (SOME gx0. \x\gx0. g x \ gc1 * g' (real x))" using assms unfolding gx3_def by simp ultimately show "g x \ gc1 * g' (real x)" unfolding gx3_def by blast qed lemma gx3_ge_x1: "gx3 \ x\<^sub>1" unfolding gx3_def by simp function f' :: "nat \ real" where "x < gx3 \ f' x = max 0 (f x / gc1)" | "x \ gx3 \ f' x = g' (real x) + (\ix. x)") (insert gx3_ge_x1, simp_all add: step_less) lemma f'_ge_f: "x \ x\<^sub>0 \ gc1 * f' x \ f x" proof (induction rule: f'.induct) case (1 x) with gc1 f_nonneg show ?case by (simp add: max_def field_simps) next case prems: (2 x) with gx3 have "gc1 * g' (real x) \ g x" by force moreover from step_ge_x0 prems(1) gx3_ge_x1 have "\i. i < k \ x\<^sub>0 \ nat \(ts!i) x\" by (intro le_nat_floor) simp hence "\i. i < k \ as!i * (gc1 * f' ((ts!i) x)) \ as!i * f ((ts!i) x)" using prems(1) by (intro mult_left_mono a_ge_0 prems(2)) auto hence "gc1 * (\i (\i A" "\a'\a. a' \ \ \ f \ O(\x. x powr p *(1 + integral (\u. g' u / u powr (p + 1)) a' x))" proof- from g'_integrable guess a0 by (elim exE) note a0 = this from h_bound guess hb . note hb = this moreover from g_growth1 guess C c1 by (elim conjE exE) note C = this hence "eventually (\x. \b\set bs. C*x \ b*x - hb*x/ln x powr (1 + e)) at_top" using hb(1) bs_nonempty by (intro C_bound) simp_all moreover from b_bounds hb(1) e_pos have "eventually (\x. \b\set bs. akra_bazzi_asymptotics b hb e p x) at_top" by (rule akra_bazzi_asymptotics) moreover note gc1(2) C(3) g'_nonneg ultimately have "eventually (\x. (\h\set hs'. \h x\ \ hb*x/ln x powr (1+e)) \ (\b\set bs. C*x \ b*x - hb*x/ln x powr (1+e)) \ (\b\set bs. akra_bazzi_asymptotics b hb e p x) \ (\u\{C*x..x}. g' u \ c1 * g' x) \ g' x \ 0) at_top" by (intro eventually_conj) (force elim!: eventually_conjE)+ then have "\X. (\x\X. (\h\set hs'. \h x\ \ hb*x/ln x powr (1+e)) \ (\b\set bs. C*x \ b*x - hb*x/ln x powr (1+e)) \ (\b\set bs. akra_bazzi_asymptotics b hb e p x) \ (\u\{C*x..x}. g' u \ c1 * g' x) \ g' x \ 0)" by (subst (asm) eventually_at_top_linorder) fast then guess X by (elim exE conjE) note X = this define x\<^sub>0'_min where "x\<^sub>0'_min = max A (max X (max 1 (max a0 (max gx3 (real x\<^sub>1 + 1)))))" { fix x\<^sub>0' :: real assume x0'_props: "x\<^sub>0' \ x\<^sub>0'_min" "x\<^sub>0' \ \" hence x0'_ge_x1: "x\<^sub>0' \ real (x\<^sub>1+1)" and x0'_ge_1: "x\<^sub>0' \ 1" and x0'_ge_X: "x\<^sub>0' \ X" unfolding x\<^sub>0'_min_def by linarith+ hence x0'_pos: "x\<^sub>0' > 0" and x0'_nonneg: "x\<^sub>0' \ 0" by simp_all have x0': "\x\x\<^sub>0'. (\h\set hs'. \h x\ \ hb*x/ln x powr (1+e))" "\x\x\<^sub>0'. (\b\set bs. C*x \ b*x - hb*x/ln x powr (1+e))" "\x\x\<^sub>0'. (\b\set bs. akra_bazzi_asymptotics b hb e p x)" "\x\x\<^sub>0'. \u\{C*x..x}. g' u \ c1 * g' x" "\x\x\<^sub>0'. g' x \ 0" using X x0'_ge_X by auto from x0'_props(2) have x0'_int: "real (nat \x\<^sub>0'\) = x\<^sub>0'" by (rule real_natfloor_nat) from x0'_props have x0'_ge_gx0: "x\<^sub>0' \ gx3" and x0'_ge_a0: "x\<^sub>0' \ a0" unfolding x\<^sub>0'_min_def by simp_all hence f'_nonneg: "\x. x \ x\<^sub>0' \ f' x \ 0" using order.trans[OF f_nonneg f'_ge_f] gc1(1) x0'_ge_x1 x0_le_x1 by (simp add: zero_le_mult_iff del: f'.simps) define bm where "bm = Min (set bs)" define x\<^sub>1' where "x\<^sub>1' = 2 * x\<^sub>0' * inverse bm" define fb1 where "fb1 = Max {f' x |x. x \ {x\<^sub>0'..x\<^sub>1'}}" from b_bounds bs_nonempty have "bm > 0" "bm < 1" unfolding bm_def by auto hence "1 < 2 * inverse bm" by (simp add: field_simps) from mult_strict_left_mono[OF this x0'_pos] have x0'_lt_x1': "x\<^sub>0' < x\<^sub>1'" and x0'_le_x1': "x\<^sub>0' \ x\<^sub>1'" unfolding x\<^sub>1'_def by simp_all from x0_le_x1 x0'_ge_x1 have ge_x0'D: "\x. x\<^sub>0' \ real x \ x\<^sub>0 \ x" by simp from x0'_ge_x1 x0'_le_x1' have gt_x1'D: "\x. x\<^sub>1' < real x \ x\<^sub>1 \ x" by simp have x0'_x1': "\b\set bs. 2 * x\<^sub>0' * inverse b \ x\<^sub>1'" proof fix b assume b: "b \ set bs" hence "bm \ b" by (simp add: bm_def) moreover from b b_bounds bs_nonempty have "bm > 0" "b > 0" unfolding bm_def by auto ultimately have "inverse b \ inverse bm" by simp with x0'_nonneg show "2 * x\<^sub>0' * inverse b \ x\<^sub>1'" unfolding x\<^sub>1'_def by (intro mult_left_mono) simp_all qed note f_nonneg' = f_nonneg have "\x. real x \ x\<^sub>0' \ x \ nat \x\<^sub>0'\" "\x. real x \ x\<^sub>1' \ x \ nat \x\<^sub>1'\" by linarith+ hence "{x |x. real x \ {x\<^sub>0'..x\<^sub>1'}} \ {x |x. x \ {nat \x\<^sub>0'\..nat \x\<^sub>1'\}}" by auto hence "finite {x |x::nat. real x \ {x\<^sub>0'..x\<^sub>1'}}" by (rule finite_subset) auto hence fin: "finite {f' x |x::nat. real x \ {x\<^sub>0'..x\<^sub>1'}}" by force note facts = hs'_real e_pos length_hs' length_as length_bs k_not_0 a_ge_0 p_props x0'_ge_1 f'_nonneg f_rec[OF gt_x1'D] x0' x0'_int x0'_x1' gc1(1) decomp from b_bounds x0'_le_x1' x0'_ge_gx0 x0'_ge_x1 interpret abr: akra_bazzi_nat_to_real as bs hs' k x\<^sub>0' x\<^sub>1' hb e p f' g' by (unfold_locales) (auto simp add: facts simp del: f'.simps intro!: f'.simps(2)) have f'_nat: "\x::nat. abr.f' (real x) = f' x" proof- fix x :: nat show "abr.f' (real (x::nat)) = f' x" proof (induction "real x" arbitrary: x rule: abr.f'.induct) case (2 x) note x = this(1) and IH = this(2) from x have "abr.f' (real x) = g' (real x) + (\iii0' x\<^sub>1' hb e p integrable integral abr.f' g' C fb1 c1 proof (unfold_locales) fix x assume "x \ x\<^sub>0'" "x \ x\<^sub>1'" thus "abr.f' x \ 0" by (intro abr.f'_base) simp_all next fix x assume x:"x \ x\<^sub>0'" show "integrable (\x. g' x / x powr (p + 1)) x\<^sub>0' x" by (rule integrable_subinterval[of _ a0 x]) (insert a0 x0'_ge_a0 x, auto) next fix x assume x: "x \ x\<^sub>0'" "x \ x\<^sub>1'" have "x\<^sub>0' = real (nat \x\<^sub>0'\)" by (simp add: x0'_int) also from x have "... \ real (nat \x\)" by (auto intro!: nat_mono floor_mono) finally have "x\<^sub>0' \ real (nat \x\)" . moreover have "real (nat \x\) \ x\<^sub>1'" using x x0'_ge_1 by linarith ultimately have "f' (nat \x\) \ {f' x |x. real x \ {x\<^sub>0'..x\<^sub>1'}}" by force from fin and this have "f' (nat \x\) \ fb1" unfolding fb1_def by (rule Max_ge) with x show "abr.f' x \ fb1" by simp qed (insert x0'(2) x0'_le_x1' x0'_ge_x1 C, simp_all add: facts) from akra_bazzi_upper guess c6 . note c6 = this { fix x :: nat assume "x \ nat \x\<^sub>0'\" hence x: "real x \ x\<^sub>0'" by linarith have "f x \ gc1 * f' x" using x x0'_ge_x1 x0_le_x1 by (intro f'_ge_f) simp_all also have "f' x = abr.f' (real x)" by (simp add: f'_nat) also note c6(1)[OF x] also from f_nonneg' x x0'_ge_x1 x0_le_x1 have "f x = \f x\" by simp also from f_approx_nonneg x have "f_approx (real x) = \f_approx (real x)\" by simp finally have "gc1 * c6 * \f_approx (real x)\ \ \f x\" using gc1 by (simp add: algebra_simps) } hence "eventually (\x. \f x\ \ gc1 * c6 * \f_approx (real x)\) at_top" using eventually_ge_at_top[of "nat \x\<^sub>0'\"] by (auto elim!: eventually_mono) hence "f \ O(\x. f_approx (real x))" using gc1(1) f_nonneg' f_approx_nonneg by (intro landau_o.bigI[of "gc1 * c6"] eventually_conj mult_pos_pos c6 eventually_nat_real) (auto simp: eventually_at_top_linorder) note this[unfolded f_approx_def] } moreover have "x\<^sub>0'_min \ A" unfolding x\<^sub>0'_min_def gx3_ge_x1 by simp ultimately show ?thesis by (intro that) auto qed lemma bigo_f: obtains a where "a > A" "f \ O(\x. x powr p *(1 + integral (\u. g' u / u powr (p + 1)) a x))" proof- from bigo_f_aux[of A] guess a . note a = this define a' where "a' = real (max (nat \a\) 0) + 1" note a moreover have "a' \ \" by (auto simp: max_def a'_def) moreover have *: "a' \ a + 1" unfolding a'_def by linarith moreover from * and a have "a' > A" by simp ultimately show ?thesis by (intro that[of a']) auto qed end locale akra_bazzi = akra_bazzi_function + fixes g' :: "real \ real" assumes f_pos: "eventually (\x. f x > 0) at_top" and g'_nonneg: "eventually (\x. g' x \ 0) at_top" assumes g'_integrable: "\a. \b\a. integrable (\u. g' u / u powr (p + 1)) a b" and g_growth1: "\C c1. c1 > 0 \ C < Min (set bs) \ eventually (\x. \u\{C*x..x}. g' u \ c1 * g' x) at_top" and g_growth2: "\C c2. c2 > 0 \ C < Min (set bs) \ eventually (\x. \u\{C*x..x}. g' u \ c2 * g' x) at_top" and g_bounded: "eventually (\a::real. (\b>a. \c. \x\{a..b}. g' x \ c)) at_top" and g_bigtheta: "g \ \(g')" begin sublocale akra_bazzi_lower using f_pos g_growth2 g_bounded bigthetaD2[OF g_bigtheta] g'_nonneg g'_integrable by unfold_locales sublocale akra_bazzi_upper using g_growth1 bigthetaD1[OF g_bigtheta] g'_nonneg g'_integrable by unfold_locales lemma bigtheta_f: obtains a where "a > A" "f \ \(\x. x powr p *(1 + integral (\u. g' u / u powr (p + 1)) a x))" proof- from bigo_f_aux[of A] guess a . note a = this moreover from bigomega_f_aux[of A] guess b . note b = this let ?a = "real (max (max (nat \a\) (nat \b\)) 0) + 1" have "?a \ \" by (auto simp: max_def) moreover have "?a \ a" "?a \ b" by linarith+ ultimately have "f \ \(\x. x powr p *(1 + integral (\u. g' u / u powr (p + 1)) ?a x))" using a b by (intro bigthetaI) blast+ moreover from a b have "?a > A" by linarith ultimately show ?thesis by (intro that[of ?a]) simp_all qed end named_theorems akra_bazzi_term_intros "introduction rules for Akra-Bazzi terms" lemma akra_bazzi_term_floor_add [akra_bazzi_term_intros]: assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \ b * real x\<^sub>1 + c" "c < (1 - b) * real x\<^sub>1" "x\<^sub>1 > 0" shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x + c\)" proof (rule akra_bazzi_termI[OF zero_less_one]) fix x assume x: "x \ x\<^sub>1" from assms x have "real x\<^sub>0 \ b * real x\<^sub>1 + c" by simp also from x assms have "... \ b * real x + c" by auto finally have step_ge_x0: "b * real x + c \ real x\<^sub>0" by simp thus "nat \b * real x + c\ \ x\<^sub>0" by (subst le_nat_iff) (simp_all add: le_floor_iff) from assms x have "c < (1 - b) * real x\<^sub>1" by simp also from assms x have "... \ (1 - b) * real x" by (intro mult_left_mono) simp_all finally show "nat \b * real x + c\ < x" using assms step_ge_x0 by (subst nat_less_iff) (simp_all add: floor_less_iff algebra_simps) from step_ge_x0 have "real_of_int \c + b * real x\ = real_of_int (nat \c + b * real x\)" by linarith thus "(b * real x) + (\b * real x + c\ - (b * real x)) = real (nat \b * real x + c\)" by linarith next have "(\x::nat. real_of_int \b * real x + c\ - b * real x) \ O(\_. \c\ + 1)" by (intro landau_o.big_mono always_eventually allI, unfold real_norm_def) linarith also have "(\_::nat. \c\ + 1) \ O(\x. real x / ln (real x) powr (1 + 1))" by force finally show "(\x::nat. real_of_int \b * real x + c\ - b * real x) \ O(\x. real x / ln (real x) powr (1+1))" . qed lemma akra_bazzi_term_floor_add' [akra_bazzi_term_intros]: assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \ b * real x\<^sub>1 + real c" "real c < (1 - b) * real x\<^sub>1" "x\<^sub>1 > 0" shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x\ + c)" proof- from assms have "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x + real c\)" by (rule akra_bazzi_term_floor_add) also have "(\x. nat \b*real x + real c\) = (\x::nat. nat \b*real x\ + c)" proof fix x :: nat have "\b * real x + real c\ = \b * real x\ + int c" by linarith also from assms have "nat ... = nat \b * real x\ + c" by (simp add: nat_add_distrib) finally show "nat \b * real x + real c\ = nat \b * real x\ + c" . qed finally show ?thesis . qed lemma akra_bazzi_term_floor_subtract [akra_bazzi_term_intros]: assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \ b * real x\<^sub>1 - c" "0 < c + (1 - b) * real x\<^sub>1" "x\<^sub>1 > 0" shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x - c\)" by (subst diff_conv_add_uminus, rule akra_bazzi_term_floor_add, insert assms) simp_all lemma akra_bazzi_term_floor_subtract' [akra_bazzi_term_intros]: assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \ b * real x\<^sub>1 - real c" "0 < real c + (1 - b) * real x\<^sub>1" "x\<^sub>1 > 0" shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x\ - c)" proof- from assms have "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x - real c\)" by (intro akra_bazzi_term_floor_subtract) simp_all also have "(\x. nat \b*real x - real c\) = (\x::nat. nat \b*real x\ - c)" proof fix x :: nat have "\b * real x - real c\ = \b * real x\ - int c" by linarith also from assms have "nat ... = nat \b * real x\ - c" by (simp add: nat_diff_distrib) finally show "nat \b * real x - real c\ = nat \b * real x\ - c" . qed finally show ?thesis . qed lemma akra_bazzi_term_floor [akra_bazzi_term_intros]: assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \ b * real x\<^sub>1" "0 < (1 - b) * real x\<^sub>1" "x\<^sub>1 > 0" shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x\)" using assms akra_bazzi_term_floor_add[where c = 0] by simp lemma akra_bazzi_term_ceiling_add [akra_bazzi_term_intros]: assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \ b * real x\<^sub>1 + c" "c + 1 \ (1 - b) * x\<^sub>1" shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x + c\)" proof (rule akra_bazzi_termI[OF zero_less_one]) fix x assume x: "x \ x\<^sub>1" have "0 \ real x\<^sub>0" by simp also from assms have "real x\<^sub>0 \ b * real x\<^sub>1 + c" by simp also from assms x have "b * real x\<^sub>1 \ b * real x" by (intro mult_left_mono) simp_all hence "b * real x\<^sub>1 + c \ b * real x + c" by simp also have "b * real x + c \ real_of_int \b * real x + c\" by linarith finally have bx_nonneg: "real_of_int \b * real x + c\ \ 0" . have "c + 1 \ (1 - b) * x\<^sub>1" by fact also have "(1 - b) * x\<^sub>1 \ (1 - b) * x" using assms x by (intro mult_left_mono) simp_all finally have "b * real x + c + 1 \ real x" using assms by (simp add: algebra_simps) with bx_nonneg show "nat \b * real x + c\ < x" by (subst nat_less_iff) (simp_all add: ceiling_less_iff) have "real x\<^sub>0 \ b * real x\<^sub>1 + c" by fact also have "... \ real_of_int \...\" by linarith also have "x\<^sub>1 \ x" by fact finally show "x\<^sub>0 \ nat \b * real x + c\" using assms by (force simp: ceiling_mono) show "b * real x + (\b * real x + c\ - b * real x) = real (nat \b * real x + c\)" using assms bx_nonneg by simp next have "(\x::nat. real_of_int \b * real x + c\ - b * real x) \ O(\_. \c\ + 1)" by (intro landau_o.big_mono always_eventually allI, unfold real_norm_def) linarith also have "(\_::nat. \c\ + 1) \ O(\x. real x / ln (real x) powr (1 + 1))" by force finally show "(\x::nat. real_of_int \b * real x + c\ - b * real x) \ O(\x. real x / ln (real x) powr (1+1))" . qed lemma akra_bazzi_term_ceiling_add' [akra_bazzi_term_intros]: assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \ b * real x\<^sub>1 + real c" "real c + 1 \ (1 - b) * x\<^sub>1" shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x\ + c)" proof- from assms have "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x + real c\)" by (rule akra_bazzi_term_ceiling_add) also have "(\x. nat \b*real x + real c\) = (\x::nat. nat \b*real x\ + c)" proof fix x :: nat from assms have "0 \ b * real x" by simp also have "b * real x \ real_of_int \b * real x\" by linarith finally have bx_nonneg: "\b * real x\ \ 0" by simp have "\b * real x + real c\ = \b * real x\ + int c" by linarith also from assms bx_nonneg have "nat ... = nat \b * real x\ + c" by (subst nat_add_distrib) simp_all finally show "nat \b * real x + real c\ = nat \b * real x\ + c" . qed finally show ?thesis . qed lemma akra_bazzi_term_ceiling_subtract [akra_bazzi_term_intros]: assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \ b * real x\<^sub>1 - c" "1 \ c + (1 - b) * x\<^sub>1" shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x - c\)" by (subst diff_conv_add_uminus, rule akra_bazzi_term_ceiling_add, insert assms) simp_all lemma akra_bazzi_term_ceiling_subtract' [akra_bazzi_term_intros]: assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \ b * real x\<^sub>1 - real c" "1 \ real c + (1 - b) * x\<^sub>1" shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x\ - c)" proof- from assms have "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x - real c\)" by (intro akra_bazzi_term_ceiling_subtract) simp_all also have "(\x. nat \b*real x - real c\) = (\x::nat. nat \b*real x\ - c)" proof fix x :: nat from assms have "0 \ b * real x" by simp also have "b * real x \ real_of_int \b * real x\" by linarith finally have bx_nonneg: "\b * real x\ \ 0" by simp have "\b * real x - real c\ = \b * real x\ - int c" by linarith also from assms bx_nonneg have "nat ... = nat \b * real x\ - c" by simp finally show "nat \b * real x - real c\ = nat \b * real x\ - c" . qed finally show ?thesis . qed lemma akra_bazzi_term_ceiling [akra_bazzi_term_intros]: assumes "(b::real) > 0" "b < 1" "real x\<^sub>0 \ b * real x\<^sub>1" "1 \ (1 - b) * x\<^sub>1" shows "akra_bazzi_term x\<^sub>0 x\<^sub>1 b (\x. nat \b*real x\)" using assms akra_bazzi_term_ceiling_add[where c = 0] by simp end diff --git a/thys/Akra_Bazzi/Akra_Bazzi_Asymptotics.thy b/thys/Akra_Bazzi/Akra_Bazzi_Asymptotics.thy --- a/thys/Akra_Bazzi/Akra_Bazzi_Asymptotics.thy +++ b/thys/Akra_Bazzi/Akra_Bazzi_Asymptotics.thy @@ -1,376 +1,376 @@ (* File: Akra_Bazzi_Asymptotics.thy - Author: Manuel Eberl + Author: Manuel Eberl Proofs for the four(ish) asymptotic inequalities required for proving the Akra Bazzi theorem with variation functions in the recursive calls. *) section \Asymptotic bounds\ theory Akra_Bazzi_Asymptotics imports Complex_Main Akra_Bazzi_Library "HOL-Library.Landau_Symbols" begin locale akra_bazzi_asymptotics_bep = fixes b e p hb :: real assumes bep: "b > 0" "b < 1" "e > 0" "hb > 0" begin context begin text \ Functions that are negligible w.r.t. @{term "ln (b*x) powr (e/2 + 1)"}. \ private abbreviation (input) negl :: "(real \ real) \ bool" where "negl f \ f \ o(\x. ln (b*x) powr (-(e/2 + 1)))" private lemma neglD: "negl f \ c > 0 \ eventually (\x. \f x\ \ c / ln (b*x) powr (e/2+1)) at_top" by (drule (1) landau_o.smallD, subst (asm) powr_minus) (simp add: field_simps) private lemma negl_mult: "negl f \ negl g \ negl (\x. f x * g x)" by (erule landau_o.small_1_mult, rule landau_o.small_imp_big, erule landau_o.small_trans) (insert bep, simp) private lemma ev4: assumes g: "negl g" shows "eventually (\x. ln (b*x) powr (-e/2) - ln x powr (-e/2) \ g x) at_top" proof (rule smallo_imp_le_real) define h1 where [abs_def]: "h1 x = (1 + ln b/ln x) powr (-e/2) - 1 + e/2 * (ln b/ln x)" for x define h2 where [abs_def]: "h2 x = ln x powr (- e / 2) * ((1 + ln b / ln x) powr (- e / 2) - 1)" for x from bep have "((\x. ln b / ln x) \ 0) at_top" by (simp add: tendsto_0_smallo_1) note one_plus_x_powr_Taylor2_bigo[OF this, of "-e/2"] also have "(\x. (1 + ln b / ln x) powr (- e / 2) - 1 - - e / 2 * (ln b / ln x)) = h1" by (simp add: h1_def) finally have "h1 \ o(\x. 1 / ln x)" by (rule landau_o.big_small_trans) (insert bep, simp add: power2_eq_square) with bep have "(\x. h1 x - e/2 * (ln b / ln x)) \ \(\x. 1 / ln x)" by simp also have "(\x. h1 x - e/2 * (ln b/ln x)) = (\x. (1 + ln b/ ln x) powr (-e/2) - 1)" by (rule ext) (simp add: h1_def) finally have "h2 \ \(\x. ln x powr (-e/2) * (1 / ln x))" unfolding h2_def by (intro landau_theta.mult) simp_all also have "(\x. ln x powr (-e/2) * (1 / ln x)) \ \(\x. ln x powr (-(e/2+1)))" by simp also from g bep have "(\x. ln x powr (-(e/2+1))) \ \(g)" by (simp add: smallomega_iff_smallo) finally have "g \ o(h2)" by (simp add: smallomega_iff_smallo) also have "eventually (\x. h2 x = ln (b*x) powr (-e/2) - ln x powr (-e/2)) at_top" using eventually_gt_at_top[of "1::real"] eventually_gt_at_top[of "1/b"] by eventually_elim (insert bep, simp add: field_simps powr_diff [symmetric] h2_def ln_mult [symmetric] powr_divide del: ln_mult) hence "h2 \ \(\x. ln (b*x) powr (-e/2) - ln x powr (-e/2))" by (rule bigthetaI_cong) finally show "g \ o(\x. ln (b * x) powr (- e / 2) - ln x powr (- e / 2))" . next show "eventually (\x. ln (b*x) powr (-e/2) - ln x powr (-e/2) \ 0) at_top" using eventually_gt_at_top[of "1/b"] eventually_gt_at_top[of "1::real"] by eventually_elim (insert bep, auto intro!: powr_mono2' simp: field_simps simp del: ln_mult) qed private lemma ev1: "negl (\x. (1 + c * inverse b * ln x powr (-(1+e))) powr p - 1)" proof- from bep have "((\x. c * inverse b * ln x powr (-(1+e))) \ 0) at_top" by (simp add: tendsto_0_smallo_1) have "(\x. (1 + c * inverse b * ln x powr (-(1+e))) powr p - 1) \ O(\x. c * inverse b * ln x powr - (1 + e))" using bep by (intro one_plus_x_powr_Taylor1_bigo) (simp add: tendsto_0_smallo_1) also from bep have "negl (\x. c * inverse b * ln x powr - (1 + e))" by simp finally show ?thesis . qed private lemma ev2_aux: defines "f \ \x. (1 + 1/ln (b*x) * ln (1 + hb / b * ln x powr (-1-e))) powr (-e/2)" obtains h where "eventually (\x. f x \ 1 + h x) at_top" "h \ o(\x. 1 / ln x)" proof (rule that[of "\x. f x - 1"]) define g where [abs_def]: "g x = 1/ln (b*x) * ln (1 + hb / b * ln x powr (-1-e))" for x have lim: "((\x. ln (1 + hb / b * ln x powr (- 1 - e))) \ 0) at_top" by (rule tendsto_eq_rhs[OF tendsto_ln[OF tendsto_add[OF tendsto_const, of _ 0]]]) (insert bep, simp_all add: tendsto_0_smallo_1) hence lim': "(g \ 0) at_top" unfolding g_def by (intro tendsto_mult_zero) (insert bep, simp add: tendsto_0_smallo_1) from one_plus_x_powr_Taylor2_bigo[OF this, of "-e/2"] have "(\x. (1 + g x) powr (-e/2) - 1 - - e/2 * g x) \ O(\x. (g x)\<^sup>2)" . also from lim' have "(\x. g x ^ 2) \ o(\x. g x * 1)" unfolding power2_eq_square by (intro landau_o.big_small_mult smalloI_tendsto) simp_all also have "o(\x. g x * 1) = o(g)" by simp also have "(\x. (1 + g x) powr (-e/2) - 1 - - e/2 * g x) = (\x. f x - 1 + e/2 * g x)" by (simp add: f_def g_def) finally have A: "(\x. f x - 1 + e / 2 * g x) \ O(g)" by (rule landau_o.small_imp_big) hence "(\x. f x - 1 + e/2 * g x - e/2 * g x) \ O(g)" by (rule sum_in_bigo) (insert bep, simp) also have "(\x. f x - 1 + e/2 * g x - e/2 * g x) = (\x. f x - 1)" by simp finally have "(\x. f x - 1) \ O(g)" . also from bep lim have "g \ o(\x. 1 / ln x)" unfolding g_def by (auto intro!: smallo_1_tendsto_0) finally show "(\x. f x - 1) \ o(\x. 1 / ln x)" . qed simp_all private lemma ev2: defines "f \ \x. ln (b * x + hb * x / ln x powr (1 + e)) powr (-e/2)" obtains h where "negl h" "eventually (\x. f x \ ln (b * x) powr (-e/2) + h x) at_top" "eventually (\x. \ln (b * x) powr (-e/2) + h x\ < 1) at_top" proof - define f' where "f' x = (1 + 1 / ln (b*x) * ln (1 + hb / b * ln x powr (-1-e))) powr (-e/2)" for x from ev2_aux obtain g where g: "eventually (\x. 1 + g x \ f' x) at_top" "g \ o(\x. 1 / ln x)" unfolding f'_def . define h where [abs_def]: "h x = ln (b*x) powr (-e/2) * g x" for x show ?thesis proof (rule that[of h]) from bep g show "negl h" unfolding h_def by (auto simp: powr_diff elim: landau_o.small_big_trans) next from g(2) have "g \ o(\x. 1)" by (rule landau_o.small_big_trans) simp with bep have "eventually (\x. \ln (b*x) powr (-e/2) * (1 + g x)\ < 1) at_top" by (intro smallo_imp_abs_less_real) simp_all thus "eventually (\x. \ln (b*x) powr (-e/2) + h x\ < 1) at_top" by (simp add: algebra_simps h_def) next from eventually_gt_at_top[of "1/b"] and g(1) show "eventually (\x. f x \ ln (b*x) powr (-e/2) + h x) at_top" proof eventually_elim case (elim x) from bep have "b * x + hb * x / ln x powr (1 + e) = b*x * (1 + hb / b * ln x powr (-1 - e))" by (simp add: field_simps powr_diff powr_add powr_minus) also from elim(1) bep have "ln \ = ln (b*x) * (1 + 1/ln (b*x) * ln (1 + hb / b * ln x powr (-1-e)))" by (subst ln_mult) (simp_all add: add_pos_nonneg field_simps) also from elim(1) bep have "\ powr (-e/2) = ln (b*x) powr (-e/2) * f' x" by (subst powr_mult) (simp_all add: field_simps f'_def) also from elim have "\ \ ln (b*x) powr (-e/2) * (1 + g x)" by (intro mult_left_mono) simp_all finally show "f x \ ln (b*x) powr (-e/2) + h x" by (simp add: f_def h_def algebra_simps) qed qed qed private lemma ev21: obtains g where "negl g" "eventually (\x. 1 + ln (b * x + hb * x / ln x powr (1 + e)) powr (-e/2) \ 1 + ln (b * x) powr (-e/2) + g x) at_top" "eventually (\x. 1 + ln (b * x) powr (-e/2) + g x > 0) at_top" proof- from ev2 guess g . note g = this from g(3) have "eventually (\x. 1 + ln (b * x) powr (-e/2) + g x > 0) at_top" by eventually_elim simp with g(1,2) show ?thesis by (intro that[of g]) simp_all qed private lemma ev22: obtains g where "negl g" "eventually (\x. 1 - ln (b * x + hb * x / ln x powr (1 + e)) powr (-e/2) \ 1 - ln (b * x) powr (-e/2) - g x) at_top" "eventually (\x. 1 - ln (b * x) powr (-e/2) - g x > 0) at_top" proof- from ev2 guess g . note g = this from g(2) have "eventually (\x. 1 - ln (b * x + hb * x / ln x powr (1 + e)) powr (-e/2) \ 1 - ln (b * x) powr (-e/2) - g x) at_top" by eventually_elim simp moreover from g(3) have "eventually (\x. 1 - ln (b * x) powr (-e/2) - g x > 0) at_top" by eventually_elim simp ultimately show ?thesis using g(1) by (intro that[of g]) simp_all qed lemma asymptotics1: shows "eventually (\x. (1 + c * inverse b * ln x powr -(1+e)) powr p * (1 + ln (b * x + hb * x / ln x powr (1 + e)) powr (- e / 2)) \ 1 + (ln x powr (-e/2))) at_top" proof- let ?f = "\x. (1 + c * inverse b * ln x powr -(1+e)) powr p" let ?g = "\x. 1 + ln (b * x + hb * x / ln x powr (1 + e)) powr (- e / 2)" define f where [abs_def]: "f x = 1 - ?f x" for x from ev1[of c] have "negl f" unfolding f_def by (subst landau_o.small.uminus_in_iff [symmetric]) simp from landau_o.smallD[OF this zero_less_one] have f: "eventually (\x. f x \ ln (b*x) powr -(e/2+1)) at_top" by eventually_elim (simp add: f_def) from ev21 guess g . note g = this define h where [abs_def]: "h x = -g x + f x + f x * ln (b*x) powr (-e/2) + f x * g x" for x have A: "eventually (\x. ?f x * ?g x \ 1 + ln (b*x) powr (-e/2) - h x) at_top" using g(2,3) f proof eventually_elim case (elim x) let ?t = "ln (b*x) powr (-e/2)" have "1 + ?t - h x = (1 - f x) * (1 + ln (b*x) powr (-e/2) + g x)" by (simp add: algebra_simps h_def) also from elim have "?f x * ?g x \ (1 - f x) * (1 + ln (b*x) powr (-e/2) + g x)" by (intro mult_mono[OF _ elim(1)]) (simp_all add: algebra_simps f_def) finally show "?f x * ?g x \ 1 + ln (b*x) powr (-e/2) - h x" . qed from bep \negl f\ g(1) have "negl h" unfolding h_def by (fastforce intro!: sum_in_smallo landau_o.small.mult simp: powr_diff intro: landau_o.small_trans)+ from ev4[OF this] A show ?thesis by eventually_elim simp qed lemma asymptotics2: shows "eventually (\x. (1 + c * inverse b * ln x powr -(1+e)) powr p * (1 - ln (b * x + hb * x / ln x powr (1 + e)) powr (- e / 2)) \ 1 - (ln x powr (-e/2))) at_top" proof- let ?f = "\x. (1 + c * inverse b * ln x powr -(1+e)) powr p" let ?g = "\x. 1 - ln (b * x + hb * x / ln x powr (1 + e)) powr (- e / 2)" define f where [abs_def]: "f x = 1 - ?f x" for x from ev1[of c] have "negl f" unfolding f_def by (subst landau_o.small.uminus_in_iff [symmetric]) simp from landau_o.smallD[OF this zero_less_one] have f: "eventually (\x. f x \ ln (b*x) powr -(e/2+1)) at_top" by eventually_elim (simp add: f_def) from ev22 guess g . note g = this define h where [abs_def]: "h x = -g x - f x + f x * ln (b*x) powr (-e/2) + f x * g x" for x have "((\x. ln (b * x + hb * x / ln x powr (1 + e)) powr - (e / 2)) \ 0) at_top" apply (insert bep, intro tendsto_neg_powr, simp) apply (rule filterlim_compose[OF ln_at_top]) apply (rule filterlim_at_top_smallomega_1, simp) using eventually_gt_at_top[of "max 1 (1/b)"] apply (auto elim!: eventually_mono intro!: add_pos_nonneg simp: field_simps) apply (smt (z3) divide_nonneg_nonneg mult_neg_pos mult_nonneg_nonneg powr_non_neg) done hence ev_g: "eventually (\x. \1 - ?g x\ < 1) at_top" by (intro smallo_imp_abs_less_real smalloI_tendsto) simp_all have A: "eventually (\x. ?f x * ?g x \ 1 - ln (b*x) powr (-e/2) + h x) at_top" using g(2,3) ev_g f proof eventually_elim case (elim x) let ?t = "ln (b*x) powr (-e/2)" from elim have "?f x * ?g x \ (1 - f x) * (1 - ln (b*x) powr (-e/2) - g x)" by (intro mult_mono) (simp_all add: f_def) also have "... = 1 - ?t + h x" by (simp add: algebra_simps h_def) finally show "?f x * ?g x \ 1 - ln (b*x) powr (-e/2) + h x" . qed from bep \negl f\ g(1) have "negl h" unfolding h_def by (fastforce intro!: sum_in_smallo landau_o.small.mult simp: powr_diff intro: landau_o.small_trans)+ from ev4[OF this] A show ?thesis by eventually_elim simp qed lemma asymptotics3: "eventually (\x. (1 + (ln x powr (-e/2))) / 2 \ 1) at_top" (is "eventually (\x. ?f x \ 1) _") proof (rule eventually_mp[OF always_eventually], clarify) from bep have "(?f \ 1/2) at_top" by (force intro: tendsto_eq_intros tendsto_neg_powr ln_at_top) hence "\e. e>0 \ eventually (\x. \?f x - 0.5\ < e) at_top" by (subst (asm) tendsto_iff) (simp add: dist_real_def) from this[of "0.5"] show "eventually (\x. \?f x - 0.5\ < 0.5) at_top" by simp fix x assume "\?f x - 0.5\ < 0.5" thus "?f x \ 1" by simp qed lemma asymptotics4: "eventually (\x. (1 - (ln x powr (-e/2))) * 2 \ 1) at_top" (is "eventually (\x. ?f x \ 1) _") proof (rule eventually_mp[OF always_eventually], clarify) from bep have "(?f \ 2) at_top" by (force intro: tendsto_eq_intros tendsto_neg_powr ln_at_top) hence "\e. e>0 \ eventually (\x. \?f x - 2\ < e) at_top" by (subst (asm) tendsto_iff) (simp add: dist_real_def) from this[of 1] show "eventually (\x. \?f x - 2\ < 1) at_top" by simp fix x assume "\?f x - 2\ < 1" thus "?f x \ 1" by simp qed lemma asymptotics5: "eventually (\x. ln (b*x - hb*x*ln x powr -(1+e)) powr (-e/2) < 1) at_top" proof- from bep have "((\x. b - hb * ln x powr -(1+e)) \ b - 0) at_top" by (intro tendsto_intros tendsto_mult_right_zero tendsto_neg_powr ln_at_top) simp_all hence "LIM x at_top. (b - hb * ln x powr -(1+e)) * x :> at_top" by (rule filterlim_tendsto_pos_mult_at_top[OF _ _ filterlim_ident], insert bep) simp_all also have "(\x. (b - hb * ln x powr -(1+e)) * x) = (\x. b*x - hb*x*ln x powr -(1+e))" by (intro ext) (simp add: algebra_simps) finally have "filterlim ... at_top at_top" . with bep have "((\x. ln (b*x - hb*x*ln x powr -(1+e)) powr -(e/2)) \ 0) at_top" by (intro tendsto_neg_powr filterlim_compose[OF ln_at_top]) simp_all hence "eventually (\x. \ln (b*x - hb*x*ln x powr -(1+e)) powr (-e/2)\ < 1) at_top" by (subst (asm) tendsto_iff) (simp add: dist_real_def) thus ?thesis by simp qed lemma asymptotics6: "eventually (\x. hb / ln x powr (1 + e) < b/2) at_top" and asymptotics7: "eventually (\x. hb / ln x powr (1 + e) < (1 - b) / 2) at_top" and asymptotics8: "eventually (\x. x*(1 - b - hb / ln x powr (1 + e)) > 1) at_top" proof- from bep have A: "(\x. hb / ln x powr (1 + e)) \ o(\_. 1)" by simp from bep have B: "b/3 > 0" and C: "(1 - b)/3 > 0" by simp_all from landau_o.smallD[OF A B] show "eventually (\x. hb / ln x powr (1+e) < b/2) at_top" by eventually_elim (insert bep, simp) from landau_o.smallD[OF A C] show "eventually (\x. hb / ln x powr (1 + e) < (1 - b)/2) at_top" by eventually_elim (insert bep, simp) from bep have "(\x. hb / ln x powr (1 + e)) \ o(\_. 1)" "(1 - b) / 2 > 0" by simp_all from landau_o.smallD[OF this] eventually_gt_at_top[of "1::real"] have A: "eventually (\x. 1 - b - hb / ln x powr (1 + e) > 0) at_top" by eventually_elim (insert bep, simp add: field_simps) from bep have "(\x. x * (1 - b - hb / ln x powr (1+e))) \ \(\_. 1)" "(0::real) < 2" by simp_all from landau_omega.smallD[OF this] A eventually_gt_at_top[of "0::real"] show "eventually (\x. x*(1 - b - hb / ln x powr (1 + e)) > 1) at_top" by eventually_elim (simp_all add: abs_mult) qed end end definition "akra_bazzi_asymptotic1 b hb e p x \ (1 - hb * inverse b * ln x powr -(1+e)) powr p * (1 + ln (b*x + hb*x/ln x powr (1+e)) powr (-e/2)) \ 1 + (ln x powr (-e/2) :: real)" definition "akra_bazzi_asymptotic1' b hb e p x \ (1 + hb * inverse b * ln x powr -(1+e)) powr p * (1 + ln (b*x + hb*x/ln x powr (1+e)) powr (-e/2)) \ 1 + (ln x powr (-e/2) :: real)" definition "akra_bazzi_asymptotic2 b hb e p x \ (1 + hb * inverse b * ln x powr -(1+e)) powr p * (1 - ln (b*x + hb*x/ln x powr (1+e)) powr (-e/2)) \ 1 - ln x powr (-e/2 :: real)" definition "akra_bazzi_asymptotic2' b hb e p x \ (1 - hb * inverse b * ln x powr -(1+e)) powr p * (1 - ln (b*x + hb*x/ln x powr (1+e)) powr (-e/2)) \ 1 - ln x powr (-e/2 :: real)" definition "akra_bazzi_asymptotic3 e x \ (1 + (ln x powr (-e/2))) / 2 \ (1::real)" definition "akra_bazzi_asymptotic4 e x \ (1 - (ln x powr (-e/2))) * 2 \ (1::real)" definition "akra_bazzi_asymptotic5 b hb e x \ ln (b*x - hb*x*ln x powr -(1+e)) powr (-e/2::real) < 1" definition "akra_bazzi_asymptotic6 b hb e x \ hb / ln x powr (1 + e :: real) < b/2" definition "akra_bazzi_asymptotic7 b hb e x \ hb / ln x powr (1 + e :: real) < (1 - b) / 2" definition "akra_bazzi_asymptotic8 b hb e x \ x*(1 - b - hb / ln x powr (1 + e :: real)) > 1" definition "akra_bazzi_asymptotics b hb e p x \ akra_bazzi_asymptotic1 b hb e p x \ akra_bazzi_asymptotic1' b hb e p x \ akra_bazzi_asymptotic2 b hb e p x \ akra_bazzi_asymptotic2' b hb e p x \ akra_bazzi_asymptotic3 e x \ akra_bazzi_asymptotic4 e x \ akra_bazzi_asymptotic5 b hb e x \ akra_bazzi_asymptotic6 b hb e x \ akra_bazzi_asymptotic7 b hb e x \ akra_bazzi_asymptotic8 b hb e x" lemmas akra_bazzi_asymptotic_defs = akra_bazzi_asymptotic1_def akra_bazzi_asymptotic1'_def akra_bazzi_asymptotic2_def akra_bazzi_asymptotic2'_def akra_bazzi_asymptotic3_def akra_bazzi_asymptotic4_def akra_bazzi_asymptotic5_def akra_bazzi_asymptotic6_def akra_bazzi_asymptotic7_def akra_bazzi_asymptotic8_def akra_bazzi_asymptotics_def lemma akra_bazzi_asymptotics: assumes "\b. b \ set bs \ b \ {0<..<1}" assumes "hb > 0" "e > 0" shows "eventually (\x. \b\set bs. akra_bazzi_asymptotics b hb e p x) at_top" proof (intro eventually_ball_finite ballI) fix b assume "b \ set bs" with assms interpret akra_bazzi_asymptotics_bep b e p hb by unfold_locales auto show "eventually (\x. akra_bazzi_asymptotics b hb e p x) at_top" unfolding akra_bazzi_asymptotic_defs using asymptotics1[of "-c" for c] asymptotics2[of "-c" for c] by (intro eventually_conj asymptotics1 asymptotics2 asymptotics3 asymptotics4 asymptotics5 asymptotics6 asymptotics7 asymptotics8) simp_all qed simp end diff --git a/thys/Akra_Bazzi/Akra_Bazzi_Library.thy b/thys/Akra_Bazzi/Akra_Bazzi_Library.thy --- a/thys/Akra_Bazzi/Akra_Bazzi_Library.thy +++ b/thys/Akra_Bazzi/Akra_Bazzi_Library.thy @@ -1,286 +1,286 @@ (* File: Akra_Bazzi_Library.thy - Author: Manuel Eberl + Author: Manuel Eberl Lemma bucket for the Akra-Bazzi theorem. *) section \Auxiliary lemmas\ theory Akra_Bazzi_Library imports Complex_Main "Landau_Symbols.Landau_More" "Pure-ex.Guess" begin (* TODO: Move? *) lemma ln_mono: "0 < x \ 0 < y \ x \ y \ ln (x::real) \ ln y" by (subst ln_le_cancel_iff) simp_all lemma ln_mono_strict: "0 < x \ 0 < y \ x < y \ ln (x::real) < ln y" by (subst ln_less_cancel_iff) simp_all declare DERIV_powr[THEN DERIV_chain2, derivative_intros] lemma sum_pos': assumes "finite I" assumes "\x\I. f x > (0 :: _ :: linordered_ab_group_add)" assumes "\x. x \ I \ f x \ 0" shows "sum f I > 0" proof- from assms(2) guess x by (elim bexE) note x = this from x have "I = insert x I" by blast also from assms(1) have "sum f ... = f x + sum f (I - {x})" by (rule sum.insert_remove) also from x assms have "... > 0" by (intro add_pos_nonneg sum_nonneg) simp_all finally show ?thesis . qed lemma min_mult_left: assumes "(x::real) > 0" shows "x * min y z = min (x*y) (x*z)" using assms by (auto simp add: min_def algebra_simps) lemma max_mult_left: assumes "(x::real) > 0" shows "x * max y z = max (x*y) (x*z)" using assms by (auto simp add: max_def algebra_simps) lemma DERIV_nonneg_imp_mono: assumes "\t. t\{x..y} \ (f has_field_derivative f' t) (at t)" assumes "\t. t\{x..y} \ f' t \ 0" assumes "(x::real) \ y" shows "(f x :: real) \ f y" proof (cases x y rule: linorder_cases) assume xy: "x < y" hence "\z. x < z \ z < y \ f y - f x = (y - x) * f' z" by (rule MVT2) (insert assms(1), simp) then guess z by (elim exE conjE) note z = this from z(1,2) assms(2) xy have "0 \ (y - x) * f' z" by (intro mult_nonneg_nonneg) simp_all also note z(3)[symmetric] finally show "f x \ f y" by simp qed (insert assms(3), simp_all) lemma eventually_conjE: "eventually (\x. P x \ Q x) F \ (eventually P F \ eventually Q F \ R) \ R" apply (frule eventually_rev_mp[of _ _ P], simp) apply (drule eventually_rev_mp[of _ _ Q], simp) apply assumption done lemma real_natfloor_nat: "x \ \ \ real (nat \x\) = x" by (elim Nats_cases) simp lemma eventually_natfloor: assumes "eventually P (at_top :: nat filter)" shows "eventually (\x. P (nat \x\)) (at_top :: real filter)" proof- from assms obtain N where N: "\n. n \ N \ P n" using eventually_at_top_linorder by blast have "\n\real N. P (nat \n\)" by (intro allI impI N le_nat_floor) simp_all thus ?thesis using eventually_at_top_linorder by blast qed lemma tendsto_0_smallo_1: "f \ o(\x. 1 :: real) \ (f \ 0) at_top" by (drule smalloD_tendsto) simp lemma smallo_1_tendsto_0: "(f \ 0) at_top \ f \ o(\x. 1 :: real)" by (rule smalloI_tendsto) simp_all lemma filterlim_at_top_smallomega_1: assumes "f \ \[F](\x. 1 :: real)" "eventually (\x. f x > 0) F" shows "filterlim f at_top F" proof - from assms have "filterlim (\x. norm (f x / 1)) at_top F" by (intro smallomegaD_filterlim_at_top_norm) (auto elim: eventually_mono) also have "?this \ ?thesis" using assms by (intro filterlim_cong refl) (auto elim!: eventually_mono) finally show ?thesis . qed lemma smallo_imp_abs_less_real: assumes "f \ o[F](g)" "eventually (\x. g x > (0::real)) F" shows "eventually (\x. \f x\ < g x) F" proof - have "1/2 > (0::real)" by simp from landau_o.smallD[OF assms(1) this] assms(2) show ?thesis by eventually_elim auto qed lemma smallo_imp_less_real: assumes "f \ o[F](g)" "eventually (\x. g x > (0::real)) F" shows "eventually (\x. f x < g x) F" using smallo_imp_abs_less_real[OF assms] by eventually_elim simp lemma smallo_imp_le_real: assumes "f \ o[F](g)" "eventually (\x. g x \ (0::real)) F" shows "eventually (\x. f x \ g x) F" using landau_o.smallD[OF assms(1) zero_less_one] assms(2) by eventually_elim simp (* TODO MOVE *) lemma filterlim_at_right: "filterlim f (at_right a) F \ eventually (\x. f x > a) F \ filterlim f (nhds a) F" by (subst filterlim_at) (auto elim!: eventually_mono) (* END TODO *) lemma one_plus_x_powr_approx_ex: assumes x: "abs (x::real) \ 1/2" obtains t where "abs t < 1/2" "(1 + x) powr p = 1 + p * x + p * (p - 1) * (1 + t) powr (p - 2) / 2 * x ^ 2" proof (cases "x = 0") assume x': "x \ 0" let ?f = "\x. (1 + x) powr p" let ?f' = "\x. p * (1 + x) powr (p - 1)" let ?f'' = "\x. p * (p - 1) * (1 + x) powr (p - 2)" let ?fs = "(!) [?f, ?f', ?f'']" have A: "\m t. m < 2 \ t \ -0.5 \ t \ 0.5 \ (?fs m has_real_derivative ?fs (Suc m) t) (at t)" proof (clarify) fix m :: nat and t :: real assume m: "m < 2" and t: "t \ -0.5" "t \ 0.5" thus "(?fs m has_real_derivative ?fs (Suc m) t) (at t)" using m by (cases m) (force intro: derivative_eq_intros algebra_simps)+ qed have "\t. (if x < 0 then x < t \ t < 0 else 0 < t \ t < x) \ (1 + x) powr p = (\m<2. ?fs m 0 / (fact m) * (x - 0)^m) + ?fs 2 t / (fact 2) * (x - 0)\<^sup>2" using assms x' by (intro Taylor[OF _ _ A]) simp_all then guess t by (elim exE conjE) note t = this with assms have "abs t < 1/2" by (auto split: if_split_asm) moreover from t(2) have "(1 + x) powr p = 1 + p * x + p * (p - 1) * (1 + t) powr (p - 2) / 2 * x ^ 2" by (simp add: numeral_2_eq_2 of_nat_Suc) ultimately show ?thesis by (rule that) next assume "x = 0" with that[of 0] show ?thesis by simp qed lemma powr_lower_bound: "\(l::real) > 0; l \ x; x \ u\ \ min (l powr z) (u powr z) \ x powr z" apply (cases "z \ 0") apply (rule order.trans[OF min.cobounded1 powr_mono2], simp_all) [] apply (rule order.trans[OF min.cobounded2 powr_mono2'], simp_all) [] done lemma powr_upper_bound: "\(l::real) > 0; l \ x; x \ u\ \ max (l powr z) (u powr z) \ x powr z" apply (cases "z \ 0") apply (rule order.trans[OF powr_mono2 max.cobounded2], simp_all) [] apply (rule order.trans[OF powr_mono2' max.cobounded1], simp_all) [] done lemma one_plus_x_powr_Taylor2: obtains k where "\x. abs (x::real) \ 1/2 \ abs ((1 + x) powr p - 1 - p*x) \ k*x^2" proof- define k where "k = \p*(p - 1)\ * max ((1/2) powr (p - 2)) ((3/2) powr (p - 2)) / 2" show ?thesis proof (rule that[of k]) fix x :: real assume "abs x \ 1/2" from one_plus_x_powr_approx_ex[OF this, of p] guess t . note t = this from t have "abs ((1 + x) powr p - 1 - p*x) = \p*(p - 1)\ * (1 + t) powr (p - 2)/2 * x\<^sup>2" by (simp add: abs_mult) also from t(1) have "(1 + t) powr (p - 2) \ max ((1/2) powr (p - 2)) ((3/2) powr (p - 2))" by (intro powr_upper_bound) simp_all finally show "abs ((1 + x) powr p - 1 - p*x) \ k*x^2" by (simp add: mult_left_mono mult_right_mono k_def) qed qed lemma one_plus_x_powr_Taylor2_bigo: assumes lim: "(f \ 0) F" shows "(\x. (1 + f x) powr (p::real) - 1 - p * f x) \ O[F](\x. f x ^ 2)" proof - from one_plus_x_powr_Taylor2[of p] guess k . moreover from tendstoD[OF lim, of "1/2"] have "eventually (\x. abs (f x) < 1/2) F" by (simp add: dist_real_def) ultimately have "eventually (\x. norm ((1 + f x) powr p - 1 - p * f x) \ k * norm (f x ^ 2)) F" by (auto elim!: eventually_mono) thus ?thesis by (rule bigoI) qed lemma one_plus_x_powr_Taylor1_bigo: assumes lim: "(f \ 0) F" shows "(\x. (1 + f x) powr (p::real) - 1) \ O[F](\x. f x)" proof - from assms have "(\x. (1 + f x) powr p - 1 - p * f x) \ O[F](\x. (f x)\<^sup>2)" by (rule one_plus_x_powr_Taylor2_bigo) also from assms have "f \ O[F](\_. 1)" by (intro bigoI_tendsto) simp_all from landau_o.big.mult[of f F f, OF _ this] have "(\x. (f x)^2) \ O[F](\x. f x)" by (simp add: power2_eq_square) finally have A: "(\x. (1 + f x) powr p - 1 - p * f x) \ O[F](f)" . have B: "(\x. p * f x) \ O[F](f)" by simp from sum_in_bigo(1)[OF A B] show ?thesis by simp qed lemma x_times_x_minus_1_nonneg: "x \ 0 \ x \ 1 \ (x::_::linordered_idom) * (x - 1) \ 0" proof (elim disjE) assume x: "x \ 0" also have "0 \ x^2" by simp finally show "x * (x - 1) \ 0" by (simp add: power2_eq_square algebra_simps) qed simp lemma x_times_x_minus_1_nonpos: "x \ 0 \ x \ 1 \ (x::_::linordered_idom) * (x - 1) \ 0" by (intro mult_nonneg_nonpos) simp_all lemma powr_mono': assumes "(x::real) > 0" "x \ 1" "a \ b" shows "x powr b \ x powr a" proof- have "inverse x powr a \ inverse x powr b" using assms by (intro powr_mono) (simp_all add: field_simps) hence "inverse (x powr a) \ inverse (x powr b)" using assms by simp with assms show ?thesis by (simp add: field_simps) qed lemma powr_less_mono': assumes "(x::real) > 0" "x < 1" "a < b" shows "x powr b < x powr a" proof- have "inverse x powr a < inverse x powr b" using assms by (intro powr_less_mono) (simp_all add: field_simps) hence "inverse (x powr a) < inverse (x powr b)" using assms by simp with assms show ?thesis by (simp add: field_simps) qed lemma real_powr_at_bot: assumes "(a::real) > 1" shows "((\x. a powr x) \ 0) at_bot" proof- from assms have "filterlim (\x. ln a * x) at_bot at_bot" by (intro filterlim_tendsto_pos_mult_at_bot[OF tendsto_const _ filterlim_ident]) auto hence "((\x. exp (x * ln a)) \ 0) at_bot" by (intro filterlim_compose[OF exp_at_bot]) (simp add: algebra_simps) thus ?thesis using assms unfolding powr_def by simp qed lemma real_powr_at_bot_neg: assumes "(a::real) > 0" "a < 1" shows "filterlim (\x. a powr x) at_top at_bot" proof- from assms have "LIM x at_bot. ln (inverse a) * -x :> at_top" by (intro filterlim_tendsto_pos_mult_at_top[OF tendsto_const] filterlim_uminus_at_top_at_bot) (simp_all add: ln_inverse) with assms have "LIM x at_bot. x * ln a :> at_top" by (subst (asm) ln_inverse) (simp_all add: mult.commute) hence "LIM x at_bot. exp (x * ln a) :> at_top" by (intro filterlim_compose[OF exp_at_top]) simp thus ?thesis using assms unfolding powr_def by simp qed lemma real_powr_at_top_neg: assumes "(a::real) > 0" "a < 1" shows "((\x. a powr x) \ 0) at_top" proof- from assms have "LIM x at_top. ln (inverse a) * x :> at_top" by (intro filterlim_tendsto_pos_mult_at_top[OF tendsto_const]) (simp_all add: filterlim_ident field_simps) with assms have "LIM x at_top. ln a * x :> at_bot" by (subst filterlim_uminus_at_bot) (simp add: ln_inverse) hence "((\x. exp (x * ln a)) \ 0) at_top" by (intro filterlim_compose[OF exp_at_bot]) (simp_all add: mult.commute) with assms show ?thesis unfolding powr_def by simp qed lemma eventually_nat_real: assumes "eventually P (at_top :: real filter)" shows "eventually (\x. P (real x)) (at_top :: nat filter)" using assms filterlim_real_sequentially unfolding filterlim_def le_filter_def eventually_filtermap by auto end diff --git a/thys/Akra_Bazzi/Akra_Bazzi_Method.thy b/thys/Akra_Bazzi/Akra_Bazzi_Method.thy --- a/thys/Akra_Bazzi/Akra_Bazzi_Method.thy +++ b/thys/Akra_Bazzi/Akra_Bazzi_Method.thy @@ -1,423 +1,423 @@ (* File: Akra_Bazzi_Method.thy - Author: Manuel Eberl + Author: Manuel Eberl Provides the "master_theorem" and "akra_bazzi_termination" proof methods. *) section \The proof methods\ subsection \Master theorem and termination\ theory Akra_Bazzi_Method imports Complex_Main Akra_Bazzi Master_Theorem Eval_Numeral begin lemma landau_symbol_ge_3_cong: assumes "landau_symbol L L' Lr" assumes "\x::'a::linordered_semidom. x \ 3 \ f x = g x" shows "L at_top (f) = L at_top (g)" apply (rule landau_symbol.cong[OF assms(1)]) apply (subst eventually_at_top_linorder, rule exI[of _ 3], simp add: assms(2)) done lemma exp_1_lt_3: "exp (1::real) < 3" proof- from Taylor_up[of 3 "\_. exp" exp 0 1 0] obtain t :: real where "t > 0" "t < 1" "exp 1 = 5/2 + exp t / 6" by (auto simp: eval_nat_numeral) note this(3) also from \t < 1\ have "exp t < exp 1" by simp finally show "exp (1::real) < 3" by (simp add: field_simps) qed lemma ln_ln_pos: assumes "(x::real) \ 3" shows "ln (ln x) > 0" proof (subst ln_gt_zero_iff) from assms exp_1_lt_3 have "ln x > ln (exp 1)" by (intro ln_mono_strict) simp_all thus "ln x > 0" "ln x > 1" by simp_all qed definition akra_bazzi_terms where "akra_bazzi_terms x\<^sub>0 x\<^sub>1 bs ts = (\i0 x\<^sub>1 (bs!i) (ts!i))" lemma akra_bazzi_termsI: "(\i. i < length bs \ akra_bazzi_term x\<^sub>0 x\<^sub>1 (bs!i) (ts!i)) \ akra_bazzi_terms x\<^sub>0 x\<^sub>1 bs ts" unfolding akra_bazzi_terms_def by blast lemma master_theorem_functionI: assumes "\x\{x\<^sub>0..1}. f x \ 0" assumes "\x\x\<^sub>1. f x = g x + (\ix\x\<^sub>1. g x \ 0" assumes "\a\set as. a \ 0" assumes "list_ex (\a. a > 0) as" assumes "\b\set bs. b \ {0<..<1}" assumes "k \ 0" assumes "length as = k" assumes "length bs = k" assumes "length ts = k" assumes "akra_bazzi_terms x\<^sub>0 x\<^sub>1 bs ts" shows "master_theorem_function x\<^sub>0 x\<^sub>1 k as bs ts f g" using assms unfolding akra_bazzi_terms_def by unfold_locales (auto simp: list_ex_iff) lemma akra_bazzi_term_measure: " x \ x\<^sub>1 \ akra_bazzi_term 0 x\<^sub>1 b t \ (t x, x) \ Wellfounded.measure (\n::nat. n)" " x > x\<^sub>1 \ akra_bazzi_term 0 (Suc x\<^sub>1) b t \ (t x, x) \ Wellfounded.measure (\n::nat. n)" unfolding akra_bazzi_term_def by auto lemma measure_prod_conv: "((a, b), (c, d)) \ Wellfounded.measure (\x. t (fst x)) \ (a, c) \ Wellfounded.measure t" "((e, f), (g, h)) \ Wellfounded.measure (\x. t (snd x)) \ (f, h) \ Wellfounded.measure t" by simp_all lemmas measure_prod_conv' = measure_prod_conv[where t = "\x. x"] lemma akra_bazzi_termination_simps: fixes x :: nat shows "a * real x / b = a/b * real x" "real x / b = 1/b * real x" by simp_all lemma akra_bazzi_params_nonzeroI: "length as = length bs \ (\a\set as. a \ 0) \ (\b\set bs. b \ {0<..<1}) \ (\a\set as. a > 0) \ akra_bazzi_params_nonzero (length as) as bs" by (unfold_locales, simp_all) [] lemmas akra_bazzi_p_rel_intros = akra_bazzi_params_nonzero.p_lessI[rotated, OF _ akra_bazzi_params_nonzeroI] akra_bazzi_params_nonzero.p_greaterI[rotated, OF _ akra_bazzi_params_nonzeroI] akra_bazzi_params_nonzero.p_leI[rotated, OF _ akra_bazzi_params_nonzeroI] akra_bazzi_params_nonzero.p_geI[rotated, OF _ akra_bazzi_params_nonzeroI] akra_bazzi_params_nonzero.p_boundsI[rotated, OF _ akra_bazzi_params_nonzeroI] akra_bazzi_params_nonzero.p_boundsI'[rotated, OF _ akra_bazzi_params_nonzeroI] lemma eval_length: "length [] = 0" "length (x # xs) = Suc (length xs)" by simp_all lemma eval_akra_bazzi_sum: "(\i<0. as!i * bs!i powr x) = 0" "(\iiii<0. as!i * f ((ts!i) x)) = 0" "(\iii0 x\<^sub>1 [] []" "akra_bazzi_term x\<^sub>0 x\<^sub>1 b t \ akra_bazzi_terms x\<^sub>0 x\<^sub>1 bs ts \ akra_bazzi_terms x\<^sub>0 x\<^sub>1 (b#bs) (t#ts)" unfolding akra_bazzi_terms_def using less_Suc_eq_0_disj by auto lemma ball_set_intros: "(\x\set []. P x)" "P x \ (\x\set xs. P x) \ (\x\set (x#xs). P x)" by auto lemma ball_set_simps: "(\x\set []. P x) = True" "(\x\set (x#xs). P x) = (P x \ (\x\set xs. P x))" by auto lemma bex_set_simps: "(\x\set []. P x) = False" "(\x\set (x#xs). P x) = (P x \ (\x\set xs. P x))" by auto lemma eval_akra_bazzi_le_list_ex: "list_ex P (x#y#xs) \ P x \ list_ex P (y#xs)" "list_ex P [x] \ P x" "list_ex P [] \ False" by (auto simp: list_ex_iff) lemma eval_akra_bazzi_le_sum_list: "x \ sum_list [] \ x \ 0" "x \ sum_list (y#ys) \ x \ y + sum_list ys" "x \ z + sum_list [] \ x \ z" "x \ z + sum_list (y#ys) \ x \ z + y + sum_list ys" by (simp_all add: algebra_simps) lemma atLeastLessThanE: "x \ {a.. (x \ a \ x < b \ P) \ P" by simp lemma master_theorem_preprocess: "\(\n::nat. 1) = \(\n::nat. real n powr 0)" "\(\n::nat. real n) = \(\n::nat. real n powr 1)" "O(\n::nat. 1) = O(\n::nat. real n powr 0)" "O(\n::nat. real n) = O(\n::nat. real n powr 1)" "\(\n::nat. ln (ln (real n))) = \(\n::nat. real n powr 0 * ln (ln (real n)))" "\(\n::nat. real n * ln (ln (real n))) = \(\n::nat. real n powr 1 * ln (ln (real n)))" "\(\n::nat. ln (real n)) = \(\n::nat. real n powr 0 * ln (real n) powr 1)" "\(\n::nat. real n * ln (real n)) = \(\n::nat. real n powr 1 * ln (real n) powr 1)" "\(\n::nat. real n powr p * ln (real n)) = \(\n::nat. real n powr p * ln (real n) powr 1)" "\(\n::nat. ln (real n) powr p') = \(\n::nat. real n powr 0 * ln (real n) powr p')" "\(\n::nat. real n * ln (real n) powr p') = \(\n::nat. real n powr 1 * ln (real n) powr p')" apply (simp_all) apply (simp_all cong: landau_symbols[THEN landau_symbol_ge_3_cong])? done lemma akra_bazzi_term_imp_size_less: "x\<^sub>1 \ x \ akra_bazzi_term 0 x\<^sub>1 b t \ size (t x) < size x" "x\<^sub>1 < x \ akra_bazzi_term 0 (Suc x\<^sub>1) b t \ size (t x) < size x" by (simp_all add: akra_bazzi_term_imp_less) definition "CLAMP (f :: nat \ real) x = (if x < 3 then 0 else f x)" definition "CLAMP' (f :: nat \ real) x = (if x < 3 then 0 else f x)" definition "MASTER_BOUND a b c x = real x powr a * ln (real x) powr b * ln (ln (real x)) powr c" definition "MASTER_BOUND' a b x = real x powr a * ln (real x) powr b" definition "MASTER_BOUND'' a x = real x powr a" lemma ln_1_imp_less_3: "ln x = (1::real) \ x < 3" proof- assume "ln x = 1" also have "(1::real) \ ln (exp 1)" by simp finally have "ln x \ ln (exp 1)" by simp hence "x \ exp 1" by (cases "x > 0") (force simp del: ln_exp simp add: not_less intro: order.trans)+ also have "... < 3" by (rule exp_1_lt_3) finally show ?thesis . qed lemma ln_1_imp_less_3': "ln (real (x::nat)) = 1 \ x < 3" by (drule ln_1_imp_less_3) simp lemma ln_ln_nonneg: "x \ (3::real) \ ln (ln x) \ 0" using ln_ln_pos[of "x"] by simp lemma ln_ln_nonneg': "x \ (3::nat) \ ln (ln (real x)) \ 0" using ln_ln_pos[of "real x"] by simp lemma MASTER_BOUND_postproc: "CLAMP (MASTER_BOUND' a 0) = CLAMP (MASTER_BOUND'' a)" "CLAMP (MASTER_BOUND' a 1) = CLAMP (\x. CLAMP (MASTER_BOUND'' a) x * CLAMP (\x. ln (real x)) x)" "CLAMP (MASTER_BOUND' a (numeral n)) = CLAMP (\x. CLAMP (MASTER_BOUND'' a) x * CLAMP (\x. ln (real x) ^ numeral n) x)" "CLAMP (MASTER_BOUND' a (-1)) = CLAMP (\x. CLAMP (MASTER_BOUND'' a) x / CLAMP (\x. ln (real x)) x)" "CLAMP (MASTER_BOUND' a (-numeral n)) = CLAMP (\x. CLAMP (MASTER_BOUND'' a) x / CLAMP (\x. ln (real x) ^ numeral n) x)" "CLAMP (MASTER_BOUND' a b) = CLAMP (\x. CLAMP (MASTER_BOUND'' a) x * CLAMP (\x. ln (real x) powr b) x)" "CLAMP (MASTER_BOUND'' 0) = CLAMP (\x. 1)" "CLAMP (MASTER_BOUND'' 1) = CLAMP (\x. (real x))" "CLAMP (MASTER_BOUND'' (numeral n)) = CLAMP (\x. (real x) ^ numeral n)" "CLAMP (MASTER_BOUND'' (-1)) = CLAMP (\x. 1 / (real x))" "CLAMP (MASTER_BOUND'' (-numeral n)) = CLAMP (\x. 1 / (real x) ^ numeral n)" "CLAMP (MASTER_BOUND'' a) = CLAMP (\x. (real x) powr a)" and MASTER_BOUND_UNCLAMP: "CLAMP (\x. CLAMP f x * CLAMP g x) = CLAMP (\x. f x * g x)" "CLAMP (\x. CLAMP f x / CLAMP g x) = CLAMP (\x. f x / g x)" "CLAMP (CLAMP f) = CLAMP f" unfolding CLAMP_def[abs_def] MASTER_BOUND'_def[abs_def] MASTER_BOUND''_def[abs_def] by (simp_all add: powr_minus divide_inverse fun_eq_iff) context begin private lemma CLAMP_: "landau_symbol L L' Lr \ L at_top (f::nat \ real) \ L at_top (\x. CLAMP f x)" unfolding CLAMP_def[abs_def] by (intro landau_symbol.cong eq_reflection) (auto intro: eventually_mono[OF eventually_ge_at_top[of "3::nat"]]) private lemma UNCLAMP'_: "landau_symbol L L' Lr \ L at_top (CLAMP' (MASTER_BOUND a b c)) \ L at_top (MASTER_BOUND a b c)" unfolding CLAMP'_def[abs_def] CLAMP_def[abs_def] by (intro landau_symbol.cong eq_reflection) (auto intro: eventually_mono[OF eventually_ge_at_top[of "3::nat"]]) private lemma UNCLAMP_: "landau_symbol L L' Lr \ L at_top (CLAMP f) \ L at_top (f)" using eventually_ge_at_top[of "3::nat"] unfolding CLAMP'_def[abs_def] CLAMP_def[abs_def] by (intro landau_symbol.cong eq_reflection) (auto intro: eventually_mono[OF eventually_ge_at_top[of "3::nat"]]) lemmas CLAMP = landau_symbols[THEN CLAMP_] lemmas UNCLAMP' = landau_symbols[THEN UNCLAMP'_] lemmas UNCLAMP = landau_symbols[THEN UNCLAMP_] end lemma propagate_CLAMP: "CLAMP (\x. f x * g x) = CLAMP' (\x. CLAMP f x * CLAMP g x)" "CLAMP (\x. f x / g x) = CLAMP' (\x. CLAMP f x / CLAMP g x)" "CLAMP (\x. inverse (f x)) = CLAMP' (\x. inverse (CLAMP f x))" "CLAMP (\x. real x) = CLAMP' (MASTER_BOUND 1 0 0)" "CLAMP (\x. real x powr a) = CLAMP' (MASTER_BOUND a 0 0)" "CLAMP (\x. real x ^ a') = CLAMP' (MASTER_BOUND (real a') 0 0)" "CLAMP (\x. ln (real x)) = CLAMP' (MASTER_BOUND 0 1 0)" "CLAMP (\x. ln (real x) powr b) = CLAMP' (MASTER_BOUND 0 b 0)" "CLAMP (\x. ln (real x) ^ b') = CLAMP' (MASTER_BOUND 0 (real b') 0)" "CLAMP (\x. ln (ln (real x))) = CLAMP' (MASTER_BOUND 0 0 1)" "CLAMP (\x. ln (ln (real x)) powr c) = CLAMP' (MASTER_BOUND 0 0 c)" "CLAMP (\x. ln (ln (real x)) ^ c') = CLAMP' (MASTER_BOUND 0 0 (real c'))" "CLAMP' (CLAMP f) = CLAMP' f" "CLAMP' (\x. CLAMP' (MASTER_BOUND a1 b1 c1) x * CLAMP' (MASTER_BOUND a2 b2 c2) x) = CLAMP' (MASTER_BOUND (a1+a2) (b1+b2) (c1+c2))" "CLAMP' (\x. CLAMP' (MASTER_BOUND a1 b1 c1) x / CLAMP' (MASTER_BOUND a2 b2 c2) x) = CLAMP' (MASTER_BOUND (a1-a2) (b1-b2) (c1-c2))" "CLAMP' (\x. inverse (MASTER_BOUND a1 b1 c1 x)) = CLAMP' (MASTER_BOUND (-a1) (-b1) (-c1))" by (insert ln_1_imp_less_3') (rule ext, simp add: CLAMP_def CLAMP'_def MASTER_BOUND_def powr_realpow powr_one[OF ln_ln_nonneg'] powr_realpow[OF ln_ln_pos] powr_add powr_diff powr_minus)+ lemma numeral_assoc_simps: "((a::real) + numeral b) + numeral c = a + numeral (b + c)" "(a + numeral b) - numeral c = a + neg_numeral_class.sub b c" "(a - numeral b) + numeral c = a + neg_numeral_class.sub c b" "(a - numeral b) - numeral c = a - numeral (b + c)" by simp_all lemmas CLAMP_aux = arith_simps numeral_assoc_simps of_nat_power of_nat_mult of_nat_numeral one_add_one numeral_One [symmetric] lemmas CLAMP_postproc = numeral_One context master_theorem_function begin lemma master1_bigo_automation: assumes "g \ O(\x. real x powr p')" "1 < (\i O(MASTER_BOUND p 0 0)" proof- have "MASTER_BOUND p 0 0 \ \(\x::nat. x powr p)" unfolding MASTER_BOUND_def[abs_def] by (intro landau_real_nat_transfer bigthetaI_cong eventually_mono[OF eventually_ge_at_top[of "3::real"]]) (auto dest!: ln_1_imp_less_3) from landau_o.big.cong_bigtheta[OF this] master1_bigo[OF assms] show ?thesis by simp qed lemma master1_automation: assumes "g \ O(MASTER_BOUND'' p')" "1 < (\ix. f x > 0) at_top" shows "f \ \(MASTER_BOUND p 0 0)" proof- have A: "MASTER_BOUND p 0 0 \ \(\x::nat. x powr p)" unfolding MASTER_BOUND_def[abs_def] by (intro landau_real_nat_transfer bigthetaI_cong eventually_mono[OF eventually_ge_at_top[of "3::real"]]) (auto dest!: ln_1_imp_less_3) have B: "O(MASTER_BOUND'' p') = O(\x::nat. real x powr p')" using eventually_ge_at_top[of "2::nat"] by (intro landau_o.big.cong) (auto elim!: eventually_mono simp: MASTER_BOUND''_def) from landau_theta.cong_bigtheta[OF A] B assms(1) master1[OF _ assms(2-)] show ?thesis by simp qed lemma master2_1_automation: assumes "g \ \(MASTER_BOUND' p p')" "p' < -1" shows "f \ \(MASTER_BOUND p 0 0)" proof- have A: "MASTER_BOUND p 0 0 \ \(\x::nat. x powr p)" unfolding MASTER_BOUND_def[abs_def] by (intro landau_real_nat_transfer bigthetaI_cong eventually_mono[OF eventually_ge_at_top[of "3::real"]]) (auto dest!: ln_1_imp_less_3) have B: "\(MASTER_BOUND' p p') = \(\x::nat. real x powr p * ln (real x) powr p')" by (subst CLAMP, (subst MASTER_BOUND_postproc MASTER_BOUND_UNCLAMP)+, simp only: UNCLAMP) from landau_theta.cong_bigtheta[OF A] B assms(1) master2_1[OF _ assms(2-)] show ?thesis by simp qed lemma master2_2_automation: assumes "g \ \(MASTER_BOUND' p (-1))" shows "f \ \(MASTER_BOUND p 0 1)" proof- have A: "MASTER_BOUND p 0 1 \ \(\x::nat. x powr p * ln (ln x))" unfolding MASTER_BOUND_def[abs_def] using eventually_ge_at_top[of "3::real"] apply (intro landau_real_nat_transfer, intro bigthetaI_cong) apply (elim eventually_mono, subst powr_one[OF ln_ln_nonneg]) apply simp_all done have B: "\(MASTER_BOUND' p (-1)) = \(\x::nat. real x powr p / ln (real x))" by (subst CLAMP, (subst MASTER_BOUND_postproc MASTER_BOUND_UNCLAMP)+, simp only: UNCLAMP) from landau_theta.cong_bigtheta[OF A] B assms(1) master2_2 show ?thesis by simp qed lemma master2_3_automation: assumes "g \ \(MASTER_BOUND' p (p' - 1))" "p' > 0" shows "f \ \(MASTER_BOUND p p' 0)" proof- have A: "MASTER_BOUND p p' 0 \ \(\x::nat. x powr p * ln x powr p')" unfolding MASTER_BOUND_def[abs_def] using eventually_ge_at_top[of "3::real"] apply (intro landau_real_nat_transfer, intro bigthetaI_cong) apply (elim eventually_mono, auto dest: ln_1_imp_less_3) done have B: "\(MASTER_BOUND' p (p' - 1)) = \(\x::nat. real x powr p * ln x powr (p' - 1))" by (subst CLAMP, (subst MASTER_BOUND_postproc MASTER_BOUND_UNCLAMP)+, simp only: UNCLAMP) from landau_theta.cong_bigtheta[OF A] B assms(1) master2_3[OF _ assms(2-)] show ?thesis by simp qed lemma master3_automation: assumes "g \ \(MASTER_BOUND'' p')" "1 > (\i \(MASTER_BOUND p' 0 0)" proof- have A: "MASTER_BOUND p' 0 0 \ \(\x::nat. x powr p')" unfolding MASTER_BOUND_def[abs_def] using eventually_ge_at_top[of "3::real"] apply (intro landau_real_nat_transfer, intro bigthetaI_cong) apply (elim eventually_mono, auto dest: ln_1_imp_less_3) done have B: "\(MASTER_BOUND'' p') = \(\x::nat. real x powr p')" by (subst CLAMP, (subst MASTER_BOUND_postproc)+, simp only: UNCLAMP) from landau_theta.cong_bigtheta[OF A] B assms(1) master3[OF _ assms(2-)] show ?thesis by simp qed lemmas master_automation = master1_automation master2_1_automation master2_2_automation master2_2_automation master3_automation ML \ fun generalize_master_thm ctxt thm = let val ([p'], ctxt') = Variable.variant_fixes ["p''"] ctxt val p' = Free (p', HOLogic.realT) val a = @{term "nth as"} $ Bound 0 val b = @{term "Transcendental.powr :: real => real => real"} $ (@{term "nth bs"} $ Bound 0) $ p' val f = Abs ("i", HOLogic.natT, @{term "(*) :: real => real => real"} $ a $ b) val sum = @{term "sum :: (nat => real) => nat set => real"} $ f $ @{term "{.. Local_Defs.unfold ctxt' [Thm.assume cprop RS @{thm p_unique}] |> Thm.implies_intr cprop |> rotate_prems 1 |> singleton (Variable.export ctxt' ctxt) end fun generalize_master_thm' (binding, thm) ctxt = Local_Theory.note ((binding, []), [generalize_master_thm ctxt thm]) ctxt |> snd \ local_setup \ fold generalize_master_thm' [(@{binding master1_automation'}, @{thm master1_automation}), (@{binding master1_bigo_automation'}, @{thm master1_bigo_automation}), (@{binding master2_1_automation'}, @{thm master2_1_automation}), (@{binding master2_2_automation'}, @{thm master2_2_automation}), (@{binding master2_3_automation'}, @{thm master2_3_automation}), (@{binding master3_automation'}, @{thm master3_automation})] \ end definition "arith_consts (x :: real) (y :: nat) = (if \ (-x) + 3 / x * 5 - 1 \ x \ True \ True \ True then x < inverse 3 powr 21 else x = real (Suc 0 ^ 2 + (if 42 - x \ 1 \ 1 div y = y mod 2 \ y < Numeral1 then 0 else 0)) + Numeral1)" ML_file \akra_bazzi.ML\ hide_const arith_consts method_setup master_theorem = \ Akra_Bazzi.setup_master_theorem \ "automatically apply the Master theorem for recursive functions" method_setup akra_bazzi_termination = \ Scan.succeed (fn ctxt => SIMPLE_METHOD' (Akra_Bazzi.akra_bazzi_termination_tac ctxt)) \ "prove termination of Akra-Bazzi functions" hide_const CLAMP CLAMP' MASTER_BOUND MASTER_BOUND' MASTER_BOUND'' end diff --git a/thys/Akra_Bazzi/Akra_Bazzi_Real.thy b/thys/Akra_Bazzi/Akra_Bazzi_Real.thy --- a/thys/Akra_Bazzi/Akra_Bazzi_Real.thy +++ b/thys/Akra_Bazzi/Akra_Bazzi_Real.thy @@ -1,1262 +1,1262 @@ (* File: Akra_Bazzi_Real.thy - Author: Manuel Eberl + Author: Manuel Eberl The continuous version of the Akra-Bazzi theorem for functions on the reals. *) section \The continuous Akra-Bazzi theorem\ theory Akra_Bazzi_Real imports Complex_Main Akra_Bazzi_Asymptotics begin text \ We want to be generic over the integral definition used; we fix some arbitrary notions of integrability and integral and assume just the properties we need. The user can then instantiate the theorems with any desired integral definition. \ locale akra_bazzi_integral = fixes integrable :: "(real \ real) \ real \ real \ bool" and integral :: "(real \ real) \ real \ real \ real" assumes integrable_const: "c \ 0 \ integrable (\_. c) a b" and integral_const: "c \ 0 \ a \ b \ integral (\_. c) a b = (b - a) * c" and integrable_subinterval: "integrable f a b \ a \ a' \ b' \ b \ integrable f a' b'" and integral_le: "integrable f a b \ integrable g a b \ (\x. x \ {a..b} \ f x \ g x) \ integral f a b \ integral g a b" and integral_combine: "a \ c \ c \ b \ integrable f a b \ integral f a c + integral f c b = integral f a b" begin lemma integral_nonneg: "a \ b \ integrable f a b \ (\x. x \ {a..b} \ f x \ 0) \ integral f a b \ 0" using integral_le[OF integrable_const[of 0], of f a b] by (simp add: integral_const) end declare sum.cong[fundef_cong] lemma strict_mono_imp_ex1_real: fixes f :: "real \ real" assumes lim_neg_inf: "LIM x at_bot. f x :> at_top" assumes lim_inf: "(f \ z) at_top" assumes mono: "\a b. a < b \ f b < f a" assumes cont: "\x. isCont f x" assumes y_greater_z: "z < y" shows "\!x. f x = y" proof (rule ex_ex1I) fix a b assume "f a = y" "f b = y" thus "a = b" by (cases rule: linorder_cases[of a b]) (auto dest: mono) next from lim_neg_inf have "eventually (\x. y \ f x) at_bot" by (subst (asm) filterlim_at_top) simp then obtain l where l: "\x. x \ l \ y \ f x" by (subst (asm) eventually_at_bot_linorder) auto from order_tendstoD(2)[OF lim_inf y_greater_z] obtain u where u: "\x. x \ u \ f x < y" by (subst (asm) eventually_at_top_linorder) auto define a where "a = min l u" define b where "b = max l u" have a: "f a \ y" unfolding a_def by (intro l) simp moreover have b: "f b < y" unfolding b_def by (intro u) simp moreover have a_le_b: "a \ b" by (simp add: a_def b_def) ultimately have "\x\a. x \ b \ f x = y" using cont by (intro IVT2) auto thus "\x. f x = y" by blast qed text \The parameter @{term "p"} in the Akra-Bazzi theorem always exists and is unique.\ definition akra_bazzi_exponent :: "real list \ real list \ real" where "akra_bazzi_exponent as bs \ (THE p. (\i 0" and a_ge_0: "a \ set as \ a \ 0" and b_bounds: "b \ set bs \ b \ {0<..<1}" begin abbreviation p :: real where "p \ akra_bazzi_exponent as bs" lemma p_def: "p = (THE p. (\i set bs \ b > 0" and b_less_1: "b \ set bs \ b < 1" using b_bounds by simp_all lemma as_nonempty [simp]: "as \ []" and bs_nonempty [simp]: "bs \ []" using length_as length_bs k_not_0 by auto lemma a_in_as[intro, simp]: "i < k \ as ! i \ set as" by (rule nth_mem) (simp add: length_as) lemma b_in_bs[intro, simp]: "i < k \ bs ! i \ set bs" by (rule nth_mem) (simp add: length_bs) end locale akra_bazzi_params_nonzero = fixes k :: nat and as bs :: "real list" assumes length_as: "length as = k" and length_bs: "length bs = k" and a_ge_0: "a \ set as \ a \ 0" and ex_a_pos: "\a\set as. a > 0" and b_bounds: "b \ set bs \ b \ {0<..<1}" begin sublocale akra_bazzi_params k as bs by unfold_locales (insert length_as length_bs a_ge_0 ex_a_pos b_bounds, auto) lemma akra_bazzi_p_strict_mono: assumes "x < y" shows "(\ii set as" "a > 0" by blast then obtain i where "i < k" "as!i > 0" by (force simp: in_set_conv_nth length_as) with b_bounds \x < y\ have "as!i * bs!i powr y < as!i * bs!i powr x" by (intro mult_strict_left_mono powr_less_mono') auto with \i < k\ show "\i\{.. {..x < y\ show "as!i * bs!i powr y \ as!i * bs!i powr x" by (intro mult_left_mono powr_mono') simp_all qed simp_all lemma akra_bazzi_p_mono: assumes "x \ y" shows "(\i (\i!p. (\i 0" by (auto simp: length_as[symmetric]) have [simp]: "\i. i < k \ as!i \ 0" by (rule a_ge_0) simp from ex_a_pos obtain a where "a \ set as" "a > 0" by blast then obtain i where i: "i < k" "as!i > 0" by (force simp: in_set_conv_nth length_as) hence "LIM p at_bot. as!i * bs!i powr p :> at_top" using b_bounds i by (intro filterlim_tendsto_pos_mult_at_top[OF tendsto_const] real_powr_at_bot_neg) simp_all moreover have "\p. as!i*bs!i powr p \ (\i\{..i\{.. 0" by (intro sum_nonneg mult_nonneg_nonneg) simp_all also have "as!i * bs!i powr p + ... = (\i\insert i {.. (\i\{..i at_top" by (rule filterlim_at_top_mono[OF _ always_eventually]) next from b_bounds show "((\x. \i (\ii. i < k \ bs ! i > 0" by simp show "isCont (\x. \iii p = p'" proof- from theI'[OF akra_bazzi_p_unique] the1_equality[OF akra_bazzi_p_unique] show "(\ii p = p'" unfolding p_def by - blast+ qed lemma p_greaterI: "1 < (\i p' < p" by (rule disjE[OF le_less_linear, of p p'], drule akra_bazzi_p_mono, subst (asm) p_props, simp_all) lemma p_lessI: "1 > (\i p' > p" by (rule disjE[OF le_less_linear, of p' p], drule akra_bazzi_p_mono, subst (asm) p_props, simp_all) lemma p_geI: "1 \ (\i p' \ p" by (rule disjE[OF le_less_linear, of p' p], simp, drule akra_bazzi_p_strict_mono, subst (asm) p_props, simp_all) lemma p_leI: "1 \ (\i p' \ p" by (rule disjE[OF le_less_linear, of p p'], simp, drule akra_bazzi_p_strict_mono, subst (asm) p_props, simp_all) lemma p_boundsI: "(\i 1 \ (\i 1 \ p \ {y..x}" by (elim conjE, drule p_leI, drule p_geI, simp) lemma p_boundsI': "(\i (\i 1 \ p \ {y<.. 1 \ p \ 0" proof (rule p_geI) assume "sum_list as \ 1" also have "... = (\i 0" by simp hence "as!i * bs!i powr 0 = as!i" by simp } hence "(\ii (\i real) list" and k :: nat and x\<^sub>0 x\<^sub>1 hb e p :: real assumes length_as: "length as = k" and length_bs: "length bs = k" and length_hs: "length hs = k" and k_not_0: "k \ 0" and a_ge_0: "a \ set as \ a \ 0" and b_bounds: "b \ set bs \ b \ {0<..<1}" (* The recursively-defined function *) and x0_ge_1: "x\<^sub>0 \ 1" and x0_le_x1: "x\<^sub>0 \ x\<^sub>1" and x1_ge: "b \ set bs \ x\<^sub>1 \ 2 * x\<^sub>0 * inverse b" (* Bounds on the variation functions *) and e_pos: "e > 0" and h_bounds: "x \ x\<^sub>1 \ h \ set hs \ \h x\ \ hb * x / ln x powr (1 + e)" (* Asymptotic inequalities *) and asymptotics: "x \ x\<^sub>0 \ b \ set bs \ akra_bazzi_asymptotics b hb e p x" begin sublocale akra_bazzi_params k as bs using length_as length_bs k_not_0 a_ge_0 b_bounds by unfold_locales lemma h_in_hs[intro, simp]: "i < k \ hs ! i \ set hs" by (rule nth_mem) (simp add: length_hs) lemma x1_gt_1: "x\<^sub>1 > 1" proof- from bs_nonempty obtain b where "b \ set bs" by (cases bs) auto from b_pos[OF this] b_less_1[OF this] x0_ge_1 have "1 < 2 * x\<^sub>0 * inverse b" by (simp add: field_simps) also from x1_ge and \b \ set bs\ have "... \ x\<^sub>1" by simp finally show ?thesis . qed lemma x1_ge_1: "x\<^sub>1 \ 1" using x1_gt_1 by simp lemma x1_pos: "x\<^sub>1 > 0" using x1_ge_1 by simp lemma bx_le_x: "x \ 0 \ b \ set bs \ b * x \ x" using b_pos[of b] b_less_1[of b] by (intro mult_left_le_one_le) (simp_all) lemma x0_pos: "x\<^sub>0 > 0" using x0_ge_1 by simp lemma assumes "x \ x\<^sub>0" "b \ set bs" shows x0_hb_bound0: "hb / ln x powr (1 + e) < b/2" and x0_hb_bound1: "hb / ln x powr (1 + e) < (1 - b) / 2" and x0_hb_bound2: "x*(1 - b - hb / ln x powr (1 + e)) > 1" using asymptotics[OF assms] unfolding akra_bazzi_asymptotic_defs by blast+ lemma step_diff: assumes "i < k" "x \ x\<^sub>1" shows "bs ! i * x + (hs ! i) x + 1 < x" proof- have "bs ! i * x + (hs ! i) x + 1 \ bs ! i * x + \(hs ! i) x\ + 1" by simp also from assms have "\(hs ! i) x\ \ hb * x / ln x powr (1 + e)" by (simp add: h_bounds) also from assms x0_le_x1 have "x*(1 - bs ! i - hb / ln x powr (1 + e)) > 1" by (simp add: x0_hb_bound2) hence "bs ! i * x + hb * x / ln x powr (1 + e) + 1 < x" by (simp add: algebra_simps) finally show ?thesis by simp qed lemma step_le_x: "i < k \ x \ x\<^sub>1 \ bs ! i * x + (hs ! i) x \ x" by (drule (1) step_diff) simp lemma x0_hb_bound0': "\x b. x \ x\<^sub>0 \ b \ set bs \ hb / ln x powr (1 + e) < b" by (drule (1) x0_hb_bound0, erule less_le_trans) (simp add: b_pos) lemma step_pos: assumes "i < k" "x \ x\<^sub>1" shows "bs ! i * x + (hs ! i) x > 0" proof- from assms x0_le_x1 have "hb / ln x powr (1 + e) < bs ! i" by (simp add: x0_hb_bound0') with assms x0_pos x0_le_x1 have "x * 0 < x * (bs ! i - hb / ln x powr (1 + e))" by simp also have "... = bs ! i * x - hb * x / ln x powr (1 + e)" by (simp add: algebra_simps) also from assms have "-hb * x / ln x powr (1 + e) \ -\(hs ! i) x\" by (simp add: h_bounds) hence "bs ! i * x - hb * x / ln x powr (1 + e) \ bs ! i * x + -\(hs ! i) x\" by simp also have "-\(hs ! i) x\ \ (hs ! i) x" by simp finally show "bs ! i * x + (hs ! i) x > 0" by simp qed lemma step_nonneg: "i < k \ x \ x\<^sub>1 \ bs ! i * x + (hs ! i) x \ 0" by (drule (1) step_pos) simp lemma step_nonneg': "i < k \ x \ x\<^sub>1 \ bs ! i + (hs ! i) x / x \ 0" by (frule (1) step_nonneg, insert x0_pos x0_le_x1) (simp_all add: field_simps) lemma hb_nonneg: "hb \ 0" proof- from k_not_0 and length_hs have "hs \ []" by auto then obtain h where h: "h \ set hs" by (cases hs) auto have "0 \ \h x\<^sub>1\" by simp also from h have "\h x\<^sub>1\ \ hb * x\<^sub>1 / ln x\<^sub>1 powr (1+e)" by (intro h_bounds) simp_all finally have "0 \ hb * x\<^sub>1 / ln x\<^sub>1 powr (1 + e)" . hence "0 \ ... * (ln x\<^sub>1 powr (1 + e) / x\<^sub>1)" by (rule mult_nonneg_nonneg) (intro divide_nonneg_nonneg, insert x1_pos, simp_all) also have "... = hb" using x1_gt_1 by (simp add: field_simps) finally show ?thesis . qed lemma x0_hb_bound3: assumes "x \ x\<^sub>1" "i < k" shows "x - (bs ! i * x + (hs ! i) x) \ x" proof- have "-(hs ! i) x \ \(hs ! i) x\" by simp also from assms have "... \ hb * x / ln x powr (1 + e)" by (simp add: h_bounds) also have "... = x * (hb / ln x powr (1 + e))" by simp also from assms x0_pos x0_le_x1 have "... < x * bs ! i" by (intro mult_strict_left_mono x0_hb_bound0') simp_all finally show ?thesis by (simp add: algebra_simps) qed lemma x0_hb_bound4: assumes "x \ x\<^sub>1" "i < k" shows "(bs ! i + (hs ! i) x / x) > bs ! i / 2" proof- from assms x0_le_x1 have "hb / ln x powr (1 + e) < bs ! i / 2" by (intro x0_hb_bound0) simp_all with assms x0_pos x0_le_x1 have "(-bs ! i / 2) * x < (-hb / ln x powr (1 + e)) * x" by (intro mult_strict_right_mono) simp_all also from assms x0_pos have "... \ -\(hs ! i) x\" using h_bounds by simp also have "... \ (hs ! i) x" by simp finally show ?thesis using assms x1_pos by (simp add: field_simps) qed lemma x0_hb_bound4': "x \ x\<^sub>1 \ i < k \ (bs ! i + (hs ! i) x / x) \ bs ! i / 2" by (drule (1) x0_hb_bound4) simp lemma x0_hb_bound5: assumes "x \ x\<^sub>1" "i < k" shows "(bs ! i + (hs ! i) x / x) \ bs ! i * 3/2" proof- have "(hs ! i) x \ \(hs ! i) x\" by simp also from assms have "... \ hb * x / ln x powr (1 + e)" by (simp add: h_bounds) also have "... = x * (hb / ln x powr (1 + e))" by simp also from assms x0_pos x0_le_x1 have "... < x * (bs ! i / 2)" by (intro mult_strict_left_mono x0_hb_bound0) simp_all finally show ?thesis using assms x1_pos by (simp add: field_simps) qed lemma x0_hb_bound6: assumes "x \ x\<^sub>1" "i < k" shows "x * ((1 - bs ! i) / 2) \ x - (bs ! i * x + (hs ! i) x)" proof- from assms x0_le_x1 have "hb / ln x powr (1 + e) < (1 - bs ! i) / 2" using x0_hb_bound1 by simp with assms x1_pos have "x * ((1 - bs ! i) / 2) \ x * (1 - (bs ! i + hb / ln x powr (1 + e)))" by (intro mult_left_mono) (simp_all add: field_simps) also have "... = x - bs ! i * x + -hb * x / ln x powr (1 + e)" by (simp add: algebra_simps) also from h_bounds assms have "-hb * x / ln x powr (1 + e) \ -\(hs ! i) x\" by (simp add: length_hs) also have "... \ -(hs ! i) x" by simp finally show ?thesis by (simp add: algebra_simps) qed lemma x0_hb_bound7: assumes "x \ x\<^sub>1" "i < k" shows "bs!i*x + (hs!i) x > x\<^sub>0" proof- from assms x0_le_x1 have x': "x \ x\<^sub>0" by simp from x1_ge assms have "2 * x\<^sub>0 * inverse (bs!i) \ x\<^sub>1" by simp with assms b_pos have "x\<^sub>0 \ x\<^sub>1 * (bs!i / 2)" by (simp add: field_simps) also from assms x' have "bs!i/2 < bs!i + (hs!i) x / x" by (intro x0_hb_bound4) also from assms step_nonneg' x' have "x\<^sub>1 * ... \ x * ..." by (intro mult_right_mono) (simp_all) also from assms x1_pos have "x * (bs!i + (hs!i) x / x) = bs!i*x + (hs!i) x" by (simp add: field_simps) finally show ?thesis using x1_pos by simp qed lemma x0_hb_bound7': "x \ x\<^sub>1 \ i < k \ bs!i*x + (hs!i) x > 1" by (rule le_less_trans[OF _ x0_hb_bound7]) (insert x0_le_x1 x0_ge_1, simp_all) lemma x0_hb_bound8: assumes "x \ x\<^sub>1" "i < k" shows "bs!i*x - hb * x / ln x powr (1+e) > x\<^sub>0" proof- from assms have "2 * x\<^sub>0 * inverse (bs!i) \ x\<^sub>1" by (intro x1_ge) simp_all with b_pos assms have "x\<^sub>0 \ x\<^sub>1 * (bs!i/2)" by (simp add: field_simps) also from assms b_pos have "... \ x * (bs!i/2)" by simp also from assms x0_le_x1 have "hb / ln x powr (1+e) < bs!i/2" by (intro x0_hb_bound0) simp_all with assms have "bs!i/2 < bs!i - hb / ln x powr (1+e)" by (simp add: field_simps) also have "x * ... = bs!i*x - hb * x / ln x powr (1+e)" by (simp add: algebra_simps) finally show ?thesis using assms x1_pos by (simp add: field_simps) qed lemma x0_hb_bound8': assumes "x \ x\<^sub>1" "i < k" shows "bs!i*x + hb * x / ln x powr (1+e) > x\<^sub>0" proof- from assms have "x\<^sub>0 < bs!i*x - hb * x / ln x powr (1+e)" by (rule x0_hb_bound8) also from assms hb_nonneg x1_pos have "hb * x / ln x powr (1+e) \ 0" by (intro mult_nonneg_nonneg divide_nonneg_nonneg) simp_all hence "bs!i*x - hb * x / ln x powr (1+e) \ bs!i*x + hb * x / ln x powr (1+e)" by simp finally show ?thesis . qed lemma assumes "x \ x\<^sub>0" shows asymptotics1: "i < k \ 1 + ln x powr (- e / 2) \ (1 - hb * inverse (bs!i) * ln x powr -(1+e)) powr p * (1 + ln (bs!i*x + hb*x/ln x powr (1+e)) powr (-e/2))" and asymptotics2: "i < k \ 1 - ln x powr (- e / 2) \ (1 + hb * inverse (bs!i) * ln x powr -(1+e)) powr p * (1 - ln (bs!i*x + hb*x/ln x powr (1+e)) powr (-e/2))" and asymptotics1': "i < k \ 1 + ln x powr (- e / 2) \ (1 + hb * inverse (bs!i) * ln x powr -(1+e)) powr p * (1 + ln (bs!i*x + hb*x/ln x powr (1+e)) powr (-e/2))" and asymptotics2': "i < k \ 1 - ln x powr (- e / 2) \ (1 - hb * inverse (bs!i) * ln x powr -(1+e)) powr p * (1 - ln (bs!i*x + hb*x/ln x powr (1+e)) powr (-e/2))" and asymptotics3: "(1 + ln x powr (- e / 2)) / 2 \ 1" and asymptotics4: "(1 - ln x powr (- e / 2)) * 2 \ 1" and asymptotics5: "i < k \ ln (bs!i*x - hb*x*ln x powr -(1+e)) powr (-e/2) < 1" apply - using assms asymptotics[of x "bs!i"] unfolding akra_bazzi_asymptotic_defs apply simp_all[4] using assms asymptotics[of x "bs!0"] unfolding akra_bazzi_asymptotic_defs apply simp_all[2] using assms asymptotics[of x "bs!i"] unfolding akra_bazzi_asymptotic_defs apply simp_all done lemma x0_hb_bound9: assumes "x \ x\<^sub>1" "i < k" shows "ln (bs!i*x + (hs!i) x) powr -(e/2) < 1" proof- from b_pos assms have "0 < bs!i/2" by simp also from assms x0_le_x1 have "... < bs!i + (hs!i) x / x" by (intro x0_hb_bound4) simp_all also from assms x1_pos have "x * ... = bs!i*x + (hs!i) x" by (simp add: field_simps) finally have pos: "bs!i*x + (hs!i) x > 0" using assms x1_pos by simp from x0_hb_bound8[OF assms] x0_ge_1 have pos': "bs!i*x - hb * x / ln x powr (1+e) > 1" by simp from assms have "-(hb * x / ln x powr (1+e)) \ -\(hs!i) x\" by (intro le_imp_neg_le h_bounds) simp_all also have "... \ (hs!i) x" by simp finally have "ln (bs!i*x - hb * x / ln x powr (1+e)) \ ln (bs!i*x + (hs!i) x)" using assms b_pos x0_pos pos' by (intro ln_mono mult_pos_pos pos) simp_all hence "ln (bs!i*x + (hs!i) x) powr -(e/2) \ ln (bs!i*x - hb * x / ln x powr (1+e)) powr -(e/2)" using assms e_pos asymptotics5[of x] pos' by (intro powr_mono2' ln_gt_zero) simp_all also have "... < 1" using asymptotics5[of x i] assms x0_le_x1 by (subst (asm) powr_minus) (simp_all add: field_simps) finally show ?thesis . qed definition akra_bazzi_measure :: "real \ nat" where "akra_bazzi_measure x = nat \x\" lemma akra_bazzi_measure_decreases: assumes "x \ x\<^sub>1" "i < k" shows "akra_bazzi_measure (bs!i*x + (hs!i) x) < akra_bazzi_measure x" proof- from step_diff assms have "(bs!i * x + (hs!i) x) + 1 < x" by (simp add: algebra_simps) hence "\(bs!i * x + (hs!i) x) + 1\ \ \x\" by (intro ceiling_mono) simp hence "\(bs!i * x + (hs!i) x)\ < \x\" by simp with assms x1_pos have "nat \(bs!i * x + (hs!i) x)\ < nat \x\" by (subst nat_mono_iff) simp_all thus ?thesis unfolding akra_bazzi_measure_def . qed lemma akra_bazzi_induct[consumes 1, case_names base rec]: assumes "x \ x\<^sub>0" assumes base: "\x. x \ x\<^sub>0 \ x \ x\<^sub>1 \ P x" assumes rec: "\x. x > x\<^sub>1 \ (\i. i < k \ P (bs!i*x + (hs!i) x)) \ P x" shows "P x" proof (insert \x \ x\<^sub>0\, induction "akra_bazzi_measure x" arbitrary: x rule: less_induct) case less show ?case proof (cases "x \ x\<^sub>1") case True with base and \x \ x\<^sub>0\ show ?thesis . next case False hence x: "x > x\<^sub>1" by simp thus ?thesis proof (rule rec) fix i assume i: "i < k" from x0_hb_bound7[OF _ i, of x] x have "bs!i*x + (hs!i) x \ x\<^sub>0" by simp with i x show "P (bs ! i * x + (hs ! i) x)" by (intro less akra_bazzi_measure_decreases) simp_all qed qed qed end locale akra_bazzi_real = akra_bazzi_real_recursion + fixes integrable integral assumes integral: "akra_bazzi_integral integrable integral" fixes f :: "real \ real" and g :: "real \ real" and C :: real assumes p_props: "(\i x\<^sub>0 \ x \ x\<^sub>1 \ f x \ 0" and f_rec: "x > x\<^sub>1 \ f x = g x + (\i x\<^sub>0 \ g x \ 0" and C_bound: "b \ set bs \ x \ x\<^sub>1 \ C*x \ b*x - hb*x/ln x powr (1+e)" and g_integrable: "x \ x\<^sub>0 \ integrable (\u. g u / u powr (p + 1)) x\<^sub>0 x" begin interpretation akra_bazzi_integral integrable integral by (rule integral) lemma akra_bazzi_integrable: "a \ x\<^sub>0 \ a \ b \ integrable (\x. g x / x powr (p + 1)) a b" by (rule integrable_subinterval[OF g_integrable, of b]) simp_all definition g_approx :: "nat \ real \ real" where "g_approx i x = x powr p * integral (\u. g u / u powr (p + 1)) (bs!i * x + (hs!i) x) x" lemma f_nonneg: "x \ x\<^sub>0 \ f x \ 0" proof (induction x rule: akra_bazzi_induct) case (base x) with f_base[of x] show ?case by simp next case (rec x) with x0_le_x1 have "g x \ 0" by (intro g_nonneg) simp_all moreover { fix i assume i: "i < k" with rec.IH have "f (bs!i*x + (hs!i) x) \ 0" by simp with i have "as!i * f (bs!i*x + (hs!i) x) \ 0" by (intro mult_nonneg_nonneg[OF a_ge_0]) simp_all } hence "(\i 0" by (intro sum_nonneg) blast ultimately show "f x \ 0" using rec.hyps by (subst f_rec) simp_all qed definition f_approx :: "real \ real" where "f_approx x = x powr p * (1 + integral (\u. g u / u powr (p + 1)) x\<^sub>0 x)" lemma f_approx_aux: assumes "x \ x\<^sub>0" shows "1 + integral (\u. g u / u powr (p + 1)) x\<^sub>0 x \ 1" proof- from assms have "integral (\u. g u / u powr (p + 1)) x\<^sub>0 x \ 0" by (intro integral_nonneg ballI g_nonneg divide_nonneg_nonneg g_integrable) simp_all thus ?thesis by simp qed lemma f_approx_pos: "x \ x\<^sub>0 \ f_approx x > 0" unfolding f_approx_def by (intro mult_pos_pos, insert x0_pos, simp, drule f_approx_aux, simp) lemma f_approx_nonneg: "x \ x\<^sub>0 \ f_approx x \ 0" using f_approx_pos[of x] by simp lemma f_approx_bounded_below: obtains c where "\x. x \ x\<^sub>0 \ x \ x\<^sub>1 \ f_approx x \ c" "c > 0" proof- { fix x assume x: "x \ x\<^sub>0" "x \ x\<^sub>1" with x0_pos have "x powr p \ min (x\<^sub>0 powr p) (x\<^sub>1 powr p)" by (intro powr_lower_bound) simp_all with x have "f_approx x \ min (x\<^sub>0 powr p) (x\<^sub>1 powr p) * 1" unfolding f_approx_def by (intro mult_mono f_approx_aux) simp_all } from this x0_pos x1_pos show ?thesis by (intro that[of "min (x\<^sub>0 powr p) (x\<^sub>1 powr p)"]) auto qed lemma asymptotics_aux: assumes "x \ x\<^sub>1" "i < k" assumes "s \ (if p \ 0 then 1 else -1)" shows "(bs!i*x - s*hb*x*ln x powr -(1+e)) powr p \ (bs!i*x + (hs!i) x) powr p" (is "?thesis1") and "(bs!i*x + (hs!i) x) powr p \ (bs!i*x + s*hb*x*ln x powr -(1+e)) powr p" (is "?thesis2") proof- from assms x1_gt_1 have ln_x_pos: "ln x > 0" by simp from assms x1_pos have x_pos: "x > 0" by simp from assms x0_le_x1 have *: "hb / ln x powr (1+e) < bs!i/2" by (intro x0_hb_bound0) simp_all with hb_nonneg ln_x_pos have "(bs!i - hb * ln x powr -(1+e)) > 0" by (subst powr_minus) (simp_all add: field_simps) with * have "0 < x * (bs!i - hb * ln x powr -(1+e))" using x_pos by (subst (asm) powr_minus, intro mult_pos_pos) hence A: "0 < bs!i*x - hb * x * ln x powr -(1+e)" by (simp add: algebra_simps) from assms have "-(hb*x*ln x powr -(1+e)) \ -\(hs!i) x\" using h_bounds[of x "hs!i"] by (subst neg_le_iff_le, subst powr_minus) (simp add: field_simps) also have "... \ (hs!i) x" by simp finally have B: "bs!i*x - hb*x*ln x powr -(1+e) \ bs!i*x + (hs!i) x" by simp have "(hs!i) x \ \(hs!i) x\" by simp also from assms have "... \ (hb*x*ln x powr -(1+e))" using h_bounds[of x "hs!i"] by (subst powr_minus) (simp_all add: field_simps) finally have C: "bs!i*x + hb*x*ln x powr -(1+e) \ bs!i*x + (hs!i) x" by simp from A B C show ?thesis1 by (cases "p \ 0") (auto intro: powr_mono2 powr_mono2' simp: assms(3)) from A B C show ?thesis2 by (cases "p \ 0") (auto intro: powr_mono2 powr_mono2' simp: assms(3)) qed lemma asymptotics1': assumes "x \ x\<^sub>1" "i < k" shows "(bs!i*x) powr p * (1 + ln x powr (-e/2)) \ (bs!i*x + (hs!i) x) powr p * (1 + ln (bs!i*x + (hs!i) x) powr (-e/2))" proof- from assms x0_le_x1 have x: "x \ x\<^sub>0" by simp from b_pos[of "bs!i"] assms have b_pos: "bs!i > 0" "bs!i \ 0" by simp_all from b_less_1[of "bs!i"] assms have b_less_1: "bs!i < 1" by simp from x1_gt_1 assms have ln_x_pos: "ln x > 0" by simp have mono: "\a b. a \ b \ (bs!i*x) powr p * a \ (bs!i*x) powr p * b" by (rule mult_left_mono) simp_all define s :: real where [abs_def]: "s = (if p \ 0 then 1 else -1)" have "1 + ln x powr (-e/2) \ (1 - s*hb*inverse(bs!i)*ln x powr -(1+e)) powr p * (1 + ln (bs!i*x + hb * x / ln x powr (1+e)) powr (-e/2))" (is "_ \ ?A * ?B") using assms x unfolding s_def using asymptotics1[OF x assms(2)] asymptotics1'[OF x assms(2)] by simp also have "(bs!i*x) powr p * ... = (bs!i*x) powr p * ?A * ?B" by simp also from x0_hb_bound0'[OF x, of "bs!i"] hb_nonneg x ln_x_pos assms have "s*hb * ln x powr -(1 + e) < bs ! i" by (subst powr_minus) (simp_all add: field_simps s_def) hence "(bs!i*x) powr p * ?A = (bs!i*x*(1 - s*hb*inverse (bs!i)*ln x powr -(1+e))) powr p" using b_pos assms x x0_pos b_less_1 ln_x_pos by (subst powr_mult[symmetric]) (simp_all add: s_def field_simps) also have "bs!i*x*(1 - s*hb*inverse (bs!i)*ln x powr -(1+e)) = bs!i*x - s*hb*x*ln x powr -(1+e)" using b_pos assms by (simp add: algebra_simps) also have "?B = 1 + ln (bs!i*x + hb*x*ln x powr -(1+e)) powr (-e/2)" by (subst powr_minus) (simp add: field_simps) also { from x assms have "(bs!i*x - s*hb*x*ln x powr -(1+e)) powr p \ (bs!i*x + (hs!i) x) powr p" using asymptotics_aux(1)[OF assms(1,2) s_def] by blast moreover { have "(hs!i) x \ \(hs!i) x\" by simp also from assms have "\(hs!i) x\ \ hb * x / ln x powr (1+e)" by (intro h_bounds) simp_all finally have "(hs ! i) x \ hb * x * ln x powr -(1 + e)" by (subst powr_minus) (simp_all add: field_simps) moreover from x hb_nonneg x0_pos have "hb * x * ln x powr -(1+e) \ 0" by (intro mult_nonneg_nonneg) simp_all ultimately have "1 + ln (bs!i*x + hb * x * ln x powr -(1+e)) powr (-e/2) \ 1 + ln (bs!i*x + (hs!i) x) powr (-e/2)" using assms x e_pos b_pos x0_pos by (intro add_left_mono powr_mono2' ln_mono ln_gt_zero step_pos x0_hb_bound7' add_pos_nonneg mult_pos_pos) simp_all } ultimately have "(bs!i*x - s*hb*x*ln x powr -(1+e)) powr p * (1 + ln (bs!i*x + hb * x * ln x powr -(1+e)) powr (-e/2)) \ (bs!i*x + (hs!i) x) powr p * (1 + ln (bs!i*x + (hs!i) x) powr (-e/2))" by (rule mult_mono) simp_all } finally show ?thesis by (simp_all add: mono) qed lemma asymptotics2': assumes "x \ x\<^sub>1" "i < k" shows "(bs!i*x + (hs!i) x) powr p * (1 - ln (bs!i*x + (hs!i) x) powr (-e/2)) \ (bs!i*x) powr p * (1 - ln x powr (-e/2))" proof- define s :: real where "s = (if p \ 0 then 1 else -1)" from assms x0_le_x1 have x: "x \ x\<^sub>0" by simp from assms x1_gt_1 have ln_x_pos: "ln x > 0" by simp from b_pos[of "bs!i"] assms have b_pos: "bs!i > 0" "bs!i \ 0" by simp_all from b_pos hb_nonneg have pos: "1 + s * hb * (inverse (bs!i) * ln x powr -(1+e)) > 0" using x0_hb_bound0'[OF x, of "bs!i"] b_pos assms ln_x_pos by (subst powr_minus) (simp add: field_simps s_def) have mono: "\a b. a \ b \ (bs!i*x) powr p * a \ (bs!i*x) powr p * b" by (rule mult_left_mono) simp_all let ?A = "(1 + s*hb*inverse(bs!i)*ln x powr -(1+e)) powr p" let ?B = "1 - ln (bs!i*x + (hs!i) x) powr (-e/2)" let ?B' = "1 - ln (bs!i*x + hb * x / ln x powr (1+e)) powr (-e/2)" from assms x have "(bs!i*x + (hs!i) x) powr p \ (bs!i*x + s*hb*x*ln x powr -(1+e)) powr p" by (intro asymptotics_aux(2)) (simp_all add: s_def) moreover from x0_hb_bound9[OF assms(1,2)] have "?B \ 0" by (simp add: field_simps) ultimately have "(bs!i*x + (hs!i) x) powr p * ?B \ (bs!i*x + s*hb*x*ln x powr -(1+e)) powr p * ?B" by (rule mult_right_mono) also from assms e_pos pos have "?B \ ?B'" proof - from x0_hb_bound8'[OF assms(1,2)] x0_hb_bound8[OF assms(1,2)] x0_ge_1 have *: "bs ! i * x + s*hb * x / ln x powr (1 + e) > 1" by (simp add: s_def) moreover from * have "... > 0" by simp moreover from x0_hb_bound7[OF assms(1,2)] x0_ge_1 have "bs ! i * x + (hs ! i) x > 1" by simp moreover { have "(hs!i) x \ \(hs!i) x\" by simp also from assms x0_le_x1 have "... \ hb*x/ln x powr (1+e)" by (intro h_bounds) simp_all finally have "bs!i*x + (hs!i) x \ bs!i*x + hb*x/ln x powr (1+e)" by simp } ultimately show "?B \ ?B'" using assms e_pos x step_pos by (intro diff_left_mono powr_mono2' ln_mono ln_gt_zero) simp_all qed hence "(bs!i*x + s*hb*x*ln x powr -(1+e)) powr p * ?B \ (bs!i*x + s*hb*x*ln x powr -(1+e)) powr p * ?B'" by (intro mult_left_mono) simp_all also have "bs!i*x + s*hb*x*ln x powr -(1+e) = bs!i*x*(1 + s*hb*inverse (bs!i)*ln x powr -(1+e))" using b_pos by (simp_all add: field_simps) also have "... powr p = (bs!i*x) powr p * ?A" using b_pos x x0_pos pos by (intro powr_mult) simp_all also have "(bs!i*x) powr p * ?A * ?B' = (bs!i*x) powr p * (?A * ?B')" by simp also have "?A * ?B' \ 1 - ln x powr (-e/2)" using assms x using asymptotics2[OF x assms(2)] asymptotics2'[OF x assms(2)] by (simp add: s_def) finally show ?thesis by (simp_all add: mono) qed lemma Cx_le_step: assumes "i < k" "x \ x\<^sub>1" shows "C*x \ bs!i*x + (hs!i) x" proof- from assms have "C*x \ bs!i*x - hb*x/ln x powr (1+e)" by (intro C_bound) simp_all also from assms have "-(hb*x/ln x powr (1+e)) \ -\(hs!i) x\" by (subst neg_le_iff_le, intro h_bounds) simp_all hence "bs!i*x - hb*x/ln x powr (1+e) \ bs!i*x + -\(hs!i) x\" by simp also have "-\(hs!i) x\ \ (hs!i) x" by simp finally show ?thesis by simp qed end locale akra_bazzi_nat_to_real = akra_bazzi_real_recursion + fixes f :: "nat \ real" and g :: "real \ real" assumes f_base: "real x \ x\<^sub>0 \ real x \ x\<^sub>1 \ f x \ 0" and f_rec: "real x > x\<^sub>1 \ f x = g (real x) + (\ibs!i * x + (hs!i) (real x)\))" and x0_int: "real (nat \x\<^sub>0\) = x\<^sub>0" begin function f' :: "real \ real" where "x \ x\<^sub>1 \ f' x = f (nat \x\)" | "x > x\<^sub>1 \ f' x = g x + (\i x\<^sub>0 \ x \ x\<^sub>1 \ f' x \ 0" apply (subst f'.simps(1), assumption) apply (rule f_base) apply (rule order.trans[of _ "real (nat \x\<^sub>0\)"], simp add: x0_int) apply (subst of_nat_le_iff, intro nat_mono floor_mono, assumption) using x0_pos apply linarith done lemmas f'_rec = f'.simps(2) end locale akra_bazzi_real_lower = akra_bazzi_real + fixes fb2 gb2 c2 :: real assumes f_base2: "x \ x\<^sub>0 \ x \ x\<^sub>1 \ f x \ fb2" and fb2_pos: "fb2 > 0" and g_growth2: "\x\x\<^sub>1. \u\{C*x..x}. c2 * g x \ g u" and c2_pos: "c2 > 0" and g_bounded: "x \ x\<^sub>0 \ x \ x\<^sub>1 \ g x \ gb2" begin interpretation akra_bazzi_integral integrable integral by (rule integral) lemma gb2_nonneg: "gb2 \ 0" using g_bounded[of x\<^sub>0] x0_le_x1 x0_pos g_nonneg[of x\<^sub>0] by simp lemma g_growth2': assumes "x \ x\<^sub>1" "i < k" "u \ {bs!i*x+(hs!i) x..x}" shows "c2 * g x \ g u" proof- from assms have "C*x \ bs!i*x+(hs!i) x" by (intro Cx_le_step) with assms have "u \ {C*x..x}" by auto with assms g_growth2 show ?thesis by simp qed lemma g_bounds2: obtains c4 where "\x i. x \ x\<^sub>1 \ i < k \ g_approx i x \ c4 * g x" "c4 > 0" proof- define c4 where "c4 = Max {c2 / min 1 (min ((b/2) powr (p+1)) ((b*3/2) powr (p+1))) |b. b \ set bs}" { from bs_nonempty obtain b where b: "b \ set bs" by (cases bs) auto let ?m = "min 1 (min ((b/2) powr (p+1)) ((b*3/2) powr (p+1)))" from b b_pos have "?m > 0" unfolding min_def by (auto simp: not_le) with b b_pos c2_pos have "c2 / ?m > 0" by (simp_all add: field_simps) with b have "c4 > 0" unfolding c4_def by (subst Max_gr_iff) (simp, simp, blast) } { fix x i assume i: "i < k" and x: "x \ x\<^sub>1" have powr_negD: "a powr b \ 0 \ a = 0" for a b :: real unfolding powr_def by (simp split: if_split_asm) let ?m = "min 1 (min ((bs!i/2) powr (p+1)) ((bs!i*3/2) powr (p+1)))" have "min 1 ((bs!i + (hs ! i) x / x) powr (p+1)) \ min 1 (min ((bs!i/2) powr (p+1)) ((bs!i*3/2) powr (p+1)))" apply (insert x i x0_le_x1 x1_pos step_pos b_pos[OF b_in_bs[OF i]], rule min.mono, simp, cases "p + 1 \ 0") apply (rule order.trans[OF min.cobounded1 powr_mono2[OF _ _ x0_hb_bound4']], simp_all add: field_simps) [] apply (rule order.trans[OF min.cobounded2 powr_mono2'[OF _ _ x0_hb_bound5]], simp_all add: field_simps) [] done with i b_pos[of "bs!i"] have "c2 / min 1 ((bs!i + (hs ! i) x / x) powr (p+1)) \ c2 / ?m" using c2_pos unfolding min_def by (intro divide_left_mono) (auto intro!: mult_pos_pos dest!: powr_negD) also from i x have "... \ c4" unfolding c4_def by (intro Max.coboundedI) auto finally have "c2 / min 1 ((bs!i + (hs ! i) x / x) powr (p+1)) \ c4" . } note c4 = this { fix x :: real and i :: nat assume x: "x \ x\<^sub>1" and i: "i < k" from x x1_pos have x_pos: "x > 0" by simp let ?x' = "bs ! i * x + (hs ! i) x" let ?x'' = "bs ! i + (hs ! i) x / x" from x x1_ge_1 i g_growth2' x0_le_x1 c2_pos have c2: "c2 > 0" "\u\{?x'..x}. g u \ c2 * g x" by auto from x0_le_x1 x i have x'_le_x: "?x' \ x" by (intro step_le_x) simp_all let ?m = "min (?x' powr (p + 1)) (x powr (p + 1))" define m' where "m' = min 1 (?x'' powr (p + 1))" have [simp]: "bs ! i > 0" by (intro b_pos nth_mem) (simp add: i length_bs) from x0_le_x1 x i have [simp]: "?x' > 0" by (intro step_pos) simp_all { fix u assume u: "u \ ?x'" "u \ x" have "?m \ u powr (p + 1)" using x u by (intro powr_lower_bound mult_pos_pos) simp_all moreover from c2 and u have "g u \ c2 * g x" by simp ultimately have "g u * ?m \ c2 * g x * u powr (p + 1)" using c2 x x1_pos x0_le_x1 by (intro mult_mono mult_nonneg_nonneg g_nonneg) auto } hence "integral (\u. g u / u powr (p+1)) ?x' x \ integral (\u. c2 * g x / ?m) ?x' x" using x_pos step_pos[OF i x] x0_hb_bound7[OF x i] c2 x x0_le_x1 by (intro integral_le x'_le_x akra_bazzi_integrable ballI integrable_const) (auto simp: field_simps intro!: mult_nonneg_nonneg g_nonneg) also from x0_pos x x0_le_x1 x'_le_x c2 have "... = (x - ?x') * (c2 * g x / ?m)" by (subst integral_const) (simp_all add: g_nonneg) also from c2 x_pos x x0_le_x1 have "c2 * g x \ 0" by (intro mult_nonneg_nonneg g_nonneg) simp_all with x i x0_le_x1 have "(x - ?x') * (c2 * g x / ?m) \ x * (c2 * g x / ?m)" by (intro x0_hb_bound3 mult_right_mono) (simp_all add: field_simps) also have "x powr (p + 1) = x powr (p + 1) * 1" by simp also have "(bs ! i * x + (hs ! i) x) powr (p + 1) = (bs ! i + (hs ! i) x / x) powr (p + 1) * x powr (p + 1)" using x x1_pos step_pos[OF i x] x_pos i x0_le_x1 by (subst powr_mult[symmetric]) (simp add: field_simps, simp, simp add: algebra_simps) also have "... = x powr (p + 1) * (bs ! i + (hs ! i) x / x) powr (p + 1)" by simp also have "min ... (x powr (p + 1) * 1) = x powr (p + 1) * m'" unfolding m'_def using x_pos by (subst min.commute, intro min_mult_left[symmetric]) simp also from x_pos have "x * (c2 * g x / (x powr (p + 1) * m')) = (c2/m') * (g x / x powr p)" by (simp add: field_simps powr_add) also from x i g_nonneg x0_le_x1 x1_pos have "... \ c4 * (g x / x powr p)" unfolding m'_def by (intro mult_right_mono c4) (simp_all add: field_simps) finally have "g_approx i x \ c4 * g x" unfolding g_approx_def using x_pos by (simp add: field_simps) } thus ?thesis using that \c4 > 0\ by blast qed lemma f_approx_bounded_above: obtains c where "\x. x \ x\<^sub>0 \ x \ x\<^sub>1 \ f_approx x \ c" "c > 0" proof- let ?m1 = "max (x\<^sub>0 powr p) (x\<^sub>1 powr p)" let ?m2 = "max (x\<^sub>0 powr (-(p+1))) (x\<^sub>1 powr (-(p+1)))" let ?m3 = "gb2 * ?m2" let ?m4 = "1 + (x\<^sub>1 - x\<^sub>0) * ?m3" let ?int = "\x. integral (\u. g u / u powr (p + 1)) x\<^sub>0 x" { fix x assume x: "x \ x\<^sub>0" "x \ x\<^sub>1" with x0_pos have "x powr p \ ?m1" "?m1 \ 0" by (intro powr_upper_bound) (simp_all add: max_def) moreover { fix u assume u: "u \ {x\<^sub>0..x}" have "g u / u powr (p + 1) = g u * u powr (-(p+1))" by (subst powr_minus) (simp add: field_simps) also from u x x0_pos have "u powr (-(p+1)) \ ?m2" by (intro powr_upper_bound) simp_all hence "g u * u powr (-(p+1)) \ g u * ?m2" using u g_nonneg x0_pos by (intro mult_left_mono) simp_all also from x u x0_pos have "g u \ gb2" by (intro g_bounded) simp_all hence "g u * ?m2 \ gb2 * ?m2" by (intro mult_right_mono) (simp_all add: max_def) finally have "g u / u powr (p + 1) \ ?m3" . } note A = this { from A x gb2_nonneg have "?int x \ integral (\_. ?m3) x\<^sub>0 x" by (intro integral_le akra_bazzi_integrable integrable_const mult_nonneg_nonneg) (simp_all add: le_max_iff_disj) also from x gb2_nonneg have "... \ (x - x\<^sub>0) * ?m3" by (subst integral_const) (simp_all add: le_max_iff_disj) also from x gb2_nonneg have "... \ (x\<^sub>1 - x\<^sub>0) * ?m3" by (intro mult_right_mono mult_nonneg_nonneg) (simp_all add: max_def) finally have "1 + ?int x \ ?m4" by simp } moreover from x g_nonneg x0_pos have "?int x \ 0" by (intro integral_nonneg akra_bazzi_integrable) (simp_all add: powr_def field_simps) hence "1 + ?int x \ 0" by simp ultimately have "f_approx x \ ?m1 * ?m4" unfolding f_approx_def by (intro mult_mono) hence "f_approx x \ max 1 (?m1 * ?m4)" by simp } from that[OF this] show ?thesis by auto qed lemma f_bounded_below: assumes c': "c' > 0" obtains c where "\x. x \ x\<^sub>0 \ x \ x\<^sub>1 \ 2 * (c * f_approx x) \ f x" "c \ c'" "c > 0" proof- obtain c where c: "\x. x\<^sub>0 \ x \ x \ x\<^sub>1 \ f_approx x \ c" "c > 0" by (rule f_approx_bounded_above) blast { fix x assume x: "x\<^sub>0 \ x" "x \ x\<^sub>1" with c have "inverse c * f_approx x \ 1" by (simp add: field_simps) moreover from x f_base2 x0_pos have "f x \ fb2" by auto ultimately have "inverse c * f_approx x * fb2 \ 1 * f x" using fb2_pos by (intro mult_mono) simp_all hence "inverse c * fb2 * f_approx x \ f x" by (simp add: field_simps) moreover have "min c' (inverse c * fb2) * f_approx x \ inverse c * fb2 * f_approx x" using f_approx_nonneg x c by (intro mult_right_mono f_approx_nonneg) (simp_all add: field_simps) ultimately have "2 * (min c' (inverse c * fb2) / 2 * f_approx x) \ f x" by simp } moreover from c' have "min c' (inverse c * fb2) / 2 \ c'" by simp moreover have "min c' (inverse c * fb2) / 2 > 0" using c fb2_pos c' by simp ultimately show ?thesis by (rule that) qed lemma akra_bazzi_lower: obtains c5 where "\x. x \ x\<^sub>0 \ f x \ c5 * f_approx x" "c5 > 0" proof- obtain c4 where c4: "\x i. x \ x\<^sub>1 \ i < k \ g_approx i x \ c4 * g x" "c4 > 0" by (rule g_bounds2) blast hence "inverse c4 / 2 > 0" by simp then obtain c5 where c5: "\x. x \ x\<^sub>0 \ x \ x\<^sub>1 \ 2 * (c5 * f_approx x) \ f x" "c5 \ inverse c4 / 2" "c5 > 0" by (rule f_bounded_below) blast { fix x :: real assume x: "x \ x\<^sub>0" from c5 x have " c5 * 1 * f_approx x \ c5 * (1 + ln x powr (- e / 2)) * f_approx x" by (intro mult_right_mono mult_left_mono f_approx_nonneg) simp_all also from x have "c5 * (1 + ln x powr (-e/2)) * f_approx x \ f x" proof (induction x rule: akra_bazzi_induct) case (base x) have "1 + ln x powr (-e/2) \ 2" using asymptotics3 base by simp hence "(1 + ln x powr (-e/2)) * (c5 * f_approx x) \ 2 * (c5 * f_approx x)" using c5 f_approx_nonneg base x0_ge_1 by (intro mult_right_mono mult_nonneg_nonneg) simp_all also from base have "2 * (c5 * f_approx x) \ f x" by (intro c5) simp_all finally show ?case by (simp add: algebra_simps) next case (rec x) let ?a = "\i. as!i" and ?b = "\i. bs!i" and ?h = "\i. hs!i" let ?int = "integral (\u. g u / u powr (p+1)) x\<^sub>0 x" let ?int1 = "\i. integral (\u. g u / u powr (p+1)) x\<^sub>0 (?b i*x+?h i x)" let ?int2 = "\i. integral (\u. g u / u powr (p+1)) (?b i*x+?h i x) x" let ?l = "ln x powr (-e/2)" and ?l' = "\i. ln (?b i*x + ?h i x) powr (-e/2)" from rec and x0_le_x1 x0_ge_1 have x: "x \ x\<^sub>0" and x_gt_1: "x > 1" by simp_all with x0_pos have x_pos: "x > 0" and x_nonneg: "x \ 0" by simp_all from c5 c4 have "c5 * c4 \ 1/2" by (simp add: field_simps) moreover from asymptotics3 x have "(1 + ?l) \ 2" by (simp add: field_simps) ultimately have "(c5*c4)*(1 + ?l) \ (1/2) * 2" by (rule mult_mono) simp_all hence "0 \ 1 - c5*c4*(1 + ?l)" by simp with g_nonneg[OF x] have "0 \ g x * ..." by (intro mult_nonneg_nonneg) simp_all hence "c5 * (1 + ?l) * f_approx x \ c5 * (1 + ?l) * f_approx x + g x - c5*c4*(1 + ?l) * g x" by (simp add: algebra_simps) also from x_gt_1 have "... = c5 * x powr p * (1 + ?l) * (1 + ?int - c4*g x/x powr p) + g x" by (simp add: field_simps f_approx_def powr_minus) also have "c5 * x powr p * (1 + ?l) * (1 + ?int - c4*g x/x powr p) = (\i (\i0 < bs ! i * x + (hs ! i) x" by (intro x0_hb_bound7) simp_all hence "1 + ?int1 i \ 1" by (intro f_approx_aux x0_hb_bound7) simp_all hence int_nonneg: "1 + ?int1 i \ 0" by simp have "(?a i * ?b i powr p) * (c5 * x powr p * (1 + ?l) * (1 + ?int - c4*g x/x powr p)) = ?f * (1 + ?l) * (1 + ?int - c4*g x/x powr p)" (is "?expr = ?A * ?B") using x_pos b_pos[of "bs!i"] i by (subst powr_mult) simp_all also from rec.hyps i have "g_approx i x \ c4 * g x" by (intro c4) simp_all hence "c4*g x/x powr p \ ?int2 i" unfolding g_approx_def using x_pos by (simp add: field_simps) hence "?A * ?B \ ?A * (1 + (?int - ?int2 i))" using i c5 a_ge_0 by (intro mult_left_mono mult_nonneg_nonneg) simp_all also from rec.hyps i have "x\<^sub>0 < bs ! i * x + (hs ! i) x" by (intro x0_hb_bound7) simp_all hence "?int - ?int2 i = ?int1 i" apply (subst diff_eq_eq, subst eq_commute) apply (intro integral_combine akra_bazzi_integrable) apply (insert rec.hyps step_le_x[OF i, of x], simp_all) done also have "?A * (1 + ?int1 i) = (c5*?a i*(1 + ?int1 i)) * ((?b i*x) powr p * (1 + ?l))" by (simp add: algebra_simps) also have "... \ (c5*?a i*(1 + ?int1 i)) * ((?b i*x + ?h i x) powr p * (1 + ?l' i))" using rec.hyps i c5 a_ge_0 int_nonneg by (intro mult_left_mono asymptotics1' mult_nonneg_nonneg) simp_all also have "... = ?a i*(c5*(1 + ?l' i)*f_approx (?b i*x + ?h i x))" by (simp add: algebra_simps f_approx_def) also from i have "... \ ?a i * f (?b i*x + ?h i x)" by (intro mult_left_mono a_ge_0 rec.IH) simp_all finally show "?expr \ ?a i * f (?b i*x + ?h i x)" . qed also have "... + g x = f x" using f_rec[of x] rec.hyps x0_le_x1 by simp finally show ?case by simp qed finally have "c5 * f_approx x \ f x" by simp } from this and c5(3) show ?thesis by (rule that) qed lemma akra_bazzi_bigomega: "f \ \(\x. x powr p * (1 + integral (\u. g u / u powr (p + 1)) x\<^sub>0 x))" apply (fold f_approx_def, rule akra_bazzi_lower, erule landau_omega.bigI) apply (subst eventually_at_top_linorder, rule exI[of _ x\<^sub>0]) apply (simp add: f_nonneg f_approx_nonneg) done end locale akra_bazzi_real_upper = akra_bazzi_real + fixes fb1 c1 :: real assumes f_base1: "x \ x\<^sub>0 \ x \ x\<^sub>1 \ f x \ fb1" and g_growth1: "\x\x\<^sub>1. \u\{C*x..x}. c1 * g x \ g u" and c1_pos: "c1 > 0" begin interpretation akra_bazzi_integral integrable integral by (rule integral) lemma g_growth1': assumes "x \ x\<^sub>1" "i < k" "u \ {bs!i*x+(hs!i) x..x}" shows "c1 * g x \ g u" proof- from assms have "C*x \ bs!i*x+(hs!i) x" by (intro Cx_le_step) with assms have "u \ {C*x..x}" by auto with assms g_growth1 show ?thesis by simp qed lemma g_bounds1: obtains c3 where "\x i. x \ x\<^sub>1 \ i < k \ c3 * g x \ g_approx i x" "c3 > 0" proof- define c3 where "c3 = Min {c1*((1-b)/2) / max 1 (max ((b/2) powr (p+1)) ((b*3/2) powr (p+1))) |b. b \ set bs}" { fix b assume b: "b \ set bs" let ?x = "max 1 (max ((b/2) powr (p+1)) ((b*3/2) powr (p+1)))" have "?x \ 1" by simp hence "?x > 0" by (rule less_le_trans[OF zero_less_one]) with b b_less_1 c1_pos have "c1*((1-b)/2) / ?x > 0" by (intro divide_pos_pos mult_pos_pos) (simp_all add: algebra_simps) } hence "c3 > 0" unfolding c3_def by (subst Min_gr_iff) auto { fix x i assume i: "i < k" and x: "x \ x\<^sub>1" with b_less_1 have b_less_1': "bs ! i < 1" by simp let ?m = "max 1 (max ((bs!i/2) powr (p+1)) ((bs!i*3/2) powr (p+1)))" from i x have "c3 \ c1*((1-bs!i)/2) / ?m" unfolding c3_def by (intro Min.coboundedI) auto also have "max 1 ((bs!i + (hs ! i) x / x) powr (p+1)) \ max 1 (max ((bs!i/2) powr (p+1)) ((bs!i*3/2) powr (p+1)))" apply (insert x i x0_le_x1 x1_pos step_pos[OF i x] b_pos[OF b_in_bs[OF i]], rule max.mono, simp, cases "p + 1 \ 0") apply (rule order.trans[OF powr_mono2[OF _ _ x0_hb_bound5] max.cobounded2], simp_all add: field_simps) [] apply (rule order.trans[OF powr_mono2'[OF _ _ x0_hb_bound4'] max.cobounded1], simp_all add: field_simps) [] done with b_less_1' c1_pos have "c1*((1-bs!i)/2) / ?m \ c1*((1-bs!i)/2) / max 1 ((bs!i + (hs ! i) x / x) powr (p+1))" by (intro divide_left_mono mult_nonneg_nonneg) (simp_all add: algebra_simps) finally have "c3 \ c1*((1-bs!i)/2) / max 1 ((bs!i + (hs ! i) x / x) powr (p+1))" . } note c3 = this { fix x :: real and i :: nat assume x: "x \ x\<^sub>1" and i: "i < k" from x x1_pos have x_pos: "x > 0" by simp let ?x' = "bs ! i * x + (hs ! i) x" let ?x'' = "bs ! i + (hs ! i) x / x" from x x1_ge_1 x0_le_x1 i c1_pos g_growth1' have c1: "c1 > 0" "\u\{?x'..x}. g u \ c1 * g x" by auto define b' where "b' = (1 - bs!i)/2" from x x0_le_x1 i have x'_le_x: "?x' \ x" by (intro step_le_x) simp_all let ?m = "max (?x' powr (p + 1)) (x powr (p + 1))" define m' where "m' = max 1 (?x'' powr (p + 1))" have [simp]: "bs ! i > 0" by (intro b_pos nth_mem) (simp add: i length_bs) from x x0_le_x1 i have x'_pos: "?x' > 0" by (intro step_pos) simp_all have m_pos: "?m > 0" unfolding max_def using x_pos step_pos[OF i x] by auto with x x0_le_x1 c1 have c1_g_m_nonneg: "c1 * g x / ?m \ 0" by (intro mult_nonneg_nonneg divide_nonneg_pos g_nonneg) simp_all from x i g_nonneg x0_le_x1 have "c3 * (g x / x powr p) \ (c1*b'/m') * (g x / x powr p)" unfolding m'_def b'_def by (intro mult_right_mono c3) (simp_all add: field_simps) also from x_pos have "... = (x * b') * (c1 * g x / (x powr (p + 1) * m'))" by (simp add: field_simps powr_add) also from x i c1_pos x1_pos x0_le_x1 have "... \ (x - ?x') * (c1 * g x / (x powr (p + 1) * m'))" unfolding b'_def m'_def by (intro x0_hb_bound6 mult_right_mono mult_nonneg_nonneg divide_nonneg_nonneg g_nonneg) simp_all also have "x powr (p + 1) * m' = max (x powr (p + 1) * (bs ! i + (hs ! i) x / x) powr (p + 1)) (x powr (p + 1) * 1)" unfolding m'_def using x_pos by (subst max.commute, intro max_mult_left) simp also have "(x powr (p + 1) * (bs ! i + (hs ! i) x / x) powr (p + 1)) = (bs ! i + (hs ! i) x / x) powr (p + 1) * x powr (p + 1)" by simp also have "... = (bs ! i * x + (hs ! i) x) powr (p + 1)" using x x1_pos step_pos[OF i x] x_pos i x0_le_x1 x_pos by (subst powr_mult[symmetric]) (simp add: field_simps, simp, simp add: algebra_simps) also have "x powr (p + 1) * 1 = x powr (p + 1)" by simp also have "(x - ?x') * (c1 * g x / ?m) = integral (\_. c1 * g x / ?m) ?x' x" using x'_le_x by (subst integral_const[OF c1_g_m_nonneg]) auto also { fix u assume u: "u \ ?x'" "u \ x" have "u powr (p + 1) \ ?m" using x u x'_pos by (intro powr_upper_bound mult_pos_pos) simp_all moreover from x'_pos u have "u \ 0" by simp moreover from c1 and u have "c1 * g x \ g u" by simp ultimately have "c1 * g x * u powr (p + 1) \ g u * ?m" using c1 x u x0_hb_bound7[OF x i] by (intro mult_mono g_nonneg) auto with m_pos u step_pos[OF i x] have "c1 * g x / ?m \ g u / u powr (p + 1)" by (simp add: field_simps) } hence "integral (\_. c1 * g x / ?m) ?x' x \ integral (\u. g u / u powr (p + 1)) ?x' x" using x0_hb_bound7[OF x i] x'_le_x by (intro integral_le ballI akra_bazzi_integrable integrable_const c1_g_m_nonneg) simp_all finally have "c3 * g x \ g_approx i x" using x_pos unfolding g_approx_def by (simp add: field_simps) } thus ?thesis using that \c3 > 0\ by blast qed lemma f_bounded_above: assumes c': "c' > 0" obtains c where "\x. x \ x\<^sub>0 \ x \ x\<^sub>1 \ f x \ (1/2) * (c * f_approx x)" "c \ c'" "c > 0" proof- obtain c where c: "\x. x\<^sub>0 \ x \ x \ x\<^sub>1 \ f_approx x \ c" "c > 0" by (rule f_approx_bounded_below) blast have fb1_nonneg: "fb1 \ 0" using f_base1[of "x\<^sub>0"] f_nonneg[of x\<^sub>0] x0_le_x1 by simp { fix x assume x: "x \ x\<^sub>0" "x \ x\<^sub>1" with f_base1 x0_pos have "f x \ fb1" by simp moreover from c and x have "f_approx x \ c" by blast ultimately have "f x * c \ fb1 * f_approx x" using c fb1_nonneg by (intro mult_mono) simp_all also from f_approx_nonneg x have "... \ (fb1 + 1) * f_approx x" by (simp add: algebra_simps) finally have "f x \ ((fb1+1) / c) * f_approx x" by (simp add: field_simps c) also have "... \ max ((fb1+1) / c) c' * f_approx x" by (intro mult_right_mono) (simp_all add: f_approx_nonneg x) finally have "f x \ 1/2 * (max ((fb1+1) / c) c' * 2 * f_approx x)" by simp } moreover have "max ((fb1+1) / c) c' * 2 \ max ((fb1+1) / c) c'" by (subst mult_le_cancel_left1) (insert c', simp) hence "max ((fb1+1) / c) c' * 2 \ c'" by (rule order.trans[OF max.cobounded2]) moreover from fb1_nonneg and c have "(fb1+1) / c > 0" by simp hence "max ((fb1+1) / c) c' * 2 > 0" by simp ultimately show ?thesis by (rule that) qed lemma akra_bazzi_upper: obtains c6 where "\x. x \ x\<^sub>0 \ f x \ c6 * f_approx x" "c6 > 0" proof- obtain c3 where c3: "\x i. x \ x\<^sub>1 \ i < k \ c3 * g x \ g_approx i x" "c3 > 0" by (rule g_bounds1) blast hence "2 / c3 > 0" by simp then obtain c6 where c6: "\x. x \ x\<^sub>0 \ x \ x\<^sub>1 \ f x \ 1/2 * (c6 * f_approx x)" "c6 \ 2 / c3" "c6 > 0" by (rule f_bounded_above) blast { fix x :: real assume x: "x \ x\<^sub>0" hence "f x \ c6 * (1 - ln x powr (-e/2)) * f_approx x" proof (induction x rule: akra_bazzi_induct) case (base x) from base have "f x \ 1/2 * (c6 * f_approx x)" by (intro c6) simp_all also have "1 - ln x powr (-e/2) \ 1/2" using asymptotics4 base by simp hence "(1 - ln x powr (-e/2)) * (c6 * f_approx x) \ 1/2 * (c6 * f_approx x)" using c6 f_approx_nonneg base x0_ge_1 by (intro mult_right_mono mult_nonneg_nonneg) simp_all finally show ?case by (simp add: algebra_simps) next case (rec x) let ?a = "\i. as!i" and ?b = "\i. bs!i" and ?h = "\i. hs!i" let ?int = "integral (\u. g u / u powr (p+1)) x\<^sub>0 x" let ?int1 = "\i. integral (\u. g u / u powr (p+1)) x\<^sub>0 (?b i*x+?h i x)" let ?int2 = "\i. integral (\u. g u / u powr (p+1)) (?b i*x+?h i x) x" let ?l = "ln x powr (-e/2)" and ?l' = "\i. ln (?b i*x + ?h i x) powr (-e/2)" from rec and x0_le_x1 have x: "x \ x\<^sub>0" by simp with x0_pos have x_pos: "x > 0" and x_nonneg: "x \ 0" by simp_all from c6 c3 have "c6 * c3 \ 2" by (simp add: field_simps) have "f x = (\i (\i ?sum'") proof (rule sum_mono, clarify) fix i assume i: "i < k" from rec.hyps i have "x\<^sub>0 < bs ! i * x + (hs ! i) x" by (intro x0_hb_bound7) simp_all hence "1 + ?int1 i \ 1" by (intro f_approx_aux x0_hb_bound7) simp_all hence int_nonneg: "1 + ?int1 i \ 0" by simp have l_le_1: "ln x powr -(e/2) \ 1" using asymptotics3[OF x] by (simp add: field_simps) from i have "f (?b i*x + ?h i x) \ c6 * (1 - ?l' i) * f_approx (?b i*x + ?h i x)" by (rule rec.IH) hence "?a i * f (?b i*x + ?h i x) \ ?a i * ..." using a_ge_0 i by (intro mult_left_mono) simp_all also have "... = (c6*?a i*(1 + ?int1 i)) * ((?b i*x + ?h i x) powr p * (1 - ?l' i))" unfolding f_approx_def by (simp add: algebra_simps) also from i rec.hyps c6 a_ge_0 have "... \ (c6*?a i*(1 + ?int1 i)) * ((?b i*x) powr p * (1 - ?l))" by (intro mult_left_mono asymptotics2' mult_nonneg_nonneg int_nonneg) simp_all also have "... = (1 + ?int1 i) * (c6*?a i*(?b i*x) powr p * (1 - ?l))" by (simp add: algebra_simps) also from rec.hyps i have "x\<^sub>0 < bs ! i * x + (hs ! i) x" by (intro x0_hb_bound7) simp_all hence "?int1 i = ?int - ?int2 i" apply (subst eq_diff_eq) apply (intro integral_combine akra_bazzi_integrable) apply (insert rec.hyps step_le_x[OF i, of x], simp_all) done also from rec.hyps i have "c3 * g x \ g_approx i x" by (intro c3) simp_all hence "?int2 i \ c3*g x/x powr p" unfolding g_approx_def using x_pos by (simp add: field_simps) hence "(1 + (?int - ?int2 i)) * (c6*?a i*(?b i*x) powr p * (1 - ?l)) \ (1 + ?int - c3*g x/x powr p) * (c6*?a i*(?b i*x) powr p * (1 - ?l))" using i c6 a_ge_0 l_le_1 by (intro mult_right_mono mult_nonneg_nonneg) (simp_all add: field_simps) also have "... = (?a i*?b i powr p) * (c6*x powr p*(1 - ?l) * (1 + ?int - c3*g x/x powr p))" using b_pos[of "bs!i"] x x0_pos i by (subst powr_mult) (simp_all add: algebra_simps) finally show "?a i * f (?b i*x + ?h i x) \ ..." . qed hence "?sum + g x \ ?sum' + g x" by simp also have "... = c6 * x powr p * (1 - ?l) * (1 + ?int - c3*g x/x powr p) + g x" by (simp add: sum_distrib_right[symmetric] p_props) also have "... = c6 * (1 - ?l) * f_approx x - (c6*c3*(1 - ?l) - 1) * g x" unfolding f_approx_def using x_pos by (simp add: field_simps) also { from c6 c3 have "c6*c3 \ 2" by (simp add: field_simps) moreover have "(1 - ?l) \ 1/2" using asymptotics4[OF x] by simp ultimately have "c6*c3*(1 - ?l) \ 2 * (1/2)" by (intro mult_mono) simp_all with x x_pos have "(c6*c3*(1 - ?l) - 1) * g x \ 0" by (intro mult_nonneg_nonneg g_nonneg) simp_all hence "c6 * (1 - ?l) * f_approx x - (c6*c3*(1 - ?l) - 1) * g x \ c6 * (1 - ?l) * f_approx x" by (simp add: algebra_simps) } finally show ?case . qed also from x c6 have "... \ c6 * 1 * f_approx x" by (intro mult_left_mono mult_right_mono f_approx_nonneg) simp_all finally have "f x \ c6 * f_approx x" by simp } from this and c6(3) show ?thesis by (rule that) qed lemma akra_bazzi_bigo: "f \ O(\x. x powr p *(1 + integral (\u. g u / u powr (p + 1)) x\<^sub>0 x))" apply (fold f_approx_def, rule akra_bazzi_upper, erule landau_o.bigI) apply (subst eventually_at_top_linorder, rule exI[of _ x\<^sub>0]) apply (simp add: f_nonneg f_approx_nonneg) done end end diff --git a/thys/Akra_Bazzi/Eval_Numeral.thy b/thys/Akra_Bazzi/Eval_Numeral.thy --- a/thys/Akra_Bazzi/Eval_Numeral.thy +++ b/thys/Akra_Bazzi/Eval_Numeral.thy @@ -1,140 +1,140 @@ (* File: Eval_Numeral.thy - Author: Manuel Eberl + Author: Manuel Eberl Evaluation of terms involving rational numerals with the simplifier. *) section \Evaluating expressions with rational numerals\ theory Eval_Numeral imports Complex_Main begin lemma real_numeral_to_Ratreal: "(0::real) = Ratreal (Frct (0, 1))" "(1::real) = Ratreal (Frct (1, 1))" "(numeral x :: real) = Ratreal (Frct (numeral x, 1))" "(1::int) = numeral Num.One" by (simp_all add: rat_number_collapse) lemma real_equals_code: "Ratreal x = Ratreal y \ x = y" by simp lemma Rat_normalize_idempotent: "Rat.normalize (Rat.normalize x) = Rat.normalize x" apply (cases "Rat.normalize x") using Rat.normalize_stable[OF normalize_denom_pos normalize_coprime] apply auto done lemma uminus_pow_Numeral1: "(-(x::_::monoid_mult)) ^ Numeral1 = -x" by simp lemmas power_numeral_simps = power_0 uminus_pow_Numeral1 power_minus_Bit0 power_minus_Bit1 lemma Fract_normalize: "Fract (fst (Rat.normalize (x,y))) (snd (Rat.normalize (x,y))) = Fract x y" by (rule quotient_of_inject) (simp add: quotient_of_Fract Rat_normalize_idempotent) lemma Frct_add: "Frct (a, numeral b) + Frct (c, numeral d) = Frct (Rat.normalize (a * numeral d + c * numeral b, numeral (b*d)))" by (auto simp: rat_number_collapse Fract_normalize) lemma Frct_uminus: "-(Frct (a,b)) = Frct (-a,b)" by simp lemma Frct_diff: "Frct (a, numeral b) - Frct (c, numeral d) = Frct (Rat.normalize (a * numeral d - c * numeral b, numeral (b*d)))" by (auto simp: rat_number_collapse Fract_normalize) lemma Frct_mult: "Frct (a, numeral b) * Frct (c, numeral d) = Frct (a*c, numeral (b*d))" by simp lemma Frct_inverse: "inverse (Frct (a, b)) = Frct (b, a)" by simp lemma Frct_divide: "Frct (a, numeral b) / Frct (c, numeral d) = Frct (a*numeral d, numeral b * c)" by simp lemma Frct_pow: "Frct (a, numeral b) ^ c = Frct (a ^ c, numeral b ^ c)" by (induction c) (simp_all add: rat_number_collapse) lemma Frct_less: "Frct (a, numeral b) < Frct (c, numeral d) \ a * numeral d < c * numeral b" by simp lemma Frct_le: "Frct (a, numeral b) \ Frct (c, numeral d) \ a * numeral d \ c * numeral b" by simp lemma Frct_equals: "Frct (a, numeral b) = Frct (c, numeral d) \ a * numeral d = c * numeral b" apply (intro iffI antisym) apply (subst Frct_le[symmetric], simp)+ apply (subst Frct_le, simp)+ done lemma real_power_code: "(Ratreal x) ^ y = Ratreal (x ^ y)" by (simp add: of_rat_power) lemmas real_arith_code = real_plus_code real_minus_code real_times_code real_uminus_code real_inverse_code real_divide_code real_power_code real_less_code real_less_eq_code real_equals_code lemmas rat_arith_code = Frct_add Frct_uminus Frct_diff Frct_mult Frct_inverse Frct_divide Frct_pow Frct_less Frct_le Frct_equals lemma gcd_numeral_red: "gcd (numeral x::int) (numeral y) = gcd (numeral y) (numeral x mod numeral y)" by (fact gcd_red_int) lemma divmod_one: "divmod (Num.One) (Num.One) = (Numeral1, 0)" "divmod (Num.One) (Num.Bit0 x) = (0, Numeral1)" "divmod (Num.One) (Num.Bit1 x) = (0, Numeral1)" "divmod x (Num.One) = (numeral x, 0)" unfolding divmod_def by simp_all lemmas divmod_numeral_simps = div_0 div_by_0 mod_0 mod_by_0 fst_divmod [symmetric] snd_divmod [symmetric] divmod_cancel divmod_steps [simplified rel_simps if_True] divmod_trivial rel_simps lemma Suc_0_to_numeral: "Suc 0 = Numeral1" by simp lemmas Suc_to_numeral = Suc_0_to_numeral Num.Suc_1 Num.Suc_numeral lemma rat_powr: "0 powr y = 0" "x > 0 \ x powr Ratreal (Frct (0, Numeral1)) = Ratreal (Frct (Numeral1, Numeral1))" "x > 0 \ x powr Ratreal (Frct (numeral a, Numeral1)) = x ^ numeral a" "x > 0 \ x powr Ratreal (Frct (-numeral a, Numeral1)) = inverse (x ^ numeral a)" by (simp_all add: rat_number_collapse powr_minus) lemmas eval_numeral_simps = real_numeral_to_Ratreal real_arith_code rat_arith_code Num.arith_simps Rat.normalize_def fst_conv snd_conv gcd_0_int gcd_0_left_int gcd.bottom_right_bottom gcd.bottom_left_bottom gcd_neg1_int gcd_neg2_int gcd_numeral_red zmod_numeral_Bit0 zmod_numeral_Bit1 power_numeral_simps divmod_numeral_simps numeral_One [symmetric] Groups.Let_0 Num.Let_numeral Suc_to_numeral power_numeral greaterThanLessThan_iff atLeastAtMost_iff atLeastLessThan_iff greaterThanAtMost_iff rat_powr Num.pow.simps Num.sqr.simps Product_Type.split of_int_numeral of_int_neg_numeral of_nat_numeral ML \ signature EVAL_NUMERAL = sig val eval_numeral_tac : Proof.context -> int -> tactic end structure Eval_Numeral : EVAL_NUMERAL = struct fun eval_numeral_tac ctxt = let val ctxt' = put_simpset HOL_ss ctxt addsimps @{thms eval_numeral_simps} in SELECT_GOAL (SOLVE (Simplifier.simp_tac ctxt' 1)) end end \ lemma "21254387548659589512*314213523632464357453884361*2342523623324234*564327438587241734743* 12561712738645824362329316482973164398214286 powr 2 / (1130246312978423123+231212374631082764842731842*122474378389424362347451251263) > (12313244512931247243543279768645745929475829310651205623844::real)" by (tactic \Eval_Numeral.eval_numeral_tac @{context} 1\) end diff --git a/thys/Akra_Bazzi/Master_Theorem.thy b/thys/Akra_Bazzi/Master_Theorem.thy --- a/thys/Akra_Bazzi/Master_Theorem.thy +++ b/thys/Akra_Bazzi/Master_Theorem.thy @@ -1,465 +1,465 @@ (* File: Master_Theorem.thy - Author: Manuel Eberl + Author: Manuel Eberl The Master theorem in a generalised form as derived from the Akra-Bazzi theorem. *) section \The Master theorem\ theory Master_Theorem imports "HOL-Analysis.Equivalence_Lebesgue_Henstock_Integration" Akra_Bazzi_Library Akra_Bazzi begin lemma fundamental_theorem_of_calculus_real: "a \ b \ \x\{a..b}. (f has_real_derivative f' x) (at x within {a..b}) \ (f' has_integral (f b - f a)) {a..b}" by (intro fundamental_theorem_of_calculus ballI) (simp_all add: has_field_derivative_iff_has_vector_derivative[symmetric]) lemma integral_powr: "y \ -1 \ a \ b \ a > 0 \ integral {a..b} (\x. x powr y :: real) = inverse (y + 1) * (b powr (y + 1) - a powr (y + 1))" by (subst right_diff_distrib, intro integral_unique fundamental_theorem_of_calculus_real) (auto intro!: derivative_eq_intros) lemma integral_ln_powr_over_x: "y \ -1 \ a \ b \ a > 1 \ integral {a..b} (\x. ln x powr y / x :: real) = inverse (y + 1) * (ln b powr (y + 1) - ln a powr (y + 1))" by (subst right_diff_distrib, intro integral_unique fundamental_theorem_of_calculus_real) (auto intro!: derivative_eq_intros) lemma integral_one_over_x_ln_x: "a \ b \ a > 1 \ integral {a..b} (\x. inverse (x * ln x) :: real) = ln (ln b) - ln (ln a)" by (intro integral_unique fundamental_theorem_of_calculus_real) (auto intro!: derivative_eq_intros simp: field_simps) lemma akra_bazzi_integral_kurzweil_henstock: "akra_bazzi_integral (\f a b. f integrable_on {a..b}) (\f a b. integral {a..b} f)" apply unfold_locales apply (rule integrable_const_ivl) apply simp apply (erule integrable_subinterval_real, simp) apply (blast intro!: integral_le) apply (rule integral_combine, simp_all) [] done locale master_theorem_function = akra_bazzi_recursion + fixes g :: "nat \ real" assumes f_nonneg_base: "x \ x\<^sub>0 \ x < x\<^sub>1 \ f x \ 0" and f_rec: "x \ x\<^sub>1 \ f x = g x + (\i x\<^sub>1 \ g x \ 0" and ex_pos_a: "\a\set as. a > 0" begin interpretation akra_bazzi_integral "\f a b. f integrable_on {a..b}" "\f a b. integral {a..b} f" by (rule akra_bazzi_integral_kurzweil_henstock) sublocale akra_bazzi_function x\<^sub>0 x\<^sub>1 k as bs ts f "\f a b. f integrable_on {a..b}" "\f a b. integral {a..b} f" g using f_nonneg_base f_rec g_nonneg ex_pos_a by unfold_locales context begin private lemma g_nonneg': "eventually (\x. g x \ 0) at_top" using g_nonneg by (force simp: eventually_at_top_linorder) private lemma g_pos: assumes "g \ \(h)" assumes "eventually (\x. h x > 0) at_top" shows "eventually (\x. g x > 0) at_top" proof- from landau_omega.bigE_nonneg_real[OF assms(1) g_nonneg'] guess c . note c = this from assms(2) c(2) show ?thesis by eventually_elim (rule less_le_trans[OF mult_pos_pos[OF c(1)]], simp_all) qed private lemma f_pos: assumes "g \ \(h)" assumes "eventually (\x. h x > 0) at_top" shows "eventually (\x. f x > 0) at_top" using g_pos[OF assms(1,2)] eventually_ge_at_top[of x\<^sub>1] by (eventually_elim) (subst f_rec, insert step_ge_x0, auto intro!: add_pos_nonneg sum_nonneg mult_nonneg_nonneg[OF a_ge_0] f_nonneg) lemma bs_lower_bound: "\C>0. \b\set bs. C < b" proof (intro exI conjI ballI) from b_pos show A: "Min (set bs) / 2 > 0" by auto fix b assume b: "b \ set bs" from A have "Min (set bs) / 2 < Min (set bs)" by simp also from b have "... \ b" by simp finally show "Min (set bs) / 2 < b" . qed private lemma powr_growth2: "\C c2. 0 < c2 \ C < Min (set bs) \ eventually (\x. \u\{C * x..x}. c2 * x powr p' \ u powr p') at_top" proof (intro exI conjI allI ballI) define C where "C = Min (set bs) / 2" from b_bounds bs_nonempty have C_pos: "C > 0" unfolding C_def by auto thus "C < Min (set bs)" unfolding C_def by simp show "max (C powr p') 1 > 0" by simp show "eventually (\x. \u\{C * x..x}. max ((Min (set bs)/2) powr p') 1 * x powr p' \ u powr p') at_top" using eventually_gt_at_top[of "0::real"] apply eventually_elim proof clarify fix x u assume x: "x > 0" and "u \ {C*x..x}" hence u: "u \ C*x" "u \ x" unfolding C_def by simp_all from u have "u powr p' \ max ((C*x) powr p') (x powr p')" using C_pos x by (intro powr_upper_bound mult_pos_pos) simp_all also from u x C_pos have "max ((C*x) powr p') (x powr p') = x powr p' * max (C powr p') 1" by (subst max_mult_left) (simp_all add: powr_mult algebra_simps) finally show "u powr p' \ max ((Min (set bs)/2) powr p') 1 * x powr p'" by (simp add: C_def algebra_simps) qed qed private lemma powr_growth1: "\C c1. 0 < c1 \ C < Min (set bs) \ eventually (\x. \u\{C * x..x}. c1 * x powr p' \ u powr p') at_top" proof (intro exI conjI allI ballI) define C where "C = Min (set bs) / 2" from b_bounds bs_nonempty have C_pos: "C > 0" unfolding C_def by auto thus "C < Min (set bs)" unfolding C_def by simp from C_pos show "min (C powr p') 1 > 0" by simp show "eventually (\x. \u\{C * x..x}. min ((Min (set bs)/2) powr p') 1 * x powr p' \ u powr p') at_top" using eventually_gt_at_top[of "0::real"] apply eventually_elim proof clarify fix x u assume x: "x > 0" and "u \ {C*x..x}" hence u: "u \ C*x" "u \ x" unfolding C_def by simp_all from u x C_pos have "x powr p' * min (C powr p') 1 = min ((C*x) powr p') (x powr p')" by (subst min_mult_left) (simp_all add: powr_mult algebra_simps) also from u have "u powr p' \ min ((C*x) powr p') (x powr p')" using C_pos x by (intro powr_lower_bound mult_pos_pos) simp_all finally show "u powr p' \ min ((Min (set bs)/2) powr p') 1 * x powr p'" by (simp add: C_def algebra_simps) qed qed private lemma powr_ln_powr_lower_bound: "a > 1 \ a \ x \ x \ b \ min (a powr p) (b powr p) * min (ln a powr p') (ln b powr p') \ x powr p * ln x powr p'" by (intro mult_mono powr_lower_bound) (auto intro: min.coboundedI1) private lemma powr_ln_powr_upper_bound: "a > 1 \ a \ x \ x \ b \ max (a powr p) (b powr p) * max (ln a powr p') (ln b powr p') \ x powr p * ln x powr p'" by (intro mult_mono powr_upper_bound) (auto intro: max.coboundedI1) private lemma powr_ln_powr_upper_bound': "eventually (\a. \b>a. \c. \x\{a..b}. x powr p * ln x powr p' \ c) at_top" by (subst eventually_at_top_dense) (force intro: powr_ln_powr_upper_bound) private lemma powr_upper_bound': "eventually (\a::real. \b>a. \c. \x\{a..b}. x powr p' \ c) at_top" by (subst eventually_at_top_dense) (force intro: powr_upper_bound) lemmas bounds = powr_ln_powr_lower_bound powr_ln_powr_upper_bound powr_ln_powr_upper_bound' powr_upper_bound' private lemma eventually_ln_const: assumes "(C::real) > 0" shows "eventually (\x. ln (C*x) / ln x > 1/2) at_top" proof- from tendstoD[OF tendsto_ln_over_ln[of C 1], of "1/2"] assms have "eventually (\x. \ln (C*x) / ln x - 1\ < 1/2) at_top" by (simp add: dist_real_def) thus ?thesis by eventually_elim linarith qed private lemma powr_ln_powr_growth1: "\C c1. 0 < c1 \ C < Min (set bs) \ eventually (\x. \u\{C * x..x}. c1 * (x powr r * ln x powr r') \ u powr r * ln u powr r') at_top" proof (intro exI conjI) let ?C = "Min (set bs) / 2" and ?f = "\x. x powr r * ln x powr r'" define C where "C = ?C" from b_bounds have C_pos: "C > 0" unfolding C_def by simp let ?T = "min (C powr r) (1 powr r) * min ((1/2) powr r') (1 powr r')" from C_pos show "?T > 0" unfolding min_def by (auto split: if_split) from bs_nonempty b_bounds have C_pos: "C > 0" unfolding C_def by simp thus "C < Min (set bs)" by (simp add: C_def) show "eventually (\x. \u\{C*x..x}. ?T * ?f x \ ?f u) at_top" using eventually_gt_at_top[of "max 1 (inverse C)"] eventually_ln_const[OF C_pos] apply eventually_elim proof clarify fix x u assume x: "x > max 1 (inverse C)" and u: "u \ {C*x..x}" hence x': "x > 1" by (simp add: field_simps) with C_pos have x_pos: "x > 0" by (simp add: field_simps) from x u C_pos have u': "u > 1" by (simp add: field_simps) assume A: "ln (C*x) / ln x > 1/2" have "min (C powr r) (1 powr r) \ (u/x) powr r" using x u u' C_pos by (intro powr_lower_bound) (simp_all add: field_simps) moreover { note A also from C_pos x' u u' have "ln (C*x) \ ln u" by (subst ln_le_cancel_iff) simp_all with x' have "ln (C*x) / ln x \ ln u / ln x" by (simp add: field_simps) finally have "min ((1/2) powr r') (1 powr r') \ (ln u / ln x) powr r'" using x u u' C_pos A by (intro powr_lower_bound) simp_all } ultimately have "?T \ (u/x) powr r * (ln u / ln x) powr r'" using x_pos by (intro mult_mono) simp_all also from x u u' have "... = ?f u / ?f x" by (simp add: powr_divide) finally show "?T * ?f x \ ?f u" using x' by (simp add: field_simps) qed qed private lemma powr_ln_powr_growth2: "\C c1. 0 < c1 \ C < Min (set bs) \ eventually (\x. \u\{C * x..x}. c1 * (x powr r * ln x powr r') \ u powr r * ln u powr r') at_top" proof (intro exI conjI) let ?C = "Min (set bs) / 2" and ?f = "\x. x powr r * ln x powr r'" define C where "C = ?C" let ?T = "max (C powr r) (1 powr r) * max ((1/2) powr r') (1 powr r')" show "?T > 0" by simp from b_bounds bs_nonempty have C_pos: "C > 0" unfolding C_def by simp thus "C < Min (set bs)" by (simp add: C_def) show "eventually (\x. \u\{C*x..x}. ?T * ?f x \ ?f u) at_top" using eventually_gt_at_top[of "max 1 (inverse C)"] eventually_ln_const[OF C_pos] apply eventually_elim proof clarify fix x u assume x: "x > max 1 (inverse C)" and u: "u \ {C*x..x}" hence x': "x > 1" by (simp add: field_simps) with C_pos have x_pos: "x > 0" by (simp add: field_simps) from x u C_pos have u': "u > 1" by (simp add: field_simps) assume A: "ln (C*x) / ln x > 1/2" from x u u' have "?f u / ?f x = (u/x) powr r * (ln u/ln x) powr r'" by (simp add: powr_divide) also { have "(u/x) powr r \ max (C powr r) (1 powr r)" using x u u' C_pos by (intro powr_upper_bound) (simp_all add: field_simps) moreover { note A also from C_pos x' u u' have "ln (C*x) \ ln u" by (subst ln_le_cancel_iff) simp_all with x' have "ln (C*x) / ln x \ ln u / ln x" by (simp add: field_simps) finally have "(ln u / ln x) powr r' \ max ((1/2) powr r') (1 powr r')" using x u u' C_pos A by (intro powr_upper_bound) simp_all } ultimately have "(u/x) powr r * (ln u / ln x) powr r' \ ?T" using x_pos by (intro mult_mono) simp_all } finally show "?T * ?f x \ ?f u" using x' by (simp add: field_simps) qed qed lemmas growths = powr_growth1 powr_growth2 powr_ln_powr_growth1 powr_ln_powr_growth2 private lemma master_integrable: "\a::real. \b\a. (\u. u powr r * ln u powr s / u powr t) integrable_on {a..b}" "\a::real. \b\a. (\u. u powr r / u powr s) integrable_on {a..b}" by (rule exI[of _ 2], force intro!: integrable_continuous_real continuous_intros)+ private lemma master_integral: fixes a p p' :: real assumes p: "p \ p'" and a: "a > 0" obtains c d where "c \ 0" "p > p' \ d \ 0" "(\x::nat. x powr p * (1 + integral {a..x} (\u. u powr p' / u powr (p+1)))) \ \(\x::nat. d * x powr p + c * x powr p')" proof- define e where "e = a powr (p' - p)" from assms have e: "e \ 0" by (simp add: e_def) define c where "c = inverse (p' - p)" define d where "d = 1 - inverse (p' - p) * e" have "c \ 0" and "p > p' \ d \ 0" using e p a unfolding c_def d_def by (auto simp: field_simps) thus ?thesis apply (rule that) apply (rule bigtheta_real_nat_transfer, rule bigthetaI_cong) using eventually_ge_at_top[of a] proof eventually_elim fix x assume x: "x \ a" hence "integral {a..x} (\u. u powr p' / u powr (p+1)) = integral {a..x} (\u. u powr (p' - (p + 1)))" by (intro Henstock_Kurzweil_Integration.integral_cong) (simp_all add: powr_diff [symmetric] ) also have "... = inverse (p' - p) * (x powr (p' - p) - a powr (p' - p))" using p x0_less_x1 a x by (simp add: integral_powr) also have "x powr p * (1 + ...) = d * x powr p + c * x powr p'" using p unfolding c_def d_def by (simp add: algebra_simps powr_diff e_def) finally show "x powr p * (1 + integral {a..x} (\u. u powr p' / u powr (p+1))) = d * x powr p + c * x powr p'" . qed qed private lemma master_integral': fixes a p p' :: real assumes p': "p' \ 0" and a: "a > 1" obtains c d :: real where "p' < 0 \ c \ 0" "d \ 0" "(\x::nat. x powr p * (1 + integral {a..x} (\u. u powr p * ln u powr (p'-1) / u powr (p+1)))) \ \(\x::nat. c * x powr p + d * x powr p * ln x powr p')" proof- define e where "e = ln a powr p'" from assms have e: "e > 0" by (simp add: e_def) define c where "c = 1 - inverse p' * e" define d where "d = inverse p'" from assms e have "p' < 0 \ c \ 0" "d \ 0" unfolding c_def d_def by (auto simp: field_simps) thus ?thesis apply (rule that) apply (rule landau_real_nat_transfer, rule bigthetaI_cong) using eventually_ge_at_top[of a] proof eventually_elim fix x :: real assume x: "x \ a" have "integral {a..x} (\u. u powr p * ln u powr (p' - 1) / u powr (p + 1)) = integral {a..x} (\u. ln u powr (p' - 1) / u)" using x a x0_less_x1 by (intro Henstock_Kurzweil_Integration.integral_cong) (simp_all add: powr_add) also have "... = inverse p' * (ln x powr p' - ln a powr p')" using p' x0_less_x1 a(1) x by (simp add: integral_ln_powr_over_x) also have "x powr p * (1 + ...) = c * x powr p + d * x powr p * ln x powr p'" using p' by (simp add: algebra_simps c_def d_def e_def) finally show "x powr p * (1+integral {a..x} (\u. u powr p * ln u powr (p'-1) / u powr (p+1))) = c * x powr p + d * x powr p * ln x powr p'" . qed qed private lemma master_integral'': fixes a p p' :: real assumes a: "a > 1" shows "(\x::nat. x powr p * (1 + integral {a..x} (\u. u powr p * ln u powr - 1/u powr (p+1)))) \ \(\x::nat. x powr p * ln (ln x))" proof (rule landau_real_nat_transfer) have "(\x::real. x powr p * (1 + integral {a..x} (\u. u powr p * ln u powr - 1/u powr (p+1)))) \ \(\x::real. (1 - ln (ln a)) * x powr p + x powr p * ln (ln x))" (is "?f \ _") apply (rule bigthetaI_cong) using eventually_ge_at_top[of a] proof eventually_elim fix x assume x: "x \ a" have "integral {a..x} (\u. u powr p * ln u powr -1 / u powr (p + 1)) = integral {a..x} (\u. inverse (u * ln u))" using x a x0_less_x1 by (intro Henstock_Kurzweil_Integration.integral_cong) (simp_all add: powr_add powr_minus field_simps) also have "... = ln (ln x) - ln (ln a)" using x0_less_x1 a(1) x by (subst integral_one_over_x_ln_x) simp_all also have "x powr p * (1 + ...) = (1 - ln (ln a)) * x powr p + x powr p * ln (ln x)" by (simp add: algebra_simps) finally show "x powr p * (1 + integral {a..x} (\u. u powr p * ln u powr - 1 / u powr (p+1))) = (1 - ln (ln a)) * x powr p + x powr p * ln (ln x)" . qed also have "(\x. (1 - ln (ln a)) * x powr p + x powr p * ln (ln x)) \ \(\x. x powr p * ln (ln x))" by simp finally show "?f \ \(\a. a powr p * ln (ln a))" . qed lemma master1_bigo: assumes g_bigo: "g \ O(\x. real x powr p')" assumes less_p': "(\i 1" shows "f \ O(\x. real x powr p)" proof- interpret akra_bazzi_upper x\<^sub>0 x\<^sub>1 k as bs ts f "\f a b. f integrable_on {a..b}" "\f a b. integral {a..b} f" g "\x. x powr p'" using assms growths g_bigo master_integrable by unfold_locales (assumption | simp)+ from less_p' have less_p: "p' < p" by (rule p_greaterI) from bigo_f[of "0"] guess a . note a = this note a(2) also from a(1) less_p x0_less_x1 have "p \ p'" by simp_all from master_integral[OF this a(1)] guess c d . note cd = this note cd(3) also from cd(1,2) less_p have "(\x::nat. d * real x powr p + c * real x powr p') \ \(\x. real x powr p)" by force finally show "f \ O(\x::nat. x powr p)" . qed lemma master1: assumes g_bigo: "g \ O(\x. real x powr p')" assumes less_p': "(\i 1" assumes f_pos: "eventually (\x. f x > 0) at_top" shows "f \ \(\x. real x powr p)" proof (rule bigthetaI) interpret akra_bazzi_lower x\<^sub>0 x\<^sub>1 k as bs ts f "\f a b. f integrable_on {a..b}" "\f a b. integral {a..b} f" g "\_. 0" using assms(1,3) bs_lower_bound by unfold_locales (auto intro: always_eventually) from bigomega_f show "f \ \(\x. real x powr p)" by force qed (fact master1_bigo[OF g_bigo less_p']) lemma master2_3: assumes g_bigtheta: "g \ \(\x. real x powr p * ln (real x) powr (p' - 1))" assumes p': "p' > 0" shows "f \ \(\x. real x powr p * ln (real x) powr p')" proof- have "eventually (\x::real. x powr p * ln x powr (p' - 1) > 0) at_top" using eventually_gt_at_top[of "1::real"] by eventually_elim simp hence "eventually (\x. f x > 0) at_top" by (rule f_pos[OF bigthetaD2[OF g_bigtheta] eventually_nat_real]) then interpret akra_bazzi x\<^sub>0 x\<^sub>1 k as bs ts f "\f a b. f integrable_on {a..b}" "\f a b. integral {a..b} f" g "\x. x powr p * ln x powr (p' - 1)" using assms growths bounds master_integrable by unfold_locales (assumption | simp)+ from bigtheta_f[of "1"] guess a . note a = this note a(2) also from a(1) p' have "p' \ 0" by simp_all from master_integral'[OF this a(1), of p] guess c d . note cd = this note cd(3) also have "(\x::nat. c * real x powr p + d * real x powr p * ln (real x) powr p') \ \(\x::nat. x powr p * ln x powr p')" using cd(1,2) p' by force finally show "f \ \(\x. real x powr p * ln (real x) powr p')" . qed lemma master2_1: assumes g_bigtheta: "g \ \(\x. real x powr p * ln (real x) powr p')" assumes p': "p' < -1" shows "f \ \(\x. real x powr p)" proof- have "eventually (\x::real. x powr p * ln x powr p' > 0) at_top" using eventually_gt_at_top[of "1::real"] by eventually_elim simp hence "eventually (\x. f x > 0) at_top" by (rule f_pos[OF bigthetaD2[OF g_bigtheta] eventually_nat_real]) then interpret akra_bazzi x\<^sub>0 x\<^sub>1 k as bs ts f "\f a b. f integrable_on {a..b}" "\f a b. integral {a..b} f" g "\x. x powr p * ln x powr p'" using assms growths bounds master_integrable by unfold_locales (assumption | simp)+ from bigtheta_f[of "1"] guess a . note a = this note a(2) also from a(1) p' have A: "p' + 1 \ 0" by simp_all obtain c d :: real where cd: "c \ 0" "d \ 0" and "(\x::nat. x powr p * (1 + integral {a..x} (\u. u powr p * ln u powr p'/ u powr (p+1)))) \ \(\x::nat. c * x powr p + d * x powr p * ln x powr (p' + 1))" by (rule master_integral'[OF A a(1), of p]) (insert p', simp) note this(3) also have "(\x::nat. c * real x powr p + d * real x powr p * ln (real x) powr (p' + 1)) \ \(\x::nat. x powr p)" using cd(1,2) p' by force finally show "f \ \(\x::nat. x powr p)" . qed lemma master2_2: assumes g_bigtheta: "g \ \(\x. real x powr p / ln (real x))" shows "f \ \(\x. real x powr p * ln (ln (real x)))" proof- have "eventually (\x::real. x powr p / ln x > 0) at_top" using eventually_gt_at_top[of "1::real"] by eventually_elim simp hence "eventually (\x. f x > 0) at_top" by (rule f_pos[OF bigthetaD2[OF g_bigtheta] eventually_nat_real]) moreover from g_bigtheta have g_bigtheta': "g \ \(\x. real x powr p * ln (real x) powr -1)" by (rule landau_theta.trans, intro landau_real_nat_transfer) simp ultimately interpret akra_bazzi x\<^sub>0 x\<^sub>1 k as bs ts f "\f a b. f integrable_on {a..b}" "\f a b. integral {a..b} f" g "\x. x powr p * ln x powr -1" using assms growths bounds master_integrable by unfold_locales (assumption | simp)+ from bigtheta_f[of 1] guess a . note a = this note a(2) also note master_integral''[OF a(1)] finally show "f \ \(\x::nat. x powr p * ln (ln x))" . qed lemma master3: assumes g_bigtheta: "g \ \(\x. real x powr p')" assumes p'_greater': "(\i \(\x. real x powr p')" proof- have "eventually (\x::real. x powr p' > 0) at_top" using eventually_gt_at_top[of "1::real"] by eventually_elim simp hence "eventually (\x. f x > 0) at_top" by (rule f_pos[OF bigthetaD2[OF g_bigtheta] eventually_nat_real]) then interpret akra_bazzi x\<^sub>0 x\<^sub>1 k as bs ts f "\f a b. f integrable_on {a..b}" "\f a b. integral {a..b} f" g "\x. x powr p'" using assms growths bounds master_integrable by unfold_locales (assumption | simp)+ from p'_greater' have p'_greater: "p' > p" by (rule p_lessI) from bigtheta_f[of 0] guess a . note a = this note a(2) also from p'_greater have "p \ p'" by simp from master_integral[OF this a(1)] guess c d . note cd = this note cd(3) also have "(\x::nat. d * x powr p + c * x powr p') \ \(\x::real. x powr p')" using p'_greater cd(1,2) by force finally show "f \ \(\x. real x powr p')" . qed end end end diff --git a/thys/Akra_Bazzi/Master_Theorem_Examples.thy b/thys/Akra_Bazzi/Master_Theorem_Examples.thy --- a/thys/Akra_Bazzi/Master_Theorem_Examples.thy +++ b/thys/Akra_Bazzi/Master_Theorem_Examples.thy @@ -1,250 +1,250 @@ (* File: Master_Theorem_Examples.thy - Author: Manuel Eberl + Author: Manuel Eberl Examples for the application of the Master theorem and related proof methods. *) section \Examples\ theory Master_Theorem_Examples imports Complex_Main Akra_Bazzi_Method Akra_Bazzi_Approximation begin subsection \Merge sort\ (* A merge sort cost function that is parametrised with the recombination costs *) function merge_sort_cost :: "(nat \ real) \ nat \ real" where "merge_sort_cost t 0 = 0" | "merge_sort_cost t 1 = 1" | "n \ 2 \ merge_sort_cost t n = merge_sort_cost t (nat \real n / 2\) + merge_sort_cost t (nat \real n / 2\) + t n" by force simp_all termination by akra_bazzi_termination simp_all lemma merge_sort_nonneg[simp]: "(\n. t n \ 0) \ merge_sort_cost t x \ 0" by (induction t x rule: merge_sort_cost.induct) (simp_all del: One_nat_def) lemma "t \ \(\n. real n) \ (\n. t n \ 0) \ merge_sort_cost t \ \(\n. real n * ln (real n))" by (master_theorem 2.3) simp_all subsection \Karatsuba multiplication\ function karatsuba_cost :: "nat \ real" where "karatsuba_cost 0 = 0" | "karatsuba_cost 1 = 1" | "n \ 2 \ karatsuba_cost n = 3 * karatsuba_cost (nat \real n / 2\) + real n" by force simp_all termination by akra_bazzi_termination simp_all lemma karatsuba_cost_nonneg[simp]: "karatsuba_cost n \ 0" by (induction n rule: karatsuba_cost.induct) (simp_all del: One_nat_def) lemma "karatsuba_cost \ O(\n. real n powr log 2 3)" by (master_theorem 1 p': 1) (simp_all add: powr_divide) lemma karatsuba_cost_pos: "n \ 1 \ karatsuba_cost n > 0" by (induction n rule: karatsuba_cost.induct) (auto intro!: add_nonneg_pos simp del: One_nat_def) lemma "karatsuba_cost \ \(\n. real n powr log 2 3)" using karatsuba_cost_pos by (master_theorem 1 p': 1) (auto simp add: powr_divide eventually_at_top_linorder) subsection \Strassen matrix multiplication\ function strassen_cost :: "nat \ real" where "strassen_cost 0 = 0" | "strassen_cost 1 = 1" | "n \ 2 \ strassen_cost n = 7 * strassen_cost (nat \real n / 2\) + real (n^2)" by force simp_all termination by akra_bazzi_termination simp_all lemma strassen_cost_nonneg[simp]: "strassen_cost n \ 0" by (induction n rule: strassen_cost.induct) (simp_all del: One_nat_def) lemma "strassen_cost \ O(\n. real n powr log 2 7)" by (master_theorem 1 p': 2) (auto simp: powr_divide eventually_at_top_linorder) lemma strassen_cost_pos: "n \ 1 \ strassen_cost n > 0" by (cases n rule: strassen_cost.cases) (simp_all add: add_nonneg_pos del: One_nat_def) lemma "strassen_cost \ \(\n. real n powr log 2 7)" using strassen_cost_pos by (master_theorem 1 p': 2) (auto simp: powr_divide eventually_at_top_linorder) subsection \Deterministic select\ (* This is not possible with the standard Master theorem from literature *) function select_cost :: "nat \ real" where "n \ 20 \ select_cost n = 0" | "n > 20 \ select_cost n = select_cost (nat \real n / 5\) + select_cost (nat \7 * real n / 10\ + 6) + 12 * real n / 5" by force simp_all termination by akra_bazzi_termination simp_all lemma "select_cost \ \(\n. real n)" by (master_theorem 3) auto subsection \Decreasing function\ function dec_cost :: "nat \ real" where "n \ 2 \ dec_cost n = 1" | "n > 2 \ dec_cost n = 0.5*dec_cost (nat \real n / 2\) + 1 / real n" by force simp_all termination by akra_bazzi_termination simp_all lemma "dec_cost \ \(\x::nat. ln x / x)" by (master_theorem 2.3) simp_all subsection \Example taken from Drmota and Szpakowski\ function drmota1 :: "nat \ real" where "n < 20 \ drmota1 n = 1" | "n \ 20 \ drmota1 n = 2 * drmota1 (nat \real n/2\) + 8/9 * drmota1 (nat \3*real n/4\) + real n^2 / ln (real n)" by force simp_all termination by akra_bazzi_termination simp_all lemma "drmota1 \ \(\n::real. n^2 * ln (ln n))" by (master_theorem 2.2) (simp_all add: power_divide) function drmota2 :: "nat \ real" where "n < 20 \ drmota2 n = 1" | "n \ 20 \ drmota2 n = 1/3 * drmota2 (nat \real n/3 + 1/2\) + 2/3 * drmota2 (nat \2*real n/3 - 1/2\) + 1" by force simp_all termination by akra_bazzi_termination simp_all lemma "drmota2 \ \(\x. ln (real x))" by master_theorem simp_all (* Average phrase length of Boncelet arithmetic coding. See Drmota and Szpankowski. *) lemma boncelet_phrase_length: fixes p \ :: real assumes p: "p > 0" "p < 1" and \: "\ > 0" "\ < 1" "2*p + \ < 2" fixes d :: "nat \ real" defines "q \ 1 - p" assumes d_nonneg: "\n. d n \ 0" assumes d_rec: "\n. n \ 2 \ d n = 1 + p * d (nat \p * real n + \\) + q * d (nat \q * real n - \\)" shows "d \ \(\x. ln x)" using assms by (master_theorem recursion: d_rec, simp_all) subsection \Transcendental exponents\ (* Certain number-theoretic conjectures would imply that if all the parameters are rational, the Akra-Bazzi parameter is either rational or transcendental. That makes this case probably transcendental *) function foo_cost :: "nat \ real" where "n < 200 \ foo_cost n = 0" | "n \ 200 \ foo_cost n = foo_cost (nat \real n / 3\) + foo_cost (nat \3 * real n / 4\ + 42) + real n" by force simp_all termination by akra_bazzi_termination simp_all lemma foo_cost_nonneg [simp]: "foo_cost n \ 0" by (induction n rule: foo_cost.induct) simp_all lemma "foo_cost \ \(\n. real n powr akra_bazzi_exponent [1,1] [1/3,3/4])" proof (master_theorem 1 p': 1) have "\n\200. foo_cost n > 0" by (simp add: add_nonneg_pos) thus "eventually (\n. foo_cost n > 0) at_top" unfolding eventually_at_top_linorder by blast qed simp_all lemma "akra_bazzi_exponent [1,1] [1/3,3/4] \ {1.1519623..1.1519624}" by (akra_bazzi_approximate 29) subsection \Functions in locale contexts\ locale det_select = fixes b :: real assumes b: "b > 0" "b < 7/10" begin function select_cost' :: "nat \ real" where "n \ 20 \ select_cost' n = 0" | "n > 20 \ select_cost' n = select_cost' (nat \real n / 5\) + select_cost' (nat \b * real n\ + 6) + 6 * real n + 5" by force simp_all termination using b by akra_bazzi_termination simp_all lemma "a \ 0 \ select_cost' \ \(\n. real n)" using b by (master_theorem 3, force+) end subsection \Non-curried functions\ (* Note: either a or b could be seen as recursion variables. *) function baz_cost :: "nat \ nat \ real" where "n \ 2 \ baz_cost (a, n) = 0" | "n > 2 \ baz_cost (a, n) = 3 * baz_cost (a, nat \real n / 2\) + real a" by force simp_all termination by akra_bazzi_termination simp_all lemma baz_cost_nonneg [simp]: "a \ 0 \ baz_cost (a, n) \ 0" by (induction a n rule: baz_cost.induct[split_format (complete)]) simp_all lemma assumes "a > 0" shows "(\x. baz_cost (a, x)) \ \(\x. x powr log 2 3)" proof (master_theorem 1 p': 0) from assms have "\x\3. baz_cost (a, x) > 0" by (auto intro: add_nonneg_pos) thus "eventually (\x. baz_cost (a, x) > 0) at_top" by (force simp: eventually_at_top_linorder) qed (insert assms, simp_all add: powr_divide) (* Non-"Akra-Bazzi" variables may even be modified without impacting the termination proof. However, the Akra-Bazzi theorem and the Master theorem itself do not apply anymore, because bar_cost cannot be seen as a recursive function with one parameter *) function bar_cost :: "nat \ nat \ real" where "n \ 2 \ bar_cost (a, n) = 0" | "n > 2 \ bar_cost (a, n) = 3 * bar_cost (2 * a, nat \real n / 2\) + real a" by force simp_all termination by akra_bazzi_termination simp_all subsection \Ham-sandwich trees\ (* f(n) = f(n/4) + f(n/2) + 1 *) function ham_sandwich_cost :: "nat \ real" where "n < 4 \ ham_sandwich_cost n = 1" | "n \ 4 \ ham_sandwich_cost n = ham_sandwich_cost (nat \n/4\) + ham_sandwich_cost (nat \n/2\) + 1" by force simp_all termination by akra_bazzi_termination simp_all lemma ham_sandwich_cost_pos [simp]: "ham_sandwich_cost n > 0" by (induction n rule: ham_sandwich_cost.induct) simp_all text \The golden ratio\ definition "\ = ((1 + sqrt 5) / 2 :: real)" lemma \_pos [simp]: "\ > 0" and \_nonneg [simp]: "\ \ 0" and \_nonzero [simp]: "\ \ 0" proof- show "\ > 0" unfolding \_def by (simp add: add_pos_nonneg) thus "\ \ 0" "\ \ 0" by simp_all qed lemma "ham_sandwich_cost \ \(\n. n powr (log 2 \))" proof (master_theorem 1 p': 0) have "(1 / 4) powr log 2 \ + (1 / 2) powr log 2 \ = inverse (2 powr log 2 \)^2 + inverse (2 powr log 2 \)" by (simp add: powr_divide field_simps powr_powr power2_eq_square powr_mult[symmetric] del: powr_log_cancel) also have "... = inverse (\^2) + inverse \" by (simp add: power2_eq_square) also have "\ + 1 = \*\" by (simp add: \_def field_simps) hence "inverse (\^2) + inverse \ = 1" by (simp add: field_simps power2_eq_square) finally show "(1 / 4) powr log 2 \ + (1 / 2) powr log 2 \ = 1" by simp qed simp_all end diff --git a/thys/Bernoulli/Bernoulli.thy b/thys/Bernoulli/Bernoulli.thy --- a/thys/Bernoulli/Bernoulli.thy +++ b/thys/Bernoulli/Bernoulli.thy @@ -1,314 +1,314 @@ (* File: Bernoulli.thy Author: Lukas Bulwahn - Author: Manuel Eberl + Author: Manuel Eberl *) section \Bernoulli numbers\ theory Bernoulli imports Complex_Main begin subsection \Preliminaries\ lemma power_numeral_reduce: "a ^ numeral n = a * a ^ pred_numeral n" by (simp only: numeral_eq_Suc power_Suc) lemma fact_diff_Suc: "n < Suc m \ fact (Suc m - n) = of_nat (Suc m - n) * fact (m - n)" by (subst fact_reduce) auto lemma of_nat_binomial_Suc: assumes "k \ n" shows "(of_nat (Suc n choose k) :: 'a :: field_char_0) = of_nat (Suc n) / of_nat (Suc n - k) * of_nat (n choose k)" using assms by (simp add: binomial_fact divide_simps fact_diff_Suc of_nat_diff del: of_nat_Suc) lemma integrals_eq: assumes "f 0 = g 0" assumes "\ x. ((\x. f x - g x) has_real_derivative 0) (at x)" shows "f x = g x" proof - show "f x = g x" proof (cases "x \ 0") case True from assms DERIV_const_ratio_const[OF this, of "\x. f x - g x" 0] show ?thesis by auto qed (simp add: assms) qed lemma sum_diff: "((\i\n::nat. f (i + 1) - f i)::'a::field) = f (n + 1) - f 0" by (induct n) (auto simp add: field_simps) lemma Rats_sum: "(\x. x \ A \ f x \ \) \ sum f A \ \" by (induction A rule: infinite_finite_induct) simp_all subsection \Bernoulli Numbers and Bernoulli Polynomials\ declare sum.cong [fundef_cong] fun bernoulli :: "nat \ real" where "bernoulli 0 = (1::real)" | "bernoulli (Suc n) = (-1 / (n + 2)) * (\k \ n. ((n + 2 choose k) * bernoulli k))" declare bernoulli.simps[simp del] lemmas bernoulli_0 [simp] = bernoulli.simps(1) lemmas bernoulli_Suc = bernoulli.simps(2) lemma bernoulli_1 [simp]: "bernoulli 1 = -1/2" by (simp add: bernoulli_Suc) lemma bernoulli_Suc_0 [simp]: "bernoulli (Suc 0) = -1/2" by (simp add: bernoulli_Suc) text \ The ``normal'' Bernoulli numbers are the negative Bernoulli numbers $B_n^{-}$ we just defined (so called because $B_1^{-} = -\frac{1}{2}$). There is also another convention, the positive Bernoulli numbers $B_n^{+}$, which differ from the negative ones only in that $B_1^{+} = \frac{1}{2}$. Both conventions have their justification, since a number of theorems are easier to state with one than the other. \ definition bernoulli' where "bernoulli' n = (if n = 1 then 1/2 else bernoulli n)" lemma bernoulli'_0 [simp]: "bernoulli' 0 = 1" by (simp add: bernoulli'_def) lemma bernoulli'_1 [simp]: "bernoulli' (Suc 0) = 1/2" by (simp add: bernoulli'_def) lemma bernoulli_conv_bernoulli': "n \ 1 \ bernoulli n = bernoulli' n" by (simp add: bernoulli'_def) lemma bernoulli'_conv_bernoulli: "n \ 1 \ bernoulli' n = bernoulli n" by (simp add: bernoulli'_def) lemma bernoulli_conv_bernoulli'_if: "n \ 1 \ bernoulli n = (if n = 1 then -1/2 else bernoulli' n)" by (simp add: bernoulli'_def) lemma bernoulli_in_Rats: "bernoulli n \ \" proof (induction n rule: less_induct) case (less n) thus ?case by (cases n) (auto simp: bernoulli_Suc intro!: Rats_sum Rats_divide) qed lemma bernoulli'_in_Rats: "bernoulli' n \ \" by (simp add: bernoulli'_def bernoulli_in_Rats) definition bernpoly :: "nat \ 'a \ 'a :: real_algebra_1" where "bernpoly n = (\x. \k \ n. of_nat (n choose k) * of_real (bernoulli k) * x ^ (n - k))" lemma bernpoly_altdef: "bernpoly n = (\x. \k\n. of_nat (n choose k) * of_real (bernoulli (n - k)) * x ^ k)" proof fix x :: 'a have "bernpoly n x = (\k\n. of_nat (n choose (n - k)) * of_real (bernoulli (n - k)) * x ^ (n - (n - k)))" unfolding bernpoly_def by (rule sum.reindex_bij_witness[of _ "\k. n - k" "\k. n - k"]) simp_all also have "\ = (\k\n. of_nat (n choose k) * of_real (bernoulli (n - k)) * x ^ k)" by (intro sum.cong refl) (simp_all add: binomial_symmetric [symmetric]) finally show "bernpoly n x = \" . qed lemma bernoulli_Suc': "bernoulli (Suc n) = -1/(real n + 2) * (\k\n. real (n + 2 choose (k + 2)) * bernoulli (n - k))" proof - have "bernoulli (Suc n) = - 1 / (real n + 2) * (\k\n. real (n + 2 choose k) * bernoulli k)" unfolding bernoulli.simps .. also have "(\k\n. real (n + 2 choose k) * bernoulli k) = (\k\n. real (n + 2 choose (n - k)) * bernoulli (n - k))" by (rule sum.reindex_bij_witness[of _ "\k. n - k" "\k. n - k"]) simp_all also have "\ = (\k\n. real (n + 2 choose (k + 2)) * bernoulli (n - k))" by (intro sum.cong refl, subst binomial_symmetric) simp_all finally show ?thesis . qed subsection \Basic Observations on Bernoulli Polynomials\ lemma bernpoly_0 [simp]: "bernpoly n 0 = (of_real (bernoulli n) :: 'a :: real_algebra_1)" proof (cases n) case 0 then show "bernpoly n 0 = of_real (bernoulli n)" unfolding bernpoly_def bernoulli.simps by auto next case (Suc n') have "(\k\n'. of_nat (Suc n' choose k) * of_real (bernoulli k) * 0 ^ (Suc n' - k)) = (0::'a)" proof (intro sum.neutral ballI) fix k assume "k \ {..n'}" thus "of_nat (Suc n' choose k) * of_real (bernoulli k) * (0::'a) ^ (Suc n' - k) = 0" by (cases "Suc n' - k") auto qed with Suc show ?thesis unfolding bernpoly_def by simp qed lemma continuous_on_bernpoly [continuous_intros]: "continuous_on A (bernpoly n :: 'a \ 'a :: real_normed_algebra_1)" unfolding bernpoly_def by (auto intro!: continuous_intros) lemma isCont_bernpoly [continuous_intros]: "isCont (bernpoly n :: 'a \ 'a :: real_normed_algebra_1) x" unfolding bernpoly_def by (auto intro!: continuous_intros) lemma has_field_derivative_bernpoly: "(bernpoly (Suc n) has_field_derivative (of_nat (n + 1) * bernpoly n x :: 'a :: real_normed_field)) (at x)" proof - have "(bernpoly (Suc n) has_field_derivative (\k\n. of_nat (Suc n - k) * x ^ (n - k) * (of_nat (Suc n choose k) * of_real (bernoulli k)))) (at x)" (is "(_ has_field_derivative ?D) _") unfolding bernpoly_def by (rule DERIV_cong) (fast intro!: derivative_intros, simp) also have "?D = of_nat (n + 1) * bernpoly n x" unfolding bernpoly_def by (subst sum_distrib_left, intro sum.cong refl, subst of_nat_binomial_Suc) simp_all ultimately show ?thesis by (auto simp del: of_nat_Suc One_nat_def) qed lemmas has_field_derivative_bernpoly' [derivative_intros] = DERIV_chain'[OF _ has_field_derivative_bernpoly] lemma sum_binomial_times_bernoulli: "(\k\n. ((Suc n) choose k) * bernoulli k) = (if n = 0 then 1 else 0)" proof (cases n) case (Suc m) then show ?thesis by (simp add: bernoulli_Suc) (simp add: field_simps add_2_eq_Suc'[symmetric] del: add_2_eq_Suc add_2_eq_Suc') qed simp_all lemma sum_binomial_times_bernoulli': "(\kkk\m. real (Suc m choose k) * bernoulli k)" unfolding Suc lessThan_Suc_atMost .. also have "\ = (if n = 1 then 1 else 0)" by (subst sum_binomial_times_bernoulli) (simp add: Suc) finally show ?thesis . qed simp_all lemma binomial_unroll: "n > 0 \ (n choose k) = (if k = 0 then 1 else (n - 1) choose (k - 1) + ((n - 1) choose k))" by (auto simp add: gr0_conv_Suc) lemma sum_unroll: "(\k\n::nat. f k) = (if n = 0 then f 0 else f n + (\k\n - 1. f k))" by (cases n) (simp_all add: add_ac) lemma bernoulli_unroll: "n > 0 \ bernoulli n = - 1 / (real n + 1) * (\k\n - 1. real (n + 1 choose k) * bernoulli k)" by (cases n) (simp add: bernoulli_Suc)+ lemmas bernoulli_unroll_all = binomial_unroll bernoulli_unroll sum_unroll bernpoly_def lemma bernpoly_1_1: "bernpoly 1 1 = of_real (1/2)" proof - have *: "(1 :: 'a) = of_real 1" by simp have "bernpoly 1 (1::'a) = 1 - of_real (1 / 2)" by (simp add: bernoulli_unroll_all) also have "\ = of_real (1 - 1 / 2)" by (simp only: * of_real_diff) also have "1 - 1 / 2 = (1 / 2 :: real)" by simp finally show ?thesis . qed subsection \Sum of Powers with Bernoulli Polynomials\ (* TODO: Generalisation not possible here because mean-value theorem is only available for reals *) lemma diff_bernpoly: fixes x :: real shows "bernpoly n (x + 1) - bernpoly n x = of_nat n * x ^ (n - 1)" proof (induct n arbitrary: x) case 0 show ?case unfolding bernpoly_def by auto next case (Suc n) have "bernpoly (Suc n) (0 + 1) - bernpoly (Suc n) (0 :: real) = (\k\n. of_real (real (Suc n choose k) * bernoulli k))" unfolding bernpoly_0 unfolding bernpoly_def by simp also have "\ = of_nat (Suc n) * 0 ^ n" by (simp only: of_real_sum [symmetric] sum_binomial_times_bernoulli) simp finally have const: "bernpoly (Suc n) (0 + 1) - bernpoly (Suc n) 0 = \" by simp have hyps': "of_nat (Suc n) * bernpoly n (x + 1) - of_nat (Suc n) * bernpoly n x = of_nat n * of_nat (Suc n) * x ^ (n - Suc 0)" for x :: real unfolding right_diff_distrib[symmetric] by (subst Suc) (simp_all add: algebra_simps) have "((\x. bernpoly (Suc n) (x + 1) - bernpoly (Suc n) x - of_nat (Suc n) * x ^ n) has_field_derivative 0) (at x)" for x :: real by (rule derivative_eq_intros refl)+ (insert hyps'[of x], simp add: algebra_simps) from integrals_eq[OF const this] show ?case by simp qed lemma bernpoly_of_real: "bernpoly n (of_real x) = of_real (bernpoly n x)" by (simp add: bernpoly_def) lemma bernpoly_1: assumes "n \ 1" shows "bernpoly n 1 = of_real (bernoulli n)" proof - have "bernpoly n 1 = bernoulli n" proof (cases "n \ 2") case False with assms have "n = 0" by auto thus ?thesis by (simp add: bernpoly_def) next case True with diff_bernpoly[of n 0] show ?thesis by (simp add: power_0_left bernpoly_0) qed hence "bernpoly n (of_real 1) = of_real (bernoulli n)" by (simp only: bernpoly_of_real) thus ?thesis by simp qed lemma bernpoly_1': "bernpoly n 1 = of_real (bernoulli' n)" using bernpoly_1_1 [where ?'a = 'a] by (cases "n = 1") (simp_all add: bernpoly_1 bernoulli'_def) theorem sum_of_powers: "(\k\n::nat. (real k) ^ m) = (bernpoly (Suc m) (n + 1) - bernpoly (Suc m) 0) / (m + 1)" proof - from diff_bernpoly[of "Suc m", simplified] have "(m + (1::real)) * (\k\n. (real k) ^ m) = (\k\n. bernpoly (Suc m) (real k + 1) - bernpoly (Suc m) (real k))" by (auto simp add: sum_distrib_left intro!: sum.cong) also have "... = (\k\n. bernpoly (Suc m) (real (k + 1)) - bernpoly (Suc m) (real k))" by (simp add: add_ac) also have "... = bernpoly (Suc m) (n + 1) - bernpoly (Suc m) 0" by (simp only: sum_diff[where f="\k. bernpoly (Suc m) (real k)"]) simp finally show ?thesis by (auto simp add: field_simps intro!: eq_divide_imp) qed lemma sum_of_powers_nat_aux: assumes "real a = b / c" "real b' = b" "real c' = c" shows "a = b' div c'" proof (cases "c = 0") case False with assms have "real (a * c') = real b'" by (simp add: field_simps) hence "b' = a * c'" by (subst (asm) of_nat_eq_iff) simp with False assms show ?thesis by simp qed (insert assms, simp_all) subsection \Instances for Square And Cubic Numbers\ theorem sum_of_squares: "real (\k\n::nat. k ^ 2) = real (2 * n ^ 3 + 3 * n ^ 2 + n) / 6" by (simp only: of_nat_sum of_nat_power sum_of_powers) (simp add: bernoulli_unroll_all field_simps power2_eq_square power_numeral_reduce) corollary sum_of_squares_nat: "(\k\n::nat. k ^ 2) = (2 * n ^ 3 + 3 * n ^ 2 + n) div 6" by (rule sum_of_powers_nat_aux[OF sum_of_squares]) simp_all theorem sum_of_cubes: "real (\k\n::nat. k ^ 3) = real (n ^ 2 + n) ^ 2 / 4" by (simp only: of_nat_sum of_nat_power sum_of_powers) (simp add: bernoulli_unroll_all field_simps power2_eq_square power_numeral_reduce) corollary sum_of_cubes_nat: "(\k\n::nat. k ^ 3) = (n ^ 2 + n) ^ 2 div 4" by (rule sum_of_powers_nat_aux[OF sum_of_cubes]) simp_all end diff --git a/thys/Bernoulli/Bernoulli_FPS.thy b/thys/Bernoulli/Bernoulli_FPS.thy --- a/thys/Bernoulli/Bernoulli_FPS.thy +++ b/thys/Bernoulli/Bernoulli_FPS.thy @@ -1,1370 +1,1370 @@ (* File: Bernoulli_FPS.thy - Author: Manuel Eberl + Author: Manuel Eberl Connection of Bernoulli numbers to formal power series; proof B_n = 0 for odd n > 1; Akiyama-Tanigawa algorithm. *) section \Connection of Bernoulli numbers to formal power series\ theory Bernoulli_FPS imports Bernoulli "HOL-Computational_Algebra.Computational_Algebra" "HOL-Combinatorics.Stirling" "HOL-Number_Theory.Number_Theory" begin subsection \Preliminaries\ context factorial_semiring begin lemma multiplicity_prime_prime: "prime p \ prime q \ multiplicity p q = (if p = q then 1 else 0)" by (simp add: prime_multiplicity_other) lemma prime_prod_dvdI: fixes f :: "'b \ 'a" assumes "finite A" assumes "\x. x \ A \ prime (f x)" assumes "\x. x \ A \ f x dvd y" assumes "inj_on f A" shows "prod f A dvd y" proof (cases "y = 0") case False have nz: "f x \ 0" if "x \ A" for x using assms(2)[of x] that by auto have "prod f A \ 0" using assms nz by (subst prod_zero_iff) auto thus ?thesis proof (rule multiplicity_le_imp_dvd) fix p :: 'a assume "prime p" show "multiplicity p (prod f A) \ multiplicity p y" proof (cases "p dvd prod f A") case True then obtain x where x: "x \ A" and "p dvd f x" using \prime p\ assms by (subst (asm) prime_dvd_prod_iff) auto have "multiplicity p (prod f A) = (\x\A. multiplicity p (f x))" using assms \prime p\ nz by (intro prime_elem_multiplicity_prod_distrib) auto also have "\ = (\x\{x}. 1 :: nat)" using assms \prime p\ \p dvd f x\ primes_dvd_imp_eq x by (intro Groups_Big.sum.mono_neutral_cong_right) (auto simp: multiplicity_prime_prime inj_on_def) finally have "multiplicity p (prod f A) = 1" by simp also have "1 \ multiplicity p y" using assms nz \prime p\ \y \ 0\ x \p dvd f x\ by (intro multiplicity_geI) force+ finally show ?thesis . qed (auto simp: not_dvd_imp_multiplicity_0) qed qed auto end (* TODO: Move? *) context semiring_gcd begin lemma gcd_add_dvd_right1: "a dvd b \ gcd a (b + c) = gcd a c" by (elim dvdE) (simp add: gcd_add_mult mult.commute[of a]) lemma gcd_add_dvd_right2: "a dvd c \ gcd a (b + c) = gcd a b" using gcd_add_dvd_right1[of a c b] by (simp add: add_ac) lemma gcd_add_dvd_left1: "a dvd b \ gcd (b + c) a = gcd c a" using gcd_add_dvd_right1[of a b c] by (simp add: gcd.commute) lemma gcd_add_dvd_left2: "a dvd c \ gcd (b + c) a = gcd b a" using gcd_add_dvd_right2[of a c b] by (simp add: gcd.commute) end context ring_gcd begin lemma gcd_diff_dvd_right1: "a dvd b \ gcd a (b - c) = gcd a c" using gcd_add_dvd_right1[of a b "-c"] by simp lemma gcd_diff_dvd_right2: "a dvd c \ gcd a (b - c) = gcd a b" using gcd_add_dvd_right2[of a "-c" b] by simp lemma gcd_diff_dvd_left1: "a dvd b \ gcd (b - c) a = gcd c a" using gcd_add_dvd_left1[of a b "-c"] by simp lemma gcd_diff_dvd_left2: "a dvd c \ gcd (b - c) a = gcd b a" using gcd_add_dvd_left2[of a "-c" b] by simp end lemma cong_int: "[a = b] (mod m) \ [int a = int b] (mod m)" by (simp add: cong_int_iff) lemma Rats_int_div_natE: assumes "(x :: 'a :: field_char_0) \ \" obtains m :: int and n :: nat where "n > 0" and "x = of_int m / of_nat n" and "coprime m n" proof - from assms obtain r where [simp]: "x = of_rat r" by (auto simp: Rats_def) obtain a b where [simp]: "r = Rat.Fract a b" and ab: "b > 0" "coprime a b" by (cases r) from ab show ?thesis by (intro that[of "nat b" a]) (auto simp: of_rat_rat) qed lemma sum_in_Ints: "(\x. x \ A \ f x \ \) \ sum f A \ \" by (induction A rule: infinite_finite_induct) auto lemma Ints_real_of_nat_divide: "b dvd a \ real a / real b \ \" by auto lemma product_dvd_fact: assumes "a > 1" "b > 1" "a = b \ a > 2" shows "(a * b) dvd fact (a * b - 1)" proof (cases "a = b") case False have "a * 1 < a * b" and "1 * b < a * b" using assms by (intro mult_strict_left_mono mult_strict_right_mono; simp)+ hence ineqs: "a \ a * b - 1" "b \ a * b - 1" by linarith+ from False have "a * b = \{a,b}" by simp also have "\ dvd \{1..a * b - 1}" using assms ineqs by (intro prod_dvd_prod_subset) auto finally show ?thesis by (simp add: fact_prod) next case [simp]: True from assms have "a > 2" by auto hence "a * 2 < a * b" using assms by (intro mult_strict_left_mono; simp) hence *: "2 * a \ a * b - 1" by linarith have "a * a dvd (2 * a) * a" by simp also have "\ = \{2*a, a}" using assms by auto also have "\ dvd \{1..a * b - 1}" using assms * by (intro prod_dvd_prod_subset) auto finally show ?thesis by (simp add: fact_prod) qed lemma composite_imp_factors_nat: assumes "m > 1" "\prime (m::nat)" shows "\n k. m = n * k \ 1 < n \ n < m \ 1 < k \ k < m" proof - from assms have "\irreducible m" by (simp flip: prime_elem_iff_irreducible ) then obtain a where a: "a dvd m" "\m dvd a" "a \ 1" using assms by (auto simp: irreducible_altdef) then obtain b where [simp]: "m = a * b" by auto from a assms have "a \ 0" "b \ 0" "b \ 1" by (auto intro!: Nat.gr0I) with a have "a > 1" "b > 1" by linarith+ moreover from this and a have "a < m" "b < m" by auto ultimately show ?thesis using \m = a * b\ by blast qed text \ This lemma describes what the numerator and denominator of a finite subseries of the harmonic series are when it is written as a single fraction. \ lemma sum_inverses_conv_fraction: fixes f :: "'a \ 'b :: field" assumes "\x. x \ A \ f x \ 0" "finite A" shows "(\x\A. 1 / f x) = (\x\A. \y\A-{x}. f y) / (\x\A. f x)" proof - have "(\x\A. (\y\A. f y) / f x) = (\x\A. \y\A-{x}. f y)" using prod.remove[of A _ f] assms by (intro sum.cong refl) (auto simp: field_simps) thus ?thesis using assms by (simp add: field_simps sum_distrib_right sum_distrib_left) qed text \ If all terms in the subseries are primes, this fraction is automatically on lowest terms. \ lemma sum_prime_inverses_fraction_coprime: fixes f :: "'a \ nat" assumes "finite A" and primes: "\x. x \ A \ prime (f x)" and inj: "inj_on f A" defines "a \ (\x\A. \y\A-{x}. f y)" shows "coprime a (\x\A. f x)" proof (intro prod_coprime_right) fix x assume x: "x \ A" have "a = (\y\A-{x}. f y) + (\y\A-{x}. \z\A-{y}. f z)" unfolding a_def using \finite A\ and x by (rule sum.remove) also have "gcd \ (f x) = gcd (\y\A-{x}. f y) (f x)" using \finite A\ and x by (intro gcd_add_dvd_left2 dvd_sum dvd_prodI) auto also from x primes inj have "coprime (\y\A-{x}. f y) (f x)" by (intro prod_coprime_left) (auto intro!: primes_coprime simp: inj_on_def) hence "gcd (\y\A-{x}. f y) (f x) = 1" by simp finally show "coprime a (f x)" by (simp only: coprime_iff_gcd_eq_1) qed (* END TODO *) text \ In the following, we will prove the correctness of the Akiyama--Tanigawa algorithm~\cite{kaneko2000}, which is a simple algorithm for computing Bernoulli numbers that was discovered by Akiyama and Tanigawa~\cite{aki_tani1999} essentially as a by-product of their studies of the Euler--Zagier multiple zeta function. The algorithm is based on a number triangle (similar to Pascal's triangle) in which the Bernoulli numbers are the leftmost diagonal. While the algorithm itself is quite simple, proving it correct is not entirely trivial. We will use generating functions and Stirling numbers, mostly following the presentation by Kaneko~\cite{kaneko2000}. \ text \ The following operator is a variant of the @{term fps_XD} operator where the multiplication is not with @{term fps_X}, but with an arbitrary formal power series. It is not quite clear if this operator has a less ad-hoc meaning than the fashion in which we use it; it is, however, very useful for proving the relationship between Stirling numbers and Bernoulli numbers. \ context includes fps_notation begin definition fps_XD' where "fps_XD' a = (\b. a * fps_deriv b)" lemma fps_XD'_0 [simp]: "fps_XD' a 0 = 0" by (simp add: fps_XD'_def) lemma fps_XD'_1 [simp]: "fps_XD' a 1 = 0" by (simp add: fps_XD'_def) lemma fps_XD'_fps_const [simp]: "fps_XD' a (fps_const b) = 0" by (simp add: fps_XD'_def) lemma fps_XD'_fps_of_nat [simp]: "fps_XD' a (of_nat b) = 0" by (simp add: fps_XD'_def) lemma fps_XD'_fps_of_int [simp]: "fps_XD' a (of_int b) = 0" by (simp add: fps_XD'_def) lemma fps_XD'_fps_numeral [simp]: "fps_XD' a (numeral b) = 0" by (simp add: fps_XD'_def) lemma fps_XD'_add [simp]: "fps_XD' a (b + c :: 'a :: comm_ring_1 fps) = fps_XD' a b + fps_XD' a c" by (simp add: fps_XD'_def algebra_simps) lemma fps_XD'_minus [simp]: "fps_XD' a (b - c :: 'a :: comm_ring_1 fps) = fps_XD' a b - fps_XD' a c" by (simp add: fps_XD'_def algebra_simps) lemma fps_XD'_prod: "fps_XD' a (b * c :: 'a :: comm_ring_1 fps) = fps_XD' a b * c + b * fps_XD' a c" by (simp add: fps_XD'_def algebra_simps) lemma fps_XD'_power: "fps_XD' a (b ^ n :: 'a :: idom fps) = of_nat n * b ^ (n - 1) * fps_XD' a b" proof (cases "n = 0") case False have "b * fps_XD' a (b ^ n) = of_nat n * b ^ n * fps_XD' a b" by (induction n) (simp_all add: fps_XD'_prod algebra_simps) also have "\ = b * (of_nat n * b ^ (n - 1) * fps_XD' a b)" by (cases n) (simp_all add: algebra_simps) finally show ?thesis using False by (subst (asm) mult_cancel_left) (auto simp: power_0_left) qed simp_all lemma fps_XD'_power_Suc: "fps_XD' a (b ^ Suc n :: 'a :: idom fps) = of_nat (Suc n) * b ^ n * fps_XD' a b" by (subst fps_XD'_power) simp_all lemma fps_XD'_sum: "fps_XD' a (sum f A) = sum (\x. fps_XD' (a :: 'a :: comm_ring_1 fps) (f x)) A" by (induction A rule: infinite_finite_induct) simp_all lemma fps_XD'_funpow_affine: fixes G H :: "real fps" assumes [simp]: "fps_deriv G = 1" defines "S \ \n i. fps_const (real (Stirling n i))" shows "(fps_XD' G ^^ n) H = (\m\n. S n m * G ^ m * (fps_deriv ^^ m) H)" proof (induction n arbitrary: H) case 0 thus ?case by (simp add: S_def) next case (Suc n H) have "(\m\Suc n. S (Suc n) m * G ^ m * (fps_deriv ^^ m) H) = (\i\n. of_nat (Suc i) * S n (Suc i) * G ^ Suc i * (fps_deriv ^^ Suc i) H) + (\i\n. S n i * G ^ Suc i * (fps_deriv ^^ Suc i) H)" (is "_ = sum (\i. ?f (Suc i)) \ + ?S2") by (subst sum.atMost_Suc_shift) (simp_all add: sum.distrib algebra_simps fps_of_nat S_def fps_const_add [symmetric] fps_const_mult [symmetric] del: fps_const_add fps_const_mult) also have "sum (\i. ?f (Suc i)) {..n} = sum (\i. ?f (Suc i)) {.. = ?f 0 + \" by simp also have "\ = sum ?f {..n}" by (subst sum.atMost_shift [symmetric]) simp_all also have "\ + ?S2 = (\x\n. fps_XD' G (S n x * G ^ x * (fps_deriv ^^ x) H))" unfolding sum.distrib [symmetric] proof (rule sum.cong, goal_cases) case (2 i) thus ?case unfolding fps_XD'_prod fps_XD'_power by (cases i) (auto simp: fps_XD'_prod fps_XD'_power_Suc algebra_simps of_nat_diff S_def fps_XD'_def) qed simp_all also have "\ = (fps_XD' G ^^ Suc n) H" by (simp add: Suc.IH fps_XD'_sum) finally show ?case .. qed subsection \Generating function of Stirling numbers\ lemma Stirling_n_0: "Stirling n 0 = (if n = 0 then 1 else 0)" by (cases n) simp_all text \ The generating function of Stirling numbers w.\,r.\,t.\ their first argument: \[\sum_{n=0}^\infty \genfrac{\{}{\}}{0pt}{}{n}{m} \frac{x^n}{n!} = \frac{(e^x - 1)^m}{m!}\] \ definition Stirling_fps :: "nat \ real fps" where "Stirling_fps m = fps_const (1 / fact m) * (fps_exp 1 - 1) ^ m" theorem sum_Stirling_binomial: "Stirling (Suc n) (Suc m) = (\i = 0..n. Stirling i m * (n choose i))" proof - have "real (Stirling (Suc n) (Suc m)) = real (\i = 0..n. Stirling i m * (n choose i))" proof (induction n arbitrary: m) case (Suc n m) have "real (\i = 0..Suc n. Stirling i m * (Suc n choose i)) = real (\i = 0..n. Stirling (Suc i) m * (Suc n choose Suc i)) + real (Stirling 0 m)" by (subst sum.atLeast0_atMost_Suc_shift) simp_all also have "real (\i = 0..n. Stirling (Suc i) m * (Suc n choose Suc i)) = real (\i = 0..n. (n choose i) * Stirling (Suc i) m) + real (\i = 0..n. (n choose Suc i) * Stirling (Suc i) m)" by (simp add: algebra_simps sum.distrib) also have "(\i = 0..n. (n choose Suc i) * Stirling (Suc i) m) = (\i = Suc 0..Suc n. (n choose i) * Stirling i m)" by (subst sum.shift_bounds_cl_Suc_ivl) simp_all also have "\ = (\i = Suc 0..n. (n choose i) * Stirling i m)" by (intro sum.mono_neutral_right) auto also have "\ = real (\i = 0..n. Stirling i m * (n choose i)) - real (Stirling 0 m)" by (simp add: sum.atLeast_Suc_atMost mult_ac) also have "real (\i = 0..n. Stirling i m * (n choose i)) = real (Stirling (Suc n) (Suc m))" by (rule Suc.IH [symmetric]) also have "real (\i = 0..n. (n choose i) * Stirling (Suc i) m) = real m * real (Stirling (Suc n) (Suc m)) + real (Stirling (Suc n) m)" by (cases m; (simp only: Suc.IH, simp add: algebra_simps sum.distrib sum_distrib_left sum_distrib_right)) also have "\ + (real (Stirling (Suc n) (Suc m)) - real (Stirling 0 m)) + real (Stirling 0 m) = real (Suc m * Stirling (Suc n) (Suc m) + Stirling (Suc n) m)" by (simp add: algebra_simps del: Stirling.simps) also have "Suc m * Stirling (Suc n) (Suc m) + Stirling (Suc n) m = Stirling (Suc (Suc n)) (Suc m)" by (rule Stirling.simps(4) [symmetric]) finally show ?case .. qed simp_all thus ?thesis by (subst (asm) of_nat_eq_iff) qed lemma Stirling_fps_aux: "(fps_exp 1 - 1) ^ m $ n * fact n = fact m * real (Stirling n m)" proof (induction m arbitrary: n) case 0 thus ?case by (simp add: Stirling_n_0) next case (Suc m n) show ?case proof (cases n) case 0 thus ?thesis by simp next case (Suc n') hence "(fps_exp 1 - 1 :: real fps) ^ Suc m $ n * fact n = fps_deriv ((fps_exp 1 - 1) ^ Suc m) $ n' * fact n'" by (simp_all add: algebra_simps del: power_Suc) also have "fps_deriv ((fps_exp 1 - 1 :: real fps) ^ Suc m) = fps_const (real (Suc m)) * ((fps_exp 1 - 1) ^ m * fps_exp 1)" by (subst fps_deriv_power) simp_all also have "\ $ n' * fact n' = real (Suc m) * ((\i = 0..n'. (fps_exp 1 - 1) ^ m $ i / fact (n' - i)) * fact n')" unfolding fps_mult_left_const_nth by (simp add: fps_mult_nth Suc.IH sum_distrib_right del: of_nat_Suc) also have "(\i = 0..n'. (fps_exp 1 - 1 :: real fps) ^ m $ i / fact (n' - i)) * fact n' = (\i = 0..n'. (fps_exp 1 - 1) ^ m $ i * fact n' / fact (n' - i))" by (subst sum_distrib_right, rule sum.cong) (simp_all add: divide_simps) also have "\ = (\i = 0..n'. (fps_exp 1 - 1) ^ m $ i * fact i * (n' choose i))" by (intro sum.cong refl) (simp_all add: binomial_fact) also have "\ = (\i = 0..n'. fact m * real (Stirling i m) * real (n' choose i))" by (simp only: Suc.IH) also have "real (Suc m) * \ = fact (Suc m) * (\i = 0..n'. real (Stirling i m) * real (n' choose i))" (is "_ = _ * ?S") by (simp add: sum_distrib_left sum_distrib_right mult_ac del: of_nat_Suc) also have "?S = Stirling (Suc n') (Suc m)" by (subst sum_Stirling_binomial) simp also have "Suc n' = n" by (simp add: Suc) finally show ?thesis . qed qed lemma Stirling_fps_nth: "Stirling_fps m $ n = Stirling n m / fact n" unfolding Stirling_fps_def using Stirling_fps_aux[of m n] by (simp add: field_simps) theorem Stirling_fps_altdef: "Stirling_fps m = Abs_fps (\n. Stirling n m / fact n)" by (simp add: fps_eq_iff Stirling_fps_nth) theorem Stirling_closed_form: "real (Stirling n k) = (\j\k. (-1)^(k - j) * real (k choose j) * real j ^ n) / fact k" proof - have "(fps_exp 1 - 1 :: real fps) = (fps_exp 1 + (-1))" by simp also have "\ ^ k = (\j\k. of_nat (k choose j) * fps_exp 1 ^ j * (- 1) ^ (k - j))" unfolding binomial_ring .. also have "\ = (\j\k. fps_const ((-1) ^ (k - j) * real (k choose j)) * fps_exp (real j))" by (simp add: fps_const_mult [symmetric] fps_const_power [symmetric] fps_const_neg [symmetric] mult_ac fps_of_nat fps_exp_power_mult del: fps_const_mult fps_const_power fps_const_neg) also have "\ $ n = (\j\k. (- 1) ^ (k - j) * real (k choose j) * real j ^ n) / fact n" by (simp add: fps_sum_nth sum_divide_distrib) also have "\ * fact n = (\j\k. (- 1) ^ (k - j) * real (k choose j) * real j ^ n)" by simp also note Stirling_fps_aux[of k n] finally show ?thesis by (simp add: atLeast0AtMost field_simps) qed subsection \Generating function of Bernoulli numbers\ text \ We will show that the negative and positive Bernoulli numbers are the coefficients of the exponential generating function $\frac{x}{e^x - 1}$ (resp. $\frac{x}{1-e^{-x}}$), i.\,e. \[\sum_{n=0}^\infty B_n^{-} \frac{x^n}{n!} = \frac{x}{e^x - 1}\] \[\sum_{n=0}^\infty B_n^{+} \frac{x^n}{n!} = \frac{x}{1 - e^{-1}}\] \ definition bernoulli_fps :: "'a :: real_normed_field fps" where "bernoulli_fps = fps_X / (fps_exp 1 - 1)" definition bernoulli'_fps :: "'a :: real_normed_field fps" where "bernoulli'_fps = fps_X / (1 - (fps_exp (-1)))" lemma bernoulli_fps_altdef: "bernoulli_fps = Abs_fps (\n. of_real (bernoulli n) / fact n :: 'a)" and bernoulli_fps_aux: "bernoulli_fps * (fps_exp 1 - 1 :: 'a :: real_normed_field fps) = fps_X" proof - have *: "Abs_fps (\n. of_real (bernoulli n) / fact n :: 'a) * (fps_exp 1 - 1) = fps_X" proof (rule fps_ext) fix n have "(Abs_fps (\n. of_real (bernoulli n) / fact n :: 'a) * (fps_exp 1 - 1)) $ n = (\i = 0..n. of_real (bernoulli i) * (1 / fact (n - i) - (if n = i then 1 else 0)) / fact i)" by (auto simp: fps_mult_nth divide_simps split: if_splits intro!: sum.cong) also have "\ = (\i = 0..n. of_real (bernoulli i) / (fact i * fact (n - i)) - (if n = i then of_real (bernoulli i) / fact i else 0))" by (intro sum.cong) (simp_all add: field_simps) also have "\ = (\i = 0..n. of_real (bernoulli i) / (fact i * fact (n - i))) - of_real (bernoulli n) / fact n" unfolding sum_subtractf by (subst sum.delta') simp_all also have "\ = (\i = (\iii = of_real (\i / fact n = fps_X $ n" by (subst sum_binomial_times_bernoulli') simp_all finally show "(Abs_fps (\n. of_real (bernoulli n) / fact n :: 'a) * (fps_exp 1 - 1)) $ n = fps_X $ n" . qed moreover show "bernoulli_fps = Abs_fps (\n. of_real (bernoulli n) / fact n :: 'a)" unfolding bernoulli_fps_def by (subst * [symmetric]) simp_all ultimately show "bernoulli_fps * (fps_exp 1 - 1 :: 'a fps) = fps_X" by simp qed theorem fps_nth_bernoulli_fps [simp]: "fps_nth bernoulli_fps n = of_real (bernoulli n) / fact n" by (simp add: bernoulli_fps_altdef) lemma bernoulli'_fps_aux: "(fps_exp 1 - 1) * Abs_fps (\n. of_real (bernoulli' n) / fact n :: 'a) = fps_exp 1 * fps_X" and bernoulli'_fps_aux': "(1 - fps_exp (-1)) * Abs_fps (\n. of_real (bernoulli' n) / fact n :: 'a) = fps_X" and bernoulli'_fps_altdef: "bernoulli'_fps = Abs_fps (\n. of_real (bernoulli' n) / fact n :: 'a :: real_normed_field)" proof - have "Abs_fps (\n. of_real (bernoulli' n) / fact n :: 'a) = bernoulli_fps + fps_X" by (simp add: fps_eq_iff bernoulli'_def) also have "(fps_exp 1 - 1) * \ = fps_exp 1 * fps_X" using bernoulli_fps_aux by (simp add: algebra_simps) finally show "(fps_exp 1 - 1) * Abs_fps (\n. of_real (bernoulli' n) / fact n :: 'a) = fps_exp 1 * fps_X" . also have "(fps_exp 1 - 1) = fps_exp 1 * (1 - fps_exp (-1 :: 'a))" by (simp add: algebra_simps fps_exp_add_mult [symmetric]) also note mult.assoc finally show *: "(1 - fps_exp (-1)) * Abs_fps (\n. of_real (bernoulli' n) / fact n :: 'a) = fps_X" by (subst (asm) mult_left_cancel) simp_all show "bernoulli'_fps = Abs_fps (\n. of_real (bernoulli' n) / fact n :: 'a)" unfolding bernoulli'_fps_def by (subst * [symmetric]) simp_all qed theorem fps_nth_bernoulli'_fps [simp]: "fps_nth bernoulli'_fps n = of_real (bernoulli' n) / fact n" by (simp add: bernoulli'_fps_altdef) lemma bernoulli_fps_conv_bernoulli'_fps: "bernoulli_fps = bernoulli'_fps - fps_X" by (simp add: fps_eq_iff bernoulli'_def) lemma bernoulli'_fps_conv_bernoulli_fps: "bernoulli'_fps = bernoulli_fps + fps_X" by (simp add: fps_eq_iff bernoulli'_def) theorem bernoulli_odd_eq_0: assumes "n \ 1" and "odd n" shows "bernoulli n = 0" proof - from bernoulli_fps_aux have "2 * bernoulli_fps * (fps_exp 1 - 1) = 2 * fps_X" by simp hence "(2 * bernoulli_fps + fps_X) * (fps_exp 1 - 1) = fps_X * (fps_exp 1 + 1)" by (simp add: algebra_simps) also have "fps_exp 1 - 1 = fps_exp (1/2) * (fps_exp (1/2) - fps_exp (-1/2 :: real))" by (simp add: algebra_simps fps_exp_add_mult [symmetric]) also have "fps_exp 1 + 1 = fps_exp (1/2) * (fps_exp (1/2) + fps_exp (-1/2 :: real))" by (simp add: algebra_simps fps_exp_add_mult [symmetric]) finally have "fps_exp (1/2) * ((2 * bernoulli_fps + fps_X) * (fps_exp (1/2) - fps_exp (- 1/2))) = fps_exp (1/2) * (fps_X * (fps_exp (1/2) + fps_exp (-1/2 :: real)))" by (simp add: algebra_simps) hence *: "(2 * bernoulli_fps + fps_X) * (fps_exp (1/2) - fps_exp (- 1/2)) = fps_X * (fps_exp (1/2) + fps_exp (-1/2 :: real))" (is "?lhs = ?rhs") by (subst (asm) mult_cancel_left) simp_all have "fps_compose ?lhs (-fps_X) = fps_compose ?rhs (-fps_X)" by (simp only: *) also have "fps_compose ?lhs (-fps_X) = (-2 * (bernoulli_fps oo - fps_X) + fps_X) * (fps_exp ((1/2)) - fps_exp (-1/2))" by (simp add: fps_compose_mult_distrib fps_compose_add_distrib fps_compose_sub_distrib algebra_simps) also have "fps_compose ?rhs (-fps_X) = -?rhs" by (simp add: fps_compose_mult_distrib fps_compose_add_distrib fps_compose_sub_distrib) also note * [symmetric] also have "- ((2 * bernoulli_fps + fps_X) * (fps_exp (1/2) - fps_exp (-1/2))) = ((-2 * bernoulli_fps - fps_X) * (fps_exp (1/2) - fps_exp (-1/2)))" by (simp add: algebra_simps) finally have "2 * (bernoulli_fps oo - fps_X) = 2 * (bernoulli_fps + fps_X :: real fps)" by (subst (asm) mult_cancel_right) (simp add: algebra_simps) hence **: "bernoulli_fps oo -fps_X = (bernoulli_fps + fps_X :: real fps)" by (subst (asm) mult_cancel_left) simp from assms have "(bernoulli_fps oo -fps_X) $ n = bernoulli n / fact n" by (subst **) simp also have "-fps_X = fps_const (-1 :: real) * fps_X" by (simp only: fps_const_neg [symmetric] fps_const_1_eq_1) simp also from assms have "(bernoulli_fps oo \) $ n = - bernoulli n / fact n" by (subst fps_compose_linear) simp finally show ?thesis by simp qed lemma bernoulli'_odd_eq_0: "n \ 1 \ odd n \ bernoulli' n = 0" by (simp add: bernoulli'_def bernoulli_odd_eq_0) text \ The following simplification rule takes care of rewriting @{term "bernoulli n"} to $0$ for any odd numeric constant greater than $1$: \ lemma bernoulli_odd_numeral_eq_0 [simp]: "bernoulli (numeral (Num.Bit1 n)) = 0" by (rule bernoulli_odd_eq_0[OF _ odd_numeral]) auto lemma bernoulli'_odd_numeral_eq_0 [simp]: "bernoulli' (numeral (Num.Bit1 n)) = 0" by (simp add: bernoulli'_def) text \ The following explicit formula for Bernoulli numbers can also derived reasonably easily using the generating functions of Stirling numbers and Bernoulli numbers. The proof follows an answer by Marko Riedel on the Mathematics StackExchange~\cite{riedel_mathse_2014}. \ theorem bernoulli_altdef: "bernoulli n = (\m\n. \k\m. (-1)^k * real (m choose k) * real k^n / real (Suc m))" proof - have "(\m\n. \k\m. (-1)^k * real (m choose k) * real k^n / real (Suc m)) = (\m\n. (\k\m. (-1)^k * real (m choose k) * real k^n) / real (Suc m))" by (subst sum_divide_distrib) simp_all also have "\ = fact n * (\m\n. (- 1) ^ m / real (Suc m) * (fps_exp 1 - 1) ^ m $ n)" proof (subst sum_distrib_left, intro sum.cong refl) fix m assume m: "m \ {..n}" have "(\k\m. (-1)^k * real (m choose k) * real k^n) = (-1)^m * (\k\m. (-1)^(m - k) * real (m choose k) * real k^n)" by (subst sum_distrib_left, intro sum.cong refl) (auto simp: minus_one_power_iff) also have "\ = (-1) ^ m * (real (Stirling n m) * fact m)" by (subst Stirling_closed_form) simp_all also have "real (Stirling n m) = Stirling_fps m $ n * fact n" by (subst Stirling_fps_nth) simp_all also have "\ * fact m = (fps_exp 1 - 1) ^ m $ n * fact n" by (simp add: Stirling_fps_def) finally show "(\k\m. (-1)^k * real (m choose k) * real k^n) / real (Suc m) = fact n * ((- 1) ^ m / real (Suc m) * (fps_exp 1 - 1) ^ m $ n)" by simp qed also have "(\m\n. (- 1) ^ m / real (Suc m) * (fps_exp 1 - 1) ^ m $ n) = fps_compose (Abs_fps (\m. (-1) ^ m / real (Suc m))) (fps_exp 1 - 1) $ n" by (simp add: fps_compose_def atLeast0AtMost fps_sum_nth) also have "fps_ln 1 = fps_X * Abs_fps (\m. (-1) ^ m / real (Suc m))" unfolding fps_ln_def by (auto simp: fps_eq_iff) hence "Abs_fps (\m. (-1) ^ m / real (Suc m)) = fps_ln 1 / fps_X" by (metis fps_X_neq_zero nonzero_mult_div_cancel_left) also have "fps_compose \ (fps_exp 1 - 1) = fps_compose (fps_ln 1) (fps_exp 1 - 1) / (fps_exp 1 - 1)" by (subst fps_compose_divide_distrib) auto also have "fps_compose (fps_ln 1) (fps_exp 1 - 1 :: real fps) = fps_X" by (simp add: fps_ln_fps_exp_inv fps_inv_fps_exp_compose) also have "(fps_X / (fps_exp 1 - 1)) = bernoulli_fps" by (simp add: bernoulli_fps_def) also have "fact n * \ $ n = bernoulli n" by simp finally show ?thesis .. qed corollary%important bernoulli_conv_Stirling: "bernoulli n = (\k\n. (-1) ^ k * fact k / real (k + 1) * Stirling n k)" proof - have "(\k\n. (-1) ^ k * fact k / (k + 1) * Stirling n k) = (\k\n. \i\k. (-1) ^ i * (k choose i) * i ^ n / real (k + 1))" proof (intro sum.cong, goal_cases) case (2 k) have "(-1) ^ k * fact k / (k + 1) * Stirling n k = (\j\k. (-1) ^ k * (-1) ^ (k - j) * (k choose j) * j ^ n / (k + 1))" by (simp add: Stirling_closed_form sum_distrib_left sum_divide_distrib mult_ac) also have "\ = (\j\k. (-1) ^ j * (k choose j) * j ^ n / (k + 1))" by (intro sum.cong) (auto simp: uminus_power_if split: if_splits) finally show ?case . qed auto also have "\ = bernoulli n" by (simp add: bernoulli_altdef) finally show ?thesis .. qed subsection \Von Staudt--Clausen Theorem\ lemma vonStaudt_Clausen_lemma: assumes "n > 0" and "prime p" shows "[(\m 0" "m < p" for m proof - from True obtain q where "2 * n = (p - 1) * q" by blast hence "[m ^ (2 * n) = (m ^ (p - 1)) ^ q] (mod p)" by (simp add: power_mult) also have "[(m ^ (p - 1)) ^ q = 1 ^ q] (mod p)" using assms \m > 0\ \m < p\ by (intro cong_pow fermat_theorem) auto finally show ?thesis by simp qed have "(\mm\{0<..n > 0\ by (intro sum.mono_neutral_right) auto also have "[\ = (\m\{0<..m\{0<..m\insert 0 {0<..m\p-1. (-1)^m * ((p - 1) choose m)) = 0" using prime_gt_1_nat[of p] assms by (subst choose_alternating_sum) auto finally show ?thesis using True by simp next case False define n' where "n' = (2 * n) mod (p - 1)" from assms False have "n' > 0" by (auto simp: n'_def dvd_eq_mod_eq_0) from False have "p \ 2" by auto with assms have "odd p" using prime_prime_factor two_is_prime_nat by blast have cong_pow_2n: "[m ^ (2*n) = m ^ n'] (mod p)" if "m > 0" "m < p" for m proof - from assms and that have "coprime p m" by (intro prime_imp_coprime) auto have "[2 * n = n'] (mod (p - 1))" by (simp add: n'_def) moreover have "ord p m dvd (p - 1)" using order_divides_totient[of p m] \coprime p m\ assms by (auto simp: totient_prime) ultimately have "[2 * n = n'] (mod ord p m)" by (rule cong_dvd_modulus_nat) thus ?thesis using \coprime p m\ by (subst order_divides_expdiff) auto qed have "(\mm\{0<..n > 0\ by (intro sum.mono_neutral_right) auto also have "[\ = (\m\{0<..m\{0<..m\p-1. (-1)^m * ((p - 1) choose m) * m ^ n')" using \n' > 0\ by (intro sum.mono_neutral_left) auto also have "\ = (\m\p-1. (-1)^(p - Suc m) * ((p - 1) choose m) * m ^ n')" using \n' > 0\ assms \odd p\ by (intro sum.cong) (auto simp: uminus_power_if) also have "\ = 0" proof - have "of_int (\m\p-1. (-1)^(p - Suc m) * ((p - 1) choose m) * m ^ n') = real (Stirling n' (p - 1)) * fact (p - 1)" by (simp add: Stirling_closed_form) also have "n' < p - 1" using assms prime_gt_1_nat[of p] by (auto simp: n'_def) hence "Stirling n' (p - 1) = 0" by simp finally show ?thesis by linarith qed finally show ?thesis using False by simp qed text \ The Von Staudt--Clausen theorem states that for \n > 0\, \[B_{2n} + \sum\limits_{p - 1\mid 2n} \frac{1}{p}\] is an integer. \ theorem vonStaudt_Clausen: assumes "n > 0" shows "bernoulli (2 * n) + (\p | prime p \ (p - 1) dvd (2 * n). 1 / real p) \ \" (is "_ + ?P \ \") proof - define P :: "nat \ real" where "P = (\m. if prime (m + 1) \ m dvd (2 * n) then 1 / (m + 1) else 0)" define P' :: "nat \ int" where "P' = (\m. if prime (m + 1) \ m dvd (2 * n) then 1 else 0)" have "?P = (\p | prime (p + 1) \ p dvd (2 * n). 1 / real (p + 1))" by (rule sum.reindex_bij_witness[of _ "\p. p + 1" "\p. p - 1"]) (use prime_gt_0_nat in auto) also have "\ = (\m\2*n. P m)" using \n > 0\ by (intro sum.mono_neutral_cong_left) (auto simp: P_def dest!: dvd_imp_le) finally have "bernoulli (2 * n) + ?P = (\m\2*n. (-1)^m * (of_int (fact m * Stirling (2*n) m) / (m + 1)) + P m)" by (simp add: sum.distrib bernoulli_conv_Stirling sum_divide_distrib algebra_simps) also have "\ = (\m\2*n. of_int ((-1)^m * fact m * Stirling (2*n) m + P' m) / (m + 1))" by (intro sum.cong) (auto simp: P'_def P_def field_simps) also have "\ \ \" proof (rule sum_in_Ints, goal_cases) case (1 m) have "m = 0 \ m = 3 \ prime (m + 1) \ (\prime (m + 1) \ m > 3)" by (cases "m = 1"; cases "m = 2") (auto simp flip: numeral_2_eq_2) then consider "m = 0" | "m = 3" | "prime (m + 1)" | "\prime (m + 1)" "m > 3" by blast thus ?case proof cases assume "m = 0" thus ?case by auto next assume [simp]: "m = 3" have "real_of_int (fact m * Stirling (2 * n) m) = real_of_int (9 ^ n + 3 - 3 * 4 ^ n)" using \n > 0\ by (auto simp: P'_def fact_numeral Stirling_closed_form power_mult atMost_nat_numeral binomial_fact zero_power) hence "int (fact m * Stirling (2 * n) m) = 9 ^ n + 3 - 3 * 4 ^ n" by linarith also have "[\ = 1 ^ n + (-1) - 3 * 0 ^ n] (mod 4)" by (intro cong_add cong_diff cong_mult cong_pow) (auto simp: cong_def) finally have dvd: "4 dvd int (fact m * Stirling (2 * n) m)" using \n > 0\ by (simp add: cong_0_iff zero_power) have "real_of_int ((- 1) ^ m * fact m * Stirling (2 * n) m + P' m) / (m + 1) = -(real_of_int (int (fact m * Stirling (2 * n) m)) / real_of_int 4)" using \n > 0\ by (auto simp: P'_def) also have "\ \ \" by (intro Ints_minus of_int_divide_in_Ints dvd) finally show ?case . next assume composite: "\prime (m + 1)" and "m > 3" obtain a b where ab: "a * b = m + 1" "a > 1" "b > 1" using \m > 3\ composite composite_imp_factors_nat[of "m + 1"] by auto have "a = b \ a > 2" proof assume "a = b" hence "a ^ 2 > 2 ^ 2" using \m > 3\ and ab by (auto simp: power2_eq_square) thus "a > 2" using power_less_imp_less_base by blast qed hence dvd: "(m + 1) dvd fact m" using product_dvd_fact[of a b] ab by auto have "real_of_int ((- 1) ^ m * fact m * Stirling (2 * n) m + P' m) / real (m + 1) = real_of_int ((- 1) ^ m * Stirling (2 * n) m) * (real (fact m) / (m + 1))" using composite by (auto simp: P'_def) also have "\ \ \" by (intro Ints_mult Ints_real_of_nat_divide dvd) auto finally show ?case . next assume prime: "prime (m + 1)" have "real_of_int ((-1) ^ m * fact m * int (Stirling (2 * n) m)) = (\j\m. (-1) ^ m * (-1) ^ (m - j) * (m choose j) * real_of_int j ^ (2 * n))" by (simp add: Stirling_closed_form sum_divide_distrib sum_distrib_left mult_ac) also have "\ = real_of_int (\j\m. (-1) ^ j * (m choose j) * j ^ (2 * n))" unfolding of_int_sum by (intro sum.cong) (auto simp: uminus_power_if) finally have "(-1) ^ m * fact m * int (Stirling (2 * n) m) = (\j\m. (-1) ^ j * (m choose j) * j ^ (2 * n))" by linarith also have "\ = (\j = (if m dvd 2 * n then - 1 else 0)] (mod (m + 1))" using vonStaudt_Clausen_lemma[of n "m + 1"] prime \n > 0\ by simp also have "(if m dvd 2 * n then - 1 else 0) = - P' m" using prime by (simp add: P'_def) finally have "int (m + 1) dvd ((- 1) ^ m * fact m * int (Stirling (2 * n) m) + P' m)" by (simp add: cong_iff_dvd_diff) hence "real_of_int ((-1)^m * fact m * int (Stirling (2*n) m) + P' m) / of_int (int (m+1)) \ \" by (intro of_int_divide_in_Ints) thus ?case by simp qed qed finally show ?thesis . qed subsection \Denominators of Bernoulli numbers\ text \ A consequence of the Von Staudt--Clausen theorem is that the denominator of $B_{2n}$ for $n > 0$ is precisely the product of all prime numbers \p\ such that \p - 1\ divides $2n$. Since the denominator is obvious in all other cases, this fully characterises the denominator of Bernoulli numbers. \ definition bernoulli_denom :: "nat \ nat" where "bernoulli_denom n = (if n = 1 then 2 else if n = 0 \ odd n then 1 else \{p. prime p \ (p - 1) dvd n})" definition bernoulli_num :: "nat \ int" where "bernoulli_num n = \bernoulli n * bernoulli_denom n\" lemma finite_bernoulli_denom_set: "n > (0 :: nat) \ finite {p. prime p \ (p - 1) dvd n}" by (rule finite_subset[of _ "{..2*n+1}"]) (auto dest!: dvd_imp_le) lemma bernoulli_denom_0 [simp]: "bernoulli_denom 0 = 1" and bernoulli_denom_1 [simp]: "bernoulli_denom 1 = 2" and bernoulli_denom_Suc_0 [simp]: "bernoulli_denom (Suc 0) = 2" and bernoulli_denom_odd [simp]: "n \ 1 \ odd n \ bernoulli_denom n = 1" and bernoulli_denom_even: "n > 0 \ even n \ bernoulli_denom n = \{p. prime p \ (p - 1) dvd n}" by (auto simp: bernoulli_denom_def) lemma bernoulli_denom_pos: "bernoulli_denom n > 0" by (auto simp: bernoulli_denom_def intro!: prod_pos) lemma bernoulli_denom_nonzero [simp]: "bernoulli_denom n \ 0" using bernoulli_denom_pos[of n] by simp lemma bernoulli_denom_code [code]: "bernoulli_denom n = (if n = 1 then 2 else if n = 0 \ odd n then 1 else prod_list (filter (\p. (p - 1) dvd n) (primes_upto (n + 1))))" (is "_ = ?rhs") proof (cases "even n \ n > 0") case True hence "?rhs = prod_list (filter (\p. (p - 1) dvd n) (primes_upto (n + 1)))" by auto also have "\ = \(set (filter (\p. (p - 1) dvd n) (primes_upto (n + 1))))" by (subst prod.distinct_set_conv_list) auto also have "(set (filter (\p. (p - 1) dvd n) (primes_upto (n + 1)))) = {p\{..n+1}. prime p \ (p - 1) dvd n}" by (auto simp: set_primes_upto) also have "\ = {p. prime p \ (p - 1) dvd n}" using True by (auto dest: dvd_imp_le) also have "\\ = bernoulli_denom n" using True by (simp add: bernoulli_denom_even) finally show ?thesis .. qed auto corollary%important bernoulli_denom_correct: obtains a :: int where "coprime a (bernoulli_denom m)" "bernoulli m = of_int a / of_nat (bernoulli_denom m)" proof - consider "m = 0" | "m = 1" | "odd m" "m \ 1" | "even m" "m > 0" by auto thus ?thesis proof cases assume "m = 0" thus ?thesis by (intro that[of 1]) (auto simp: bernoulli_denom_def) next assume "m = 1" thus ?thesis by (intro that[of "-1"]) (auto simp: bernoulli_denom_def) next assume "odd m" "m \ 1" thus ?thesis by (intro that[of 0]) (auto simp: bernoulli_denom_def bernoulli_odd_eq_0) next assume "even m" "m > 0" define n where "n = m div 2" have [simp]: "m = 2 * n" and n: "n > 0" using \even m\ \m > 0\ by (auto simp: n_def intro!: Nat.gr0I) obtain a b where ab: "bernoulli (2 * n) = a / b" "coprime a (int b)" "b > 0" using Rats_int_div_natE[OF bernoulli_in_Rats] by metis define P where "P = {p. prime p \ (p - 1) dvd (2 * n)}" have "finite P" unfolding P_def using n by (intro finite_bernoulli_denom_set) auto from vonStaudt_Clausen[of n] obtain k where k: "bernoulli (2 * n) + (\p\P. 1/p) = of_int k" using \n > 0\ by (auto simp: P_def Ints_def) define c where "c = (\p\P. \(P-{p}))" from \finite P\ have "(\p\P. 1 / p) = c / \P" by (subst sum_inverses_conv_fraction) (auto simp: P_def prime_gt_0_nat c_def) moreover have P_nz: "prod real P > 0" using prime_gt_0_nat by (auto simp: P_def intro!: prod_pos) ultimately have eq: "bernoulli (2 * n) = (k * \P - c) / \P" using ab P_nz by (simp add: field_simps k [symmetric]) have "gcd (k * \P - int c) (\P) = gcd (int c) (\P)" by (simp add: gcd_diff_dvd_left1) also have "\ = int (gcd c (\P))" by (simp flip: gcd_int_int_eq) also have "coprime c (\P)" unfolding c_def using \finite P\ by (intro sum_prime_inverses_fraction_coprime) (auto simp: P_def) hence "gcd c (\P) = 1" by simp finally have coprime: "coprime (k * \P - int c) (\P)" by (simp only: coprime_iff_gcd_eq_1) have eq': "\P = bernoulli_denom (2 * n)" using n by (simp add: bernoulli_denom_def P_def) show ?thesis by (rule that[of "k * \P - int c"]) (use eq eq' coprime in simp_all) qed qed lemma bernoulli_conv_num_denom: "bernoulli n = bernoulli_num n / bernoulli_denom n" (is ?th1) and coprime_bernoulli_num_denom: "coprime (bernoulli_num n) (bernoulli_denom n)" (is ?th2) proof - obtain a :: int where a: "coprime a (bernoulli_denom n)" "bernoulli n = a / bernoulli_denom n" using bernoulli_denom_correct[of n] by blast thus ?th1 by (simp add: bernoulli_num_def) with a show ?th2 by auto qed text \ Two obvious consequences from this are that the denominators of all odd Bernoulli numbers except for the first one are squarefree and multiples of 6: \ lemma six_divides_bernoulli_denom: assumes "even n" "n > 0" shows "6 dvd bernoulli_denom n" proof - from assms have "\{2, 3} dvd \{p. prime p \ (p - 1) dvd n}" by (intro prod_dvd_prod_subset finite_bernoulli_denom_set) auto with assms show ?thesis by (simp add: bernoulli_denom_even) qed lemma squarefree_bernoulli_denom: "squarefree (bernoulli_denom n)" by (auto intro!: squarefree_prod_coprime primes_coprime simp: bernoulli_denom_def squarefree_prime) text \ Furthermore, the denominator of $B_n$ divides $2(2^n - 1)$. This also gives us an upper bound on the denominators. \ lemma bernoulli_denom_dvd: "bernoulli_denom n dvd (2 * (2 ^ n - 1))" proof (cases "even n \ n > 0") case True hence "bernoulli_denom n = \{p. prime p \ (p - 1) dvd n}" by (auto simp: bernoulli_denom_def) also have "\ dvd (2 * (2 ^ n - 1))" proof (rule prime_prod_dvdI; clarify?) from True show "finite {p. prime p \ (p - 1) dvd n}" by (intro finite_bernoulli_denom_set) auto next fix p assume p: "prime p" "(p - 1) dvd n" show "p dvd (2 * (2 ^ n - 1))" proof (cases "p = 2") case False with p have "p > 2" using prime_gt_1_nat[of p] by force have "[2 ^ n - 1 = 1 - 1] (mod p)" using p \p > 2\ prime_odd_nat by (intro cong_diff_nat Carmichael_divides) (auto simp: Carmichael_prime) hence "p dvd (2 ^ n - 1)" by (simp add: cong_0_iff) thus ?thesis by simp qed auto qed auto finally show ?thesis . qed (auto simp: bernoulli_denom_def) corollary bernoulli_bound: assumes "n > 0" shows "bernoulli_denom n \ 2 * (2 ^ n - 1)" proof - from assms have "2 ^ n > (1 :: nat)" by (intro one_less_power) auto thus ?thesis by (intro dvd_imp_le[OF bernoulli_denom_dvd]) auto qed text \ It can also be shown fairly easily from the von Staudt--Clausen theorem that if \p\ is prime and \2p + 1\ is not, then $B_{2p} \equiv \frac{1}{6}\ (\text{mod}\ 1)$ or, equivalently, the denominator of $B_{2p}$ is 6 and the numerator is of the form $6k+1$. This is the case e.\,g.\ for any primes of the form $3k+1$ or $5k+2$. \ lemma bernoulli_denom_prime_nonprime: assumes "prime p" "\prime (2 * p + 1)" shows "bernoulli (2 * p) - 1 / 6 \ \" "[bernoulli_num (2 * p) = 1] (mod 6)" "bernoulli_denom (2 * p) = 6" proof - from assms have "p > 0" using prime_gt_0_nat by auto define P where "P = {q. prime q \ (q - 1) dvd (2 * p)}" have P_eq: "P = {2, 3}" proof (intro equalityI subsetI) fix q assume "q \ P" hence q: "prime q" "(q - 1) dvd (2 * p)" by (simp_all add: P_def) have "q - 1 \ {1, 2, p, 2 * p}" proof - obtain b c where bc: "b dvd 2" "c dvd p" "q - 1 = b * c" using division_decomp[OF q(2)] by auto from bc have "b \ {1, 2}" and "c \ {1, p}" using prime_nat_iff two_is_prime_nat \prime p\ by blast+ with bc show ?thesis by auto qed hence "q \ {2, 3, p + 1, 2 * p + 1}" using prime_gt_0_nat[OF \prime q\] by force moreover have "q \ p + 1" proof assume [simp]: "q = p + 1" have "even q \ even p" by auto with \prime q\ and \prime p\ have "p = 2" using prime_odd_nat[of p] prime_odd_nat[of q] prime_gt_1_nat[of p] prime_gt_1_nat[of q] by force with assms show False by (simp add: cong_def) qed ultimately show "q \ {2, 3}" using assms \prime q\ by auto qed (auto simp: P_def) show [simp]: "bernoulli_denom (2 * p) = 6" using \p > 0\ P_eq by (subst bernoulli_denom_even) (auto simp: P_def) have "bernoulli (2 * p) + 5 / 6 \ \" using \p > 0\ P_eq vonStaudt_Clausen[of p] by (auto simp: P_def) hence "bernoulli (2 * p) + 5 / 6 - 1 \ \" by (intro Ints_diff) auto thus "bernoulli (2 * p) - 1 / 6 \ \" by simp then obtain a where "of_int a = bernoulli (2 * p) - 1 / 6" by (elim Ints_cases) auto hence "real_of_int a = real_of_int (bernoulli_num (2 * p) - 1) / 6" by (auto simp: bernoulli_conv_num_denom) hence "bernoulli_num (2 * p) - 1 = 6 * a" by simp thus "[bernoulli_num (2 * p) = 1] (mod 6)" by (auto simp: cong_iff_dvd_diff) qed subsection \Akiyama--Tanigawa algorithm\ text \ First, we define the Akiyama--Tanigawa number triangle as shown by Kaneko~\cite{kaneko2000}. We define this generically, parametrised by the first row. This makes the proofs a little bit more modular. \ fun gen_akiyama_tanigawa :: "(nat \ real) \ nat \ nat \ real" where "gen_akiyama_tanigawa f 0 m = f m" | "gen_akiyama_tanigawa f (Suc n) m = real (Suc m) * (gen_akiyama_tanigawa f n m - gen_akiyama_tanigawa f n (Suc m))" lemma gen_akiyama_tanigawa_0 [simp]: "gen_akiyama_tanigawa f 0 = f" by (simp add: fun_eq_iff) text \ The ``regular'' Akiyama--Tanigawa triangle is the one that is used for reading off Bernoulli numbers: \ definition akiyama_tanigawa where "akiyama_tanigawa = gen_akiyama_tanigawa (\n. 1 / real (Suc n))" context begin private definition AT_fps :: "(nat \ real) \ nat \ real fps" where "AT_fps f n = (fps_X - 1) * Abs_fps (gen_akiyama_tanigawa f n)" private lemma AT_fps_Suc: "AT_fps f (Suc n) = (fps_X - 1) * fps_deriv (AT_fps f n)" proof (rule fps_ext) fix m :: nat show "AT_fps f (Suc n) $ m = ((fps_X - 1) * fps_deriv (AT_fps f n)) $ m" by (cases m) (simp_all add: AT_fps_def fps_deriv_def algebra_simps) qed private lemma AT_fps_altdef: "AT_fps f n = (\m\n. fps_const (real (Stirling n m)) * (fps_X - 1)^m * (fps_deriv ^^ m) (AT_fps f 0))" proof - have "AT_fps f n = (fps_XD' (fps_X - 1) ^^ n) (AT_fps f 0)" by (induction n) (simp_all add: AT_fps_Suc fps_XD'_def) also have "\ = (\m\n. fps_const (real (Stirling n m)) * (fps_X - 1) ^ m * (fps_deriv ^^ m) (AT_fps f 0))" by (rule fps_XD'_funpow_affine) simp_all finally show ?thesis . qed private lemma AT_fps_0_nth: "AT_fps f 0 $ n = (if n = 0 then -f 0 else f (n - 1) - f n)" by (simp add: AT_fps_def algebra_simps) text \ The following fact corresponds to Proposition 1 in Kaneko's proof: \ lemma gen_akiyama_tanigawa_n_0: "gen_akiyama_tanigawa f n 0 = (\k\n. (- 1) ^ k * fact k * real (Stirling (Suc n) (Suc k)) * f k)" proof (cases "n = 0") case False note [simp del] = gen_akiyama_tanigawa.simps have "gen_akiyama_tanigawa f n 0 = -(AT_fps f n $ 0)" by (simp add: AT_fps_def) also have "AT_fps f n $ 0 = (\k\n. real (Stirling n k) * (- 1) ^ k * (fact k * AT_fps f 0 $ k))" by (subst AT_fps_altdef) (simp add: fps_sum_nth fps_nth_power_0 fps_0th_higher_deriv) also have "\ = (\k\n. real (Stirling n k) * (- 1) ^ k * (fact k * (f (k - 1) - f k)))" using False by (intro sum.cong refl) (auto simp: Stirling_n_0 AT_fps_0_nth) also have "\ = (\k\n. fact k * (real (Stirling n k) * (- 1) ^ k) * f (k - 1)) - (\k\n. fact k * (real (Stirling n k) * (- 1) ^ k) * f k)" (is "_ = sum ?f _ - ?S2") by (simp add: sum_subtractf algebra_simps) also from False have "sum ?f {..n} = sum ?f {0<..n}" by (intro sum.mono_neutral_right) (auto simp: Stirling_n_0) also have "\ = sum ?f {0<..Suc n}" by (intro sum.mono_neutral_left) auto also have "{0<..Suc n} = {Suc 0..Suc n}" by auto also have "sum ?f \ = sum (\n. ?f (Suc n)) {0..n}" by (subst sum.atLeast_Suc_atMost_Suc_shift) simp_all also have "{0..n} = {..n}" by auto also have "sum (\n. ?f (Suc n)) \ - ?S2 = (\k\n. -((-1)^k * fact k * real (Stirling (Suc n) (Suc k)) * f k))" by (subst sum_subtractf [symmetric], intro sum.cong) (simp_all add: algebra_simps) also have "-\ = (\k\n. ((-1)^k * fact k * real (Stirling (Suc n) (Suc k)) * f k))" by (simp add: sum_negf) finally show ?thesis . qed simp_all text \ The following lemma states that for $A(x) := \sum_{k=0}^\infty a_{0,k} x^k$, we have \[\sum_{n=0}^\infty a_{n,0}\frac{x^n}{n!} = e^x A(1 - e^x)\] which correspond's to Kaneko's remark at the end of Section 2. This seems to be easier to formalise than his actual proof of his Theorem 1, since his proof contains an infinite sum of formal power series, and it was unclear to us how to capture this formally. \ lemma gen_akiyama_tanigawa_fps: "Abs_fps (\n. gen_akiyama_tanigawa f n 0 / fact n) = fps_exp 1 * fps_compose (Abs_fps f) (1 - fps_exp 1)" proof (rule fps_ext) fix n :: nat have "(fps_const (fact n) * (fps_compose (Abs_fps (\n. gen_akiyama_tanigawa f 0 n)) (1 - fps_exp 1) * fps_exp 1)) $ n = (\m\n. \k\m. (1 - fps_exp 1) ^ k $ m * fact n / fact (n - m) * f k)" unfolding fps_mult_left_const_nth by (simp add: fps_times_def fps_compose_def gen_akiyama_tanigawa_n_0 sum_Stirling_binomial field_simps sum_distrib_left sum_distrib_right atLeast0AtMost del: Stirling.simps of_nat_Suc) also have "\ = (\m\n. \k\m. (-1)^k * fact k * real (Stirling m k) * real (n choose m) * f k)" proof (intro sum.cong refl, goal_cases) case (1 m k) have "(1 - fps_exp 1 :: real fps) ^ k = (-fps_exp 1 + 1 :: real fps) ^ k" by simp also have "\ = (\i\k. of_nat (k choose i) * (-1) ^ i * fps_exp (real i))" by (subst binomial_ring) (simp add: atLeast0AtMost power_minus' fps_exp_power_mult mult.assoc) also have "\ = (\i\k. fps_const (real (k choose i) * (-1) ^ i) * fps_exp (real i))" by (simp add: fps_const_mult [symmetric] fps_of_nat fps_const_power [symmetric] fps_const_neg [symmetric] del: fps_const_mult fps_const_power fps_const_neg) also have "\ $ m = (\i\k. real (k choose i) * (- 1) ^ i * real i ^ m) / fact m" (is "_ = ?S / _") by (simp add: fps_sum_nth sum_divide_distrib [symmetric]) also have "?S = (-1) ^ k * (\i\k. (-1) ^ (k - i) * real (k choose i) * real i ^ m)" by (subst sum_distrib_left, intro sum.cong refl) (auto simp: minus_one_power_iff) also have "(\i\k. (-1) ^ (k - i) * real (k choose i) * real i ^ m) = real (Stirling m k) * fact k" by (subst Stirling_closed_form) (simp_all add: field_simps) finally have *: "(1 - fps_exp 1 :: real fps) ^ k $ m * fact n / fact (n - m) = (- 1) ^ k * fact k * real (Stirling m k) * real (n choose m)" using 1 by (simp add: binomial_fact del: of_nat_Suc) show ?case using 1 by (subst *) simp qed also have "\ = (\m\n. \k\n. (- 1) ^ k * fact k * real (Stirling m k) * real (n choose m) * f k)" by (rule sum.cong[OF refl], rule sum.mono_neutral_left) auto also have "\ = (\k\n. \m\n. (- 1) ^ k * fact k * real (Stirling m k) * real (n choose m) * f k)" by (rule sum.swap) also have "\ = gen_akiyama_tanigawa f n 0" by (simp add: gen_akiyama_tanigawa_n_0 sum_Stirling_binomial sum_distrib_left sum_distrib_right mult.assoc atLeast0AtMost del: Stirling.simps) finally show "Abs_fps (\n. gen_akiyama_tanigawa f n 0 / fact n) $ n = (fps_exp 1 * (Abs_fps f oo 1 - fps_exp 1)) $ n" by (subst (asm) fps_mult_left_const_nth) (simp add: field_simps del: of_nat_Suc) qed text \ As Kaneko notes in his afore-mentioned remark, if we let $a_{0,k} = \frac{1}{k+1}$, we obtain \[A(z) = \sum_{k=0}^\infty \frac{x^k}{k+1} = -\frac{\ln (1 - x)}{x}\] and therefore \[\sum_{n=0}^\infty a_{n,0} \frac{x^n}{n!} = \frac{x e^x}{e^x - 1} = \frac{x}{1 - e^{-x}},\] which immediately gives us the connection to the positive Bernoulli numbers. \ theorem bernoulli'_conv_akiyama_tanigawa: "bernoulli' n = akiyama_tanigawa n 0" proof - define f where "f = (\n. 1 / real (Suc n))" note gen_akiyama_tanigawa_fps[of f] also { have "fps_ln 1 = fps_X * Abs_fps (\n. (-1)^n / real (Suc n))" by (intro fps_ext) (simp del: of_nat_Suc add: fps_ln_def) hence "fps_ln 1 / fps_X = Abs_fps (\n. (-1)^n / real (Suc n))" by (metis fps_X_neq_zero nonzero_mult_div_cancel_left) also have "fps_compose \ (-fps_X) = Abs_fps f" by (simp add: fps_compose_uminus' fps_eq_iff f_def) finally have "Abs_fps f = fps_compose (fps_ln 1 / fps_X) (-fps_X)" .. also have "fps_ln 1 / fps_X oo - fps_X oo 1 - fps_exp (1::real) = fps_ln 1 / fps_X oo fps_exp 1 - 1" by (subst fps_compose_assoc [symmetric]) (simp_all add: fps_compose_uminus) also have "\ = (fps_ln 1 oo fps_exp 1 - 1) / (fps_exp 1 - 1)" by (subst fps_compose_divide_distrib) auto also have "\ = fps_X / (fps_exp 1 - 1)" by (simp add: fps_ln_fps_exp_inv fps_inv_fps_exp_compose) finally have "Abs_fps f oo 1 - fps_exp 1 = fps_X / (fps_exp 1 - 1)" . } also have "fps_exp (1::real) - 1 = (1 - fps_exp (-1)) * fps_exp 1" by (simp add: algebra_simps fps_exp_add_mult [symmetric]) also have "fps_exp 1 * (fps_X / \) = bernoulli'_fps" unfolding bernoulli'_fps_def by (subst dvd_div_mult2_eq) (auto simp: fps_dvd_iff intro!: subdegree_leI) finally have "Abs_fps (\n. gen_akiyama_tanigawa f n 0 / fact n) = bernoulli'_fps" . thus ?thesis by (simp add: fps_eq_iff akiyama_tanigawa_def f_def) qed theorem bernoulli_conv_akiyama_tanigawa: "bernoulli n = akiyama_tanigawa n 0 - (if n = 1 then 1 else 0)" using bernoulli'_conv_akiyama_tanigawa[of n] by (auto simp: bernoulli_conv_bernoulli') end end subsection \Efficient code\ text \ We can now compute parts of the Akiyama--Tanigawa (and thereby Bernoulli numbers) with reasonable efficiency but iterating the recurrence row by row. We essentially start with some finite prefix of the zeroth row, say of length $n$, and then apply the recurrence one to get a prefix of the first row of length $n - 1$ etc. \ fun akiyama_tanigawa_step_aux :: "nat \ real list \ real list" where "akiyama_tanigawa_step_aux m (x # y # xs) = real m * (x - y) # akiyama_tanigawa_step_aux (Suc m) (y # xs)" | "akiyama_tanigawa_step_aux m xs = []" lemma length_akiyama_tanigawa_step_aux [simp]: "length (akiyama_tanigawa_step_aux m xs) = length xs - 1" by (induction m xs rule: akiyama_tanigawa_step_aux.induct) simp_all lemma akiyama_tanigawa_step_aux_eq_Nil_iff [simp]: "akiyama_tanigawa_step_aux m xs = [] \ length xs < 2" by (subst length_0_conv [symmetric]) auto lemma nth_akiyama_tanigawa_step_aux: "n < length xs - 1 \ akiyama_tanigawa_step_aux m xs ! n = real (m + n) * (xs ! n - xs ! Suc n)" proof (induction m xs arbitrary: n rule: akiyama_tanigawa_step_aux.induct) case (1 m x y xs n) thus ?case by (cases n) auto qed auto definition gen_akiyama_tanigawa_row where "gen_akiyama_tanigawa_row f n l u = map (gen_akiyama_tanigawa f n) [l.. l \ u" by (auto simp add: gen_akiyama_tanigawa_row_def) lemma nth_gen_akiyama_tanigawa_row: "i < u - l \ gen_akiyama_tanigawa_row f n l u ! i = gen_akiyama_tanigawa f n (i + l)" by (simp add: gen_akiyama_tanigawa_row_def add_ac) lemma gen_akiyama_tanigawa_row_0 [code]: "gen_akiyama_tanigawa_row f 0 l u = map f [l.. l \ u" by (auto simp add: akiyama_tanigawa_row_def) lemma nth_akiyama_tanigawa_row: "i < u - l \ akiyama_tanigawa_row n l u ! i = akiyama_tanigawa n (i + l)" by (simp add: akiyama_tanigawa_row_def add_ac) lemma akiyama_tanigawa_row_0 [code]: "akiyama_tanigawa_row 0 l u = map (\n. inverse (real (Suc n))) [l.. n = 1 \ odd n") case False thus ?thesis by (auto simp add: bernoulli_conv_akiyama_tanigawa) qed (auto simp: bernoulli_odd_eq_0) lemma bernoulli'_code [code]: "bernoulli' n = (if n = 0 then 1 else if n = 1 then 1/2 else if odd n then 0 else akiyama_tanigawa n 0)" by (simp add: bernoulli'_def bernoulli_code) text \ Evaluation with the simplifier is much slower than by reflection, but can still be done with much better efficiency than before: \ lemmas eval_bernoulli = akiyama_tanigawa_code akiyama_tanigawa_row_numeral numeral_2_eq_2 [symmetric] akiyama_tanigawa_row_Suc upt_conv_Cons akiyama_tanigawa_row_0 bernoulli_code[of "numeral n" for n] lemmas eval_bernoulli' = eval_bernoulli bernoulli'_code[of "numeral n" for n] lemmas eval_bernpoly = bernpoly_def atMost_nat_numeral power_eq_if binomial_fact fact_numeral eval_bernoulli (* This should only take a few seconds *) lemma bernoulli_upto_20 [simp]: "bernoulli 2 = 1 / 6" "bernoulli 4 = -(1 / 30)" "bernoulli 6 = 1 / 42" "bernoulli 8 = - (1 / 30)" "bernoulli 10 = 5 / 66" "bernoulli 12 = - (691 / 2730)" "bernoulli 14 = 7 / 6" "bernoulli 16 = -(3617 / 510)" "bernoulli 18 = 43867 / 798" "bernoulli 20 = -(174611 / 330)" by (simp_all add: eval_bernoulli) lemma bernoulli'_upto_20 [simp]: "bernoulli' 2 = 1 / 6" "bernoulli' 4 = -(1 / 30)" "bernoulli' 6 = 1 / 42" "bernoulli' 8 = - (1 / 30)" "bernoulli' 10 = 5 / 66" "bernoulli' 12 = - (691 / 2730)" "bernoulli' 14 = 7 / 6" "bernoulli' 16 = -(3617 / 510)" "bernoulli' 18 = 43867 / 798" "bernoulli' 20 = -(174611 / 330)" by (simp_all add: bernoulli'_def) end diff --git a/thys/Bernoulli/Periodic_Bernpoly.thy b/thys/Bernoulli/Periodic_Bernpoly.thy --- a/thys/Bernoulli/Periodic_Bernpoly.thy +++ b/thys/Bernoulli/Periodic_Bernpoly.thy @@ -1,296 +1,296 @@ (* File: Periodic_Bernpoly.thy - Author: Manuel Eberl + Author: Manuel Eberl Definition of the periodic Bernoulli polynomials as required for the Euler-Maclaurin summation formula and Stirling's formula for the lnGamma function. *) section \Periodic Bernoulli polynomials\ theory Periodic_Bernpoly imports Bernoulli "HOL-Library.Periodic_Fun" begin text \ Given the $n$-th Bernoulli polynomial $B_n(x)$, one can define the periodic function $P_n(x) = B_n(x - \lfloor x\rfloor)$, which shares many of the interesting properties of the Bernoulli polynomials. In particular, all $P_n(x)$ with $n\neq 1$ are continuous and if $n \geq 3$, they are continuously differentiable with $P_n'(x) = n P_{n-1}(x)$ just like the Bernoully polynomials themselves. These functions occur e.\,g.\ in the Euler--MacLaurin summation formula and Stirling's approximation for the logarithmic Gamma function. \ (* TODO Move to distribution *) lemma frac_0 [simp]: "frac 0 = 0" by (simp add: frac_def) lemma frac_eq_id: "x \ {0..<1} \ frac x = x" by (simp add: frac_eq) lemma periodic_continuous_onI: fixes f :: "real \ real" assumes periodic: "\x. f (x + p) = f x" "p > 0" assumes cont: "continuous_on {a..a+p} f" shows "continuous_on UNIV f" unfolding continuous_on_def proof safe fix x :: real interpret f: periodic_fun_simple f p by unfold_locales (rule periodic) have "continuous_on {a-p..a} (f \ (\x. x + p))" by (intro continuous_on_compose) (auto intro!: continuous_intros cont) also have "f \ (\x. x + p) = f" by (rule ext) (simp add: f.periodic_simps) finally have "continuous_on ({a-p..a} \ {a..a+p}) f" using cont by (intro continuous_on_closed_Un) simp_all also have "{a-p..a} \ {a..a+p} = {a-p..a+p}" by auto finally have "continuous_on {a-p..a+p} f" . hence cont: "continuous_on {a-p<..(a - x) / p\" have "(a - x) / p \ n" "n < (a - x) / p + 1" unfolding n_def by linarith+ with \p > 0\ have "x + n * p \ {a-p<..x+n*p\ f (x+n*p)" by (simp add: isCont_def f.periodic_simps) have "(\x. f (x + n*p)) \x\ f (x+n*p)" by (intro tendsto_compose[OF *] tendsto_intros) thus "f \x\ f x" by (simp add: f.periodic_simps) qed lemma has_field_derivative_at_within_union: assumes "(f has_field_derivative D) (at x within A)" "(f has_field_derivative D) (at x within B)" shows "(f has_field_derivative D) (at x within (A \ B))" proof - from assms have "((\y. (f y - f x) / (y - x)) \ D) (sup (at x within A) (at x within B))" unfolding has_field_derivative_iff by (rule filterlim_sup) also have "sup (at x within A) (at x within B) = at x within (A \ B)" using at_within_union .. finally show ?thesis unfolding has_field_derivative_iff . qed lemma has_field_derivative_cong_ev': assumes "x = y" and *: "eventually (\x. x \ s \ f x = g x) (nhds x)" and "u = v" "s = t" "f x = g y" shows "(f has_field_derivative u) (at x within s) = (g has_field_derivative v) (at y within t)" proof - have "(f has_field_derivative u) (at x within (s \ {x})) = (g has_field_derivative v) (at y within (s \ {x}))" using assms by (intro has_field_derivative_cong_ev) (auto elim!: eventually_mono) also from assms have "at x within (s \ {x}) = at x within s" by (simp add: at_within_def) also from assms have "at y within (s \ {x}) = at y within t" by (simp add: at_within_def) finally show ?thesis . qed interpretation frac: periodic_fun_simple' frac by unfold_locales (simp add: frac_def) lemma tendsto_frac_at_right_0: "(frac \ 0) (at_right (0 :: 'a :: {floor_ceiling,order_topology}))" proof - have *: "eventually (\x. x = frac x) (at_right (0::'a))" by (intro eventually_at_rightI[of 0 1]) (simp_all add: frac_eq eq_commute[of _ "frac x" for x]) moreover have **: "((\x::'a. x) \ 0) (at_right 0)" by (rule tendsto_ident_at) ultimately show ?thesis by (blast intro: Lim_transform_eventually) qed lemma tendsto_frac_at_left_1: "(frac \ 1) (at_left (1 :: 'a :: {floor_ceiling,order_topology}))" proof - have *: "eventually (\x. x = frac x) (at_left (1::'a))" by (intro eventually_at_leftI[of 0]) (simp_all add: frac_eq eq_commute[of _ "frac x" for x]) moreover have **: "((\x::'a. x) \ 1) (at_left 1)" by (rule tendsto_ident_at) ultimately show ?thesis by (blast intro: Lim_transform_eventually) qed lemma continuous_on_frac [THEN continuous_on_subset, continuous_intros]: "continuous_on {0::'a::{floor_ceiling,order_topology}..<1} frac" proof (subst continuous_on_cong[OF refl]) fix x :: 'a assume "x \ {0..<1}" thus "frac x = x" by (simp add: frac_eq) qed (auto intro: continuous_intros) lemma isCont_frac [continuous_intros]: assumes "(x :: 'a :: {floor_ceiling,order_topology,t2_space}) \ {0<..<1}" shows "isCont frac x" proof - have "continuous_on {0<..<(1::'a)} frac" by (rule continuous_on_frac) auto with assms show ?thesis by (subst (asm) continuous_on_eq_continuous_at) auto qed lemma has_field_derivative_frac: assumes "(x::real) \ \" shows "(frac has_field_derivative 1) (at x)" proof - have "((\t. t - of_int \x\) has_field_derivative 1) (at x)" by (auto intro!: derivative_eq_intros) also have "?this \ ?thesis" using eventually_floor_eq[OF filterlim_ident assms] by (intro DERIV_cong_ev refl) (auto elim!: eventually_mono simp: frac_def) finally show ?thesis . qed lemmas has_field_derivative_frac' [derivative_intros] = DERIV_chain'[OF _ has_field_derivative_frac] lemma continuous_on_compose_fracI: fixes f :: "real \ real" assumes cont1: "continuous_on {0..1} f" assumes cont2: "f 0 = f 1" shows "continuous_on UNIV (\x. f (frac x))" proof (rule periodic_continuous_onI) have cont: "continuous_on {0..1} (\x. f (frac x))" unfolding continuous_on_def proof safe fix x :: real assume x: "x \ {0..1}" show "((\x. f (frac x)) \ f (frac x)) (at x within {0..1})" proof (cases "x = 1") case False with x have [simp]: "frac x = x" by (simp add: frac_eq) from x False have "eventually (\x. x \ {..<1}) (nhds x)" by (intro eventually_nhds_in_open) auto hence "eventually (\x. frac x = x) (at x within {0..1})" by (auto simp: eventually_at_filter frac_eq elim!: eventually_mono) hence "eventually (\x. f x = f (frac x)) (at x within {0..1})" by eventually_elim simp moreover from cont1 x have "(f \ f (frac x)) (at x within {0..1})" by (simp add: continuous_on_def) ultimately show "((\x. f (frac x)) \ f (frac x)) (at x within {0..1})" by (blast intro: Lim_transform_eventually) next case True from cont1 have **: "(f \ f 1) (at 1 within {0..1})" by (simp add: continuous_on_def) moreover have *: "filterlim frac (at 1 within {0..1}) (at 1 within {0..1})" proof (subst filterlim_cong[OF refl refl]) show "eventually (\x. frac x = x) (at 1 within {0..1})" by (auto simp: eventually_at_filter frac_eq) qed (simp add: filterlim_ident) ultimately have "((\x. f (frac x)) \ f 1) (at 1 within {0..1})" by (rule filterlim_compose) thus ?thesis by (simp add: True cont2 frac_def) qed qed thus "continuous_on {0..0+1} (\x. f (frac x))" by simp qed (simp_all add: frac.periodic_simps) (* END TODO *) definition pbernpoly :: "nat \ real \ real" where "pbernpoly n x = bernpoly n (frac x)" lemma pbernpoly_0 [simp]: "pbernpoly n 0 = bernoulli n" by (simp add: pbernpoly_def) lemma pbernpoly_eq_bernpoly: "x \ {0..<1} \ pbernpoly n x = bernpoly n x" by (simp add: pbernpoly_def frac_eq_id) interpretation pbernpoly: periodic_fun_simple' "pbernpoly n" by unfold_locales (simp add: pbernpoly_def frac.periodic_simps) lemma continuous_on_pbernpoly [continuous_intros]: assumes "n \ 1" shows "continuous_on A (pbernpoly n)" proof (cases "n = 0") case True thus ?thesis by (auto intro: continuous_intros simp: pbernpoly_def bernpoly_def) next case False with assms have n: "n \ 2" by auto have "continuous_on UNIV (pbernpoly n)" unfolding pbernpoly_def [abs_def] by (rule continuous_on_compose_fracI) (insert n, auto intro!: continuous_intros simp: bernpoly_0 bernpoly_1) thus ?thesis by (rule continuous_on_subset) simp_all qed lemma continuous_on_pbernpoly' [continuous_intros]: assumes "n \ 1" "continuous_on A f" shows "continuous_on A (\x. pbernpoly n (f x))" using continuous_on_compose[OF assms(2) continuous_on_pbernpoly[OF assms(1)]] by (simp add: o_def) lemma isCont_pbernpoly [continuous_intros]: "n \ 1 \ isCont (pbernpoly n) x" using continuous_on_pbernpoly[of n UNIV] by (simp add: continuous_on_eq_continuous_at) lemma has_field_derivative_pbernpoly_Suc: assumes "n \ 2 \ x \ \" shows "(pbernpoly (Suc n) has_field_derivative real (Suc n) * pbernpoly n x) (at x)" using assms proof (cases "x \ \") assume "x \ \" with assms show ?thesis unfolding pbernpoly_def by (auto intro!: derivative_eq_intros simp del: of_nat_Suc) next case True from True obtain k where k: "x = of_int k" by (auto elim: Ints_cases) have "(pbernpoly (Suc n) has_field_derivative real (Suc n) * pbernpoly n x) (at x within ({.. {x<..}))" proof (rule has_field_derivative_at_within_union) have "((\x. bernpoly (Suc n) (x - of_int (k-1))) has_field_derivative real (Suc n) * bernpoly n (x - of_int (k-1))) (at_left x)" by (auto intro!: derivative_eq_intros) also have "?this \ (pbernpoly (Suc n) has_field_derivative real (Suc n) * pbernpoly n x) (at_left x)" using assms proof (intro has_field_derivative_cong_ev' refl) have "\\<^sub>F y in nhds x. y \ {x - 1<..\<^sub>F t in nhds x. t \ {.. bernpoly (Suc n) (t - real_of_int (k - 1)) = pbernpoly (Suc n) t" proof (elim eventually_mono, safe) fix t assume "t < x" "t \ {x-1<..x. bernpoly (Suc n) (x - of_int k)) has_field_derivative real (Suc n) * bernpoly n (x - of_int k)) (at_right x)" by (auto intro!: derivative_eq_intros) also have "?this \ (pbernpoly (Suc n) has_field_derivative real (Suc n) * pbernpoly n x) (at_right x)" using assms proof (intro has_field_derivative_cong_ev' refl) have "\\<^sub>F y in nhds x. y \ {x - 1<..\<^sub>F t in nhds x. t \ {x<..} \ bernpoly (Suc n) (t - real_of_int k) = pbernpoly (Suc n) t" proof (elim eventually_mono, safe) fix t assume "t > x" "t \ {x-1<.. {x<..} = UNIV - {x}" by auto also have "at x within \ = at x" by (simp add: at_within_def) finally show ?thesis . qed lemmas has_field_derivative_pbernpoly_Suc' = DERIV_chain'[OF _ has_field_derivative_pbernpoly_Suc] lemma bounded_pbernpoly: obtains c where "\x. norm (pbernpoly n x) \ c" proof - have "\x\{0..1}. \y\{0..1}. norm (bernpoly n y :: real) \ norm (bernpoly n x :: real)" by (intro continuous_attains_sup) (auto intro!: continuous_intros) then obtain x where x: "\y. y \ {0..1} \ norm (bernpoly n y :: real) \ norm (bernpoly n x :: real)" by blast have "norm (pbernpoly n y) \ norm (bernpoly n x :: real)" for y unfolding pbernpoly_def using frac_lt_1[of y] by (intro x) simp_all thus ?thesis by (rule that) qed end diff --git a/thys/Bertrands_Postulate/Bertrand.thy b/thys/Bertrands_Postulate/Bertrand.thy --- a/thys/Bertrands_Postulate/Bertrand.thy +++ b/thys/Bertrands_Postulate/Bertrand.thy @@ -1,1859 +1,1859 @@ (* File: Bertrand.thy - Authors: Julian Biendarra, Manuel Eberl , Larry Paulson + Authors: Julian Biendarra, Manuel Eberl , Larry Paulson A proof of Bertrand's postulate (based on John Harrison's HOL Light proof). Uses reflection and the approximation tactic. *) theory Bertrand imports Complex_Main "HOL-Number_Theory.Number_Theory" "HOL-Library.Discrete" "HOL-Decision_Procs.Approximation_Bounds" "HOL-Library.Code_Target_Numeral" Pratt_Certificate.Pratt_Certificate begin subsection \Auxiliary facts\ lemma ln_2_le: "ln 2 \ 355 / (512 :: real)" proof - have "ln 2 \ real_of_float (ub_ln2 12)" by (rule ub_ln2) also have "ub_ln2 12 = Float 5680 (- 13)" by code_simp finally show ?thesis by simp qed lemma ln_2_ge: "ln 2 \ (5677 / 8192 :: real)" proof - have "ln 2 \ real_of_float (lb_ln2 12)" by (rule lb_ln2) also have "lb_ln2 12 = Float 5677 (-13)" by code_simp finally show ?thesis by simp qed lemma ln_2_ge': "ln (2 :: real) \ 2/3" and ln_2_le': "ln (2 :: real) \ 16/23" using ln_2_le ln_2_ge by simp_all lemma of_nat_ge_1_iff: "(of_nat x :: 'a :: linordered_semidom) \ 1 \ x \ 1" using of_nat_le_iff[of 1 x] by (subst (asm) of_nat_1) lemma floor_conv_div_nat: "of_int (floor (real m / real n)) = real (m div n)" by (subst floor_divide_of_nat_eq) simp lemma frac_conv_mod_nat: "frac (real m / real n) = real (m mod n) / real n" by (cases "n = 0") (simp_all add: frac_def floor_conv_div_nat field_simps of_nat_mult [symmetric] of_nat_add [symmetric] del: of_nat_mult of_nat_add) lemma of_nat_prod_mset: "prod_mset (image_mset of_nat A) = of_nat (prod_mset A)" by (induction A) simp_all lemma prod_mset_pos: "(\x :: 'a :: linordered_semidom. x \# A \ x > 0) \ prod_mset A > 0" by (induction A) simp_all lemma ln_msetprod: assumes "\x. x \#I \ x > 0" shows "(\p::nat\#I. ln p) = ln (\p\#I. p)" using assms by (induction I) (simp_all add: of_nat_prod_mset ln_mult prod_mset_pos) lemma ln_fact: "ln (fact n) = (\d=1..n. ln d)" by (induction n) (simp_all add: ln_mult) lemma overpower_lemma: fixes f g :: "real \ real" assumes "f a \ g a" assumes "\x. a \ x \ ((\x. g x - f x) has_real_derivative (d x)) (at x)" assumes "\x. a \ x \ d x \ 0" assumes "a \ x" shows "f x \ g x" proof (cases "a < x") case True with assms have "\z. z > a \ z < x \ g x - f x - (g a - f a) = (x - a) * d z" by (intro MVT2) auto then obtain z where z: "z > a" "z < x" "g x - f x - (g a - f a) = (x - a) * d z" by blast hence "f x = g x + (f a - g a) + (a - x) * d z" by (simp add: algebra_simps) also from assms have "f a - g a \ 0" by (simp add: algebra_simps) also from assms z have "(a - x) * d z \ 0 * d z" by (intro mult_right_mono) simp_all finally show ?thesis by simp qed (insert assms, auto) subsection \Preliminary definitions\ definition primepow_even :: "nat \ bool" where "primepow_even q \ (\ p k. 1 \ k \ prime p \ q = p^(2*k))" definition primepow_odd :: "nat \ bool" where "primepow_odd q \ (\ p k. 1 \ k \ prime p \ q = p^(2*k+1))" abbreviation (input) isprimedivisor :: "nat \ nat \ bool" where "isprimedivisor q p \ prime p \ p dvd q" definition pre_mangoldt :: "nat \ nat" where "pre_mangoldt d = (if primepow d then aprimedivisor d else 1)" definition mangoldt_even :: "nat \ real" where "mangoldt_even d = (if primepow_even d then ln (real (aprimedivisor d)) else 0)" definition mangoldt_odd :: "nat \ real" where "mangoldt_odd d = (if primepow_odd d then ln (real (aprimedivisor d)) else 0)" definition mangoldt_1 :: "nat \ real" where "mangoldt_1 d = (if prime d then ln d else 0)" definition psi :: "nat \ real" where "psi n = (\d=1..n. mangoldt d)" definition psi_even :: "nat \ real" where "psi_even n = (\d=1..n. mangoldt_even d)" definition psi_odd :: "nat \ real" where "psi_odd n = (\d=1..n. mangoldt_odd d)" abbreviation (input) psi_even_2 :: "nat \ real" where "psi_even_2 n \ (\d=2..n. mangoldt_even d)" abbreviation (input) psi_odd_2 :: "nat \ real" where "psi_odd_2 n \ (\d=2..n. mangoldt_odd d)" definition theta :: "nat \ real" where "theta n = (\p=1..n. if prime p then ln (real p) else 0)" subsection \Properties of prime powers\ lemma primepow_even_imp_primepow: assumes "primepow_even n" shows "primepow n" proof - from assms obtain p k where "1 \ k" "prime p" "n = p ^ (2 * k)" unfolding primepow_even_def by blast moreover from \1 \ k\ have "2 * k > 0" by simp ultimately show ?thesis unfolding primepow_def by blast qed lemma primepow_odd_imp_primepow: assumes "primepow_odd n" shows "primepow n" proof - from assms obtain p k where "1 \ k" "prime p" "n = p ^ (2 * k + 1)" unfolding primepow_odd_def by blast moreover from \1 \ k\ have "Suc (2 * k) > 0" by simp ultimately show ?thesis unfolding primepow_def by (auto simp del: power_Suc) qed lemma primepow_odd_altdef: "primepow_odd n \ primepow n \ odd (multiplicity (aprimedivisor n) n) \ multiplicity (aprimedivisor n) n > 1" proof (intro iffI conjI; (elim conjE)?) assume "primepow_odd n" then obtain p k where n: "k \ 1" "prime p" "n = p ^ (2 * k + 1)" by (auto simp: primepow_odd_def) thus "odd (multiplicity (aprimedivisor n) n)" "multiplicity (aprimedivisor n) n > 1" by (simp_all add: aprimedivisor_primepow prime_elem_multiplicity_mult_distrib) next assume A: "primepow n" and B: "odd (multiplicity (aprimedivisor n) n)" and C: "multiplicity (aprimedivisor n) n > 1" from A obtain p k where n: "k \ 1" "prime p" "n = p ^ k" by (auto simp: primepow_def Suc_le_eq) with B C have "odd k" "k > 1" by (simp_all add: aprimedivisor_primepow prime_elem_multiplicity_mult_distrib) then obtain j where j: "k = 2 * j + 1" "j > 0" by (auto elim!: oddE) with n show "primepow_odd n" by (auto simp: primepow_odd_def intro!: exI[of _ p, OF exI[of _ j]]) qed (auto dest: primepow_odd_imp_primepow) lemma primepow_even_altdef: "primepow_even n \ primepow n \ even (multiplicity (aprimedivisor n) n)" proof (intro iffI conjI; (elim conjE)?) assume "primepow_even n" then obtain p k where n: "k \ 1" "prime p" "n = p ^ (2 * k)" by (auto simp: primepow_even_def) thus "even (multiplicity (aprimedivisor n) n)" by (simp_all add: aprimedivisor_primepow prime_elem_multiplicity_mult_distrib) next assume A: "primepow n" and B: "even (multiplicity (aprimedivisor n) n)" from A obtain p k where n: "k \ 1" "prime p" "n = p ^ k" by (auto simp: primepow_def Suc_le_eq) with B have "even k" by (simp_all add: aprimedivisor_primepow prime_elem_multiplicity_mult_distrib) then obtain j where j: "k = 2 * j" by (auto elim!: evenE) from j n have "j \ 0" by (intro notI) simp_all with j n show "primepow_even n" by (auto simp: primepow_even_def intro!: exI[of _ p, OF exI[of _ j]]) qed (auto dest: primepow_even_imp_primepow) lemma primepow_odd_mult: assumes "d > Suc 0" shows "primepow_odd (aprimedivisor d * d) \ primepow_even d" using assms by (auto simp: primepow_odd_altdef primepow_even_altdef primepow_mult_aprimedivisorI aprimedivisor_primepow prime_aprimedivisor' aprimedivisor_dvd' prime_elem_multiplicity_mult_distrib prime_elem_aprimedivisor_nat dest!: primepow_multD) lemma pre_mangoldt_primepow: assumes "primepow n" "aprimedivisor n = p" shows "pre_mangoldt n = p" using assms by (simp add: pre_mangoldt_def) lemma pre_mangoldt_notprimepow: assumes "\primepow n" shows "pre_mangoldt n = 1" using assms by (simp add: pre_mangoldt_def) lemma primepow_cases: "primepow d \ ( primepow_even d \ \ primepow_odd d \ \ prime d) \ (\ primepow_even d \ primepow_odd d \ \ prime d) \ (\ primepow_even d \ \ primepow_odd d \ prime d)" by (auto simp: primepow_even_altdef primepow_odd_altdef multiplicity_aprimedivisor_Suc_0_iff elim!: oddE intro!: Nat.gr0I) subsection \Deriving a recurrence for the psi function\ lemma ln_fact_bounds: assumes "n > 0" shows "abs(ln (fact n) - n * ln n + n) \ 1 + ln n" proof - have "\n\{0<..}. \z>real n. z < real (n + 1) \ real (n + 1) * ln (real (n + 1)) - real n * ln (real n) = (real (n + 1) - real n) * (ln z + 1)" by (intro ballI MVT2) (auto intro!: derivative_eq_intros) hence "\n\{0<..}. \z>real n. z < real (n + 1) \ real (n + 1) * ln (real (n + 1)) - real n * ln (real n) = (ln z + 1)" by (simp add: algebra_simps) from bchoice[OF this] obtain k :: "nat \ real" where lb: "real n < k n" and ub: "k n < real (n + 1)" and mvt: "real (n+1) * ln (real (n+1)) - real n * ln (real n) = ln (k n) + 1" if "n > 0" for n::nat by blast have *: "(n + 1) * ln (n + 1) = (\i=1..n. ln(k i) + 1)" for n::nat proof (induction n) case (Suc n) have "(\i = 1..n+1. ln (k i) + 1) = (\i = 1..n. ln (k i) + 1) + ln (k (n+1)) + 1" by simp also from Suc.IH have "(\i = 1..n. ln (k i) + 1) = real (n+1) * ln (real (n+1))" .. also from mvt[of "n+1"] have "\ = real (n+2) * ln (real (n+2)) - ln (k (n+1)) - 1" by simp finally show ?case by simp qed simp have **: "abs((\i=1..n+1. ln i) - ((n+1) * ln (n+1) - (n+1))) \ 1 + ln(n+1)" for n::nat proof - have "(\i=1..n+1. ln i) \ (\i=1..n. ln i) + ln (n+1)" by simp also have "(\i=1..n. ln i) \ (\i=1..n. ln (k i))" by (intro sum_mono, subst ln_le_cancel_iff) (auto simp: Suc_le_eq dest: lb ub) also have "\ = (\i=1..n. ln (k i) + 1) - n" by (simp add: sum.distrib) also from * have "\ = (n+1) * ln (n+1) - n" by simp finally have a_minus_b: "(\i=1..n+1. ln i) - ((n+1) * ln (n+1) - (n+1)) \ 1 + ln (n+1)" by simp from * have "(n+1) * ln (n+1) - n = (\i=1..n. ln (k i) + 1) - n" by simp also have "\ = (\i=1..n. ln (k i))" by (simp add: sum.distrib) also have "\ \ (\i=1..n. ln (i+1))" by (intro sum_mono, subst ln_le_cancel_iff) (auto simp: Suc_le_eq dest: lb ub) also from sum.shift_bounds_cl_nat_ivl[of "ln" 1 1 n] have "\ = (\i=1+1..n+1. ln i)" .. also have "\ = (\i=1..n+1. ln i)" by (rule sum.mono_neutral_left) auto finally have b_minus_a: "((n+1) * ln (n+1) - (n+1)) - (\i=1..n+1. ln i) \ 1" by simp have "0 \ ln (n+1)" by simp with b_minus_a have "((n+1) * ln (n+1) - (n+1)) - (\i=1..n+1. ln i) \ 1 + ln (n+1)" by linarith with a_minus_b show ?thesis by linarith qed from \n > 0\ have "n \ 1" by simp thus ?thesis proof (induction n rule: dec_induct) case base then show ?case by simp next case (step n) from ln_fact[of "n+1"] **[of n] show ?case by simp qed qed lemma ln_fact_diff_bounds: "abs(ln (fact n) - 2 * ln (fact (n div 2)) - n * ln 2) \ 4 * ln (if n = 0 then 1 else n) + 3" proof (cases "n div 2 = 0") case True hence "n \ 1" by simp with ln_le_minus_one[of "2::real"] show ?thesis by (cases n) simp_all next case False then have "n > 1" by simp let ?a = "real n * ln 2" let ?b = "4 * ln (real n) + 3" let ?l1 = "ln (fact (n div 2))" let ?a1 = "real (n div 2) * ln (real (n div 2)) - real (n div 2)" let ?b1 = "1 + ln (real (n div 2))" let ?l2 = "ln (fact n)" let ?a2 = "real n * ln (real n) - real n" let ?b2 = "1 + ln (real n)" have abs_a: "abs(?a - (?a2 - 2 * ?a1)) \ ?b - 2 * ?b1 - ?b2" proof (cases "even n") case True then have "real (2 * (n div 2)) = real n" by simp then have n_div_2: "real (n div 2) = real n / 2" by simp from \n > 1\ have *: "abs(?a - (?a2 - 2 * ?a1)) = 0" by (simp add: n_div_2 ln_div algebra_simps) from \even n\ and \n > 1\ have "0 \ ln (real n) - ln (real (n div 2))" by (auto elim: evenE) also have "2 * \ \ 3 * ln (real n) - 2 * ln (real (n div 2))" using \n > 1\ by (auto intro!: ln_ge_zero) also have "\ = ?b - 2 * ?b1 - ?b2" by simp finally show ?thesis using * by simp next case False then have "real (2 * (n div 2)) = real (n - 1)" by simp with \n > 1\ have n_div_2: "real (n div 2) = (real n - 1) / 2" by simp from \odd n\ \n div 2 \ 0\ have "n \ 3" by presburger have "?a - (?a2 - 2 * ?a1) = real n * ln 2 - real n * ln (real n) + real n + 2 * real (n div 2) * ln (real (n div 2)) - 2* real (n div 2)" by (simp add: algebra_simps) also from n_div_2 have "2 * real (n div 2) = real n - 1" by simp also have "real n * ln 2 - real n * ln (real n) + real n + (real n - 1) * ln (real (n div 2)) - (real n - 1) = real n * (ln (real n - 1) - ln (real n)) - ln (real (n div 2)) + 1" using \n > 1\ by (simp add: algebra_simps n_div_2 ln_div) finally have lhs: "abs(?a - (?a2 - 2 * ?a1)) = abs(real n * (ln (real n - 1) - ln (real n)) - ln (real (n div 2)) + 1)" by simp from \n > 1\ have "real n * (ln (real n - 1) - ln (real n)) \ 0" by (simp add: algebra_simps mult_left_mono) moreover from \n > 1\ have "ln (real (n div 2)) \ ln (real n)" by simp moreover { have "exp 1 \ (3::real)" by (rule exp_le) also from \n \ 3\ have "\ \ exp (ln (real n))" by simp finally have "ln (real n) \ 1" by simp } ultimately have ub: "real n * (ln (real n - 1) - ln (real n)) - ln(real (n div 2)) + 1 \ 3 * ln (real n) - 2 * ln(real (n div 2))" by simp have mon: "real n' * (ln (real n') - ln (real n' - 1)) \ real n * (ln (real n) - ln (real n - 1))" if "n \ 3" "n' \ n" for n n'::nat proof (rule DERIV_nonpos_imp_nonincreasing[where f = "\x. x * (ln x - ln (x - 1))"]) fix t assume t: "real n \ t" "t \ real n'" with that have "1 / (t - 1) \ ln (1 + 1/(t - 1))" by (intro ln_add_one_self_le_self) simp_all also from t that have "ln (1 + 1/(t - 1)) = ln t- ln (t - 1)" by (simp add: ln_div [symmetric] field_simps) finally have "ln t - ln (t - 1) \ 1 / (t - 1)" . with that t show "\y. ((\x. x * (ln x - ln (x - 1))) has_field_derivative y) (at t) \ y \ 0" by (intro exI[of _ "1 / (1 - t) + ln t - ln (t - 1)"]) (force intro!: derivative_eq_intros simp: field_simps)+ qed (use that in simp_all) from \n > 1\ have "ln 2 = ln (real n) - ln (real n / 2)" by (simp add: ln_div) also from \n > 1\ have "\ \ ln (real n) - ln (real (n div 2))" by simp finally have *: "3*ln 2 + ln(real (n div 2)) \ 3* ln(real n) - 2* ln(real (n div 2))" by simp have "- real n * (ln (real n - 1) - ln (real n)) + ln(real (n div 2)) - 1 = real n * (ln (real n) - ln (real n - 1)) - 1 + ln(real (n div 2))" by (simp add: algebra_simps) also have "real n * (ln (real n) - ln (real n - 1)) \ 3 * (ln 3 - ln (3 - 1))" using mon[OF _ \n \ 3\] by simp also { have "Some (Float 3 (-1)) = ub_ln 1 3" by code_simp from ub_ln(1)[OF this] have "ln 3 \ (1.6 :: real)" by simp also have "1.6 - 1 / 3 \ 2 * (2/3 :: real)" by simp also have "2/3 \ ln (2 :: real)" by (rule ln_2_ge') finally have "ln 3 - 1 / 3 \ 2 * ln (2 :: real)" by simp } hence "3 * (ln 3 - ln (3 - 1)) - 1 \ 3 * ln (2 :: real)" by simp also note * finally have "- real n * (ln (real n - 1) - ln (real n)) + ln(real (n div 2)) - 1 \ 3 * ln (real n) - 2 * ln (real (n div 2))" by simp hence lhs': "abs(real n * (ln (real n - 1) - ln (real n)) - ln(real (n div 2)) + 1) \ 3 * ln (real n) - 2 * ln (real (n div 2))" using ub by simp have rhs: "?b - 2 * ?b1 - ?b2 = 3* ln (real n) - 2 * ln (real (n div 2))" by simp from \n > 1\ have "ln (real (n div 2)) \ 3* ln (real n) - 2* ln (real (n div 2))" by simp with rhs lhs lhs' show ?thesis by simp qed then have minus_a: "-?a \ ?b - 2 * ?b1 - ?b2 - (?a2 - 2 * ?a1)" by simp from abs_a have a: "?a \ ?b - 2 * ?b1 - ?b2 + ?a2 - 2 * ?a1" by (simp) from ln_fact_bounds[of "n div 2"] False have abs_l1: "abs(?l1 - ?a1) \ ?b1" by (simp add: algebra_simps) then have minus_l1: "?a1 - ?l1 \ ?b1" by linarith from abs_l1 have l1: "?l1 - ?a1 \ ?b1" by linarith from ln_fact_bounds[of n] False have abs_l2: "abs(?l2 - ?a2) \ ?b2" by (simp add: algebra_simps) then have l2: "?l2 - ?a2 \ ?b2" by simp from abs_l2 have minus_l2: "?a2 - ?l2 \ ?b2" by simp from minus_a minus_l1 l2 have "?l2 - 2 * ?l1 - ?a \ ?b" by simp moreover from a l1 minus_l2 have "- ?l2 + 2 * ?l1 + ?a \ ?b" by simp ultimately have "abs((?l2 - 2*?l1) - ?a) \ ?b" by simp then show ?thesis by simp qed lemma ln_primefact: assumes "n \ (0::nat)" shows "ln n = (\d=1..n. if primepow d \ d dvd n then ln (aprimedivisor d) else 0)" (is "?lhs = ?rhs") proof - have "?rhs = (\d\{x \ {1..n}. primepow x \ x dvd n}. ln (real (aprimedivisor d)))" unfolding primepow_factors_def by (subst sum.inter_filter [symmetric]) simp_all also have "{x \ {1..n}. primepow x \ x dvd n} = primepow_factors n" using assms by (auto simp: primepow_factors_def dest: dvd_imp_le primepow_gt_Suc_0) finally have *: "(\d\primepow_factors n. ln (real (aprimedivisor d))) = ?rhs" .. from in_prime_factors_imp_prime prime_gt_0_nat have pf_pos: "\p. p\#prime_factorization n \ p > 0" by blast from ln_msetprod[of "prime_factorization n", OF pf_pos] assms have "ln n = (\p\#prime_factorization n. ln p)" by (simp add: of_nat_prod_mset) also from * sum_prime_factorization_conv_sum_primepow_factors[of n ln, OF assms(1)] have "\ = ?rhs" by simp finally show ?thesis . qed context begin private lemma divisors: fixes x d::nat assumes "x \ {1..n}" assumes "d dvd x" shows "\k\{1..n div d}. x = d * k" proof - from assms have "x \ n" by simp then have ub: "x div d \ n div d" by (simp add: div_le_mono \x \ n\) from assms have "1 \ x div d" by (auto elim!: dvdE) with ub have "x div d \ {1..n div d}" by simp with \d dvd x\ show ?thesis by (auto intro!: bexI[of _ "x div d"]) qed lemma ln_fact_conv_mangoldt: "ln (fact n) = (\d=1..n. mangoldt d * floor (n / d))" proof - have *: "(\da=1..n. if primepow da \ da dvd d then ln (aprimedivisor da) else 0) = (\(da::nat)=1..d. if primepow da \ da dvd d then ln (aprimedivisor da) else 0)" if d: "d \ {1..n}" for d by (rule sum.mono_neutral_right, insert d) (auto dest: dvd_imp_le) have "(\d=1..n. \da=1..d. if primepow da \ da dvd d then ln (aprimedivisor da) else 0) = (\d=1..n. \da=1..n. if primepow da \ da dvd d then ln (aprimedivisor da) else 0)" by (rule sum.cong) (insert *, simp_all) also have "\ = (\da=1..n. \d=1..n. if primepow da \ da dvd d then ln (aprimedivisor da) else 0)" by (rule sum.swap) also have "\ = sum (\d. mangoldt d * floor (n/d)) {1..n}" proof (rule sum.cong) fix d assume d: "d \ {1..n}" have "(\da = 1..n. if primepow d \ d dvd da then ln (real (aprimedivisor d)) else 0) = (\da = 1..n. if d dvd da then mangoldt d else 0)" by (intro sum.cong) (simp_all add: mangoldt_def) also have "\ = mangoldt d * real (card {x. x \ {1..n} \ d dvd x})" by (subst sum.inter_filter [symmetric]) (simp_all add: algebra_simps) also { have "{x. x \ {1..n} \ d dvd x} = {x. \k \{1..n div d}. x=k*d}" proof safe fix x assume "x \ {1..n}" "d dvd x" thus "\k\{1..n div d}. x = k * d" using divisors[of x n d] by auto next fix x k assume k: "k \ {1..n div d}" from k have "k * d \ n div d * d" by (intro mult_right_mono) simp_all also have "n div d * d \ n div d * d + n mod d" by (rule le_add1) also have "\ = n" by simp finally have "k * d \ n" . thus "k * d \ {1..n}" using d k by auto qed auto also have "\ = (\k. k*d) ` {1..n div d}" by fast also have "card \ = card {1..n div d}" by (rule card_image) (simp add: inj_on_def) also have "\ = n div d" by simp also have "... = \n / d\" by (simp add: floor_divide_of_nat_eq) finally have "real (card {x. x \ {1..n} \ d dvd x}) = real_of_int \n / d\" by force } finally show "(\da = 1..n. if primepow d \ d dvd da then ln (real (aprimedivisor d)) else 0) = mangoldt d * real_of_int \real n / real d\" . qed simp_all finally have "(\d=1..n. \da=1..d. if primepow da \ da dvd d then ln (aprimedivisor da) else 0) = sum (\d. mangoldt d * floor (n/d)) {1..n}" . with ln_primefact have "(\d=1..n. ln d) = (\d=1..n. mangoldt d * floor (n/d))" by simp with ln_fact show ?thesis by simp qed end context begin private lemma div_2_mult_2_bds: fixes n d :: nat assumes "d > 0" shows "0 \ \n / d\ - 2 * \(n div 2) / d\" "\n / d\ - 2 * \(n div 2) / d\ \ 1" proof - have "\2::real\ * \(n div 2) / d\ \ \2 * ((n div 2) / d)\" by (rule le_mult_floor) simp_all also from assms have "\ \ \n / d\" by (intro floor_mono) (simp_all add: field_simps) finally show "0 \ \n / d\ - 2 * \(n div 2) / d\" by (simp add: algebra_simps) next have "real (n div d) \ real (2 * ((n div 2) div d) + 1)" by (subst div_mult2_eq [symmetric], simp only: mult.commute, subst div_mult2_eq) simp thus "\n / d\ - 2 * \(n div 2) / d\ \ 1" unfolding of_nat_add of_nat_mult floor_conv_div_nat [symmetric] by simp_all qed private lemma n_div_d_eq_1: "d \ {n div 2 + 1..n} \ \real n / real d\ = 1" by (cases "n = d") (auto simp: field_simps intro: floor_eq) lemma psi_bounds_ln_fact: shows "ln (fact n) - 2 * ln (fact (n div 2)) \ psi n" "psi n - psi (n div 2) \ ln (fact n) - 2 * ln (fact (n div 2))" proof - fix n::nat let ?k = "n div 2" and ?d = "n mod 2" have *: "\?k / d\ = 0" if "d > ?k" for d proof - from that div_less have "0 = ?k div d" by simp also have "\ = \?k / d\" by (rule floor_divide_of_nat_eq [symmetric]) finally show "\?k / d\ = 0" by simp qed have sum_eq: "(\d=1..2*?k+?d. mangoldt d * \?k / d\) = (\d=1..?k. mangoldt d * \?k / d\)" by (intro sum.mono_neutral_right) (auto simp: *) from ln_fact_conv_mangoldt have "ln (fact n) = (\d=1..n. mangoldt d * \n / d\)" . also have "\ = (\d=1..n. mangoldt d * \(2 * (n div 2) + n mod 2) / d\)" by simp also have "\ \ (\d=1..n. mangoldt d * (2 * \?k / d\ + 1))" using div_2_mult_2_bds(2)[of _ n] by (intro sum_mono mult_left_mono, subst of_int_le_iff) (auto simp: algebra_simps mangoldt_nonneg) also have "\ = 2 * (\d=1..n. mangoldt d * \(n div 2) / d\) + (\d=1..n. mangoldt d)" by (simp add: algebra_simps sum.distrib sum_distrib_left) also have "\ = 2 * (\d=1..2*?k+?d. mangoldt d * \(n div 2) / d\) + (\d=1..n. mangoldt d)" by presburger also from sum_eq have "\ = 2 * (\d=1..?k. mangoldt d * \(n div 2) / d\) + (\d=1..n. mangoldt d)" by presburger also from ln_fact_conv_mangoldt psi_def have "\ = 2 * ln (fact ?k) + psi n" by presburger finally show "ln (fact n) - 2 * ln (fact (n div 2)) \ psi n" by simp next fix n::nat let ?k = "n div 2" and ?d = "n mod 2" from psi_def have "psi n - psi ?k = (\d=1..2*?k+?d. mangoldt d) - (\d=1..?k. mangoldt d)" by presburger also have "\ = sum mangoldt ({1..2 * (n div 2) + n mod 2} - {1..n div 2})" by (subst sum_diff) simp_all also have "\ = (\d\({1..2 * (n div 2) + n mod 2} - {1..n div 2}). (if d \ ?k then 0 else mangoldt d))" by (intro sum.cong) simp_all also have "\ = (\d=1..2*?k+?d. (if d \ ?k then 0 else mangoldt d))" by (intro sum.mono_neutral_left) auto also have "\ = (\d=1..n. (if d \ ?k then 0 else mangoldt d))" by presburger also have "\ = (\d=1..n. (if d \ ?k then mangoldt d * 0 else mangoldt d))" by (intro sum.cong) simp_all also from div_2_mult_2_bds(1) have "\ \ (\d=1..n. (if d \ ?k then mangoldt d * (\n/d\ - 2 * \?k/d\) else mangoldt d))" by (intro sum_mono) (auto simp: algebra_simps mangoldt_nonneg intro!: mult_left_mono simp del: of_int_mult) also from n_div_d_eq_1 have "\ = (\d=1..n. (if d \ ?k then mangoldt d * (\n/d\ - 2 * \?k/d\) else mangoldt d * \n/d\))" by (intro sum.cong refl) auto also have "\ = (\d=1..n. mangoldt d * real_of_int (\real n / real d\) - (if d \ ?k then 2 * mangoldt d * real_of_int \real ?k / real d\ else 0))" by (intro sum.cong refl) (auto simp: algebra_simps) also have "\ = (\d=1..n. mangoldt d * real_of_int (\real n / real d\)) - (\d=1..n. (if d \ ?k then 2 * mangoldt d * real_of_int \real ?k / real d\ else 0))" by (rule sum_subtractf) also have "(\d=1..n. (if d \ ?k then 2 * mangoldt d * real_of_int \real ?k / real d\ else 0)) = (\d=1..?k. (if d \ ?k then 2 * mangoldt d * real_of_int \real ?k / real d\ else 0))" by (intro sum.mono_neutral_right) auto also have "\ = (\d=1..?k. 2 * mangoldt d * real_of_int \real ?k / real d\)" by (intro sum.cong) simp_all also have "\ = 2 * (\d=1..?k. mangoldt d * real_of_int \real ?k / real d\)" by (simp add: sum_distrib_left mult_ac) also have "(\d = 1..n. mangoldt d * real_of_int \real n / real d\) - \ = ln (fact n) - 2 * ln (fact (n div 2))" by (simp add: ln_fact_conv_mangoldt) finally show "psi n - psi (n div 2) \ ln (fact n) - 2 * ln (fact (n div 2))" . qed end lemma psi_bounds_induct: "real n * ln 2 - (4 * ln (real (if n = 0 then 1 else n)) + 3) \ psi n" "psi n - psi (n div 2) \ real n * ln 2 + (4 * ln (real (if n = 0 then 1 else n)) + 3)" proof - from le_imp_neg_le[OF ln_fact_diff_bounds] have "n * ln 2 - (4 * ln (if n = 0 then 1 else n) + 3) \ n * ln 2 - abs(ln (fact n) - 2 * ln (fact (n div 2)) - n * ln 2)" by simp also have "\ \ ln (fact n) - 2 * ln (fact (n div 2))" by simp also from psi_bounds_ln_fact (1) have "\ \ psi n" by simp finally show "real n * ln 2 - (4 * ln (real (if n = 0 then 1 else n)) + 3) \ psi n" . next from psi_bounds_ln_fact (2) have "psi n - psi (n div 2) \ ln (fact n) - 2 * ln (fact (n div 2))" . also have "\ \ n * ln 2 + abs(ln (fact n) - 2 * ln (fact (n div 2)) - n * ln 2)" by simp also from ln_fact_diff_bounds [of n] have "abs(ln (fact n) - 2 * ln (fact (n div 2)) - n * ln 2) \ (4 * ln (real (if n = 0 then 1 else n)) + 3)" by simp finally show "psi n - psi (n div 2) \ real n * ln 2 + (4 * ln (real (if n = 0 then 1 else n)) + 3)" by simp qed subsection \Bounding the psi function\ text \ In this section, we will first prove the relatively tight estimate @{prop "psi n \ 3 / 2 + ln 2 * n"} for @{term "n \ 128"} and then use the recurrence we have just derived to extend it to @{prop "psi n \ 551 / 256"} for @{term "n \ 1024"}, at which point applying the recurrence can be used to prove the same bound for arbitrarily big numbers. First of all, we will prove the bound for @{term "n <= 128"} using reflection and approximation. \ context begin private lemma Ball_insertD: assumes "\x\insert y A. P x" shows "P y" "\x\A. P x" using assms by auto private lemma meta_eq_TrueE: "PROP A \ Trueprop True \ PROP A" by simp private lemma pre_mangoldt_pos: "pre_mangoldt n > 0" unfolding pre_mangoldt_def by (auto simp: primepow_gt_Suc_0) private lemma psi_conv_pre_mangoldt: "psi n = ln (real (prod pre_mangoldt {1..n}))" by (auto simp: psi_def mangoldt_def pre_mangoldt_def ln_prod primepow_gt_Suc_0 intro!: sum.cong) private lemma eval_psi_aux1: "psi 0 = ln (real (numeral Num.One))" by (simp add: psi_def) private lemma eval_psi_aux2: assumes "psi m = ln (real (numeral x))" "pre_mangoldt n = y" "m + 1 = n" "numeral x * y = z" shows "psi n = ln (real z)" proof - from assms(2) [symmetric] have [simp]: "y > 0" by (simp add: pre_mangoldt_pos) have "psi n = psi (Suc m)" by (simp add: assms(3) [symmetric]) also have "\ = ln (real y * (\x = Suc 0..m. real (pre_mangoldt x)))" using assms(2,3) [symmetric] by (simp add: psi_conv_pre_mangoldt prod.nat_ivl_Suc' mult_ac) also have "\ = ln (real y) + psi m" by (subst ln_mult) (simp_all add: pre_mangoldt_pos prod_pos psi_conv_pre_mangoldt) also have "psi m = ln (real (numeral x))" by fact also have "ln (real y) + \ = ln (real (numeral x * y))" by (simp add: ln_mult) finally show ?thesis by (simp add: assms(4) [symmetric]) qed private lemma Ball_atLeast0AtMost_doubleton: assumes "psi 0 \ 3 / 2 * ln 2 * real 0" assumes "psi 1 \ 3 / 2 * ln 2 * real 1" shows "(\x\{0..1}. psi x \ 3 / 2 * ln 2 * real x)" using assms unfolding One_nat_def atLeast0_atMost_Suc ball_simps by auto private lemma Ball_atLeast0AtMost_insert: assumes "(\x\{0..m}. psi x \ 3 / 2 * ln 2 * real x)" assumes "psi (numeral n) \ 3 / 2 * ln 2 * real (numeral n)" "m = pred_numeral n" shows "(\x\{0..numeral n}. psi x \ 3 / 2 * ln 2 * real x)" using assms by (subst numeral_eq_Suc[of n], subst atLeast0_atMost_Suc, subst ball_simps, simp only: numeral_eq_Suc [symmetric]) private lemma eval_psi_ineq_aux: assumes "psi n = x" "x \ 3 / 2 * ln 2 * n" shows "psi n \ 3 / 2 * ln 2 * n" using assms by simp_all private lemma eval_psi_ineq_aux2: assumes "numeral m ^ 2 \ (2::nat) ^ (3 * n)" shows "ln (real (numeral m)) \ 3 / 2 * ln 2 * real n" proof - have "ln (real (numeral m)) \ 3 / 2 * ln 2 * real n \ 2 * log 2 (real (numeral m)) \ 3 * real n" by (simp add: field_simps log_def) also have "2 * log 2 (real (numeral m)) = log 2 (real (numeral m ^ 2))" by (subst of_nat_power, subst log_nat_power) simp_all also have "\ \ 3 * real n \ real ((numeral m) ^ 2) \ 2 powr real (3 * n)" by (subst Transcendental.log_le_iff) simp_all also have "2 powr (3 * n) = real (2 ^ (3 * n))" by (simp add: powr_realpow [symmetric]) also have "real ((numeral m) ^ 2) \ \ \ numeral m ^ 2 \ (2::nat) ^ (3 * n)" by (rule of_nat_le_iff) finally show ?thesis using assms by blast qed private lemma eval_psi_ineq_aux_mono: assumes "psi n = x" "psi m = x" "psi n \ 3 / 2 * ln 2 * n" "n \ m" shows "psi m \ 3 / 2 * ln 2 * m" proof - from assms have "psi m = psi n" by simp also have "\ \ 3 / 2 * ln 2 * n" by fact also from \n \ m\ have "\ \ 3 / 2 * ln 2 * m" by simp finally show ?thesis . qed lemma not_primepow_1_nat: "\primepow (1 :: nat)" by auto ML_file \bertrand.ML\ (* This should not take more than 1 minute *) local_setup \fn lthy => let fun tac ctxt = let val psi_cache = Bertrand.prove_psi ctxt 129 fun prove_psi_ineqs ctxt = let fun tac goal_ctxt = HEADGOAL (resolve_tac goal_ctxt @{thms eval_psi_ineq_aux2} THEN' Simplifier.simp_tac goal_ctxt) fun prove_by_approx n thm = let val thm = thm RS @{thm eval_psi_ineq_aux} val [prem] = Thm.prems_of thm val prem = Goal.prove ctxt [] [] prem (tac o #context) in prem RS thm end fun prove_by_mono last_thm last_thm' thm = let val thm = @{thm eval_psi_ineq_aux_mono} OF [last_thm, thm, last_thm'] val [prem] = Thm.prems_of thm val prem = Goal.prove ctxt [] [] prem (fn {context = goal_ctxt, ...} => HEADGOAL (Simplifier.simp_tac goal_ctxt)) in prem RS thm end fun go _ acc [] = acc | go last acc ((n, x, thm) :: xs) = let val thm' = case last of NONE => prove_by_approx n thm | SOME (last_x, last_thm, last_thm') => if last_x = x then prove_by_mono last_thm last_thm' thm else prove_by_approx n thm in go (SOME (x, thm, thm')) (thm' :: acc) xs end in rev o go NONE [] end val psi_ineqs = prove_psi_ineqs ctxt psi_cache fun prove_ball ctxt (thm1 :: thm2 :: thms) = let val thm = @{thm Ball_atLeast0AtMost_doubleton} OF [thm1, thm2] fun solve_prem thm = let val thm' = Goal.prove ctxt [] [] (Thm.cprem_of thm 1 |> Thm.term_of) (fn {context = goal_ctxt, ...} => HEADGOAL (Simplifier.simp_tac goal_ctxt)) in thm' RS thm end fun go thm thm' = (@{thm Ball_atLeast0AtMost_insert} OF [thm', thm]) |> solve_prem in fold go thms thm end | prove_ball _ _ = raise Match in HEADGOAL (resolve_tac ctxt [prove_ball ctxt psi_ineqs]) end val thm = Goal.prove lthy [] [] @{prop "\n\{0..128}. psi n \ 3 / 2 * ln 2 * n"} (tac o #context) in Local_Theory.note ((@{binding psi_ubound_log_128}, []), [thm]) lthy |> snd end \ end context begin private lemma psi_ubound_aux: defines "f \ \x::real. (4 * ln x + 3) / (ln 2 * x)" assumes "x \ 2" "x \ y" shows "f x \ f y" using assms(3) proof (rule DERIV_nonpos_imp_nonincreasing, goal_cases) case (1 t) define f' where "f' = (\x. (1 - 4 * ln x) / x^2 / ln 2 :: real)" from 1 assms(2) have "(f has_real_derivative f' t) (at t)" unfolding f_def f'_def by (auto intro!: derivative_eq_intros simp: field_simps power2_eq_square) moreover { from ln_2_ge have "1/4 \ ln (2::real)" by simp also from assms(2) 1 have "\ \ ln t" by simp finally have "ln t \ 1/4" . } with 1 assms(2) have "f' t \ 0" by (simp add: f'_def field_simps) ultimately show ?case by (intro exI[of _ "f' t"]) simp_all qed text \ These next rules are used in combination with @{thm psi_bounds_induct} and @{thm psi_ubound_log_128} to extend the upper bound for @{term "psi"} from values no greater than 128 to values no greater than 1024. The constant factor of the upper bound changes every time, but once we have reached 1024, the recurrence is self-sustaining in the sense that we do not have to adjust the constant factor anymore in order to double the range. \ lemma psi_ubound_log_double_cases': assumes "\n. n \ m \ psi n \ c * ln 2 * real n" "n \ m'" "m' = 2*m" "c \ c'" "c \ 0" "m \ 1" "c' \ 1 + c/2 + (4 * ln (m+1) + 3) / (ln 2 * (m+1))" shows "psi n \ c' * ln 2 * real n" proof (cases "n > m") case False hence "psi n \ c * ln 2 * real n" by (intro assms) simp_all also have "c \ c'" by fact finally show ?thesis by - (simp_all add: mult_right_mono) next case True hence n: "n \ m+1" by simp from psi_bounds_induct(2)[of n] True have "psi n \ real n * ln 2 + 4 * ln (real n) + 3 + psi (n div 2)" by simp also from assms have "psi (n div 2) \ c * ln 2 * real (n div 2)" by (intro assms) simp_all also have "real (n div 2) \ real n / 2" by simp also have "c * ln 2 * \ = c / 2 * ln 2 * real n" by simp also have "real n * ln 2 + 4 * ln (real n) + 3 + \ = (1 + c/2) * ln 2 * real n + (4 * ln (real n) + 3)" by (simp add: field_simps) also { have "(4 * ln (real n) + 3) / (ln 2 * (real n)) \ (4 * ln (m+1) + 3) / (ln 2 * (m+1))" using n assms by (intro psi_ubound_aux) simp_all also from assms have "(4 * ln (m+1) + 3) / (ln 2 * (m+1)) \ c' - 1 - c/2" by (simp add: algebra_simps) finally have "4 * ln (real n) + 3 \ (c' - 1 - c/2) * ln 2 * real n" using n by (simp add: field_simps) } also have "(1 + c / 2) * ln 2 * real n + (c' - 1 - c / 2) * ln 2 * real n = c' * ln 2 * real n" by (simp add: field_simps) finally show ?thesis using \c \ 0\ by (simp_all add: mult_left_mono) qed end lemma psi_ubound_log_double_cases: assumes "\n\m. psi n \ c * ln 2 * real n" "c' \ 1 + c/2 + (4 * ln (m+1) + 3) / (ln 2 * (m+1))" "m' = 2*m" "c \ c'" "c \ 0" "m \ 1" shows "\n\m'. psi n \ c' * ln 2 * real n" using assms(1) by (intro allI impI assms psi_ubound_log_double_cases'[of m c _ m' c']) auto lemma psi_ubound_log_1024: "\n\1024. psi n \ 551 / 256 * ln 2 * real n" proof - from psi_ubound_log_128 have "\n\128. psi n \ 3 / 2 * ln 2 * real n" by simp hence "\n\256. psi n \ 1025 / 512 * ln 2 * real n" proof (rule psi_ubound_log_double_cases, goal_cases) case 1 have "Some (Float 624 (- 7)) = ub_ln 9 129" by code_simp from ub_ln(1)[OF this] and ln_2_ge show ?case by (simp add: field_simps) qed simp_all hence "\n\512. psi n \ 549 / 256 * ln 2 * real n" proof (rule psi_ubound_log_double_cases, goal_cases) case 1 have "Some (Float 180 (- 5)) = ub_ln 7 257" by code_simp from ub_ln(1)[OF this] and ln_2_ge show ?case by (simp add: field_simps) qed simp_all thus "\n\1024. psi n \ 551 / 256 * ln 2 * real n" proof (rule psi_ubound_log_double_cases, goal_cases) case 1 have "Some (Float 203 (- 5)) = ub_ln 7 513" by code_simp from ub_ln(1)[OF this] and ln_2_ge show ?case by (simp add: field_simps) qed simp_all qed lemma psi_bounds_sustained_induct: assumes "4 * ln (1 + 2 ^ j) + 3 \ d * ln 2 * (1 + 2^j)" assumes "4 / (1 + 2^j) \ d * ln 2" assumes "0 \ c" assumes "c / 2 + d + 1 \ c" assumes "j \ k" assumes "\n. n \ 2^k \ psi n \ c * ln 2 * n" assumes "n \ 2^(Suc k)" shows "psi n \ c * ln 2 * n" proof (cases "n \ 2^k") case True with assms(6) show ?thesis . next case False from psi_bounds_induct(2) have "psi n - psi (n div 2) \ real n * ln 2 + (4 * ln (real (if n = 0 then 1 else n)) + 3)" . also from False have "(if n = 0 then 1 else n) = n" by simp finally have "psi n \ real n * ln 2 + (4 * ln (real n) + 3) + psi (n div 2)" by simp also from assms(6,7) have "psi (n div 2) \ c * ln 2 * (n div 2)" by simp also have "real (n div 2) \ real n / 2" by simp also have "real n * ln 2 + (4 * ln (real n) + 3) + c * ln 2 * (n / 2) \ c * ln 2 * real n" proof (rule overpower_lemma[of "\x. x * ln 2 + (4 * ln x + 3) + c * ln 2 * (x / 2)" "1+2^j" "\x. c * ln 2 * x" "\x. c * ln 2 - ln 2 - 4 / x - c / 2 * ln 2" "real n"]) from assms(1) have "4 * ln (1 + 2^j) + 3 \ d * ln 2 * (1 + 2^j)" . also from assms(4) have "d \ c - c/2 - 1" by simp also have "(\) * ln 2 * (1 + 2 ^ j) = c * ln 2 * (1 + 2 ^ j) - c / 2 * ln 2 * (1 + 2 ^ j) - (1 + 2 ^ j) * ln 2" by (simp add: left_diff_distrib) finally have "4 * ln (1 + 2^j) + 3 \ c * ln 2 * (1 + 2 ^ j) - c / 2 * ln 2 * (1 + 2 ^ j) - (1 + 2 ^ j) * ln 2" by (simp add: add_pos_pos) then show "(1 + 2 ^ j) * ln 2 + (4 * ln (1 + 2 ^ j) + 3) + c * ln 2 * ((1 + 2 ^ j) / 2) \ c * ln 2 * (1 + 2 ^ j)" by simp next fix x::real assume x: "1 + 2^j \ x" moreover have "1 + 2 ^ j > (0::real)" by (simp add: add_pos_pos) ultimately have x_pos: "x > 0" by linarith show "((\x. c * ln 2 * x - (x * ln 2 + (4 * ln x + 3) + c * ln 2 * (x / 2))) has_real_derivative c * ln 2 - ln 2 - 4 / x - c / 2 * ln 2) (at x)" by (rule derivative_eq_intros refl | simp add: \0 < x\)+ from \0 < x\ \0 < 1 + 2^j\ have "0 < x * (1 + 2^j)" by (rule mult_pos_pos) have "4 / x \ 4 / (1 + 2^j)" by (intro divide_left_mono mult_pos_pos add_pos_pos x x_pos) simp_all also from assms(2) have "4 / (1 + 2^j) \ d * ln 2" . also from assms(4) have "d \ c - c/2 - 1" by simp also have "\ * ln 2 = c * ln 2 - c/2 * ln 2 - ln 2" by (simp add: algebra_simps) finally show "0 \ c * ln 2 - ln 2 - 4 / x - c / 2 * ln 2" by simp next have "1 + 2^j = real (1 + 2^j)" by simp also from assms(5) have "\ \ real (1 + 2^k)" by simp also from False have "2^k \ n - 1" by simp finally show "1 + 2^j \ real n" using False by simp qed finally show ?thesis using assms by - (simp_all add: mult_left_mono) qed lemma psi_bounds_sustained: assumes "\n. n \ 2^k \ psi n \ c * ln 2 * n" assumes "4 * ln (1 + 2^k) + 3 \ (c/2 - 1) * ln 2 * (1 + 2^k)" assumes "4 / (1 + 2^k) \ (c/2 - 1) * ln 2" assumes "c \ 0" shows "psi n \ c * ln 2 * n" proof - have "psi n \ c * ln 2 * n" if "n \ 2^j" for j n using that proof (induction j arbitrary: n) case 0 with assms(4) 0 show ?case unfolding psi_def mangoldt_def by (cases n) auto next case (Suc j) show ?case proof (cases "k \ j") case True from assms(4) have c_div_2: "c/2 + (c/2 - 1) + 1 \ c" by simp from psi_bounds_sustained_induct[of k "c/2 -1" c j, OF assms(2) assms(3) assms(4) c_div_2 True Suc.IH Suc.prems] show ?thesis by simp next case False then have j_lt_k: "Suc j \ k" by simp from Suc.prems have "n \ 2 ^ Suc j" . also have "(2::nat) ^ Suc j \ 2 ^ k" using power_increasing[of "Suc j" k "2::nat", OF j_lt_k] by simp finally show ?thesis using assms(1) by simp qed qed from less_exp this [of n n] show ?thesis by simp qed lemma psi_ubound_log: "psi n \ 551 / 256 * ln 2 * n" proof (rule psi_bounds_sustained) show "0 \ 551 / (256 :: real)" by simp next fix n :: nat assume "n \ 2 ^ 10" with psi_ubound_log_1024 show "psi n \ 551 / 256 * ln 2 * real n" by auto next have "4 / (1 + 2 ^ 10) \ (551 / 256 / 2 - 1) * (2/3 :: real)" by simp also have "\ \ (551 / 256 / 2 - 1) * ln 2" by (intro mult_left_mono ln_2_ge') simp_all finally show "4 / (1 + 2 ^ 10) \ (551 / 256 / 2 - 1) * ln (2 :: real)" . next have "Some (Float 16 (-1)) = ub_ln 3 1025" by code_simp from ub_ln(1)[OF this] and ln_2_ge have "2048 * ln 1025 + 1536 \ 39975 * (ln 2::real)" by simp thus "4 * ln (1 + 2 ^ 10) + 3 \ (551 / 256 / 2 - 1) * ln 2 * (1 + 2 ^ 10 :: real)" by simp qed lemma psi_ubound_3_2: "psi n \ 3/2 * n" proof - have "(551 / 256) * ln 2 \ (551 / 256) * (16/23 :: real)" by (intro mult_left_mono ln_2_le') auto also have "\ \ 3 / 2" by simp finally have "551 / 256 * ln 2 \ 3/(2::real)" . with of_nat_0_le_iff mult_right_mono have "551 / 256 * ln 2 * n \ 3/2 * n" by blast with psi_ubound_log[of "n"] show ?thesis by linarith qed subsection \Doubling psi and theta\ lemma psi_residues_compare_2: "psi_odd_2 n \ psi_even_2 n" proof - have "psi_odd_2 n = (\d\{d. d \ {2..n} \ primepow_odd d}. mangoldt_odd d)" unfolding mangoldt_odd_def by (rule sum.mono_neutral_right) auto also have "\ = (\d\{d. d \ {2..n} \ primepow_odd d}. ln (real (aprimedivisor d)))" by (intro sum.cong refl) (simp add: mangoldt_odd_def) also have "\ \ (\d\{d. d \ {2..n} \ primepow_even d}. ln (real (aprimedivisor d)))" proof (rule sum_le_included [where i = "\y. y * aprimedivisor y"]; clarify?) fix d :: nat assume "d \ {2..n}" "primepow_odd d" note d = this then obtain p k where d': "k \ 1" "prime p" "d = p ^ (2*k+1)" by (auto simp: primepow_odd_def) from d' have "p ^ (2 * k) \ p ^ (2 * k + 1)" by (subst power_increasing_iff) (auto simp: prime_gt_Suc_0_nat) also from d d' have "\ \ n" by simp finally have "p ^ (2 * k) \ n" . moreover from d' have "p ^ (2 * k) > 1" by (intro one_less_power) (simp_all add: prime_gt_Suc_0_nat) ultimately have "p ^ (2 * k) \ {2..n}" by simp moreover from d' have "primepow_even (p ^ (2 * k))" by (auto simp: primepow_even_def) ultimately show "\y\{d \ {2..n}. primepow_even d}. y * aprimedivisor y = d \ ln (real (aprimedivisor d)) \ ln (real (aprimedivisor y))" using d' by (intro bexI[of _ "p ^ (2 * k)"]) (auto simp: aprimedivisor_prime_power aprimedivisor_primepow) qed (simp_all add: of_nat_ge_1_iff Suc_le_eq) also have "\ = (\d\{d. d \ {2..n} \ primepow_even d}. mangoldt_even d)" by (intro sum.cong refl) (simp add: mangoldt_even_def) also have "\ = psi_even_2 n" unfolding mangoldt_even_def by (rule sum.mono_neutral_left) auto finally show ?thesis . qed lemma psi_residues_compare: "psi_odd n \ psi_even n" proof - have "\ primepow_odd 1" by (simp add: primepow_odd_def) hence *: "mangoldt_odd 1 = 0" by (simp add: mangoldt_odd_def) have "\ primepow_even 1" using primepow_gt_Suc_0[OF primepow_even_imp_primepow, of 1] by auto with mangoldt_even_def have **: "mangoldt_even 1 = 0" by simp from psi_odd_def have "psi_odd n = (\d=1..n. mangoldt_odd d)" by simp also from * have "\ = psi_odd_2 n" by (cases "n \ 1") (simp_all add: eval_nat_numeral sum.atLeast_Suc_atMost) also from psi_residues_compare_2 have "\ \ psi_even_2 n" . also from ** have "\ = psi_even n" by (cases "n \ 1") (simp_all add: eval_nat_numeral sum.atLeast_Suc_atMost psi_even_def) finally show ?thesis . qed lemma primepow_iff_even_sqr: "primepow n \ primepow_even (n^2)" by (cases "n = 0") (auto simp: primepow_even_altdef aprimedivisor_primepow_power primepow_power_iff_nat prime_elem_multiplicity_power_distrib prime_aprimedivisor' prime_imp_prime_elem unit_factor_nat_def primepow_gt_0_nat dest: primepow_gt_Suc_0) lemma psi_sqrt: "psi (Discrete.sqrt n) = psi_even n" proof (induction n) case 0 with psi_def psi_even_def show ?case by simp next case (Suc n) then show ?case proof cases assume asm: "\ m. Suc n = m^2" with sqrt_Suc have sqrt_seq: "Discrete.sqrt(Suc n) = Suc(Discrete.sqrt n)" by simp from asm obtain "m" where " Suc n = m^2" by blast with sqrt_seq have "Suc(Discrete.sqrt n) = m" by simp with \Suc n = m^2\ have suc_sqrt_n_sqrt: "(Suc(Discrete.sqrt n))^2 = Suc n" by simp from sqrt_seq have "psi (Discrete.sqrt (Suc n)) = psi (Suc (Discrete.sqrt n))" by simp also from psi_def have "\ = psi (Discrete.sqrt n) + mangoldt (Suc (Discrete.sqrt n))" by simp also from Suc.IH have "psi (Discrete.sqrt n) = psi_even n" . also have "mangoldt (Suc (Discrete.sqrt n)) = mangoldt_even (Suc n)" proof (cases "primepow (Suc(Discrete.sqrt n))") case True with primepow_iff_even_sqr have True2: "primepow_even ((Suc(Discrete.sqrt n))^2)" by simp from suc_sqrt_n_sqrt have "mangoldt_even (Suc n) = mangoldt_even ((Suc(Discrete.sqrt n))^2)" by simp also from mangoldt_even_def True2 have "\ = ln (aprimedivisor ((Suc (Discrete.sqrt n))^2))" by simp also from True have "aprimedivisor ((Suc (Discrete.sqrt n))^2) = aprimedivisor (Suc (Discrete.sqrt n))" by (simp add: aprimedivisor_primepow_power) also from True have "ln (\) = mangoldt (Suc (Discrete.sqrt n))" by (simp add: mangoldt_def) finally show ?thesis .. next case False with primepow_iff_even_sqr have False2: "\ primepow_even ((Suc(Discrete.sqrt n))^2)" by simp from suc_sqrt_n_sqrt have "mangoldt_even (Suc n) = mangoldt_even ((Suc(Discrete.sqrt n))^2)" by simp also from mangoldt_even_def False2 have "\ = 0" by simp also from False have "\ = mangoldt (Suc (Discrete.sqrt n))" by (simp add: mangoldt_def) finally show ?thesis .. qed also from psi_even_def have "psi_even n + mangoldt_even (Suc n) = psi_even (Suc n)" by simp finally show ?case . next assume asm: "\(\m. Suc n = m^2)" with sqrt_Suc have sqrt_eq: "Discrete.sqrt (Suc n) = Discrete.sqrt n" by simp then have lhs: "psi (Discrete.sqrt (Suc n)) = psi (Discrete.sqrt n)" by simp have "\ primepow_even (Suc n)" proof assume "primepow_even (Suc n)" with primepow_even_def obtain "p" "k" where "1 \ k \ prime p \ Suc n = p ^ (2 * k)" by blast with power_even_eq have "Suc n = (p ^ k)^2" by simp with asm show False by blast qed with psi_even_def mangoldt_even_def have rhs: "psi_even (Suc n) = psi_even n" by simp from Suc.IH lhs rhs show ?case by simp qed qed lemma mangoldt_split: "mangoldt d = mangoldt_1 d + mangoldt_even d + mangoldt_odd d" proof (cases "primepow d") case False thus ?thesis by (auto simp: mangoldt_def mangoldt_1_def mangoldt_even_def mangoldt_odd_def dest: primepow_even_imp_primepow primepow_odd_imp_primepow) next case True thus ?thesis by (auto simp: mangoldt_def mangoldt_1_def mangoldt_even_def mangoldt_odd_def primepow_cases) qed lemma psi_split: "psi n = theta n + psi_even n + psi_odd n" by (induction n) (simp_all add: psi_def theta_def psi_even_def psi_odd_def mangoldt_1_def mangoldt_split) lemma psi_mono: "m \ n \ psi m \ psi n" unfolding psi_def by (intro sum_mono2 mangoldt_nonneg) auto lemma psi_pos: "0 \ psi n" by (auto simp: psi_def intro!: sum_nonneg mangoldt_nonneg) lemma mangoldt_odd_pos: "0 \ mangoldt_odd d" using aprimedivisor_gt_Suc_0[of d] by (auto simp: mangoldt_odd_def of_nat_le_iff[of 1, unfolded of_nat_1] Suc_le_eq intro!: ln_ge_zero dest!: primepow_odd_imp_primepow primepow_gt_Suc_0) lemma psi_odd_mono: "m \ n \ psi_odd m \ psi_odd n" using mangoldt_odd_pos sum_mono2[of "{1..n}" "{1..m}" "mangoldt_odd"] by (simp add: psi_odd_def) lemma psi_odd_pos: "0 \ psi_odd n" by (auto simp: psi_odd_def intro!: sum_nonneg mangoldt_odd_pos) lemma psi_theta: "theta n + psi (Discrete.sqrt n) \ psi n" "psi n \ theta n + 2 * psi (Discrete.sqrt n)" using psi_odd_pos[of n] psi_residues_compare[of n] psi_sqrt[of n] psi_split[of n] by simp_all context begin private lemma sum_minus_one: "(\x \ {1..y}. (- 1 :: real) ^ (x + 1)) = (if odd y then 1 else 0)" by (induction y) simp_all private lemma div_invert: fixes x y n :: nat assumes "x > 0" "y > 0" "y \ n div x" shows "x \ n div y" proof - from assms(1,3) have "y * x \ (n div x) * x" by simp also have "\ \ n" by (simp add: minus_mod_eq_div_mult[symmetric]) finally have "y * x \ n" . with assms(2) show ?thesis using div_le_mono[of "y*x" n y] by simp qed lemma sum_expand_lemma: "(\d=1..n. (-1) ^ (d + 1) * psi (n div d)) = (\d = 1..n. (if odd (n div d) then 1 else 0) * mangoldt d)" proof - have **: "x \ n" if "x \ n div y" for x y using div_le_dividend order_trans that by blast have "(\d=1..n. (-1)^(d+1) * psi (n div d)) = (\d=1..n. (-1)^(d+1) * (\e=1..n div d. mangoldt e))" by (simp add: psi_def) also have "\ = (\d = 1..n. \e = 1..n div d. (-1)^(d+1) * mangoldt e)" by (simp add: sum_distrib_left) also from ** have "\ = (\d = 1..n. \e\{y\{1..n}. y \ n div d}. (-1)^(d+1) * mangoldt e)" by (intro sum.cong) auto also have "\ = (\y = 1..n. \x | x \ {1..n} \ y \ n div x. (- 1) ^ (x + 1) * mangoldt y)" by (rule sum.swap_restrict) simp_all also have "\ = (\y = 1..n. \x | x \ {1..n} \ x \ n div y. (- 1) ^ (x + 1) * mangoldt y)" by (intro sum.cong) (auto intro: div_invert) also from ** have "\ = (\y = 1..n. \x \ {1..n div y}. (- 1) ^ (x + 1) * mangoldt y)" by (intro sum.cong) auto also have "\ = (\y = 1..n. (\x \ {1..n div y}. (- 1) ^ (x + 1)) * mangoldt y)" by (intro sum.cong) (simp_all add: sum_distrib_right) also have "\ = (\y = 1..n. (if odd (n div y) then 1 else 0) * mangoldt y)" by (intro sum.cong refl) (simp_all only: sum_minus_one) finally show ?thesis . qed private lemma floor_half_interval: fixes n d :: nat assumes "d \ 0" shows "real (n div d) - real (2 * ((n div 2) div d)) = (if odd (n div d) then 1 else 0)" proof - have "((n div 2) div d) = (n div (2 * d))" by (rule div_mult2_eq[symmetric]) also have "\ = ((n div d) div 2)" by (simp add: mult_ac div_mult2_eq) also have "real (n div d) - real (2 * \) = (if odd (n div d) then 1 else 0)" by (cases "odd (n div d)", cases "n div d = 0 ", simp_all) finally show ?thesis by simp qed lemma fact_expand_psi: "ln (fact n) - 2 * ln (fact (n div 2)) = (\d=1..n. (-1)^(d+1) * psi (n div d))" proof - have "ln (fact n) - 2 * ln (fact (n div 2)) = (\d=1..n. mangoldt d * \n / d\) - 2 * (\d=1..n div 2. mangoldt d * \(n div 2) / d\)" by (simp add: ln_fact_conv_mangoldt) also have "(\d=1..n div 2. mangoldt d * \real (n div 2) / d\) = (\d=1..n. mangoldt d * \real (n div 2) / d\)" by (rule sum.mono_neutral_left) (auto simp: floor_unique[of 0]) also have "2 * \ = (\d=1..n. mangoldt d * 2 * \real (n div 2) / d\)" by (simp add: sum_distrib_left mult_ac) also have "(\d=1..n. mangoldt d * \n / d\) - \ = (\d=1..n. (mangoldt d * \n / d\ - mangoldt d * 2 * \real (n div 2) / d\))" by (simp add: sum_subtractf) also have "\ = (\d=1..n. mangoldt d * (\n / d\ - 2 * \real (n div 2) / d\))" by (simp add: algebra_simps) also have "\ = (\d=1..n. mangoldt d * (if odd(n div d) then 1 else 0))" by (intro sum.cong refl) (simp_all add: floor_conv_div_nat [symmetric] floor_half_interval [symmetric]) also have "\ = (\d=1..n. (if odd(n div d) then 1 else 0) * mangoldt d)" by (simp add: mult_ac) also from sum_expand_lemma[symmetric] have "\ = (\d=1..n. (-1)^(d+1) * psi (n div d))" . finally show ?thesis . qed end lemma psi_expansion_cutoff: assumes "m \ p" shows "(\d=1..2*m. (-1)^(d+1) * psi (n div d)) \ (\d=1..2*p. (-1)^(d+1) * psi (n div d))" "(\d=1..2*p+1. (-1)^(d+1) * psi (n div d)) \ (\d=1..2*m+1. (-1)^(d+1) * psi (n div d))" using assms proof (induction m rule: inc_induct) case (step k) have "(\d = 1..2 * k. (-1)^(d + 1) * psi (n div d)) \ (\d = 1..2 * Suc k. (-1)^(d + 1) * psi (n div d))" by (simp add: psi_mono div_le_mono2) with step.IH(1) show "(\d = 1..2 * k. (-1)^(d + 1) * psi (n div d)) \ (\d = 1..2 * p. (-1)^(d + 1) * psi (n div d))" by simp from step.IH(2) have "(\d = 1..2 * p + 1. (-1)^(d + 1) * psi (n div d)) \ (\d = 1..2 * Suc k + 1. (-1)^(d + 1) * psi (n div d))" . also have "\ \ (\d = 1..2 * k + 1. (-1)^(d + 1) * psi (n div d))" by (simp add: psi_mono div_le_mono2) finally show "(\d = 1..2 * p + 1. (-1)^(d + 1) * psi (n div d)) \ (\d = 1..2 * k + 1. (-1)^(d + 1) * psi (n div d))" . qed simp_all lemma fact_psi_bound_even: assumes "even k" shows "(\d=1..k. (-1)^(d+1) * psi (n div d)) \ ln (fact n) - 2 * ln (fact (n div 2))" proof - have "(\d=1..k. (-1)^(d+1) * psi (n div d)) \ (\d = 1..n. (- 1) ^ (d + 1) * psi (n div d))" proof (cases "k \ n") case True with psi_expansion_cutoff(1)[of "k div 2" "n div 2" n] have "(\d=1..2*(k div 2). (-1)^(d+1) * psi (n div d)) \ (\d = 1..2*(n div 2). (- 1) ^ (d + 1) * psi (n div d))" by simp also from assms have "2*(k div 2) = k" by simp also have "(\d = 1..2*(n div 2). (- 1) ^ (d + 1) * psi (n div d)) \ (\d = 1..n. (- 1) ^ (d + 1) * psi (n div d))" proof (cases "even n") case True then show ?thesis by simp next case False from psi_pos have "(\d = 1..2*(n div 2). (- 1) ^ (d + 1) * psi (n div d)) \ (\d = 1..2*(n div 2) + 1. (- 1) ^ (d + 1) * psi (n div d))" by simp with False show ?thesis by simp qed finally show ?thesis . next case False hence *: "n div 2 \ (k-1) div 2" by simp have "(\d=1..k. (-1)^(d+1) * psi (n div d)) \ (\d=1..2*((k-1) div 2) + 1. (-1)^(d+1) * psi (n div d))" proof (cases "k = 0") case True with psi_pos show ?thesis by simp next case False with sum.cl_ivl_Suc[of "\d. (-1)^(d+1) * psi (n div d)" 1 "k-1"] have "(\d=1..k. (-1)^(d+1) * psi (n div d)) = (\d=1..k-1. (-1)^(d+1) * psi (n div d)) + (-1)^(k+1) * psi (n div k)" by simp also from assms psi_pos have "(-1)^(k+1) * psi (n div k) \ 0" by simp also from assms False have "k-1 = 2*((k-1) div 2) + 1" by presburger finally show ?thesis by simp qed also from * psi_expansion_cutoff(2)[of "n div 2" "(k-1) div 2" n] have "\ \ (\d=1..2*(n div 2) + 1. (-1)^(d+1) * psi (n div d))" by blast also have "\ \ (\d = 1..n. (- 1) ^ (d + 1) * psi (n div d))" by (cases "even n") (simp_all add: psi_def) finally show ?thesis . qed also from fact_expand_psi have "\ = ln (fact n) - 2 * ln (fact (n div 2))" .. finally show ?thesis . qed lemma fact_psi_bound_odd: assumes "odd k" shows "ln (fact n) - 2 * ln (fact (n div 2)) \ (\d=1..k. (-1)^(d+1) * psi (n div d))" proof - from fact_expand_psi have "ln (fact n) - 2 * ln (fact (n div 2)) = (\d = 1..n. (- 1) ^ (d + 1) * psi (n div d))" . also have "\ \ (\d=1..k. (-1)^(d+1) * psi (n div d))" proof (cases "k \ n") case True have "(\d=1..n. (-1)^(d+1) * psi (n div d)) \ ( \d=1..2*(n div 2)+1. (-1)^(d+1) * psi (n div d))" by (cases "even n") (simp_all add: psi_pos) also from True assms psi_expansion_cutoff(2)[of "k div 2" "n div 2" n] have "\ \ (\d=1..k. (-1)^(d+1) * psi (n div d))" by simp finally show ?thesis . next case False have "(\d=1..n. (-1)^(d+1) * psi (n div d)) \ (\d=1..2*((n+1) div 2). (-1)^(d+1) * psi (n div d))" by (cases "even n") (simp_all add: psi_def) also from False assms psi_expansion_cutoff(1)[of "(n+1) div 2" "k div 2" n] have "(\d=1..2*((n+1) div 2). (-1)^(d+1) * psi (n div d)) \ (\d=1..2*(k div 2). (-1)^(d+1) * psi (n div d))" by simp also from assms have "\ \ (\d=1..k. (-1)^(d+1) * psi (n div d))" by (auto elim: oddE simp: psi_pos) finally show ?thesis . qed finally show ?thesis . qed lemma fact_psi_bound_2_3: "psi n - psi (n div 2) \ ln (fact n) - 2 * ln (fact (n div 2))" "ln (fact n) - 2 * ln (fact (n div 2)) \ psi n - psi (n div 2) + psi (n div 3)" proof - show "psi n - psi (n div 2) \ ln (fact n) - 2 * ln (fact (n div 2))" by (rule psi_bounds_ln_fact (2)) next from fact_psi_bound_odd[of 3 n] have "ln (fact n) - 2 * ln (fact (n div 2)) \ (\d = 1..3. (- 1) ^ (d + 1) * psi (n div d))" by simp also have "\ = psi n - psi (n div 2) + psi (n div 3)" by (simp add: sum.atLeast_Suc_atMost numeral_2_eq_2) finally show "ln (fact n) - 2 * ln (fact (n div 2)) \ psi n - psi (n div 2) + psi (n div 3)" . qed lemma ub_ln_1200: "ln 1200 \ 57 / (8 :: real)" proof - have "Some (Float 57 (-3)) = ub_ln 8 1200" by code_simp from ub_ln(1)[OF this] show ?thesis by simp qed lemma psi_double_lemma: assumes "n \ 1200" shows "real n / 6 \ psi n - psi (n div 2)" proof - from ln_fact_diff_bounds have "\ln (fact n) - 2 * ln (fact (n div 2)) - real n * ln 2\ \ 4 * ln (real (if n = 0 then 1 else n)) + 3" . with assms have "ln (fact n) - 2 * ln (fact (n div 2)) \ real n * ln 2 - 4 * ln (real n) - 3" by simp moreover have "real n * ln 2 - 4 * ln (real n) - 3 \ 2 / 3 * n" proof (rule overpower_lemma[of "\n. 2/3 * n" 1200]) show "2 / 3 * 1200 \ 1200 * ln 2 - 4 * ln 1200 - (3::real)" using ub_ln_1200 ln_2_ge by linarith next fix x::real assume "1200 \ x" then have "0 < x" by simp show "((\x. x * ln 2 - 4 * ln x - 3 - 2 / 3 * x) has_real_derivative ln 2 - 4 / x - 2 / 3) (at x)" by (rule derivative_eq_intros refl | simp add: \0 < x\)+ next fix x::real assume "1200 \ x" then have "12 / x \ 12 / 1200" by simp then have "0 \ 0.67 - 4 / x - 2 / 3" by simp also have "0.67 \ ln (2::real)" using ln_2_ge by simp finally show "0 \ ln 2 - 4 / x - 2 / 3" by simp next from assms show "1200 \ real n" by simp qed ultimately have "2 / 3 * real n \ ln (fact n) - 2 * ln (fact (n div 2))" by simp with psi_ubound_3_2[of "n div 3"] have "n/6 + psi (n div 3) \ ln (fact n) - 2 * ln (fact (n div 2))" by simp with fact_psi_bound_2_3[of "n"] show ?thesis by simp qed lemma theta_double_lemma: assumes "n \ 1200" shows "theta (n div 2) < theta n" proof - from psi_theta[of "n div 2"] psi_pos[of "Discrete.sqrt (n div 2)"] have theta_le_psi_n_2: "theta (n div 2) \ psi (n div 2)" by simp have "(Discrete.sqrt n * 18)^2 \ 324 * n" by simp from mult_less_cancel2[of "324" "n" "n"] assms have "324 * n < n^2" by (simp add: power2_eq_square) with \(Discrete.sqrt n * 18)^2 \ 324 * n\ have "(Discrete.sqrt n*18)^2 < n^2" by presburger with power2_less_imp_less assms have "Discrete.sqrt n * 18 < n" by blast with psi_ubound_3_2[of "Discrete.sqrt n"] have "2 * psi (Discrete.sqrt n) < n / 6" by simp with psi_theta[of "n"] have psi_lt_theta_n: "psi n - n / 6 < theta n" by simp from psi_double_lemma[OF assms(1)] have "psi (n div 2) \ psi n - n / 6" by simp with theta_le_psi_n_2 psi_lt_theta_n show ?thesis by simp qed subsection \Proof of the main result\ lemma theta_mono: "mono theta" by (auto simp: theta_def [abs_def] intro!: monoI sum_mono2) lemma theta_lessE: assumes "theta m < theta n" "m \ 1" obtains p where "p \ {m<..n}" "prime p" proof - from mono_invE[OF theta_mono assms(1)] have "m \ n" by blast hence "theta n = theta m + (\p\{m<..n}. if prime p then ln (real p) else 0)" unfolding theta_def using assms(2) by (subst sum.union_disjoint [symmetric]) (auto simp: ivl_disj_un) also note assms(1) finally have "(\p\{m<..n}. if prime p then ln (real p) else 0) \ 0" by simp then obtain p where "p \ {m<..n}" "(if prime p then ln (real p) else 0) \ 0" by (rule sum.not_neutral_contains_not_neutral) thus ?thesis using that[of p] by (auto intro!: exI[of _ p] split: if_splits) qed theorem bertrand: fixes n :: nat assumes "n > 1" shows "\p\{n<..<2*n}. prime p" proof cases assume n_less: "n < 600" define prime_constants where "prime_constants = {2, 3, 5, 7, 13, 23, 43, 83, 163, 317, 631::nat}" from \n > 1\ n_less have "\p \ prime_constants. n < p \ p < 2 * n" unfolding bex_simps greaterThanLessThan_iff prime_constants_def by presburger moreover have "\p\prime_constants. prime p" unfolding prime_constants_def ball_simps HOL.simp_thms by (intro conjI; pratt (silent)) ultimately show ?thesis unfolding greaterThanLessThan_def greaterThan_def lessThan_def by blast next assume n: "\(n < 600)" from n have "theta n < theta (2 * n)" using theta_double_lemma[of "2 * n"] by simp with assms obtain p where "p \ {n<..2*n}" "prime p" by (auto elim!: theta_lessE) moreover from assms have "\prime (2*n)" by (auto dest!: prime_product) with \prime p\ have "p \ 2 * n" by auto ultimately show ?thesis by auto qed subsection \Proof of Mertens' first theorem\ text \ The following proof of Mertens' first theorem was ported from John Harrison's HOL Light proof by Larry Paulson: \ lemma sum_integral_ubound_decreasing': fixes f :: "real \ real" assumes "m \ n" and der: "\x. x \ {of_nat m - 1..of_nat n} \ (g has_field_derivative f x) (at x)" and le: "\x y. \real m - 1 \ x; x \ y; y \ real n\ \ f y \ f x" shows "(\k = m..n. f (of_nat k)) \ g (of_nat n) - g (of_nat m - 1)" proof - have "(\k = m..n. f (of_nat k)) \ (\k = m..n. g (of_nat(Suc k) - 1) - g (of_nat k - 1))" proof (rule sum_mono, clarsimp) fix r assume r: "m \ r" "r \ n" hence "\z>real r - 1. z < real r \ g (real r) - g (real r - 1) = (real r - (real r - 1)) * f z" using assms by (intro MVT2) auto hence "\z\{of_nat r - 1..of_nat r}. g (real r) - g (real r - 1) = f z" by auto then obtain u::real where u: "u \ {of_nat r - 1..of_nat r}" and eq: "g r - g (of_nat r - 1) = f u" by blast have "real m \ u + 1" using r u by auto then have "f (of_nat r) \ f u" using r(2) and u by (intro le) auto then show "f (of_nat r) \ g r - g (of_nat r - 1)" by (simp add: eq) qed also have "\ \ g (of_nat n) - g (of_nat m - 1)" using \m \ n\ by (subst sum_Suc_diff) auto finally show ?thesis . qed lemma Mertens_lemma: assumes "n \ 0" shows "\(\d = 1..n. mangoldt d / real d) - ln n\ \ 4" proof - have *: "\abs(s' - nl + n) \ a; abs(s' - s) \ (k - 1) * n - a\ \ abs(s - nl) \ n * k" for s' s k nl a::real by (auto simp: algebra_simps abs_if split: if_split_asm) have le: "\(\d=1..n. mangoldt d * floor (n / d)) - n * ln n + n\ \ 1 + ln n" using ln_fact_bounds ln_fact_conv_mangoldt assms by simp have "\real n * ((\d = 1..n. mangoldt d / real d) - ln n)\ = \((\d = 1..n. real n * mangoldt d / real d) - n * ln n)\" by (simp add: algebra_simps sum_distrib_left) also have "\ \ real n * 4" proof (rule * [OF le]) have "\(\d = 1..n. mangoldt d * \n / d\) - (\d = 1..n. n * mangoldt d / d)\ = \\d = 1..n. mangoldt d * (\n / d\ - n / d)\" by (simp add: sum_subtractf algebra_simps) also have "\ \ psi n" (is "\?sm\ \ ?rhs") proof - have "-?sm = (\d = 1..n. mangoldt d * (n/d - \n/d\))" by (simp add: sum_subtractf algebra_simps) also have "\ \ (\d = 1..n. mangoldt d * 1)" by (intro sum_mono mult_left_mono mangoldt_nonneg) linarith+ finally have "-?sm \ ?rhs" by (simp add: psi_def) moreover have "?sm \ 0" using mangoldt_nonneg by (simp add: mult_le_0_iff sum_nonpos) ultimately show ?thesis by (simp add: abs_if) qed also have "\ \ 3/2 * real n" by (rule psi_ubound_3_2) also have "\\ (4 - 1) * real n - (1 + ln n)" using ln_le_minus_one [of n] assms by (simp add: divide_simps) finally show "\(\d = 1..n. mangoldt d * real_of_int \real n / real d\) - (\d = 1..n. real n * mangoldt d / real d)\ \ (4 - 1) * real n - (1 + ln n)" . qed finally have "\real n * ((\d = 1..n. mangoldt d / real d) - ln n)\ \ real n * 4" . then show ?thesis using assms mult_le_cancel_left_pos by (simp add: abs_mult) qed lemma Mertens_mangoldt_versus_ln: assumes "I \ {1..n}" shows "\(\i\I. mangoldt i / i) - (\p | prime p \ p \ I. ln p / p)\ \ 3" (is "\?lhs\ \ 3") proof (cases "n = 0") case True with assms show ?thesis by simp next case False have "finite I" using assms finite_subset by blast have "0 \ (\i\I. mangoldt i / i - (if prime i then ln i / i else 0))" using mangoldt_nonneg by (intro sum_nonneg) simp_all moreover have "\ \ (\i = 1..n. mangoldt i / i - (if prime i then ln i / i else 0))" using assms by (intro sum_mono2) (auto simp: mangoldt_nonneg) ultimately have *: "\\i\I. mangoldt i / i - (if prime i then ln i / i else 0)\ \ \\i = 1..n. mangoldt i / i - (if prime i then ln i / i else 0)\" by linarith moreover have "?lhs = (\i\I. mangoldt i / i - (if prime i then ln i / i else 0))" "(\i = 1..n. mangoldt i / i - (if prime i then ln i / i else 0)) = (\d = 1..n. mangoldt d / d) - (\p | prime p \ p \ {1..n}. ln p / p)" using sum.inter_restrict [of _ "\i. ln (real i) / i" "Collect prime", symmetric] by (force simp: sum_subtractf \finite I\ intro: sum.cong)+ ultimately have "\?lhs\ \ \(\d = 1..n. mangoldt d / d) - (\p | prime p \ p \ {1..n}. ln p / p)\" by linarith also have "\ \ 3" proof - have eq_sm: "(\i = 1..n. mangoldt i / i) = (\i \ {p^k |p k. prime p \ p^k \ n \ k \ 1}. mangoldt i / i)" proof (intro sum.mono_neutral_right ballI, goal_cases) case (3 i) hence "\primepow i" by (auto simp: primepow_def Suc_le_eq) thus ?case by (simp add: mangoldt_def) qed (auto simp: Suc_le_eq prime_gt_0_nat) have "(\i = 1..n. mangoldt i / i) - (\p | prime p \ p \ {1..n}. ln p / p) = (\i \ {p^k |p k. prime p \ p^k \ n \ k \ 2}. mangoldt i / i)" proof - have eq: "{p ^ k |p k. prime p \ p ^ k \ n \ 1 \ k} = {p ^ k |p k. prime p \ p ^ k \ n \ 2 \ k} \ {p. prime p \ p \ {1..n}}" (is "?A = ?B \ ?C") proof (intro equalityI subsetI; (elim UnE)?) fix x assume "x \ ?A" then obtain p k where "x = p ^ k" "prime p" "p ^ k \ n" "k \ 1" by auto thus "x \ ?B \ ?C" by (cases "k \ 2") (auto simp: prime_power_iff Suc_le_eq) next fix x assume "x \ ?B" then obtain p k where "x = p ^ k" "prime p" "p ^ k \ n" "k \ 1" by auto thus "x \ ?A" by (auto simp: prime_power_iff Suc_le_eq) next fix x assume "x \ ?C" then obtain p where "x = p ^ 1" "1 \ (1::nat)" "prime p" "p ^ 1 \ n" by auto thus "x \ ?A" by blast qed have eqln: "(\p | prime p \ p \ {1..n}. ln p / p) = (\p | prime p \ p \ {1..n}. mangoldt p / p)" by (rule sum.cong) auto have "(\i \ {p^k |p k. prime p \ p^k \ n \ k \ 1}. mangoldt i / i) = (\i \ {p ^ k |p k. prime p \ p ^ k \ n \ 2 \ k} \ {p. prime p \ p \ {1..n}}. mangoldt i / i)" by (subst eq) simp_all also have "\ = (\i \ {p^k |p k. prime p \ p^k \ n \ k \ 2}. mangoldt i / i) + (\p | prime p \ p \ {1..n}. mangoldt p / p)" by (intro sum.union_disjoint) (auto simp: prime_power_iff finite_nat_set_iff_bounded_le) also have "\ = (\i \ {p^k |p k. prime p \ p^k \ n \ k \ 2}. mangoldt i / i) + (\p | prime p \ p \ {1..n}. ln p / p)" by (simp only: eqln) finally show ?thesis using eq_sm by auto qed have "(\p | prime p \ p \ {1..n}. ln p / p) \ (\p | prime p \ p \ {1..n}. mangoldt p / p)" using mangoldt_nonneg by (auto intro: sum_mono) also have "\ \ (\i = Suc 0..n. mangoldt i / i)" by (intro sum_mono2) (auto simp: mangoldt_nonneg) finally have "0 \ (\i = 1..n. mangoldt i / i) - (\p | prime p \ p \ {1..n}. ln p / p)" by simp moreover have "(\i = 1..n. mangoldt i / i) - (\p | prime p \ p \ {1..n}. ln p / p) \ 3" (is "?M - ?L \ 3") proof - have *: "\q. \j\{1..n}. prime q \ 1 \ q \ q \ n \ (q ^ j = p ^ k \ mangoldt (p ^ k) / real p ^ k \ ln (real q) / real q ^ j)" if "prime p" "p ^ k \ n" "1 \ k" for p k proof - have "mangoldt (p ^ k) / real p ^ k \ ln p / p ^ k" using that by (simp add: divide_simps) moreover have "p \ n" using that self_le_power[of p k] by (simp add: prime_ge_Suc_0_nat) moreover have "k \ n" proof - have "k < 2^k" using of_nat_less_two_power of_nat_less_numeral_power_cancel_iff by blast also have "\ \ p^k" by (simp add: power_mono prime_ge_2_nat that) also have "\ \ n" by (simp add: that) finally show ?thesis by (simp add: that) qed ultimately show ?thesis using prime_ge_1_nat that by auto (use atLeastAtMost_iff in blast) qed have finite: "finite {p ^ k |p k. prime p \ p ^ k \ n \ 1 \ k}" by (rule finite_subset[of _ "{..n}"]) auto have "?M \ (\(x, k)\{p. prime p \ p \ {1..n}} \ {1..n}. ln (real x) / real x ^ k)" by (subst eq_sm, intro sum_le_included [where i = "\(p,k). p^k"]) (insert * finite, auto) also have "\ = (\p | prime p \ p \ {1..n}. (\k = 1..n. ln p / p^k))" by (subst sum.Sigma) auto also have "\ = ?L + (\p | prime p \ p \ {1..n}. (\k = 2..n. ln p / p^k))" by (simp add: comm_monoid_add_class.sum.distrib sum.atLeast_Suc_atMost numeral_2_eq_2) finally have "?M - ?L \ (\p | prime p \ p \ {1..n}. (\k = 2..n. ln p / p^k))" by (simp add: algebra_simps) also have "\ = (\p | prime p \ p \ {1..n}. ln p * (\k = 2..n. inverse p ^ k))" by (simp add: field_simps sum_distrib_left) also have "\ = (\p | prime p \ p \ {1..n}. ln p * (((inverse p)\<^sup>2 - inverse p ^ Suc n) / (1 - inverse p)))" by (intro sum.cong refl) (simp add: sum_gp) also have "\ \ (\p | prime p \ p \ {1..n}. ln p * inverse (real (p * (p - 1))))" by (intro sum_mono mult_left_mono) (auto simp: divide_simps power2_eq_square of_nat_diff mult_less_0_iff) also have "\ \ (\p = 2..n. ln p * inverse (real (p * (p - 1))))" by (rule sum_mono2) (use prime_ge_2_nat in auto) also have "\ \ (\i = 2..n. ln i / (i - 1)\<^sup>2)" unfolding divide_inverse power2_eq_square mult.assoc by (auto intro: sum_mono mult_left_mono mult_right_mono) also have "\ \ 3" proof (cases "n \ 3") case False then show ?thesis proof (cases "n \ 2") case False then show ?thesis by simp next case True then have "n = 2" using False by linarith with ln_le_minus_one [of 2] show ?thesis by simp qed next case True have "(\i = 3..n. ln (real i) / (real (i - Suc 0))\<^sup>2) \ (ln (of_nat n - 1)) - (ln (of_nat n)) - (ln (of_nat n) / (of_nat n - 1)) + 2 * ln 2" proof - have 1: "((\z. ln (z - 1) - ln z - ln z / (z - 1)) has_field_derivative ln x / (x - 1)\<^sup>2) (at x)" if x: "x \ {2..real n}" for x by (rule derivative_eq_intros | rule refl | (use x in \force simp: power2_eq_square divide_simps\))+ have 2: "ln y / (y - 1)\<^sup>2 \ ln x / (x - 1)\<^sup>2" if xy: "2 \ x" "x \ y" "y \ real n" for x y proof (cases "x = y") case False define f' :: "real \ real" where "f' = (\u. ((u - 1)\<^sup>2 / u - ln u * (2 * u - 2)) / (u - 1) ^ 4)" have f'_altdef: "f' u = inverse u * inverse ((u - 1)\<^sup>2) - 2 * ln u / (u - 1) ^ 3" if u: "u \ {x..y}" for u::real unfolding f'_def using u (* TODO ugly *) by (simp add: eval_nat_numeral divide_simps) (simp add: algebra_simps)? have deriv: "((\z. ln z / (z - 1)\<^sup>2) has_field_derivative f' u) (at u)" if u: "u \ {x..y}" for u::real unfolding f'_def by (rule derivative_eq_intros refl | (use u xy in \force simp: divide_simps\))+ hence "\z>x. z < y \ ln y / (y - 1)\<^sup>2 - ln x / (x - 1)\<^sup>2 = (y - x) * f' z" using xy and \x \ y\ by (intro MVT2) auto then obtain \::real where "x < \" "\ < y" and \: "ln y / (y - 1)\<^sup>2 - ln x / (x - 1)\<^sup>2 = (y - x) * f' \" by blast have "f' \ \ 0" proof - have "2/3 \ ln (2::real)" by (fact ln_2_ge') also have "\ \ ln \" using \x < \\ xy by auto finally have "1 \ 2 * ln \" by simp then have *: "\ \ \ * (2 * ln \)" using \x < \\ xy by auto hence "\ - 1 \ ln \ * 2 * \" by (simp add: algebra_simps) hence "1 / (\ * (\ - 1)\<^sup>2) \ ln \ * 2 / (\ - 1) ^ 3" using xy \x < \\ by (simp add: divide_simps power_eq_if) thus ?thesis using xy \x < \\ \\ < y\ by (subst f'_altdef) (auto simp: divide_simps) qed then have "(ln y / (y - 1)\<^sup>2 - ln x / (x - 1)\<^sup>2) \ 0" using \x \ y\ by (simp add: mult_le_0_iff \) then show ?thesis by simp qed simp_all show ?thesis using sum_integral_ubound_decreasing' [OF \3 \ n\, of "\z. ln(z-1) - ln z - ln z / (z - 1)" "\z. ln z / (z-1)\<^sup>2"] 1 2 \3 \ n\ by (auto simp: in_Reals_norm of_nat_diff) qed also have "\ \ 2" proof - have "ln (real n - 1) - ln n \ 0" "0 \ ln n / (real n - 1)" using \3 \ n\ by auto then have "ln (real n - 1) - ln n - ln n / (real n - 1) \ 0" by linarith with ln_2_less_1 show ?thesis by linarith qed also have "\ \ 3 - ln 2" using ln_2_less_1 by (simp add: algebra_simps) finally show ?thesis using True by (simp add: algebra_simps sum.atLeast_Suc_atMost [of 2 n]) qed finally show ?thesis . qed ultimately show ?thesis by linarith qed finally show ?thesis . qed proposition Mertens: assumes "n \ 0" shows "\(\p | prime p \ p \ n. ln p / of_nat p) - ln n\ \ 7" proof - have "\(\d = 1..n. mangoldt d / real d) - (\p | prime p \ p \ {1..n}. ln (real p) / real p)\ \ 7 - 4" using Mertens_mangoldt_versus_ln [of "{1..n}" n] by simp_all also have "{p. prime p \ p \ {1..n}} = {p. prime p \ p \ n}" using atLeastAtMost_iff prime_ge_1_nat by blast finally have "\(\d = 1..n. mangoldt d / real d) - (\p\\. ln (real p) / real p)\ \ 7 - 4" . moreover from assms have "\(\d = 1..n. mangoldt d / real d) - ln n\ \ 4" by (rule Mertens_lemma) ultimately show ?thesis by linarith qed end diff --git a/thys/Buffons_Needle/Buffons_Needle.thy b/thys/Buffons_Needle/Buffons_Needle.thy --- a/thys/Buffons_Needle/Buffons_Needle.thy +++ b/thys/Buffons_Needle/Buffons_Needle.thy @@ -1,534 +1,534 @@ (* File: Buffons_Needle.thy - Author: Manuel Eberl + Author: Manuel Eberl A formal solution of Buffon's needle problem. *) section \Buffon's Needle Problem\ theory Buffons_Needle imports "HOL-Probability.Probability" begin subsection \Auxiliary material\ lemma sin_le_zero': "sin x \ 0" if "x \ -pi" "x \ 0" for x by (metis minus_le_iff neg_0_le_iff_le sin_ge_zero sin_minus that(1) that(2)) subsection \Problem definition\ text \ Consider a needle of length $l$ whose centre has the $x$-coordinate $x$. The following then defines the set of all $x$-coordinates that the needle covers (i.e. the projection of the needle onto the $x$-axis.) \ definition needle :: "real \ real \ real \ real set" where "needle l x \ = closed_segment (x - l / 2 * sin \) (x + l / 2 * sin \)" text_raw \ \begin{figure} \begin{center} \begin{tikzpicture} \coordinate (lefttick) at (-3,0); \coordinate (righttick) at (3,0); \draw (lefttick) -- (righttick); \draw [thick] (lefttick) ++ (0,0.4) -- ++(0,3); \draw [thick] (righttick) ++ (0,0.4) -- ++(0,3); \coordinate (needle) at (1,2); \newcommand{\needleangle}{55} \newcommand{\needlelength}{{1}} \newcommand{\needlethickness}{0.6pt} \draw ($(lefttick)+(0,4pt)$) -- ($(lefttick)-(0,4pt)$); \draw ($(righttick)+(0,4pt)$) -- ($(righttick)-(0,4pt)$); \draw (0,4pt) -- (0,-4pt); \draw [densely dashed, thin] let \p1 = (needle) in (\x1, 0) -- (needle); \draw [densely dashed, thin] let \p1 = (needle) in (needle) -- (3, \y1); \draw (needle) ++ (15pt,0) arc(0:\needleangle:15pt); \path (needle) -- ++(15pt,0) node [above, midway, yshift=-1.9pt, xshift=1.8pt] {$\scriptstyle\varphi$}; \node [below, xshift=-3.5pt] at ($(lefttick)-(0,4pt)$) {$-\nicefrac{d}{2}$}; \node [below] at ($(righttick)-(0,4pt)$) {$\nicefrac{d}{2}$}; \node [below,yshift=-1pt] at (0,-4pt) {$0$}; \node [below,yshift=-2pt] at (needle |- 0,-4pt) {$x$}; \draw[<->] (needle) ++({\needleangle+90}:5pt) ++(\needleangle:{-\needlelength}) -- ++(\needleangle:2) node [midway, above, rotate=\needleangle] {$\scriptstyle l$}; \draw [line width=0.7pt,fill=white] (needle) ++({\needleangle+90}:\needlethickness) -- ++(\needleangle:\needlelength) arc({\needleangle+90}:{\needleangle-90}:\needlethickness) -- ++(\needleangle:-\needlelength) -- ++(\needleangle:-\needlelength) arc({\needleangle+270}:{\needleangle+90}:\needlethickness) -- ++(\needleangle:\needlelength); \end{tikzpicture} \end{center} \caption{A sketch of the situation in Buffon's needle experiment. There is a needle of length $l$ with its centre at a certain $x$ coordinate, angled at an angle $\varphi$ off the horizontal axis. The two vertical lines are a distance of $d$ apart, each being $\nicefrac{d}{2}$ away from the origin.} \label{fig:buffon} \end{figure} \definecolor{myred}{HTML}{cc2428} \begin{figure}[h] \begin{center} \begin{tikzpicture} \begin{axis}[ xmin=0, xmax=7, ymin=0, ymax=1, width=\textwidth, height=0.6\textwidth, xlabel={$l/d$}, ylabel={$\mathcal P$}, tick style={thin,black}, ylabel style = {rotate=270,anchor=west}, ] \addplot [color=myred, line width=1pt, mark=none,domain=0:1,samples=200] ({x}, {2/pi*x}); \addplot [color=myred, line width=1pt, mark=none,domain=1:7,samples=200] ({x}, {2/pi*(x-sqrt(x*x-1)+acos(1/x)/180*pi)}); \end{axis} \end{tikzpicture} \caption{The probability $\mathcal P$ of the needle hitting one of the lines, as a function of the quotient $l/d$ (where $l$ is the length of the needle and $d$ the horizontal distance between the lines).} \label{fig:buffonplot} \end{center} \end{figure} \ text \ Buffon's Needle problem is then this: Assuming the needle's $x$ position is chosen uniformly at random in a strip of width $d$ centred at the origin, what is the probability that the needle crosses at least one of the left/right boundaries of that strip (located at $x = \pm\frac{1}{2}d$)? We will show that, if we let $x := \nicefrac{l}{d}$, the probability of this is \[ \mathcal P_{l,d} = \begin{cases} \nicefrac{2}{\pi} \cdot x & \text{if}\ l \leq d\\ \nicefrac{2}{\pi}\cdot(x - \sqrt{x^2 - 1} + \arccos (\nicefrac{1}{x})) & \text{if}\ l \geq d \end{cases} \] A plot of this function can be found in Figure~\ref{fig:buffonplot}. \ locale Buffon = fixes d l :: real assumes d: "d > 0" and l: "l > 0" begin definition Buffon :: "(real \ real) measure" where "Buffon = uniform_measure lborel ({-d/2..d/2} \ {-pi..pi})" lemma space_Buffon [simp]: "space Buffon = UNIV" by (simp add: Buffon_def) definition Buffon_set :: "(real \ real) set" where "Buffon_set = {(x,\) \ {-d/2..d/2} \ {-pi..pi}. needle l x \ \ {-d/2, d/2} \ {}}" subsection \Derivation of the solution\ text \ The following form is a bit easier to handle. \ lemma Buffon_set_altdef1: "Buffon_set = {(x,\) \ {-d/2..d/2} \ {-pi..pi}. let a = x - l / 2 * sin \; b = x + l / 2 * sin \ in min a b + d/2 \ 0 \ max a b + d/2 \ 0 \ min a b - d/2 \ 0 \ max a b - d/2 \ 0}" proof - have "(\(x,\). needle l x \ \ {-d/2, d/2} \ {}) = (\(x,\). let a = x - l / 2 * sin \; b = x + l / 2 * sin \ in -d/2 \ min a b \ -d/2 \ max a b \ min a b \ d/2 \ max a b \ d/2)" by (auto simp: needle_def Let_def closed_segment_eq_real_ivl min_def max_def) also have "\ = (\(x,\). let a = x - l / 2 * sin \; b = x + l / 2 * sin \ in min a b + d/2 \ 0 \ max a b + d/2 \ 0 \ min a b - d/2 \ 0 \ max a b - d/2 \ 0)" by (auto simp add: algebra_simps Let_def) finally show ?thesis unfolding Buffon_set_def case_prod_unfold by (intro Collect_cong conj_cong refl) meson qed lemma Buffon_set_altdef2: "Buffon_set = {(x,\) \ {-d/2..d/2} \ {-pi..pi}. abs x \ d / 2 - abs (sin \) * l / 2}" unfolding Buffon_set_altdef1 proof (intro Collect_cong prod.case_cong refl conj_cong) fix x \ assume *: "(x, \) \ {-d/2..d/2} \ {-pi..pi}" let ?P = "\x \. let a = x - l / 2 * sin \; b = x + l / 2 * sin \ in min a b + d/2 \ 0 \ max a b + d/2 \ 0 \ min a b - d/2 \ 0 \ max a b - d/2 \ 0" show "?P x \ \ (d / 2 - \sin \\ * l / 2 \ \x\)" proof (cases "\ \ 0") case True have "x - l / 2 * sin \ \ x + l / 2 * sin \" using l True * by (auto simp: sin_ge_zero) moreover from True and * have "sin \ \ 0" by (auto simp: sin_ge_zero) ultimately show ?thesis using * True by (force simp: field_simps Let_def min_def max_def case_prod_unfold abs_if) next case False with * have "x - l / 2 * sin \ \ x + l / 2 * sin \" using l by (auto simp: sin_le_zero' mult_nonneg_nonpos) moreover from False and * have "sin \ \ 0" by (auto simp: sin_le_zero') ultimately show ?thesis using * False l d by (force simp: field_simps Let_def min_def max_def case_prod_unfold abs_if) qed qed text \ By using the symmetry inherent in the problem, we can reduce the problem to the following set, which corresponds to one quadrant of the original set: \ definition Buffon_set' :: "(real \ real) set" where "Buffon_set' = {(x,\) \ {0..d/2} \ {0..pi}. x \ d / 2 - sin \ * l / 2}" lemma closed_buffon_set [simp, intro, measurable]: "closed Buffon_set" proof - have "Buffon_set = ({-d/2..d/2} \ {-pi..pi}) \ (\z. abs (fst z) + abs (sin (snd z)) * l / 2 - d / 2) -` {0..}" (is "_ = ?A") unfolding Buffon_set_altdef2 by auto also have "closed \" by (intro closed_Int closed_vimage closed_Times) (auto intro!: continuous_intros) finally show ?thesis by simp qed lemma closed_buffon_set' [simp, intro, measurable]: "closed Buffon_set'" proof - have "Buffon_set' = ({0..d/2} \ {0..pi}) \ (\z. fst z + sin (snd z) * l / 2 - d / 2) -` {0..}" (is "_ = ?A") unfolding Buffon_set'_def by auto also have "closed \" by (intro closed_Int closed_vimage closed_Times) (auto intro!: continuous_intros) finally show ?thesis by simp qed lemma measurable_buffon_set [measurable]: "Buffon_set \ sets borel" by measurable lemma measurable_buffon_set' [measurable]: "Buffon_set' \ sets borel" by measurable sublocale prob_space Buffon unfolding Buffon_def proof - have "emeasure lborel ({- d / 2..d / 2} \ {- pi..pi}) = ennreal (2 * d * pi)" unfolding lborel_prod [symmetric] using d by (subst lborel.emeasure_pair_measure_Times) (auto simp: ennreal_mult mult_ac simp flip: ennreal_numeral) also have "\ \ 0 \ \ \ \" using d by auto finally show "prob_space (uniform_measure lborel ({- d / 2..d / 2} \ {- pi..pi}))" by (intro prob_space_uniform_measure) auto qed lemma buffon_prob_aux: "emeasure Buffon {(x,\). needle l x \ \ {-d/2, d/2} \ {}} = emeasure lborel Buffon_set / ennreal (2 * d * pi)" proof - have [measurable]: "A \ B \ sets borel" if "A \ sets borel" "B \ sets borel" for A B :: "real set" using that unfolding borel_prod [symmetric] by simp have "{(x, \). needle l x \ \ {- d / 2, d / 2} \ {}} \ sets borel" by (intro pred_Collect_borel) (simp add: borel_prod [symmetric] needle_def closed_segment_eq_real_ivl case_prod_unfold) hence "emeasure Buffon {(x,\). needle l x \ \ {-d/2, d/2} \ {}} = emeasure lborel (({-d/2..d/2} \ {- pi..pi}) \ {(x,\). needle l x \ \ {-d/2, d/2} \ {}}) / emeasure lborel ({-(d/2)..d/2} \ {-pi..pi})" unfolding Buffon_def Buffon_set_def by (subst emeasure_uniform_measure) simp_all also have "({-d/2..d/2} \ {- pi..pi}) \ {(x, \). needle l x \ \ {-d/2, d/2} \ {}} = Buffon_set" unfolding Buffon_set_def by auto also have "emeasure lborel ({-(d/2)..d/2} \ {-pi..pi}) = ennreal (2 * d * pi)" using d by (simp flip: lborel_prod ennreal_mult add: lborel.emeasure_pair_measure_Times) finally show ?thesis . qed lemma emeasure_buffon_set_conv_buffon_set': "emeasure lborel Buffon_set = 4 * emeasure lborel Buffon_set'" proof - have distr_lborel [simp]: "distr M lborel f = distr M borel f" for M and f :: "real \ real" by (rule distr_cong) simp_all define A where "A = Buffon_set'" define B C D where "B = (\x. (-fst x, snd x)) -` A" and "C = (\x. (fst x, -snd x)) -` A" and "D = (\x. (-fst x, -snd x)) -` A" have meas [measurable]: "(\x::real \ real. (-fst x, snd x)) \ borel_measurable borel" "(\x::real \ real. (fst x, -snd x)) \ borel_measurable borel" "(\x::real \ real. (-fst x, -snd x)) \ borel_measurable borel" unfolding borel_prod [symmetric] by measurable have meas' [measurable]: "A \ sets borel" "B \ sets borel" "C \ sets borel" "D \ sets borel" unfolding A_def B_def C_def D_def by (rule measurable_buffon_set' measurable_sets_borel meas)+ have *: "Buffon_set = A \ B \ C \ D" proof (intro equalityI subsetI, goal_cases) case (1 z) show ?case proof (cases "fst z \ 0"; cases "snd z \ 0") assume "fst z \ 0" "snd z \ 0" with 1 have "z \ A" by (auto split: prod.splits simp: Buffon_set_altdef2 Buffon_set'_def sin_ge_zero A_def B_def) thus ?thesis by blast next assume "\(fst z \ 0)" "snd z \ 0" with 1 have "z \ B" by (auto split: prod.splits simp: Buffon_set_altdef2 Buffon_set'_def sin_ge_zero A_def B_def) thus ?thesis by blast next assume "fst z \ 0" "\(snd z \ 0)" with 1 have "z \ C" by (auto split: prod.splits simp: Buffon_set_altdef2 Buffon_set'_def sin_le_zero' A_def B_def C_def) thus ?thesis by blast next assume "\(fst z \ 0)" "\(snd z \ 0)" with 1 have "z \ D" by (auto split: prod.splits simp: Buffon_set_altdef2 Buffon_set'_def sin_le_zero' A_def B_def D_def) thus ?thesis by blast qed next case (2 z) thus ?case using d l by (auto simp: Buffon_set_altdef2 Buffon_set'_def sin_ge_zero sin_le_zero' A_def B_def C_def D_def) qed have "A \ B = {0} \ ({0..pi} \ {\. sin \ * l - d \ 0})" using d l by (auto simp: Buffon_set'_def A_def B_def C_def D_def) moreover have "emeasure lborel \ = 0" unfolding lborel_prod [symmetric] by (subst lborel.emeasure_pair_measure_Times) simp_all ultimately have AB: "(A \ B) \ null_sets lborel" unfolding lborel_prod [symmetric] by (simp add: null_sets_def) have "C \ D = {0} \ ({-pi..0} \ {\. -sin \ * l - d \ 0})" using d l by (auto simp: Buffon_set'_def A_def B_def C_def D_def) moreover have "emeasure lborel \ = 0" unfolding lborel_prod [symmetric] by (subst lborel.emeasure_pair_measure_Times) simp_all ultimately have CD: "(C \ D) \ null_sets lborel" unfolding lborel_prod [symmetric] by (simp add: null_sets_def) have "A \ D = {}" "B \ C = {}" using d l by (auto simp: Buffon_set'_def A_def D_def B_def C_def) moreover have "A \ C = {(d/2, 0)}" "B \ D = {(-d/2, 0)}" using d l by (auto simp: case_prod_unfold Buffon_set'_def A_def B_def C_def D_def) ultimately have AD: "A \ D \ null_sets lborel" and BC: "B \ C \ null_sets lborel" and AC: "A \ C \ null_sets lborel" and BD: "B \ D \ null_sets lborel" by auto note * also have "emeasure lborel (A \ B \ C \ D) = emeasure lborel (A \ B \ C) + emeasure lborel D" using AB AC AD BC BD CD by (intro emeasure_Un') (auto simp: Int_Un_distrib2) also have "emeasure lborel (A \ B \ C) = emeasure lborel (A \ B) + emeasure lborel C" using AB AC BC using AB AC AD BC BD CD by (intro emeasure_Un') (auto simp: Int_Un_distrib2) also have "emeasure lborel (A \ B) = emeasure lborel A + emeasure lborel B" using AB using AB AC AD BC BD CD by (intro emeasure_Un') (auto simp: Int_Un_distrib2) also have "emeasure lborel B = emeasure (distr lborel lborel (\(x,y). (-x, y))) A" (is "_ = emeasure ?M _") unfolding B_def by (subst emeasure_distr) (simp_all add: case_prod_unfold) also have "?M = lborel" unfolding lborel_prod [symmetric] by (subst pair_measure_distr [symmetric]) (simp_all add: sigma_finite_lborel lborel_distr_uminus) also have "emeasure lborel C = emeasure (distr lborel lborel (\(x,y). (x, -y))) A" (is "_ = emeasure ?M _") unfolding C_def by (subst emeasure_distr) (simp_all add: case_prod_unfold) also have "?M = lborel" unfolding lborel_prod [symmetric] by (subst pair_measure_distr [symmetric]) (simp_all add: sigma_finite_lborel lborel_distr_uminus) also have "emeasure lborel D = emeasure (distr lborel lborel (\(x,y). (-x, -y))) A" (is "_ = emeasure ?M _") unfolding D_def by (subst emeasure_distr) (simp_all add: case_prod_unfold) also have "?M = lborel" unfolding lborel_prod [symmetric] by (subst pair_measure_distr [symmetric]) (simp_all add: sigma_finite_lborel lborel_distr_uminus) finally have "emeasure lborel Buffon_set = of_nat (Suc (Suc (Suc (Suc 0)))) * emeasure lborel A" unfolding of_nat_Suc ring_distribs by simp also have "of_nat (Suc (Suc (Suc (Suc 0)))) = (4 :: ennreal)" by simp finally show ?thesis unfolding A_def . qed text \ It only remains now to compute the measure of @{const Buffon_set'}. We first reduce this problem to a relatively simple integral: \ lemma emeasure_buffon_set': "emeasure lborel Buffon_set' = ennreal (integral {0..pi} (\x. min (d / 2) (sin x * l / 2)))" (is "emeasure lborel ?A = _") proof - have "emeasure lborel ?A = nn_integral lborel (\x. indicator ?A x)" by (intro nn_integral_indicator [symmetric]) simp_all also have "(lborel :: (real \ real) measure) = lborel \\<^sub>M lborel" by (simp only: lborel_prod) also have "nn_integral \ (indicator ?A) = (\\<^sup>+\. \\<^sup>+x. indicator ?A (x, \) \lborel \lborel)" by (subst lborel_pair.nn_integral_snd [symmetric]) (simp_all add: lborel_prod borel_prod) also have "\ = (\\<^sup>+\. \\<^sup>+x. indicator {0..pi} \ * indicator {max 0 (d/2 - sin \ * l / 2) .. d/2} x \lborel \lborel)" using d l by (intro nn_integral_cong) (auto simp: indicator_def field_simps Buffon_set'_def) also have "\ = \\<^sup>+ \. indicator {0..pi} \ * emeasure lborel {max 0 (d / 2 - sin \ * l / 2)..d / 2} \lborel" by (subst nn_integral_cmult) simp_all also have "\ = \\<^sup>+ \. ennreal (indicator {0..pi} \ * min (d / 2) (sin \ * l / 2)) \lborel" (is "_ = ?I") using d l by (intro nn_integral_cong) (auto simp: indicator_def sin_ge_zero max_def min_def) also have "integrable lborel (\\. (d / 2) * indicator {0..pi} \)" by simp hence int: "integrable lborel (\\. indicator {0..pi} \ * min (d / 2) (sin \ * l / 2))" by (rule Bochner_Integration.integrable_bound) (insert l d, auto intro!: AE_I2 simp: indicator_def min_def sin_ge_zero) hence "?I = set_lebesgue_integral lborel {0..pi} (\\. min (d / 2) (sin \ * l / 2))" by (subst nn_integral_eq_integral, assumption) (insert d l, auto intro!: AE_I2 simp: sin_ge_zero min_def indicator_def set_lebesgue_integral_def) also have "\ = ennreal (integral {0..pi} (\x. min (d / 2) (sin x * l / 2)))" (is "_ = ennreal ?I") using int by (subst set_borel_integral_eq_integral) (simp_all add: set_integrable_def) finally show ?thesis by (simp add: lborel_prod) qed text \ We now have to distinguish two cases: The first and easier one is that where the length of the needle, $l$, is less than or equal to the strip width, $d$: \ context assumes l_le_d: "l \ d" begin lemma emeasure_buffon_set'_short: "emeasure lborel Buffon_set' = ennreal l" proof - have "emeasure lborel Buffon_set' = ennreal (integral {0..pi} (\x. min (d / 2) (sin x * l / 2)))" (is "_ = ennreal ?I") by (rule emeasure_buffon_set') also have *: "sin \ * l \ d" if "\ \ 0" "\ \ pi" for \ using mult_mono[OF l_le_d sin_le_one _ sin_ge_zero] that d by (simp add: algebra_simps) have "?I = integral {0..pi} (\x. (l / 2) * sin x)" using l d l_le_d by (intro integral_cong) (auto dest: * simp: min_def sin_ge_zero) also have "\ = l / 2 * integral {0..pi} sin" by simp also have "(sin has_integral (-cos pi - (- cos 0))) {0..pi}" by (intro fundamental_theorem_of_calculus) (auto intro!: derivative_eq_intros simp: has_field_derivative_iff_has_vector_derivative [symmetric]) hence "integral {0..pi} sin = -cos pi - (-cos 0)" by (simp add: has_integral_iff) finally show ?thesis by (simp add: lborel_prod) qed lemma emeasure_buffon_set_short: "emeasure lborel Buffon_set = 4 * ennreal l" by (simp add: emeasure_buffon_set_conv_buffon_set' emeasure_buffon_set'_short l_le_d) lemma prob_short_aux: "Buffon {(x, \). needle l x \ \ {- d / 2, d / 2} \ {}} = ennreal (2 * l / (d * pi))" unfolding buffon_prob_aux emeasure_buffon_set_short using d l by (simp flip: ennreal_mult ennreal_numeral add: divide_ennreal) lemma prob_short: "\

((x,\) in Buffon. needle l x \ \ {-d/2, d/2} \ {}) = 2 * l / (d * pi)" using prob_short_aux unfolding emeasure_eq_measure using l d by (subst (asm) ennreal_inj) auto end text \ The other case where the needle is at least as long as the strip width is more complicated: \ context assumes l_ge_d: "l \ d" begin lemma emeasure_buffon_set'_long: shows "l * (1 - sqrt (1 - (d / l)\<^sup>2)) + arccos (d / l) * d \ 0" and "emeasure lborel Buffon_set' = ennreal (l * (1 - sqrt (1 - (d / l)\<^sup>2)) + arccos (d / l) * d)" proof - define \' where "\' = arcsin (d / l)" have \'_nonneg: "\' \ 0" unfolding \'_def using d l l_ge_d arcsin_le_mono[of 0 "d/l"] by (simp add: \'_def) have \'_le: "\' \ pi / 2" unfolding \'_def using arcsin_bounded[of "d/l"] d l l_ge_d by (simp add: field_simps) have ge_phi': "sin \ \ d / l" if "\ \ \'" "\ \ pi / 2" for \ using arcsin_le_iff[of "d / l" "\"] d l_ge_d that \'_nonneg by (auto simp: \'_def field_simps) have le_phi': "sin \ \ d / l" if "\ \ \'" "\ \ 0" for \ using le_arcsin_iff[of "d / l" "\"] d l_ge_d that \'_le by (auto simp: \'_def field_simps) have "cos \' = sqrt (1 - (d / l)^2)" unfolding \'_def by (rule cos_arcsin) (insert d l l_ge_d, auto simp: field_simps) have "l * (1 - cos \') + arccos (d / l) * d \ 0" using l d l_ge_d by (intro add_nonneg_nonneg mult_nonneg_nonneg arccos_lbound) (auto simp: field_simps) thus "l * (1 - sqrt (1 - (d / l)\<^sup>2)) + arccos (d / l) * d \ 0" by (simp add: \cos \' = sqrt (1 - (d / l)^2)\) let ?f = "(\x. min (d / 2) (sin x * l / 2))" have "emeasure lborel Buffon_set' = ennreal (integral {0..pi} ?f)" (is "_ = ennreal ?I") by (rule emeasure_buffon_set') also have "?I = integral {0..pi/2} ?f + integral {pi/2..pi} ?f" by (rule Henstock_Kurzweil_Integration.integral_combine [symmetric]) (auto intro!: integrable_continuous_real continuous_intros) also have "integral {pi/2..pi} ?f = integral {-pi/2..0} (?f \ (\\. \ + pi))" by (subst integral_shift) (auto intro!: continuous_intros) also have "\ = integral {-(pi/2)..-0} (\x. min (d / 2) (sin (-x) * l / 2))" by (simp add: o_def) also have "\ = integral {0..pi/2} ?f" (is "_ = ?I") by (subst Henstock_Kurzweil_Integration.integral_reflect_real) simp_all also have "\ + \ = 2 * \" by simp also have "?I = integral {0..\'} ?f + integral {\'..pi/2} ?f" using l d l_ge_d \'_nonneg \'_le by (intro Henstock_Kurzweil_Integration.integral_combine [symmetric]) (auto intro!: integrable_continuous_real continuous_intros) also have "integral {0..\'} ?f = integral {0..\'} (\x. l / 2 * sin x)" using l by (intro integral_cong) (auto simp: min_def field_simps dest: le_phi') also have "((\x. l / 2 * sin x) has_integral (- (l / 2 * cos \') - (- (l / 2 * cos 0)))) {0..\'}" using \'_nonneg by (intro fundamental_theorem_of_calculus) (auto simp: has_field_derivative_iff_has_vector_derivative [symmetric] intro!: derivative_eq_intros) hence "integral {0..\'} (\x. l / 2 * sin x) = (1 - cos \') * l / 2" by (simp add: has_integral_iff algebra_simps) also have "integral {\'..pi/2} ?f = integral {\'..pi/2} (\_. d / 2)" using l by (intro integral_cong) (auto simp: min_def field_simps dest: ge_phi') also have "\ = arccos (d / l) * d / 2" using \'_le d l l_ge_d by (subst arccos_arcsin_eq) (auto simp: field_simps \'_def) also note \cos \' = sqrt (1 - (d / l)^2)\ also have "2 * ((1 - sqrt (1 - (d / l)\<^sup>2)) * l / 2 + arccos (d / l) * d / 2) = l * (1 - sqrt (1 - (d / l)\<^sup>2)) + arccos (d / l) * d" using d l by (simp add: field_simps) finally show "emeasure lborel Buffon_set' = ennreal (l * (1 - sqrt (1 - (d / l)\<^sup>2)) + arccos (d / l) * d)" . qed lemma emeasure_set_long: "emeasure lborel Buffon_set = 4 * ennreal (l * (1 - sqrt (1 - (d / l)\<^sup>2)) + arccos (d / l) * d)" by (simp add: emeasure_buffon_set_conv_buffon_set' emeasure_buffon_set'_long l_ge_d) lemma prob_long_aux: shows "2 / pi * ((l / d) - sqrt ((l / d)\<^sup>2 - 1) + arccos (d / l)) \ 0" and "Buffon {(x, \). needle l x \ \ {- d / 2, d / 2} \ {}} = ennreal (2 / pi * ((l / d) - sqrt ((l / d)\<^sup>2 - 1) + arccos (d / l)))" using emeasure_buffon_set'_long(1) proof - have *: "l * sqrt ((l\<^sup>2 - d\<^sup>2) / l\<^sup>2) + 0 \ l + d * arccos (d / l)" using d l_ge_d by (intro add_mono mult_nonneg_nonneg arccos_lbound) (auto simp: field_simps) have "l / d \ sqrt ((l / d)\<^sup>2 - 1)" using l d l_ge_d by (intro real_le_lsqrt) (auto simp: field_simps) thus "2 / pi * ((l / d) - sqrt ((l / d)\<^sup>2 - 1) + arccos (d / l)) \ 0" using d l l_ge_d by (intro mult_nonneg_nonneg add_nonneg_nonneg arccos_lbound) (auto simp: field_simps) have "emeasure Buffon {(x,\). needle l x \ \ {-d/2, d/2} \ {}} = ennreal (4 * (l - l * sqrt (1 - (d / l)\<^sup>2) + arccos (d / l) * d)) / ennreal (2 * d * pi)" using d l l_ge_d * unfolding buffon_prob_aux emeasure_set_long ennreal_numeral [symmetric] by (subst ennreal_mult [symmetric]) (auto intro!: add_nonneg_nonneg mult_nonneg_nonneg simp: field_simps) also have "\ = ennreal ((4 * (l - l * sqrt (1 - (d / l)\<^sup>2) + arccos (d / l) * d)) / (2 * d * pi))" using d l * by (subst divide_ennreal) (auto simp: field_simps) also have "(4 * (l - l * sqrt (1 - (d / l)\<^sup>2) + arccos (d / l) * d)) / (2 * d * pi) = 2 / pi * (l / d - l / d * sqrt ((d / l)^2 * ((l / d)^2 - 1)) + arccos (d / l))" using d l by (simp add: field_simps) also have "l / d * sqrt ((d / l)^2 * ((l / d)^2 - 1)) = sqrt ((l / d) ^ 2 - 1)" using d l l_ge_d unfolding real_sqrt_mult real_sqrt_abs by simp finally show "emeasure Buffon {(x,\). needle l x \ \ {-d/2, d/2} \ {}} = ennreal (2 / pi * ((l / d) - sqrt ((l / d)\<^sup>2 - 1) + arccos (d / l)))" . qed lemma prob_long: "\

((x,\) in Buffon. needle l x \ \ {-d/2, d/2} \ {}) = 2 / pi * ((l / d) - sqrt ((l / d)\<^sup>2 - 1) + arccos (d / l))" using prob_long_aux unfolding emeasure_eq_measure by (subst (asm) ennreal_inj) simp_all end theorem prob_eq: defines "x \ l / d" shows "\

((x,\) in Buffon. needle l x \ \ {-d/2, d/2} \ {}) = (if l \ d then 2 / pi * x else 2 / pi * (x - sqrt (x\<^sup>2 - 1) + arccos (1 / x)))" using prob_short prob_long unfolding x_def by auto end end \ No newline at end of file diff --git a/thys/Comparison_Sort_Lower_Bound/Comparison_Sort_Lower_Bound.thy b/thys/Comparison_Sort_Lower_Bound/Comparison_Sort_Lower_Bound.thy --- a/thys/Comparison_Sort_Lower_Bound/Comparison_Sort_Lower_Bound.thy +++ b/thys/Comparison_Sort_Lower_Bound/Comparison_Sort_Lower_Bound.thy @@ -1,250 +1,250 @@ (* File: Comparison_Sort_Lower_Bound.thy - Author: Manuel Eberl + Author: Manuel Eberl Proof of the lower-bound on worst-case comparisons in a comparison-based sorting algorithm. *) section \Lower bound on costs of comparison-based sorting\ theory Comparison_Sort_Lower_Bound imports Complex_Main Linorder_Relations Stirling_Formula.Stirling_Formula "Landau_Symbols.Landau_More" begin subsection \Abstract description of sorting algorithms\ text \ We have chosen to model a sorting algorithm in the following way: A sorting algorithm takes a list with distinct elements and a linear ordering on these elements, and it returns a list with the same elements that is sorted w.\,r.\,t.\ the given ordering. The use of an explicit ordering means that the algorithm must look at the ordering, i.\,e.\ it has to use pair-wise comparison of elements, since all the information that is relevant for producing the correct sorting is in the ordering; the elements themselves are irrelevant. Furthermore, we record the number of comparisons that the algorithm makes by not giving it the relation explicitly, but in the form of a comparison oracle that may be queried. A sorting algorithm (or `sorter') for a fixed input list (but for arbitrary orderings) can then be written as a recursive datatype that is either the result (the sorted list) or a comparison query consisting of two elements and a continuation that maps the result of the comparison to the remaining computation. \ datatype 'a sorter = Return "'a list" | Query 'a 'a "bool \ 'a sorter" text \ Cormen~\emph{et\ al.}~\cite{cormen}\ use a similar `decision tree' model where an sorting algorithm for lists of fixed size $n$ is modelled as a binary tree where each node is a comparison of two elements. They also demand that every leaf in the tree be reachable in order to avoid `dead' subtrees (if the algorithm makes redundant comparisons, there may be branches that can never be taken). Then, the worst-case number of comparisons made is simply the height of the tree. We chose a subtly different model that does not have this restriction on the algorithm but instead uses a more semantic way of counting the worst-case number of comparisons: We simply use the maximum number of comparisons that occurs for any of the (finitely many) inputs. We therefore first define a function that counts the number of queries for a specific ordering and then a function that counts the number of queries in the worst case (ranging over a given set of allowed orderings; typically, this will be the set of all linear orders on the list). \ primrec count_queries :: "('a \ 'a) set \ 'a sorter \ nat" where "count_queries _ (Return _) = 0" | "count_queries R (Query a b f) = Suc (count_queries R (f ((a, b) \ R)))" definition count_wc_queries :: "('a \ 'a) set set \ 'a sorter \ nat" where "count_wc_queries Rs sorter = (if Rs = {} then 0 else Max ((\R. count_queries R sorter) ` Rs))" lemma count_wc_queries_empty [simp]: "count_wc_queries {} sorter = 0" by (simp add: count_wc_queries_def) lemma count_wc_queries_aux: assumes "\R. R \ Rs \ sorter = sorter' R" "Rs \ Rs'" "finite Rs'" shows "count_wc_queries Rs sorter \ Max ((\R. count_queries R (sorter' R)) ` Rs')" proof (cases "Rs = {}") case False hence "count_wc_queries Rs sorter = Max ((\R. count_queries R sorter) ` Rs)" by (simp add: count_wc_queries_def) also have "(\R. count_queries R sorter) ` Rs = (\R. count_queries R (sorter' R)) ` Rs" by (intro image_cong refl) (simp_all add: assms) also have "Max \ \ Max ((\R. count_queries R (sorter' R)) ` Rs')" using False by (intro Max_mono assms image_mono finite_imageI) auto finally show ?thesis . qed simp_all primrec eval_sorter :: "('a \ 'a) set \ 'a sorter \ 'a list" where "eval_sorter _ (Return ys) = ys" | "eval_sorter R (Query a b f) = eval_sorter R (f ((a,b) \ R))" text \ We now get an obvious bound on the maximum number of different results that a given sorter can produce. \ lemma card_range_eval_sorter: assumes "finite Rs" shows "card ((\R. eval_sorter R e) ` Rs) \ 2 ^ count_wc_queries Rs e" using assms proof (induction e arbitrary: Rs) case (Return xs Rs) have *: "(\R. eval_sorter R (Return xs)) ` Rs = (if Rs = {} then {} else {xs})" by auto show ?case by (subst *) auto next case (Query a b f Rs) have "f True \ range f" "f False \ range f" by simp_all note IH = this [THEN Query.IH] let ?Rs1 = "{R\Rs. (a, b) \ R}" and ?Rs2 = "{R\Rs. (a, b) \ R}" let ?A = "(\R. eval_sorter R (f True)) ` ?Rs1" and ?B = "(\R. eval_sorter R (f False)) ` ?Rs2" from Query.prems have fin: "finite ?Rs1" "finite ?Rs2" by simp_all have *: "(\R. eval_sorter R (Query a b f)) ` Rs \ ?A \ ?B" proof (intro subsetI, elim imageE, goal_cases) case (1 xs R) thus ?case by (cases "(a,b) \ R") auto qed show ?case proof (cases "Rs = {}") case False have "card ((\R. eval_sorter R (Query a b f)) ` Rs) \ card (?A \ ?B)" by (intro card_mono finite_UnI finite_imageI fin *) also have "\ \ card ?A + card ?B" by (rule card_Un_le) also have "\ \ 2 ^ count_wc_queries ?Rs1 (f True) + 2 ^ count_wc_queries ?Rs2 (f False)" by (intro add_mono IH fin) also have "count_wc_queries ?Rs1 (f True) \ Max ((\R. count_queries R (f ((a,b)\R))) ` Rs)" by (intro count_wc_queries_aux Query.prems) auto also have "count_wc_queries ?Rs2 (f False) \ Max ((\R. count_queries R (f ((a,b)\R))) ` Rs)" by (intro count_wc_queries_aux Query.prems) auto also have "2 ^ \ + 2 ^ \ = (2 ^ Suc \ :: nat)" by simp also have "Suc (Max ((\R. count_queries R (f ((a,b)\R))) ` Rs)) = Max (Suc ` ((\R. count_queries R (f ((a,b)\R))) ` Rs))" using False by (intro mono_Max_commute finite_imageI Query.prems) (auto simp: incseq_def) also have "Suc ` ((\R. count_queries R (f ((a,b)\R))) ` Rs) = (\R. Suc (count_queries R (f ((a,b)\R)))) ` Rs" by (simp add: image_image) also have "Max \ = count_wc_queries Rs (Query a b f)" using False by (auto simp add: count_wc_queries_def) finally show ?thesis by - simp_all qed simp_all qed text \ The following predicate describes what constitutes a valid sorting result for a given ordering and a given input list. Note that when the ordering is linear, the result is actually unique. \ definition is_sorting :: "('a \ 'a) set \ 'a list \ 'a list \ bool" where "is_sorting R xs ys \ (mset xs = mset ys) \ sorted_wrt R ys" subsection \Lower bounds on number of comparisons\ text \ For a list of $n$ distinct elements, there are $n!$ linear orderings on $n$ elements, each of which leads to a different result after sorting the original list. Since a sorter can produce at most $2^k$ different results with $k$ comparisons, we get the bound $2^k \geq n!$: \ theorem fixes sorter :: "'a sorter" and xs :: "'a list" assumes distinct: "distinct xs" assumes sorter: "\R. linorder_on (set xs) R \ is_sorting R xs (eval_sorter R sorter)" defines "Rs \ {R. linorder_on (set xs) R}" shows two_power_count_queries_ge: "fact (length xs) \ (2 ^ count_wc_queries Rs sorter :: nat)" and count_queries_ge: "log 2 (fact (length xs)) \ real (count_wc_queries Rs sorter)" proof - have "Rs \ Pow (set xs \ set xs)" by (auto simp: Rs_def linorder_on_def refl_on_def) hence fin: "finite Rs" by (rule finite_subset) simp_all from assms have "fact (length xs) = card (permutations_of_set (set xs))" by (simp add: distinct_card) also have "permutations_of_set (set xs) \ (\R. eval_sorter R sorter) ` Rs" proof (rule subsetI, goal_cases) case (1 ys) define R where "R = linorder_of_list ys" define zs where "zs = eval_sorter R sorter" from 1 and distinct have mset_ys: "mset ys = mset xs" by (auto simp: set_eq_iff_mset_eq_distinct permutations_of_set_def) from 1 have *: "linorder_on (set xs) R" unfolding R_def using linorder_linorder_of_list[of ys] by (simp add: permutations_of_set_def) from sorter[OF this] have "mset xs = mset zs" "sorted_wrt R zs" by (simp_all add: is_sorting_def zs_def) moreover from 1 have "sorted_wrt R ys" unfolding R_def by (intro sorted_wrt_linorder_of_list) (simp_all add: permutations_of_set_def) ultimately have "zs = ys" by (intro sorted_wrt_linorder_unique[OF *]) (simp_all add: mset_ys) moreover from * have "R \ Rs" by (simp add: Rs_def) ultimately show ?case unfolding zs_def by blast qed hence "card (permutations_of_set (set xs)) \ card ((\R. eval_sorter R sorter) ` Rs)" by (intro card_mono finite_imageI fin) also from fin have "\ \ 2 ^ count_wc_queries Rs sorter" by (rule card_range_eval_sorter) finally show *: "fact (length xs) \ (2 ^ count_wc_queries Rs sorter :: nat)" . have "ln (fact (length xs)) = ln (real (fact (length xs)))" by simp also have "\ \ ln (real (2 ^ count_wc_queries Rs sorter))" proof (subst ln_le_cancel_iff) show "real (fact (length xs)) \ real (2 ^ count_wc_queries Rs sorter)" by (subst of_nat_le_iff) (rule *) qed simp_all also have "\ = real (count_wc_queries Rs sorter) * ln 2" by (simp add: ln_realpow) finally have "real (count_wc_queries Rs sorter) \ ln (fact (length xs)) / ln 2" by (simp add: field_simps) also have "ln (fact (length xs)) / ln 2 = log 2 (fact (length xs))" by (simp add: log_def) finally show **: "log 2 (fact (length xs)) \ real (count_wc_queries Rs sorter)" . qed (* TODO: Good example for automation. Also, move. *) lemma ln_fact_bigo: "(\n. ln (fact n) - (ln (2 * pi * n) / 2 + n * ln n - n)) \ O(\n. 1 / n)" and asymp_equiv_ln_fact [asymp_equiv_intros]: "(\n. ln (fact n)) \[at_top] (\n. n * ln n)" proof - include asymp_equiv_notation define f where "f = (\n. ln (2 * pi * real n) / 2 + real n * ln (real n) - real n)" have "eventually (\n. ln (fact n) - f n \ {0..1/(12*real n)}) at_top" using eventually_gt_at_top[of "1::nat"] proof eventually_elim case (elim n) with ln_fact_bounds[of n] show ?case by (simp add: f_def) qed hence "eventually (\n. norm (ln (fact n) - f n) \ (1/12) * norm (1 / real n)) at_top" using eventually_gt_at_top[of "0::nat"] by eventually_elim (simp_all add: field_simps) thus "(\n. ln (fact n) - f n) \ O(\n. 1 / real n)" using bigoI[of "\n. ln (fact n) - f n" "1/12" "\n. 1 / real n"] by simp also have "(\n. 1 / real n) \ o(f)" unfolding f_def by (intro smallo_real_nat_transfer) simp finally have "(\n. f n + (ln (fact n) - f n)) \ f" by (subst asymp_equiv_add_right) simp_all hence "(\n. ln (fact n)) \ f" by simp also have "f \ (\n. n * ln n + (ln (2*pi*n)/2 - n))" by (simp add: f_def algebra_simps) also have "\ \ (\n. n * ln n)" by (subst asymp_equiv_add_right) auto finally show "(\n. ln (fact n)) \ (\n. n * ln n)" . qed text \ This leads to the following well-known Big-Omega bound on the number of comparisons that a general sorting algorithm has to make: \ corollary count_queries_bigomega: fixes sorter :: "nat \ nat sorter" assumes sorter: "\n R. linorder_on {.. is_sorting R [0.. \n. {R. linorder_on {..n. count_wc_queries (Rs n) (sorter n)) \ \(\n. n * ln n)" proof - have "(\n. n * ln n) \ \(\n. ln (fact n))" by (subst bigtheta_sym) (intro asymp_equiv_imp_bigtheta asymp_equiv_intros) also have "(\n. ln (fact n)) \ \(\n. log 2 (fact n))" by (simp add: log_def) also have "(\n. log 2 (fact n)) \ O(\n. count_wc_queries (Rs n) (sorter n))" proof (intro bigoI[where c = 1] always_eventually allI, goal_cases) case (1 n) have "norm (log 2 (fact n)) = log 2 (fact (length [0.. \ real (count_wc_queries (Rs n) (sorter n))" using count_queries_ge[of "[0.. = 1 * norm \" by simp finally show ?case by simp qed finally show ?thesis by (simp add: bigomega_iff_bigo) qed end diff --git a/thys/Descartes_Sign_Rule/Descartes_Sign_Rule.thy b/thys/Descartes_Sign_Rule/Descartes_Sign_Rule.thy --- a/thys/Descartes_Sign_Rule/Descartes_Sign_Rule.thy +++ b/thys/Descartes_Sign_Rule/Descartes_Sign_Rule.thy @@ -1,829 +1,829 @@ (* File: Descartes_Sign_Rule.thy - Author: Manuel Eberl + Author: Manuel Eberl Descartes' Rule of Signs, which relates the number of positive real roots of a polynomial with the number of sign changes in its coefficient list. *) section \Sign changes and Descartes' Rule of Signs\ theory Descartes_Sign_Rule imports Complex_Main "HOL-Computational_Algebra.Polynomial" begin lemma op_plus_0: "((+) (0 :: 'a :: monoid_add)) = id" by auto lemma filter_dropWhile: "filter (\x. \P x) (dropWhile P xs) = filter (\x. \P x) xs" by (induction xs) simp_all subsection \Polynomials\ text\ A real polynomial whose leading and constant coefficients have opposite non-zero signs must have a positive root. \ lemma pos_root_exI: assumes "poly p 0 * lead_coeff p < (0 :: real)" obtains x where "x > 0" "poly p x = 0" proof - have P: "\x>0. poly p x = (0::real)" if "lead_coeff p > 0" "poly p 0 < 0" for p proof - note that(1) also from poly_pinfty_gt_lc[OF \lead_coeff p > 0\] obtain x0 where "\x. x \ x0 \ poly p x \ lead_coeff p" by auto hence "poly p (max x0 1) \ lead_coeff p" by auto finally have "poly p (max x0 1) > 0" . with that have "\x. x > 0 \ x < max x0 1 \ poly p x = 0" by (intro poly_IVT mult_neg_pos) auto thus "\x>0. poly p x = 0" by auto qed show ?thesis proof (cases "lead_coeff p > 0") case True with assms have "poly p 0 < 0" by (auto simp: mult_less_0_iff) from P[OF True this] that show ?thesis by blast next case False from False assms have "poly (-p) 0 < 0" by (auto simp: mult_less_0_iff) moreover from assms have "p \ 0" by auto with False have "lead_coeff (-p) > 0" by (cases rule: linorder_cases[of "lead_coeff p" 0]) (simp_all add:) ultimately show ?thesis using that P[of "-p"] by auto qed qed text \ Substitute $X$ with $aX$ in a polynomial $p(X)$. This turns all the $X - a$ factors in $p$ into factors of the form $X - 1$. \ definition reduce_root where "reduce_root a p = pcompose p [:0, a:]" lemma reduce_root_pCons: "reduce_root a (pCons c p) = pCons c (smult a (reduce_root a p))" by (simp add: reduce_root_def pcompose_pCons) lemma reduce_root_nonzero [simp]: "a \ 0 \ p \ 0 \ reduce_root a p \ (0 :: 'a :: idom poly)" unfolding reduce_root_def using pcompose_eq_0[of p "[:0, a:]"] by auto subsection \List of partial sums\ text \ We first define, for a given list, the list of accumulated partial sums from left to right: the list @{term "psums xs"} has as its $i$-th entry $\sum_{j=0}^i \mathrm{xs}_i$. \ fun psums where "psums [] = []" | "psums [x] = [x]" | "psums (x#y#xs) = x # psums ((x+y) # xs)" lemma length_psums [simp]: "length (psums xs) = length xs" by (induction xs rule: psums.induct) simp_all lemma psums_Cons: "psums (x#xs) = (x :: 'a :: semigroup_add) # map ((+) x) (psums xs)" by (induction xs rule: psums.induct) (simp_all add: algebra_simps) lemma last_psums: "(xs :: 'a :: monoid_add list) \ [] \ last (psums xs) = sum_list xs" by (induction xs rule: psums.induct) (auto simp add: add.assoc [symmetric] psums_Cons o_def) lemma psums_0_Cons [simp]: "psums (0#xs :: 'a :: monoid_add list) = 0 # psums xs" by (induction xs rule: psums.induct) (simp_all add: algebra_simps) lemma map_uminus_psums: fixes xs :: "'a :: ab_group_add list" shows "map uminus (psums xs) = psums (map uminus xs)" by (induction xs rule: psums.induct) (simp_all) lemma psums_replicate_0_append: "psums (replicate n (0 :: 'a :: monoid_add) @ xs) = replicate n 0 @ psums xs" by (induction n) (simp_all add: psums_Cons op_plus_0) lemma psums_nth: "n < length xs \ psums xs ! n = (\i\n. xs ! i)" proof (induction xs arbitrary: n rule: psums.induct[case_names Nil sng rec]) case (rec x y xs n) show ?case proof (cases n) case (Suc m) from Suc have "psums (x # y # xs) ! n = psums ((x+y) # xs) ! m" by simp also from rec.prems Suc have "\ = (\i\m. ((x+y) # xs) ! i)" by (intro rec.IH) simp_all also have "\ = x + y + (\i=1..m. (y#xs) ! i)" by (auto simp: atLeast0AtMost [symmetric] sum.atLeast_Suc_atMost[of 0]) also have "(\i=1..m. (y#xs) ! i) = (\i=Suc 1..Suc m. (x#y#xs) ! i)" by (subst sum.shift_bounds_cl_Suc_ivl) simp also from Suc have "x + y + \ = (\i\n. (x#y#xs) ! i)" by (auto simp: atLeast0AtMost [symmetric] sum.atLeast_Suc_atMost add_ac) finally show ?thesis . qed simp qed simp_all subsection \Sign changes in a list\ text \ Next, we define the number of sign changes in a sequence. Intuitively, this is the number of times that, when passing through the list, a sign change between one element and the next element occurs (while ignoring all zero entries). We implement this by filtering all zeros from the list of signs, removing all adjacent equal elements and taking the length of the resulting list minus one. \ definition sign_changes :: "('a :: {sgn,zero} list) \ nat" where "sign_changes xs = length (remdups_adj (filter (\x. x \ 0) (map sgn xs))) - 1" lemma sign_changes_Nil [simp]: "sign_changes [] = 0" by (simp add: sign_changes_def) lemma sign_changes_singleton [simp]: "sign_changes [x] = 0" by (simp add: sign_changes_def) lemma sign_changes_cong: assumes "map sgn xs = map sgn ys" shows "sign_changes xs = sign_changes ys" using assms unfolding sign_changes_def by simp lemma sign_changes_Cons_ge: "sign_changes (x # xs) \ sign_changes xs" unfolding sign_changes_def by (simp add: remdups_adj_Cons split: list.split) lemma sign_changes_Cons_Cons_different: fixes x y :: "'a :: linordered_idom" assumes "x * y < 0" shows "sign_changes (x # y # xs) = 1 + sign_changes (y # xs)" proof - from assms have "sgn x = -1 \ sgn y = 1 \ sgn x = 1 \ sgn y = -1" by (auto simp: mult_less_0_iff) thus ?thesis by (fastforce simp: sign_changes_def) qed lemma sign_changes_Cons_Cons_same: fixes x y :: "'a :: linordered_idom" shows "x * y > 0 \ sign_changes (x # y # xs) = sign_changes (y # xs)" by (subst (asm) zero_less_mult_iff) (fastforce simp: sign_changes_def) lemma sign_changes_0_Cons [simp]: "sign_changes (0 # xs :: 'a :: idom_abs_sgn list) = sign_changes xs" by (simp add: sign_changes_def) lemma sign_changes_two: fixes x y :: "'a :: linordered_idom" shows "sign_changes [x,y] = (if x > 0 \ y < 0 \ x < 0 \ y > 0 then 1 else 0)" by (auto simp: sgn_if sign_changes_def mult_less_0_iff) lemma sign_changes_induct [case_names nil sing zero nonzero]: assumes "P []" "\x. P [x]" "\xs. P xs \ P (0#xs)" "\x y xs. x \ 0 \ P ((x + y) # xs) \ P (x # y # xs)" shows "P xs" proof (induction "length xs" arbitrary: xs rule: less_induct) case (less xs) show ?case proof (cases xs rule: psums.cases) fix x y xs' assume "xs = x # y # xs'" with assms less show ?thesis by (cases "x = 0") auto qed (insert less assms, auto) qed lemma sign_changes_filter: fixes xs :: "'a :: linordered_idom list" shows "sign_changes (filter (\x. x \ 0) xs) = sign_changes xs" by (simp add: sign_changes_def filter_map o_def sgn_0_0) lemma sign_changes_Cons_Cons_0: fixes xs :: "'a :: linordered_idom list" shows "sign_changes (x # 0 # xs) = sign_changes (x # xs)" by (subst (1 2) sign_changes_filter [symmetric]) simp_all lemma sign_changes_uminus: fixes xs :: "'a :: linordered_idom list" shows "sign_changes (map uminus xs) = sign_changes xs" proof - have "sign_changes (map uminus xs) = length (remdups_adj [x\map sgn (map uminus xs) . x \ 0]) - 1" unfolding sign_changes_def .. also have "map sgn (map uminus xs) = map uminus (map sgn xs)" by (auto simp: sgn_minus) also have "remdups_adj (filter (\x. x \ 0) \) = map uminus (remdups_adj (filter (\x. x \ 0) (map sgn xs)))" by (subst filter_map, subst remdups_adj_map_injective) (simp_all add: o_def) also have "length \ - 1 = sign_changes xs" by (simp add: sign_changes_def) finally show ?thesis . qed lemma sign_changes_replicate: "sign_changes (replicate n x) = 0" by (simp add: sign_changes_def remdups_adj_replicate filter_replicate) lemma sign_changes_decompose: assumes "x \ (0 :: 'a :: linordered_idom)" shows "sign_changes (xs @ x # ys) = sign_changes (xs @ [x]) + sign_changes (x # ys)" proof - have "sign_changes (xs @ x # ys) = length (remdups_adj ([x\map sgn xs . x \ 0] @ sgn x # [x\map sgn ys . x \ 0])) - 1" by (simp add: sgn_0_0 assms sign_changes_def) also have "\ = sign_changes (xs @ [x]) + sign_changes (x # ys)" by (subst remdups_adj_append) (simp add: sign_changes_def assms sgn_0_0) finally show ?thesis . qed text \ If the first and the last entry of a list are non-zero, its number of sign changes is even if and only if the first and the last element have the same sign. This will be important later to establish the base case of Descartes' Rule. (if there are no positive roots, the number of sign changes is even) \ lemma even_sign_changes_iff: assumes "xs \ ([] :: 'a :: linordered_idom list)" "hd xs \ 0" "last xs \ 0" shows "even (sign_changes xs) \ sgn (hd xs) = sgn (last xs)" using assms proof (induction "length xs" arbitrary: xs rule: less_induct) case (less xs) show ?case proof (cases xs) case (Cons x xs') note x = this show ?thesis proof (cases xs') case (Cons y xs'') note y = this show ?thesis proof (rule linorder_cases[of "x*y" 0]) assume xy: "x*y = 0" with x y less(1,3,4) show ?thesis by (auto simp: sign_changes_Cons_Cons_0) next assume xy: "x*y > 0" with less(1,4) show ?thesis by (auto simp add: x y sign_changes_Cons_Cons_same zero_less_mult_iff) next assume xy: "x*y < 0" moreover from xy have "sgn x = - sgn y" by (auto simp: mult_less_0_iff) moreover have "even (sign_changes (y # xs'')) \ sgn (hd (y # xs'')) = sgn (last (y # xs''))" using xy less.prems by (intro less) (auto simp: x y) moreover from xy less.prems have "sgn y = sgn (last xs) \ -sgn y \ sgn (last xs)" by (auto simp: sgn_if) ultimately show ?thesis by (auto simp: sign_changes_Cons_Cons_different x y) qed qed (auto simp: x) qed (insert less.prems, simp_all) qed subsection \Arthan's lemma\ context begin text \ We first prove an auxiliary lemma that allows us to assume w.l.o.g. that the first element of the list is non-negative, similarly to what Arthan does in his proof. \ private lemma arthan_wlog [consumes 3, case_names nonneg lift]: fixes xs :: "'a :: linordered_idom list" assumes "xs \ []" "last xs \ 0" "x + y + sum_list xs = 0" assumes "\x y xs. xs \ [] \ last xs \ 0 \ x + y + sum_list xs = 0 \ x \ 0 \ P x y xs" assumes "\x y xs. xs \ [] \ P x y xs \ P (-x) (-y) (map uminus xs)" shows "P x y xs" proof (cases "x \ 0") assume x: "\(x \ 0)" from assms have "map uminus xs \ []" by simp moreover from x assms(1,2,3) have"P (-x) (-y) (map uminus xs)" using uminus_sum_list_map[of "\x. x" xs, symmetric] by (intro assms) (auto simp: last_map algebra_simps o_def neg_eq_iff_add_eq_0) ultimately have "P (- (-x)) (- (-y)) (map uminus (map uminus xs))" by (rule assms) thus ?thesis by (simp add: o_def) qed (simp_all add: assms) text \ We now show that the $\alpha$ and $\beta$ in Arthan's proof have the necessary properties: their difference is non-negative and even. \ private lemma arthan_aux1: fixes xs :: "'a :: {linordered_idom} list" assumes "xs \ []" "last xs \ 0" "x + y + sum_list xs = 0" defines "v \ \xs. int (sign_changes xs)" shows "v (x # y # xs) - v ((x + y) # xs) \ v (psums (x # y # xs)) - v (psums ((x + y) # xs)) \ even (v (x # y # xs) - v ((x + y) # xs) - (v (psums (x # y # xs)) - v (psums ((x + y) # xs))))" using assms(1-3) proof (induction rule: arthan_wlog) have uminus_v: "v (map uminus xs) = v xs" for xs by (simp add: v_def sign_changes_uminus) case (lift x y xs) note lift(2) also have "v (psums (x#y#xs)) - v (psums ((x+y)#xs)) = v (psums (- x # - y # map uminus xs)) - v (psums ((- x + - y) # map uminus xs))" by (subst (1 2) uminus_v [symmetric]) (simp add: map_uminus_psums) also have "v (x # y # xs) - v ((x + y) # xs) = v (-x # -y # map uminus xs) - v ((-x + -y) # map uminus xs)" by (subst (1 2) uminus_v [symmetric]) simp finally show ?case . next case (nonneg x y xs) define p where "p = (LEAST n. xs ! n \ 0)" define xs1 :: "'a list" where "xs1 = replicate p 0" define xs2 where "xs2 = drop (Suc p) xs" from nonneg have "xs ! (length xs - 1) \ 0" by (simp add: last_conv_nth) hence p_nz: "xs ! p \ 0" unfolding p_def by (rule LeastI) { fix q assume "q < p" hence "xs ! q = 0" using Least_le[of "\n. xs ! n \ 0" q] unfolding p_def by force } note less_p_zero = this from Least_le[of "\n. xs ! n \ 0" "length xs - 1"] nonneg have "p \ length xs - 1" unfolding p_def by (auto simp: last_conv_nth) with nonneg have p_less_length: "p < length xs" by (cases xs) simp_all from p_less_length less_p_zero have "take p xs = replicate p 0" by (subst list_eq_iff_nth_eq) auto with p_less_length have xs_decompose: "xs = xs1 @ xs ! p # xs2" unfolding xs1_def xs2_def by (subst append_take_drop_id [of p, symmetric], subst Cons_nth_drop_Suc) simp_all have v_decompose: "v (xs' @ xs) = v (xs' @ [xs ! p]) + v (xs ! p # xs2)" for xs' proof - have "xs' @ xs = (xs' @ xs1) @ xs ! p # xs2" by (subst xs_decompose) simp also have "v \ = v (xs' @ [xs ! p]) + v (xs ! p # xs2)" unfolding v_def by (subst sign_changes_decompose[OF p_nz], subst (1 2 3 4) sign_changes_filter [symmetric]) (simp_all add: xs1_def) finally show ?thesis . qed have psums_decompose: "psums xs = replicate p 0 @ psums (xs!p # xs2)" by (subst xs_decompose) (simp add: xs1_def psums_replicate_0_append) have v_psums_decompose: "sign_changes (xs' @ psums xs) = sign_changes (xs' @ [xs!p]) + sign_changes (xs!p # map ((+) (xs!p)) (psums xs2))" for xs' proof - fix xs' :: "'a list" have "sign_changes (xs' @ psums xs) = sign_changes (xs' @ xs ! p # map ((+) (xs!p)) (psums xs2))" by (subst psums_decompose, subst (1 2) sign_changes_filter [symmetric]) (simp_all add: psums_Cons) also have "\ = sign_changes (xs' @ [xs!p]) + sign_changes (xs!p # map ((+) (xs!p)) (psums xs2))" by (subst sign_changes_decompose[OF p_nz]) simp_all finally show "sign_changes (xs' @ psums xs) = \" . qed show ?case proof (cases "x > 0") assume "\(x > 0)" with nonneg show ?thesis by (auto simp: v_def) next assume x: "x > 0" show ?thesis proof (rule linorder_cases[of y 0]) assume y: "y > 0" from x and this have xy: "x + y > 0" by (rule add_pos_pos) with y have "sign_changes ((x + y) # xs) = sign_changes (y # xs)" by (intro sign_changes_cong) auto moreover have "sign_changes (x # psums ((x + y) # xs)) = sign_changes (psums ((x+y) # xs))" using x xy by (subst (1 2) psums_Cons) (simp_all add: sign_changes_Cons_Cons_same) ultimately show ?thesis using x y by (simp add: v_def algebra_simps sign_changes_Cons_Cons_same) next assume y: "y = 0" with x show ?thesis by (simp add: v_def sign_changes_Cons_Cons_0 psums_Cons o_def sign_changes_Cons_Cons_same) next assume y: "y < 0" with x have different: "x * y < 0" by (rule mult_pos_neg) show ?thesis proof (rule linorder_cases[of "x + y" 0]) assume xy: "x + y < 0" with x have different': "x * (x + y) < 0" by (rule mult_pos_neg) have "(\t. t + (x + y)) = ((+) (x + y))" by (rule ext) simp moreover from y xy have "sign_changes ((x+y) # xs) = sign_changes (y # xs)" by (intro sign_changes_cong) auto ultimately show ?thesis using xy different different' y by (simp add: v_def sign_changes_Cons_Cons_different psums_Cons o_def add_ac) next assume xy: "x + y = 0" show ?case proof (cases "xs ! p > 0") assume p: "xs ! p > 0" from p y have different': "y * xs ! p < 0" by (intro mult_neg_pos) with v_decompose[of "[x, y]"] v_decompose[of "[x+y]"] x xy p different different' v_psums_decompose[of "[x]"] v_psums_decompose[of "[]"] show ?thesis by (auto simp add: algebra_simps v_def sign_changes_Cons_Cons_0 sign_changes_Cons_Cons_different sign_changes_Cons_Cons_same) next assume "\(xs ! p > 0)" with p_nz have p: "xs ! p < 0" by simp from p y have same: "y * xs ! p > 0" by (intro mult_neg_neg) from p x have different': "x * xs ! p < 0" by (intro mult_pos_neg) from v_decompose[of "[x, y]"] v_decompose[of "[x+y]"] xy different different' same v_psums_decompose[of "[x]"] v_psums_decompose[of "[]"] show ?thesis by (auto simp add: algebra_simps v_def sign_changes_Cons_Cons_0 sign_changes_Cons_Cons_different sign_changes_Cons_Cons_same) qed next assume xy: "x + y > 0" from x and this have same: "x * (x + y) > 0" by (rule mult_pos_pos) show ?case proof (cases "xs ! p > 0") assume p: "xs ! p > 0" from xy p have same': "(x + y) * xs ! p > 0" by (intro mult_pos_pos) from p y have different': "y * xs ! p < 0" by (intro mult_neg_pos) have "(\t. t + (x + y)) = ((+) (x + y))" by (rule ext) simp with v_decompose[of "[x, y]"] v_decompose[of "[x+y]"] different different' same same' show ?thesis by (auto simp add: algebra_simps v_def psums_Cons o_def sign_changes_Cons_Cons_different sign_changes_Cons_Cons_same) next assume "\(xs ! p > 0)" with p_nz have p: "xs ! p < 0" by simp from xy p have different': "(x + y) * xs ! p < 0" by (rule mult_pos_neg) from y p have same': "y * xs ! p > 0" by (rule mult_neg_neg) have "(\t. t + (x + y)) = ((+) (x + y))" by (rule ext) simp with v_decompose[of "[x, y]"] v_decompose[of "[x+y]"] different different' same same' show ?thesis by (auto simp add: algebra_simps v_def psums_Cons o_def sign_changes_Cons_Cons_different sign_changes_Cons_Cons_same) qed qed qed qed qed text \ Now we can prove the main lemma of the proof by induction over the list with our specialised induction rule for @{term "sign_changes"}. It states that for a non-empty list whose last element is non-zero and whose sum is zero, the difference of the sign changes in the list and in the list of its partial sums is odd and positive. \ lemma arthan: fixes xs :: "'a :: linordered_idom list" assumes "xs \ []" "last xs \ 0" "sum_list xs = 0" shows "sign_changes xs > sign_changes (psums xs) \ odd (sign_changes xs - sign_changes (psums xs))" using assms proof (induction xs rule: sign_changes_induct) case (nonzero x y xs) show ?case proof (cases "xs = []") case False define \ where "\ = int (sign_changes (x # y # xs)) - int (sign_changes ((x + y) # xs))" define \ where "\ = int (sign_changes (psums (x # y # xs))) - int (sign_changes (psums ((x+y) # xs)))" from nonzero False have "\ \ \ \ even (\ - \)" unfolding \_def \_def by (intro arthan_aux1) auto from False and nonzero.prems have "sign_changes (psums ((x + y) # xs)) < sign_changes ((x + y) # xs) \ odd (sign_changes ((x + y) # xs) - sign_changes (psums ((x + y) # xs)))" by (intro nonzero.IH) (auto simp: add.assoc) with arthan_aux1[of xs x y] nonzero(4,5) False(1) show ?thesis by force qed (insert nonzero.prems, auto split: if_split_asm simp: sign_changes_two add_eq_0_iff) qed (auto split: if_split_asm simp: add_eq_0_iff) end subsection \Roots of a polynomial with a certain property\ text \ The set of roots of a polynomial @{term "p"} that fulfil a given property @{term "P"}: \ definition "roots_with P p = {x. P x \ poly p x = 0}" text \ The number of roots of a polynomial @{term "p"} with a given property @{term "P"}, where multiple roots are counted multiple times. \ definition "count_roots_with P p = (\x\roots_with P p. order x p)" abbreviation "pos_roots \ roots_with (\x. x > 0)" abbreviation "count_pos_roots \ count_roots_with (\x. x > 0)" lemma finite_roots_with [simp]: "(p :: 'a :: linordered_idom poly) \ 0 \ finite (roots_with P p)" by (rule finite_subset[OF _ poly_roots_finite[of p]]) (auto simp: roots_with_def) lemma count_roots_with_times_root: assumes "p \ 0" "P (a :: 'a :: linordered_idom)" shows "count_roots_with P ([:a, -1:] * p) = Suc (count_roots_with P p)" proof - define q where "q = [:a, -1:] * p" from assms have a: "a \ roots_with P q" by (simp_all add: roots_with_def q_def) have q_nz: "q \ 0" unfolding q_def by (rule no_zero_divisors) (simp_all add: assms) have "count_roots_with P q = (\x\roots_with P q. order x q)" by (simp add: count_roots_with_def) also from a q_nz have "\ = order a q + (\x\roots_with P q - {a}. order x q)" by (subst sum.remove) simp_all also have "order a q = order a [:a, -1:] + order a p" unfolding q_def by (subst order_mult[OF no_zero_divisors]) (simp_all add: assms) also have "order a [:a, -1:] = 1" by (subst order_smult [of "-1", symmetric]) (insert order_power_n_n[of a 1], simp_all add: order_1) also have "(\x\roots_with P q - {a}. order x q) = (\x\roots_with P q - {a}. order x p)" proof (intro sum.cong refl) fix x assume x: "x \ roots_with P q - {a}" from assms have "order x q = order x [:a, -1:] + order x p" unfolding q_def by (subst order_mult[OF no_zero_divisors]) (simp_all add: assms) also from x have "order x [:a, -1:] = 0" by (intro order_0I) simp_all finally show "order x q = order x p" by simp qed also from a q_nz have "1 + order a p + (\x\roots_with P q - {a}. order x p) = 1 + (\x\roots_with P q. order x p)" by (subst add.assoc, subst sum.remove[symmetric]) simp_all also from q_nz have "(\x\roots_with P q. order x p) = (\x\roots_with P p. order x p)" proof (intro sum.mono_neutral_right) show "roots_with P p \ roots_with P q" by (auto simp: roots_with_def q_def simp del: mult_pCons_left) show "\x\roots_with P q - roots_with P p. order x p = 0" by (auto simp: roots_with_def q_def order_root simp del: mult_pCons_left) qed simp_all finally show ?thesis by (simp add: q_def count_roots_with_def) qed subsection \Coefficient sign changes of a polynomial\ abbreviation (input) "coeff_sign_changes f \ sign_changes (coeffs f)" text \ We first show that when building a polynomial from a coefficient list, the coefficient sign sign changes of the resulting polynomial are the same as the same sign changes in the list. Note that constructing a polynomial from a list removes all trailing zeros. \ lemma sign_changes_coeff_sign_changes: assumes "Poly xs = (p :: 'a :: linordered_idom poly)" shows "sign_changes xs = coeff_sign_changes p" proof - have "coeffs p = coeffs (Poly xs)" by (subst assms) (rule refl) also have "\ = strip_while ((=) 0) xs" by simp also have "filter ((\) 0) \ = filter ((\) 0) xs" unfolding strip_while_def o_def by (subst rev_filter [symmetric], subst filter_dropWhile) (simp_all add: rev_filter) also have "sign_changes \ = sign_changes xs" by (simp add: sign_changes_filter) finally show ?thesis by (simp add: sign_changes_filter) qed text \ By applying @{term "reduce_root a"}, we can assume w.l.o.g. that the root in question is 1, since applying root reduction does not change the number of sign changes. \ lemma coeff_sign_changes_reduce_root: assumes "a > (0 :: 'a :: linordered_idom)" shows "coeff_sign_changes (reduce_root a p) = coeff_sign_changes p" proof (intro sign_changes_cong, induction p) case (pCons c p) have "map sgn (coeffs (reduce_root a (pCons c p))) = cCons (sgn c) (map sgn (coeffs (reduce_root a p)))" using assms by (auto simp add: cCons_def sgn_0_0 sgn_mult reduce_root_pCons coeffs_smult) also note pCons.IH also have "cCons (sgn c) (map sgn (coeffs p)) = map sgn (coeffs (pCons c p))" using assms by (auto simp add: cCons_def sgn_0_0) finally show ?case . qed (simp_all add: reduce_root_def) text \ Multiplying a polynomial with a positive constant also does not change the number of sign changes. (in fact, any non-zero constant would also work, but the proof is slightly more difficult and positive constants suffice in our use case) \ lemma coeff_sign_changes_smult: assumes "a > (0 :: 'a :: linordered_idom)" shows "coeff_sign_changes (smult a p) = coeff_sign_changes p" using assms by (auto intro!: sign_changes_cong simp: sgn_mult coeffs_smult) context begin text \ We now show that a polynomial with an odd number of sign changes contains a positive root. We first assume that the constant coefficient is non-zero. Then it is clear that the polynomial's sign at 0 will be the sign of the constant coefficient, whereas the polynomial's sign for sufficiently large inputs will be the sign of the leading coefficient. Moreover, we have shown before that in a list with an odd number of sign changes and non-zero initial and last coefficients, the initial coefficient and the last coefficient have opposite and non-zero signs. Then, the polynomial obviously has a positive root. \ private lemma odd_coeff_sign_changes_imp_pos_roots_aux: assumes [simp]: "p \ (0 :: real poly)" "poly p 0 \ 0" assumes "odd (coeff_sign_changes p)" obtains x where "x > 0" "poly p x = 0" proof - from \poly p 0 \ 0\ have [simp]: "hd (coeffs p) \ 0" by (induct p) auto from assms have "\ even (coeff_sign_changes p)" by blast also have "even (coeff_sign_changes p) \ sgn (hd (coeffs p)) = sgn (lead_coeff p)" by (auto simp add: even_sign_changes_iff last_coeffs_eq_coeff_degree) finally have "sgn (hd (coeffs p)) * sgn (lead_coeff p) < 0" by (auto simp: sgn_if split: if_split_asm) also from \p \ 0\ have "hd (coeffs p) = poly p 0" by (induction p) auto finally have "poly p 0 * lead_coeff p < 0" by (auto simp: mult_less_0_iff) from pos_root_exI[OF this] that show ?thesis by blast qed text \ We can now show the statement without the restriction to a non-zero constant coefficient. We can do this by simply factoring $p$ into the form $p \cdot x^n$, where $n$ is chosen as large as possible. This corresponds to stripping all initial zeros of the coefficient list, which obviously changes neither the existence of positive roots nor the number of coefficient sign changes. \ lemma odd_coeff_sign_changes_imp_pos_roots: assumes "p \ (0 :: real poly)" assumes "odd (coeff_sign_changes p)" obtains x where "x > 0" "poly p x = 0" proof - define s where "s = sgn (lead_coeff p)" define n where "n = order 0 p" define r where "r = p div [:0, 1:] ^ n" have p: "p = [:0, 1:] ^ n * r" unfolding r_def n_def using order_1[of 0 p] by (simp del: mult_pCons_left) from assms p have r_nz: "r \ 0" by auto obtain x where "x > 0" "poly r x = 0" proof (rule odd_coeff_sign_changes_imp_pos_roots_aux) show "r \ 0" by fact have "order 0 p = order 0 p + order 0 r" by (subst p, insert order_power_n_n[of "0::real" n] r_nz) (simp del: mult_pCons_left add: order_mult n_def) hence "order 0 r = 0" by simp with r_nz show nz: "poly r 0 \ 0" by (simp add: order_root) note \odd (coeff_sign_changes p)\ also have "p = [:0, 1:] ^ n * r" by (simp add: p) also have "[:0, 1:] ^ n = monom 1 n" by (induction n) (simp_all add: monom_Suc monom_0) also have "coeffs (monom 1 n * r) = replicate n 0 @ coeffs r" by (induction n) (simp_all add: monom_Suc cCons_def r_nz monom_0) also have "sign_changes \ = coeff_sign_changes r" by (subst (1 2) sign_changes_filter [symmetric]) simp finally show "odd (coeff_sign_changes r)" . qed thus ?thesis by (intro that[of x]) (simp_all add: p) qed end subsection \Proof of Descartes' sign rule\ text \ For a polynomial $p(X) = a_0 + \ldots + a_n X^n$, we have $[X^i] (1-X)p(X) = (\sum\limits_{j=0}^i a_j)$. \ lemma coeff_poly_times_one_minus_x: fixes g :: "'a :: linordered_idom poly" shows "coeff g n = (\i\n. coeff (g * [:1, -1:]) i)" by (induction n) simp_all text \ We apply the previous lemma to the coefficient list of a polynomial and show: given a polynomial $p(X)$ and $q(X) = (1 - X)p(X)$, the coefficient list of $p(X)$ is the list of partial sums of the coefficient list of $q(X)$. \ lemma Poly_times_one_minus_x_eq_psums: fixes xs :: "'a :: linordered_idom list" assumes [simp]: "length xs = length ys" assumes "Poly xs = Poly ys * [:1, -1:]" shows "ys = psums xs" proof (rule nth_equalityI; safe?) fix i assume i: "i < length ys" hence "ys ! i = coeff (Poly ys) i" by (simp add: nth_default_def) also from coeff_poly_times_one_minus_x[of "Poly ys" i] assms have "\ = (\j\i. coeff (Poly xs) j)" by simp also from i have "\ = psums xs ! i" by (auto simp: nth_default_def psums_nth) finally show "ys ! i = psums xs ! i" . qed simp_all text \ We can now apply our main lemma on the sign changes in lists to the coefficient lists of a nonzero polynomial $p(X)$ and $(1-X)p(X)$: the difference of the changes in the coefficient lists is odd and positive. \ lemma sign_changes_poly_times_one_minus_x: fixes g :: "'a :: linordered_idom poly" and a :: 'a assumes nz: "g \ 0" defines "v \ coeff_sign_changes" shows "v ([:1, -1:] * g) - v g > 0 \ odd (v ([:1, -1:] * g) - v g)" proof - define xs where "xs = coeffs ([:1, -1:] * g)" define ys where "ys = coeffs g @ [0]" have ys: "ys = psums xs" proof (rule Poly_times_one_minus_x_eq_psums) show "length xs = length ys" unfolding xs_def ys_def by (simp add: length_coeffs nz degree_mult_eq no_zero_divisors del: mult_pCons_left) show "Poly xs = Poly ys * [:1, - 1:]" unfolding xs_def ys_def by (simp only: Poly_snoc Poly_coeffs) simp qed have "sign_changes (psums xs) < sign_changes xs \ odd (sign_changes xs - sign_changes (psums xs))" proof (rule arthan) show "xs \ []" by (auto simp: xs_def nz simp del: mult_pCons_left) then show "sum_list xs = 0" by (simp add: last_psums [symmetric] ys [symmetric] ys_def) show "last xs \ 0" by (auto simp: xs_def nz last_coeffs_eq_coeff_degree simp del: mult_pCons_left) qed with ys have "sign_changes ys < sign_changes xs \ odd (sign_changes xs - sign_changes ys)" by simp also have "sign_changes xs = v ([:1, -1:] * g)" unfolding v_def by (intro sign_changes_coeff_sign_changes) (simp_all add: xs_def) also have "sign_changes ys = v g" unfolding v_def by (intro sign_changes_coeff_sign_changes) (simp_all add: ys_def Poly_snoc) finally show ?thesis by simp qed text \ We can now lift the previous lemma to the case of $p(X)$ and $(a-X)p(X)$ by substituting $X$ with $aX$, yielding the polynomials $p(aX)$ and $a \cdot (1-X) \cdot p(aX)$. \ lemma sign_changes_poly_times_root_minus_x: fixes g :: "'a :: linordered_idom poly" and a :: 'a assumes nz: "g \ 0" and pos: "a > 0" defines "v \ coeff_sign_changes" shows "v ([:a, -1:] * g) - v g > 0 \ odd (v ([:a, -1:] * g) - v g)" proof - have "0 < v ([:1, - 1:] * reduce_root a g) - v (reduce_root a g) \ odd (v ([:1, - 1:] * reduce_root a g) - v (reduce_root a g))" using nz pos unfolding v_def by (intro sign_changes_poly_times_one_minus_x) simp_all also have "v ([:1, -1:] * reduce_root a g) = v (smult a ([:1, -1:] * reduce_root a g))" unfolding v_def by (simp add: coeff_sign_changes_smult pos) also have "smult a ([:1, -1:] * reduce_root a g) = [:a:] * [:1, -1:] * reduce_root a g" by (subst mult.assoc) simp also have "[:a:] * [:1, -1:] = reduce_root a [:a, -1:]" by (simp add: reduce_root_def pcompose_pCons) also have "\ * reduce_root a g = reduce_root a ([:a, -1:] * g)" unfolding reduce_root_def by (simp only: pcompose_mult) also have "v \ = v ([:a, -1:] * g)" by (simp add: v_def coeff_sign_changes_reduce_root pos) also have "v (reduce_root a g) = v g" by (simp add: v_def coeff_sign_changes_reduce_root pos) finally show ?thesis . qed text \ Finally, the difference of the number of coefficient sign changes and the number of positive roots is non-negative and even. This follows straightforwardly by induction over the roots. \ lemma descartes_sign_rule_aux: fixes p :: "real poly" assumes "p \ 0" shows "coeff_sign_changes p \ count_pos_roots p \ even (coeff_sign_changes p - count_pos_roots p)" using assms proof (induction p rule: poly_root_induct[where P = "\a. a > 0"]) case (root a p) define q where "q = [:a, -1:] * p" from root.prems have p: "p \ 0" by auto with root p sign_changes_poly_times_root_minus_x[of p a] count_roots_with_times_root[of p "\x. x > 0" a] show ?case by (fold q_def) fastforce next case (no_roots p) from no_roots have "pos_roots p = {}" by (auto simp: roots_with_def) hence [simp]: "count_pos_roots p = 0" by (simp add: count_roots_with_def) thus ?case using no_roots \p \ 0\ odd_coeff_sign_changes_imp_pos_roots[of p] by (auto simp: roots_with_def) qed simp_all text \ The main theorem is then an obvious consequence \ theorem descartes_sign_rule: fixes p :: "real poly" assumes "p \ 0" shows "\d. even d \ coeff_sign_changes p = count_pos_roots p + d" proof define d where "d = coeff_sign_changes p - count_pos_roots p" show "even d \ coeff_sign_changes p = count_pos_roots p + d" unfolding d_def using descartes_sign_rule_aux[OF assms] by auto qed end diff --git a/thys/E_Transcendental/E_Transcendental.thy b/thys/E_Transcendental/E_Transcendental.thy --- a/thys/E_Transcendental/E_Transcendental.thy +++ b/thys/E_Transcendental/E_Transcendental.thy @@ -1,687 +1,687 @@ (* File: E_Transcendental.thy - Author: Manuel Eberl + Author: Manuel Eberl A proof that e (Euler's number) is transcendental. Could possibly be extended to a transcendence proof for pi or the very general Lindemann-Weierstrass theorem. *) section \Proof of the Transcendence of $e$\ theory E_Transcendental imports "HOL-Complex_Analysis.Complex_Analysis" "HOL-Number_Theory.Number_Theory" "HOL-Computational_Algebra.Polynomial" begin (* TODO: Lots of stuff to move to the distribution *) subsection \Various auxiliary facts\ lemma fact_dvd_pochhammer: assumes "m \ n + 1" shows "fact m dvd pochhammer (int n - int m + 1) m" proof - have "(real n gchoose m) * fact m = of_int (pochhammer (int n - int m + 1) m)" by (simp add: gbinomial_pochhammer' pochhammer_of_int [symmetric]) also have "(real n gchoose m) * fact m = of_int (int (n choose m) * fact m)" by (simp add: binomial_gbinomial) finally have "int (n choose m) * fact m = pochhammer (int n - int m + 1) m" by (subst (asm) of_int_eq_iff) from this [symmetric] show ?thesis by simp qed lemma of_nat_eq_1_iff [simp]: "of_nat x = (1 :: 'a :: semiring_char_0) \ x = 1" by (fact of_nat_eq_1_iff) lemma prime_elem_int_not_dvd_neg1_power: "prime_elem (p :: int) \ \p dvd (-1) ^ n" by (rule notI, frule (1) prime_elem_dvd_power, cases "p \ 0") (auto simp: prime_elem_def) lemma nat_fact [simp]: "nat (fact n) = fact n" by (subst of_nat_fact [symmetric]) (rule nat_int) lemma prime_dvd_fact_iff_int: "p dvd fact n \ p \ int n" if "prime p" using that prime_dvd_fact_iff [of "nat \p\" n] by auto (simp add: prime_ge_0_int) lemma filterlim_minus_nat_at_top: "filterlim (\n. n - k :: nat) at_top at_top" proof - have "sequentially = filtermap (\n. n + k) at_top" by (auto simp: filter_eq_iff eventually_filtermap) also have "filterlim (\n. n - k :: nat) at_top \" by (simp add: filterlim_filtermap filterlim_ident) finally show ?thesis . qed lemma power_over_fact_tendsto_0: "(\n. (x :: real) ^ n / fact n) \ 0" using summable_exp[of x] by (intro summable_LIMSEQ_zero) (simp add: sums_iff field_simps) lemma power_over_fact_tendsto_0': "(\n. c * (x :: real) ^ n / fact n) \ 0" using tendsto_mult[OF tendsto_const[of c] power_over_fact_tendsto_0[of x]] by simp subsection \Lifting integer polynomials\ lift_definition of_int_poly :: "int poly \ 'a :: comm_ring_1 poly" is "\g x. of_int (g x)" by (auto elim: eventually_mono) lemma coeff_of_int_poly [simp]: "coeff (of_int_poly p) n = of_int (coeff p n)" by transfer' simp lemma of_int_poly_0 [simp]: "of_int_poly 0 = 0" by transfer (simp add: fun_eq_iff) lemma of_int_poly_pCons [simp]: "of_int_poly (pCons c p) = pCons (of_int c) (of_int_poly p)" by transfer' (simp add: fun_eq_iff split: nat.splits) lemma of_int_poly_smult [simp]: "of_int_poly (smult c p) = smult (of_int c) (of_int_poly p)" by transfer simp lemma of_int_poly_1 [simp]: "of_int_poly 1 = 1" by (simp add: one_pCons) lemma of_int_poly_add [simp]: "of_int_poly (p + q) = of_int_poly p + of_int_poly q" by transfer' (simp add: fun_eq_iff) lemma of_int_poly_mult [simp]: "of_int_poly (p * q) = (of_int_poly p * of_int_poly q)" by (induction p) simp_all lemma of_int_poly_sum [simp]: "of_int_poly (sum f A) = sum (\x. of_int_poly (f x)) A" by (induction A rule: infinite_finite_induct) simp_all lemma of_int_poly_prod [simp]: "of_int_poly (prod f A) = prod (\x. of_int_poly (f x)) A" by (induction A rule: infinite_finite_induct) simp_all lemma of_int_poly_power [simp]: "of_int_poly (p ^ n) = of_int_poly p ^ n" by (induction n) simp_all lemma of_int_poly_monom [simp]: "of_int_poly (monom c n) = monom (of_int c) n" by transfer (simp add: fun_eq_iff) lemma poly_of_int_poly [simp]: "poly (of_int_poly p) (of_int x) = of_int (poly p x)" by (induction p) simp_all lemma poly_of_int_poly_of_nat [simp]: "poly (of_int_poly p) (of_nat x) = of_int (poly p (int x))" by (induction p) simp_all lemma poly_of_int_poly_0 [simp]: "poly (of_int_poly p) 0 = of_int (poly p 0)" by (induction p) simp_all lemma poly_of_int_poly_1 [simp]: "poly (of_int_poly p) 1 = of_int (poly p 1)" by (induction p) simp_all lemma poly_of_int_poly_of_real [simp]: "poly (of_int_poly p) (of_real x) = of_real (poly (of_int_poly p) x)" by (induction p) simp_all lemma of_int_poly_eq_iff [simp]: "of_int_poly p = (of_int_poly q :: 'a :: {comm_ring_1, ring_char_0} poly) \ p = q" by (simp add: poly_eq_iff) lemma of_int_poly_eq_0_iff [simp]: "of_int_poly p = (0 :: 'a :: {comm_ring_1, ring_char_0} poly) \ p = 0" using of_int_poly_eq_iff[of p 0] by (simp del: of_int_poly_eq_iff) lemma degree_of_int_poly [simp]: "degree (of_int_poly p :: 'a :: {comm_ring_1, ring_char_0} poly) = degree p" by (simp add: degree_def) lemma pderiv_of_int_poly [simp]: "pderiv (of_int_poly p) = of_int_poly (pderiv p)" by (induction p) (simp_all add: pderiv_pCons) lemma higher_pderiv_of_int_poly [simp]: "(pderiv ^^ n) (of_int_poly p) = of_int_poly ((pderiv ^^ n) p)" by (induction n) simp_all lemma int_polyE: assumes "\n. coeff (p :: 'a :: {comm_ring_1, ring_char_0} poly) n \ \" obtains p' where "p = of_int_poly p'" proof - from assms have "\n. \c. coeff p n = of_int c" by (auto simp: Ints_def) hence "\c. \n. of_int (c n) = coeff p n" by (simp add: choice_iff eq_commute) then obtain c where c: "of_int (c n) = coeff p n" for n by blast have [simp]: "coeff (Abs_poly c) = c" proof (rule poly.Abs_poly_inverse, clarify) have "eventually (\n. n > degree p) at_top" by (rule eventually_gt_at_top) hence "eventually (\n. coeff p n = 0) at_top" by eventually_elim (simp add: coeff_eq_0) thus "eventually (\n. c n = 0) cofinite" by (simp add: c [symmetric] cofinite_eq_sequentially) qed have "p = of_int_poly (Abs_poly c)" by (rule poly_eqI) (simp add: c) thus ?thesis by (rule that) qed subsection \General facts about polynomials\ lemma pderiv_power: "pderiv (p ^ n) = smult (of_nat n) (p ^ (n - 1) * pderiv p)" by (cases n) (simp_all add: pderiv_power_Suc del: power_Suc) lemma degree_prod_sum_eq: "(\x. x \ A \ f x \ 0) \ degree (prod f A :: 'a :: idom poly) = (\x\A. degree (f x))" by (induction A rule: infinite_finite_induct) (auto simp: degree_mult_eq) lemma pderiv_monom: "pderiv (monom c n) = monom (of_nat n * c) (n - 1)" by (cases n) (simp_all add: monom_altdef pderiv_power_Suc pderiv_smult pderiv_pCons mult_ac del: power_Suc) lemma power_poly_const [simp]: "[:c:] ^ n = [:c ^ n:]" by (induction n) (simp_all add: power_commutes) lemma monom_power: "monom c n ^ k = monom (c ^ k) (n * k)" by (induction k) (simp_all add: mult_monom) lemma coeff_higher_pderiv: "coeff ((pderiv ^^ m) f) n = pochhammer (of_nat (Suc n)) m * coeff f (n + m)" by (induction m arbitrary: n) (simp_all add: coeff_pderiv pochhammer_rec algebra_simps) lemma higher_pderiv_add: "(pderiv ^^ n) (p + q) = (pderiv ^^ n) p + (pderiv ^^ n) q" by (induction n arbitrary: p q) (simp_all del: funpow.simps add: funpow_Suc_right pderiv_add) lemma higher_pderiv_smult: "(pderiv ^^ n) (smult c p) = smult c ((pderiv ^^ n) p)" by (induction n arbitrary: p) (simp_all del: funpow.simps add: funpow_Suc_right pderiv_smult) lemma higher_pderiv_0 [simp]: "(pderiv ^^ n) 0 = 0" by (induction n) simp_all lemma higher_pderiv_monom: "m \ n + 1 \ (pderiv ^^ m) (monom c n) = monom (pochhammer (int n - int m + 1) m * c) (n - m)" proof (induction m arbitrary: c n) case (Suc m) thus ?case by (cases n) (simp_all del: funpow.simps add: funpow_Suc_right pderiv_monom pochhammer_rec' Suc.IH) qed simp_all lemma higher_pderiv_monom_eq_zero: "m > n + 1 \ (pderiv ^^ m) (monom c n) = 0" proof (induction m arbitrary: c n) case (Suc m) thus ?case by (cases n) (simp_all del: funpow.simps add: funpow_Suc_right pderiv_monom pochhammer_rec' Suc.IH) qed simp_all lemma higher_pderiv_sum: "(pderiv ^^ n) (sum f A) = (\x\A. (pderiv ^^ n) (f x))" by (induction A rule: infinite_finite_induct) (simp_all add: higher_pderiv_add) lemma fact_dvd_higher_pderiv: "[:fact n :: int:] dvd (pderiv ^^ n) p" proof - have "[:fact n:] dvd (pderiv ^^ n) (monom c k)" for c :: int and k :: nat by (cases "n \ k + 1") (simp_all add: higher_pderiv_monom higher_pderiv_monom_eq_zero fact_dvd_pochhammer const_poly_dvd_iff) hence "[:fact n:] dvd (pderiv ^^ n) (\k\degree p. monom (coeff p k) k)" by (simp_all add: higher_pderiv_sum dvd_sum) thus ?thesis by (simp add: poly_as_sum_of_monoms) qed lemma fact_dvd_poly_higher_pderiv_aux: "(fact n :: int) dvd poly ((pderiv ^^ n) p) x" proof - have "[:fact n:] dvd (pderiv ^^ n) p" by (rule fact_dvd_higher_pderiv) then obtain q where "(pderiv ^^ n) p = [:fact n:] * q" by (erule dvdE) thus ?thesis by simp qed lemma fact_dvd_poly_higher_pderiv_aux': "m \ n \ (fact m :: int) dvd poly ((pderiv ^^ n) p) x" by (rule dvd_trans[OF fact_dvd fact_dvd_poly_higher_pderiv_aux]) simp_all lemma algebraicE': assumes "algebraic (x :: 'a :: field_char_0)" obtains p where "p \ 0" "poly (of_int_poly p) x = 0" proof - from assms obtain q where "\i. coeff q i \ \" "q \ 0" "poly q x = 0" by (erule algebraicE) moreover from this(1) obtain q' where "q = of_int_poly q'" by (erule int_polyE) ultimately show ?thesis by (intro that[of q']) simp_all qed lemma algebraicE'_nonzero: assumes "algebraic (x :: 'a :: field_char_0)" "x \ 0" obtains p where "p \ 0" "coeff p 0 \ 0" "poly (of_int_poly p) x = 0" proof - from assms(1) obtain p where p: "p \ 0" "poly (of_int_poly p) x = 0" by (erule algebraicE') define n :: nat where "n = order 0 p" have "monom 1 n dvd p" by (simp add: monom_1_dvd_iff p n_def) then obtain q where q: "p = monom 1 n * q" by (erule dvdE) from p have "q \ 0" "poly (of_int_poly q) x = 0" by (auto simp: q poly_monom assms(2)) moreover from this have "order 0 p = n + order 0 q" by (simp add: q order_mult) hence "order 0 q = 0" by (simp add: n_def) with \q \ 0\ have "poly q 0 \ 0" by (simp add: order_root) ultimately show ?thesis using that[of q] by (auto simp: poly_0_coeff_0) qed lemma algebraic_of_real_iff [simp]: "algebraic (of_real x :: 'a :: {real_algebra_1,field_char_0}) \ algebraic x" proof assume "algebraic (of_real x :: 'a)" then obtain p where "p \ 0" "poly (of_int_poly p) (of_real x :: 'a) = 0" by (erule algebraicE') hence "(of_int_poly p :: real poly) \ 0" "poly (of_int_poly p :: real poly) x = 0" by simp_all thus "algebraic x" by (intro algebraicI[of "of_int_poly p"]) simp_all next assume "algebraic x" then obtain p where "p \ 0" "poly (of_int_poly p) x = 0" by (erule algebraicE') hence "of_int_poly p \ (0 :: 'a poly)" "poly (of_int_poly p) (of_real x :: 'a) = 0" by simp_all thus "algebraic (of_real x)" by (intro algebraicI[of "of_int_poly p"]) simp_all qed subsection \Main proof\ lemma lindemann_weierstrass_integral: fixes u :: complex and f :: "complex poly" defines "df \ \n. (pderiv ^^ n) f" defines "m \ degree f" defines "I \ \f u. exp u * (\j\degree f. poly ((pderiv ^^ j) f) 0) - (\j\degree f. poly ((pderiv ^^ j) f) u)" shows "((\t. exp (u - t) * poly f t) has_contour_integral I f u) (linepath 0 u)" proof - note [derivative_intros] = exp_scaleR_has_vector_derivative_right vector_diff_chain_within let ?g = "\t. 1 - t" and ?f = "\t. -exp (t *\<^sub>R u)" have "((\t. exp ((1 - t) *\<^sub>R u) * u) has_integral (?f \ ?g) 1 - (?f \ ?g) 0) {0..1}" by (rule fundamental_theorem_of_calculus) (auto intro!: derivative_eq_intros simp del: o_apply) hence aux_integral: "((\t. exp (u - t *\<^sub>R u) * u) has_integral exp u - 1) {0..1}" by (simp add: algebra_simps) have "((\t. exp (u - t *\<^sub>R u) * u * poly f (t *\<^sub>R u)) has_integral I f u) {0..1}" unfolding df_def m_def proof (induction "degree f" arbitrary: f) case 0 then obtain c where c: "f = [:c:]" by (auto elim: degree_eq_zeroE) have "((\t. c * (exp (u - t *\<^sub>R u) * u)) has_integral c * (exp u - 1)) {0..1}" using aux_integral by (rule has_integral_mult_right) with c show ?case by (simp add: algebra_simps I_def) next case (Suc m) define df where "df = (\j. (pderiv ^^ j) f)" show ?case proof (rule integration_by_parts[OF bounded_bilinear_mult]) fix t :: real assume "t \ {0..1}" have "((?f \ ?g) has_vector_derivative exp (u - t *\<^sub>R u) * u) (at t)" by (auto intro!: derivative_eq_intros simp: algebra_simps simp del: o_apply) thus "((\t. -exp (u - t *\<^sub>R u)) has_vector_derivative exp (u - t *\<^sub>R u) * u) (at t)" by (simp add: algebra_simps o_def) next fix t :: real assume "t \ {0..1}" have "(poly f \ (\t. t *\<^sub>R u) has_vector_derivative u * poly (pderiv f) (t *\<^sub>R u)) (at t)" by (rule field_vector_diff_chain_at) (auto intro!: derivative_eq_intros) thus "((\t. poly f (t *\<^sub>R u)) has_vector_derivative u * poly (pderiv f) (t *\<^sub>R u)) (at t)" by (simp add: o_def) next from Suc(2) have m: "m = degree (pderiv f)" by (simp add: degree_pderiv) from Suc(1)[OF this] this have "((\t. exp (u - t *\<^sub>R u) * u * poly (pderiv f) (t *\<^sub>R u)) has_integral exp u * (\j=0..m. poly (df (Suc j)) 0) - (\j=0..m. poly (df (Suc j)) u)) {0..1}" by (simp add: df_def funpow_swap1 atMost_atLeast0 I_def) also have "(\j=0..m. poly (df (Suc j)) 0) = (\j=Suc 0..Suc m. poly (df j) 0)" by (rule sum.shift_bounds_cl_Suc_ivl [symmetric]) also have "\ = (\j=0..Suc m. poly (df j) 0) - poly f 0" by (subst (2) sum.atLeast_Suc_atMost) (simp_all add: df_def) also have "(\j=0..m. poly (df (Suc j)) u) = (\j=Suc 0..Suc m. poly (df j) u)" by (rule sum.shift_bounds_cl_Suc_ivl [symmetric]) also have "\ = (\j=0..Suc m. poly (df j) u) - poly f u" by (subst (2) sum.atLeast_Suc_atMost) (simp_all add: df_def) finally have "((\t. - (exp (u - t *\<^sub>R u) * u * poly (pderiv f) (t *\<^sub>R u))) has_integral -(exp u * ((\j = 0..Suc m. poly (df j) 0) - poly f 0) - ((\j = 0..Suc m. poly (df j) u) - poly f u))) {0..1}" (is "(_ has_integral ?I) _") by (rule has_integral_neg) also have "?I = - exp (u - 1 *\<^sub>R u) * poly f (1 *\<^sub>R u) - - exp (u - 0 *\<^sub>R u) * poly f (0 *\<^sub>R u) - I f u" by (simp add: df_def algebra_simps Suc(2) atMost_atLeast0 I_def) finally show "((\t. - exp (u - t *\<^sub>R u) * (u * poly (pderiv f) (t *\<^sub>R u))) has_integral \) {0..1}" by (simp add: algebra_simps) qed (auto intro!: continuous_intros) qed thus ?thesis by (simp add: has_contour_integral_linepath algebra_simps) qed locale lindemann_weierstrass_aux = fixes f :: "complex poly" begin definition I :: "complex \ complex" where "I u = exp u * (\j\degree f. poly ((pderiv ^^ j) f) 0) - (\j\degree f. poly ((pderiv ^^ j) f) u)" lemma lindemann_weierstrass_integral_bound: fixes u :: complex assumes "C \ 0" "\t. t \ closed_segment 0 u \ norm (poly f t) \ C" shows "norm (I u) \ norm u * exp (norm u) * C" proof - have "I u = contour_integral (linepath 0 u) (\t. exp (u - t) * poly f t)" using contour_integral_unique[OF lindemann_weierstrass_integral[of u f]] unfolding I_def .. also have "norm \ \ exp (norm u) * C * norm (u - 0)" proof (intro contour_integral_bound_linepath) fix t assume t: "t \ closed_segment 0 u" then obtain s where s: "s \ {0..1}" "t = s *\<^sub>R u" by (auto simp: closed_segment_def) hence "s * norm u \ 1 * norm u" by (intro mult_right_mono) simp_all with s have norm_t: "norm t \ norm u" by auto from s have "Re u - Re t = (1 - s) * Re u" by (simp add: algebra_simps) also have "\ \ norm u" proof (cases "Re u \ 0") case True with \s \ {0..1}\ have "(1 - s) * Re u \ 1 * Re u" by (intro mult_right_mono) simp_all also have "Re u \ norm u" by (rule complex_Re_le_cmod) finally show ?thesis by simp next case False with \s \ {0..1}\ have "(1 - s) * Re u \ 0" by (intro mult_nonneg_nonpos) simp_all also have "\ \ norm u" by simp finally show ?thesis . qed finally have "exp (Re u - Re t) \ exp (norm u)" by simp hence "exp (Re u - Re t) * norm (poly f t) \ exp (norm u) * C" using assms t norm_t by (intro mult_mono) simp_all thus "norm (exp (u - t) * poly f t) \ exp (norm u) * C" by (simp add: norm_mult exp_diff norm_divide field_simps) qed (auto simp: intro!: mult_nonneg_nonneg contour_integrable_continuous_linepath continuous_intros assms) finally show ?thesis by (simp add: mult_ac) qed end lemma poly_higher_pderiv_aux1: fixes c :: "'a :: idom" assumes "k < n" shows "poly ((pderiv ^^ k) ([:-c, 1:] ^ n * p)) c = 0" using assms proof (induction k arbitrary: n p) case (Suc k n p) from Suc.prems obtain n' where n: "n = Suc n'" by (cases n) auto from Suc.prems n have "k < n'" by simp have "(pderiv ^^ Suc k) ([:- c, 1:] ^ n * p) = (pderiv ^^ k) ([:- c, 1:] ^ n * pderiv p + [:- c, 1:] ^ n' * smult (of_nat n) p)" by (simp only: funpow_Suc_right o_def pderiv_mult n pderiv_power_Suc, simp only: n [symmetric]) (simp add: pderiv_pCons mult_ac) also from Suc.prems \k < n'\ have "poly \ c = 0" by (simp add: higher_pderiv_add Suc.IH del: mult_smult_right) finally show ?case . qed simp_all lemma poly_higher_pderiv_aux1': fixes c :: "'a :: idom" assumes "k < n" "[:-c, 1:] ^ n dvd p" shows "poly ((pderiv ^^ k) p) c = 0" proof - from assms(2) obtain q where "p = [:-c, 1:] ^ n * q" by (elim dvdE) also from assms(1) have "poly ((pderiv ^^ k) \) c = 0" by (rule poly_higher_pderiv_aux1) finally show ?thesis . qed lemma poly_higher_pderiv_aux2: fixes c :: "'a :: {idom, semiring_char_0}" shows "poly ((pderiv ^^ n) ([:-c, 1:] ^ n * p)) c = fact n * poly p c" proof (induction n arbitrary: p) case (Suc n p) have "(pderiv ^^ Suc n) ([:- c, 1:] ^ Suc n * p) = (pderiv ^^ n) ([:- c, 1:] ^ Suc n * pderiv p) + (pderiv ^^ n) ([:- c, 1:] ^ n * smult (1 + of_nat n) p)" by (simp del: funpow.simps power_Suc add: funpow_Suc_right pderiv_mult pderiv_power_Suc higher_pderiv_add pderiv_pCons mult_ac) also have "[:- c, 1:] ^ Suc n * pderiv p = [:- c, 1:] ^ n * ([:-c, 1:] * pderiv p)" by (simp add: algebra_simps) finally show ?case by (simp add: Suc.IH del: mult_smult_right power_Suc) qed simp_all lemma poly_higher_pderiv_aux3: fixes c :: "'a :: {idom,semiring_char_0}" assumes "k \ n" shows "\q. poly ((pderiv ^^ k) ([:-c, 1:] ^ n * p)) c = fact n * poly q c" using assms proof (induction k arbitrary: n p) case (Suc k n p) show ?case proof (cases n) fix n' assume n: "n = Suc n'" have "poly ((pderiv ^^ Suc k) ([:-c, 1:] ^ n * p)) c = poly ((pderiv ^^ k) ([:- c, 1:] ^ n * pderiv p)) c + of_nat n * poly ((pderiv ^^ k) ([:-c, 1:] ^ n' * p)) c" by (simp del: funpow.simps power_Suc add: funpow_Suc_right pderiv_power_Suc pderiv_mult n pderiv_pCons higher_pderiv_add mult_ac higher_pderiv_smult) also have "\q1. poly ((pderiv ^^ k) ([:-c, 1:] ^ n * pderiv p)) c = fact n * poly q1 c" using Suc.prems Suc.IH[of n "pderiv p"] by (cases "n' = k") (auto simp: n poly_higher_pderiv_aux1 simp del: power_Suc of_nat_Suc intro: exI[of _ "0::'a poly"]) then obtain q1 where "poly ((pderiv ^^ k) ([:-c, 1:] ^ n * pderiv p)) c = fact n * poly q1 c" .. also from Suc.IH[of n' p] Suc.prems obtain q2 where "poly ((pderiv ^^ k) ([:-c, 1:] ^ n' * p)) c = fact n' * poly q2 c" by (auto simp: n) finally show ?case by (auto intro!: exI[of _ "q1 + q2"] simp: n algebra_simps) qed auto qed auto lemma poly_higher_pderiv_aux3': fixes c :: "'a :: {idom, semiring_char_0}" assumes "k \ n" "[:-c, 1:] ^ n dvd p" shows "fact n dvd poly ((pderiv ^^ k) p) c" proof - from assms(2) obtain q where "p = [:-c, 1:] ^ n * q" by (elim dvdE) with poly_higher_pderiv_aux3[OF assms(1), of c q] show ?thesis by auto qed lemma e_transcendental_aux_bound: obtains C where "C \ 0" "\x. x \ closed_segment 0 (of_nat n) \ norm (\k\{1..n}. (x - of_nat k :: complex)) \ C" proof - let ?f = "\x. (\k\{1..n}. (x - of_nat k))" define C where "C = max 0 (Sup (cmod ` ?f ` closed_segment 0 (of_nat n)))" have "C \ 0" by (simp add: C_def) moreover { fix x :: complex assume "x \ closed_segment 0 (of_nat n)" hence "cmod (?f x) \ Sup ((cmod \ ?f) ` closed_segment 0 (of_nat n))" by (intro cSup_upper bounded_imp_bdd_above compact_imp_bounded compact_continuous_image) (auto intro!: continuous_intros) also have "\ \ C" by (simp add: C_def image_comp) finally have "cmod (?f x) \ C" . } ultimately show ?thesis by (rule that) qed theorem e_transcendental_complex: "\ algebraic (exp 1 :: complex)" proof assume "algebraic (exp 1 :: complex)" then obtain q :: "int poly" where q: "q \ 0" "coeff q 0 \ 0" "poly (of_int_poly q) (exp 1 :: complex) = 0" by (elim algebraicE'_nonzero) simp_all define n :: nat where "n = degree q" from q have [simp]: "n \ 0" by (intro notI) (auto simp: n_def elim!: degree_eq_zeroE) define qmax where "qmax = Max (insert 0 (abs ` set (coeffs q)))" have qmax_nonneg [simp]: "qmax \ 0" by (simp add: qmax_def) have qmax: "\coeff q k\ \ qmax" for k by (cases "k \ degree q") (auto simp: qmax_def coeff_eq_0 coeffs_def simp del: upt_Suc intro: Max.coboundedI) obtain C where C: "C \ 0" "\x. x \ closed_segment 0 (of_nat n) \ norm (\k\{1..n}. (x - of_nat k :: complex)) \ C" by (erule e_transcendental_aux_bound) define E where "E = (1 + real n) * real_of_int qmax * real n * exp (real n) / real n" define F where "F = real n * C" have ineq: "fact (p - 1) \ E * F ^ p" if p: "prime p" "p > n" "p > abs (coeff q 0)" for p proof - from p(1) have p_pos: "p > 0" by (simp add: prime_gt_0_nat) define f :: "int poly" where "f = monom 1 (p - 1) * (\k\{1..n}. [:-of_nat k, 1:] ^ p)" have poly_f: "poly (of_int_poly f) x = x ^ (p - 1) * (\k\{1..n}. (x - of_nat k)) ^ p" for x :: complex by (simp add: f_def poly_prod poly_monom prod_power_distrib) define m :: nat where "m = degree f" from p_pos have m: "m = (n + 1) * p - 1" by (simp add: m_def f_def degree_mult_eq degree_monom_eq degree_prod_sum_eq degree_linear_power) define M :: int where "M = (- 1) ^ (n * p) * fact n ^ p" with p have p_not_dvd_M: "\int p dvd M" by (auto simp: M_def prime_elem_int_not_dvd_neg1_power prime_dvd_power_iff prime_gt_0_nat prime_dvd_fact_iff_int prime_dvd_mult_iff) interpret lindemann_weierstrass_aux "of_int_poly f" . define J :: complex where "J = (\k\n. of_int (coeff q k) * I (of_nat k))" define idxs where "idxs = ({..n}\{..m}) - {(0, p - 1)}" hence "J = (\k\n. of_int (coeff q k) * exp 1 ^ k) * (\n\m. of_int (poly ((pderiv ^^ n) f) 0)) - of_int (\k\n. \n\m. coeff q k * poly ((pderiv ^^ n) f) (int k))" by (simp add: J_def I_def algebra_simps sum_subtractf sum_distrib_left m_def exp_of_nat_mult [symmetric]) also have "(\k\n. of_int (coeff q k) * exp 1 ^ k) = poly (of_int_poly q) (exp 1 :: complex)" by (simp add: poly_altdef n_def) also have "\ = 0" by fact finally have "J = of_int (-(\(k,n)\{..n}\{..m}. coeff q k * poly ((pderiv ^^ n) f) (int k)))" by (simp add: sum.cartesian_product) also have "{..n}\{..m} = insert (0, p - 1) idxs" by (auto simp: m idxs_def) also have "-(\(k,n)\\. coeff q k * poly ((pderiv ^^ n) f) (int k)) = - (coeff q 0 * poly ((pderiv ^^ (p - 1)) f) 0) - (\(k, n)\idxs. coeff q k * poly ((pderiv ^^ n) f) (of_nat k))" by (subst sum.insert) (simp_all add: idxs_def) also have "coeff q 0 * poly ((pderiv ^^ (p - 1)) f) 0 = coeff q 0 * M * fact (p - 1)" proof - have "f = [:-0, 1:] ^ (p - 1) * (\k = 1..n. [:- of_nat k, 1:] ^ p)" by (simp add: f_def monom_altdef) also have "poly ((pderiv ^^ (p - 1)) \) 0 = fact (p - 1) * poly (\k = 1..n. [:- of_nat k, 1:] ^ p) 0" by (rule poly_higher_pderiv_aux2) also have "poly (\k = 1..n. [:- of_nat k :: int, 1:] ^ p) 0 = (-1)^(n*p) * fact n ^ p" by (induction n) (simp_all add: prod.nat_ivl_Suc' power_mult_distrib mult_ac power_minus' power_add del: of_nat_Suc) finally show ?thesis by (simp add: mult_ac M_def) qed also obtain N where "(\(k, n)\idxs. coeff q k * poly ((pderiv ^^ n) f) (int k)) = fact p * N" proof - have "\(k, n)\idxs. fact p dvd poly ((pderiv ^^ n) f) (of_nat k)" proof clarify fix k j assume idxs: "(k, j) \ idxs" then consider "k = 0" "j < p - 1" | "k = 0" "j > p - 1" | "k \ 0" "j < p" | "k \ 0" "j \ p" by (fastforce simp: idxs_def) thus "fact p dvd poly ((pderiv ^^ j) f) (of_nat k)" proof cases case 1 thus ?thesis by (simp add: f_def poly_higher_pderiv_aux1' monom_altdef) next case 2 thus ?thesis by (simp add: f_def poly_higher_pderiv_aux3' monom_altdef fact_dvd_poly_higher_pderiv_aux') next case 3 thus ?thesis unfolding f_def by (subst poly_higher_pderiv_aux1'[of _ p]) (insert idxs, auto simp: idxs_def intro!: dvd_mult) next case 4 thus ?thesis unfolding f_def by (intro poly_higher_pderiv_aux3') (insert idxs, auto intro!: dvd_mult simp: idxs_def) qed qed hence "fact p dvd (\(k, n)\idxs. coeff q k * poly ((pderiv ^^ n) f) (int k))" by (auto intro!: dvd_sum dvd_mult simp del: of_int_fact) with that show thesis by blast qed also from p have "- (coeff q 0 * M * fact (p - 1)) - fact p * N = - fact (p - 1) * (coeff q 0 * M + p * N)" by (subst fact_reduce[of p]) (simp_all add: algebra_simps) finally have J: "J = -of_int (fact (p - 1) * (coeff q 0 * M + p * N))" by simp from p q(2) have "\p dvd coeff q 0 * M + p * N" by (auto simp: dvd_add_left_iff p_not_dvd_M prime_dvd_fact_iff_int prime_dvd_mult_iff dest: dvd_imp_le_int) hence "coeff q 0 * M + p * N \ 0" by (intro notI) simp_all hence "abs (coeff q 0 * M + p * N) \ 1" by simp hence "norm (of_int (coeff q 0 * M + p * N) :: complex) \ 1" by (simp only: norm_of_int) hence "fact (p - 1) * \ \ fact (p - 1) * 1" by (intro mult_left_mono) simp_all hence J_lower: "norm J \ fact (p - 1)" unfolding J norm_minus_cancel of_int_mult of_int_fact by (simp add: norm_mult) have "norm J \ (\k\n. norm (of_int (coeff q k) * I (of_nat k)))" unfolding J_def by (rule norm_sum) also have "\ \ (\k\n. of_int qmax * (real n * exp (real n) * real n ^ (p - 1) * C ^ p))" proof (intro sum_mono) fix k assume k: "k \ {..n}" have "n > 0" by (rule ccontr) simp { fix x :: complex assume x: "x \ closed_segment 0 (of_nat k)" then obtain t where t: "t \ 0" "t \ 1" "x = of_real t * of_nat k" by (auto simp: closed_segment_def scaleR_conv_of_real) hence "norm x = t * real k" by (simp add: norm_mult) also from \t \ 1\ k have *: "\ \ 1 * real n" by (intro mult_mono) simp_all finally have x': "norm x \ real n" by simp from t \n > 0\ * have x'': "x \ closed_segment 0 (of_nat n)" by (auto simp: closed_segment_def scaleR_conv_of_real field_simps intro!: exI[of _ "t * real k / real n"] ) have "norm (poly (of_int_poly f) x) = norm x ^ (p - 1) * cmod (\i = 1..n. x - i) ^ p" by (simp add: poly_f norm_mult norm_power) also from x x' x'' have "\ \ of_nat n ^ (p - 1) * C ^ p" by (intro mult_mono C power_mono) simp_all finally have "norm (poly (of_int_poly f) x) \ real n ^ (p - 1) * C ^ p" . } note A = this have "norm (I (of_nat k)) \ cmod (of_nat k) * exp (cmod (of_nat k)) * (of_nat n ^ (p - 1) * C ^ p)" by (intro lindemann_weierstrass_integral_bound[OF _ A] C mult_nonneg_nonneg zero_le_power) auto also have "\ \ cmod (of_nat n) * exp (cmod (of_nat n)) * (of_nat n ^ (p - 1) * C ^ p)" using k by (intro mult_mono zero_le_power mult_nonneg_nonneg C) simp_all finally show "cmod (of_int (coeff q k) * I (of_nat k)) \ of_int qmax * (real n * exp (real n) * real n ^ (p - 1) * C ^ p)" unfolding norm_mult by (intro mult_mono) (simp_all add: qmax of_int_abs [symmetric] del: of_int_abs) qed also have "\ = E * F ^ p" using p_pos by (simp add: power_diff power_mult_distrib E_def F_def) finally show "fact (p - 1) \ E * F ^ p" using J_lower by linarith qed have "(\n. E * F * F ^ (n - 1) / fact (n - 1)) \ 0" (is ?P) by (intro filterlim_compose[OF power_over_fact_tendsto_0' filterlim_minus_nat_at_top]) also have "?P \ (\n. E * F ^ n / fact (n - 1)) \ 0" by (intro filterlim_cong refl eventually_mono[OF eventually_gt_at_top[of "0::nat"]]) (auto simp: power_Suc [symmetric] simp del: power_Suc) finally have "eventually (\n. E * F ^ n / fact (n - 1) < 1) at_top" by (rule order_tendstoD) simp_all hence "eventually (\n. E * F ^ n < fact (n - 1)) at_top" by eventually_elim simp then obtain P where P: "\n. n \ P \ E * F ^ n < fact (n - 1)" by (auto simp: eventually_at_top_linorder) have "\p. prime p \ p > Max {nat (abs (coeff q 0)), n, P}" by (rule bigger_prime) then obtain p where "prime p" "p > Max {nat (abs (coeff q 0)), n, P}" by blast hence "int p > abs (coeff q 0)" "p > n" "p \ P" by auto with ineq[of p] \prime p\ have "fact (p - 1) \ E * F ^ p" by simp moreover from \p \ P\ have "fact (p - 1) > E * F ^ p" by (rule P) ultimately show False by linarith qed corollary e_transcendental_real: "\ algebraic (exp 1 :: real)" proof - have "\algebraic (exp 1 :: complex)" by (rule e_transcendental_complex) also have "(exp 1 :: complex) = of_real (exp 1)" using exp_of_real[of 1] by simp also have "algebraic \ \ algebraic (exp 1 :: real)" by simp finally show ?thesis . qed end diff --git a/thys/Landau_Symbols/Group_Sort.thy b/thys/Landau_Symbols/Group_Sort.thy --- a/thys/Landau_Symbols/Group_Sort.thy +++ b/thys/Landau_Symbols/Group_Sort.thy @@ -1,330 +1,330 @@ (* File: Group_Sort.thy - Author: Manuel Eberl + Author: Manuel Eberl A sorting algorithm that sorts values according to a key function and groups equivalent elements using a commutative and associative binary operation. *) section \Sorting and grouping factors\ theory Group_Sort imports Main "HOL-Library.Multiset" begin text \ For the reification of products of powers of primitive functions such as @{term "\x. x * ln x ^2"} into a canonical form, we need to be able to sort the factors according to the growth of the primitive function it contains and merge terms with the same function by adding their exponents. The following locale defines such an operation in a general setting; we can then instantiate it for our setting. The locale takes as parameters a key function @{term "f"} that sends list elements into a linear ordering that determines the sorting order, a @{term "merge"} function to merge to equivalent (w.r.t. @{term "f"}) elements into one, and a list reduction function @{term "g"} that reduces a list to a single value. This function must be invariant w.r.t. the order of list elements and be compatible with merging of equivalent elements. In our case, this list reduction function will be the product of all list elements. \ locale groupsort = fixes f :: "'a \ ('b::linorder)" fixes merge :: "'a \ 'a \ 'a" fixes g :: "'a list \ 'c" assumes f_merge: "f x = f y \ f (merge x y) = f x" assumes g_cong: "mset xs = mset ys \ g xs = g ys" assumes g_merge: "f x = f y \ g [x,y] = g [merge x y]" assumes g_append_cong: "g xs1 = g xs2 \ g ys1 = g ys2 \ g (xs1 @ ys1) = g (xs2 @ ys2)" begin context begin private function part_aux :: "'b \ 'a list \ ('a list) \ ('a list) \ ('a list) \ ('a list) \ ('a list) \ ('a list)" where "part_aux p [] (ls, eq, gs) = (ls, eq, gs)" | "f x < p \ part_aux p (x#xs) (ls, eq, gs) = part_aux p xs (x#ls, eq, gs)" | "f x > p \ part_aux p (x#xs) (ls, eq, gs) = part_aux p xs (ls, eq, x#gs)" | "f x = p \ part_aux p (x#xs) (ls, eq, gs) = part_aux p xs (ls, eq@[x], gs)" proof (clarify, goal_cases) case prems: (1 P p xs ls eq gs) show ?case proof (cases xs) fix x xs' assume "xs = x # xs'" thus ?thesis using prems by (cases "f x" p rule: linorder_cases) auto qed (auto intro: prems(1)) qed simp_all termination by (relation "Wellfounded.measure (size \ fst \ snd)") simp_all private lemma groupsort_locale: "groupsort f merge g" by unfold_locales private lemmas part_aux_induct = part_aux.induct[split_format (complete), OF groupsort_locale] private definition part where "part p xs = part_aux (f p) xs ([], [p], [])" private lemma part: "part p xs = (rev (filter (\x. f x < f p) xs), p # filter (\x. f x = f p) xs, rev (filter (\x. f x > f p) xs))" proof- { fix p xs ls eq gs have "fst (part_aux p xs (ls, eq, gs)) = rev (filter (\x. f x < p) xs) @ ls" by (induction p xs ls eq gs rule: part_aux_induct) simp_all } note A = this { fix p xs ls eq gs have "snd (snd (part_aux p xs (ls, eq, gs))) = rev (filter (\x. f x > p) xs) @ gs" by (induction p xs ls eq gs rule: part_aux_induct) simp_all } note B = this { fix p xs ls eq gs have "fst (snd (part_aux p xs (ls, eq, gs))) = eq @ filter (\x. f x = p) xs" by (induction p xs ls eq gs rule: part_aux_induct) auto } note C = this note ABC = A B C from ABC[of "f p" xs "[]" "[p]" "[]"] show ?thesis unfolding part_def by (intro prod_eqI) simp_all qed private function sort :: "'a list \ 'a list" where "sort [] = []" | "sort (x#xs) = (case part x xs of (ls, eq, gs) \ sort ls @ eq @ sort gs)" by pat_completeness simp_all termination by (relation "Wellfounded.measure length") (simp_all add: part less_Suc_eq_le) private lemma filter_mset_union: assumes "\x. x \# A \ P x \ Q x \ False" shows "filter_mset P A + filter_mset Q A = filter_mset (\x. P x \ Q x) A" (is "?lhs = ?rhs") using assms by (auto simp add: count_eq_zero_iff intro!: multiset_eqI) blast private lemma multiset_of_sort: "mset (sort xs) = mset xs" proof (induction xs rule: sort.induct) case (2 x xs) let ?M = "\oper. {#y:# mset xs. oper (f y) (f x)#}" from 2 have "mset (sort (x#xs)) = ?M (<) + ?M (=) + ?M (>) + {#x#}" by (simp add: part Multiset.union_assoc mset_filter) also have "?M (<) + ?M (=) + ?M (>) = mset xs" by ((subst filter_mset_union, force)+, subst multiset_eq_iff, force) finally show ?case by simp qed simp private lemma g_sort: "g (sort xs) = g xs" by (intro g_cong multiset_of_sort) private lemma set_sort: "set (sort xs) = set xs" using arg_cong[OF multiset_of_sort[of xs], of "set_mset"] by (simp only: set_mset_mset) private lemma sorted_all_equal: "(\x. x \ set xs \ x = y) \ sorted xs" by (induction xs) (auto) private lemma sorted_sort: "sorted (map f (sort xs))" apply (induction xs rule: sort.induct) apply simp apply (simp only: sorted_append sort.simps part map_append split) apply (intro conjI TrueI) using sorted_map_same by (auto simp: set_sort) private fun group where "group [] = []" | "group (x#xs) = (case partition (\y. f y = f x) xs of (xs', xs'') \ fold merge xs' x # group xs'')" private lemma f_fold_merge: "(\y. y \ set xs \ f y = f x) \ f (fold merge xs x) = f x" by (induction xs rule: rev_induct) (auto simp: f_merge) private lemma f_group: "x \ set (group xs) \ \x'\set xs. f x = f x'" proof (induction xs rule: group.induct) case (2 x' xs) hence "x = fold merge [y\xs . f y = f x'] x' \ x \ set (group [xa\xs . f xa \ f x'])" by (auto simp: o_def) thus ?case proof assume "x = fold merge [y\xs . f y = f x'] x'" also have "f ... = f x'" by (rule f_fold_merge) simp finally show ?thesis by simp next assume "x \ set (group [xa\xs . f xa \ f x'])" from 2(1)[OF _ this] have "\x'\set [xa\xs . f xa \ f x']. f x = f x'" by (simp add: o_def) thus ?thesis by force qed qed simp private lemma sorted_group: "sorted (map f xs) \ sorted (map f (group xs))" proof (induction xs rule: group.induct) case (2 x xs) { fix x' assume x': "x' \ set (group [y\xs . f y \ f x])" with f_group obtain x'' where x'': "x'' \ set xs" "f x' = f x''" by force have "f (fold merge [y\xs . f y = f x] x) = f x" by (subst f_fold_merge) simp_all also from 2(2) x'' have "... \ f x'" by (auto) finally have "f (fold merge [y\xs . f y = f x] x) \ f x'" . } moreover from 2(2) have "sorted (map f (group [xa\xs . f xa \ f x]))" by (intro 2 sorted_filter) (simp_all add: o_def) ultimately show ?case by (simp add: o_def) qed simp_all private lemma distinct_group: "distinct (map f (group xs))" proof (induction xs rule: group.induct) case (2 x xs) have "distinct (map f (group [xa\xs . f xa \ f x]))" by (intro 2) (simp_all add: o_def) moreover have "f (fold merge [y\xs . f y = f x] x) \ set (map f (group [xa\xs . f xa \ f x]))" by (rule notI, subst (asm) f_fold_merge) (auto dest: f_group) ultimately show ?case by (simp add: o_def) qed simp private lemma g_fold_same: assumes "\z. z \ set xs \ f z = f x" shows "g (fold merge xs x # ys) = g (x#xs@ys)" using assms proof (induction xs arbitrary: x) case (Cons y xs) have "g (x # y # xs @ ys) = g (y # x # xs @ ys)" by (intro g_cong) (auto simp: add_ac) also have "y # x # xs @ ys = [y,x] @ xs @ ys" by simp also from Cons.prems have "g ... = g ([merge y x] @ xs @ ys)" by (intro g_append_cong g_merge) auto also have "[merge y x] @ xs @ ys = merge y x # xs @ ys" by simp also from Cons.prems have "g ... = g (fold merge xs (merge y x) # ys)" by (intro Cons.IH[symmetric]) (auto simp: f_merge) also have "... = g (fold merge (y # xs) x # ys)" by simp finally show ?case by simp qed simp private lemma g_group: "g (group xs) = g xs" proof (induction xs rule: group.induct) case (2 x xs) have "g (group (x#xs)) = g (fold merge [y\xs . f y = f x] x # group [xa\xs . f xa \ f x])" by (simp add: o_def) also have "... = g (x # [y\xs . f y = f x] @ group [y\xs . f y \ f x])" by (intro g_fold_same) simp_all also have "... = g ((x # [y\xs . f y = f x]) @ group [y\xs . f y \ f x])" (is "_ = ?A") by simp also from 2 have "g (group [y\xs . f y \ f x]) = g [y\xs . f y \ f x]" by (simp add: o_def) hence "?A = g ((x # [y\xs . f y = f x]) @ [y\xs . f y \ f x])" by (intro g_append_cong) simp_all also have "... = g (x#xs)" by (intro g_cong) (simp_all) finally show ?case . qed simp function group_part_aux :: "'b \ 'a list \ ('a list) \ 'a \ ('a list) \ ('a list) \ 'a \ ('a list)" where "group_part_aux p [] (ls, eq, gs) = (ls, eq, gs)" | "f x < p \ group_part_aux p (x#xs) (ls, eq, gs) = group_part_aux p xs (x#ls, eq, gs)" | "f x > p \ group_part_aux p (x#xs) (ls, eq, gs) = group_part_aux p xs (ls, eq, x#gs)" | "f x = p \ group_part_aux p (x#xs) (ls, eq, gs) = group_part_aux p xs (ls, merge x eq, gs)" proof (clarify, goal_cases) case prems: (1 P p xs ls eq gs) show ?case proof (cases xs) fix x xs' assume "xs = x # xs'" thus ?thesis using prems by (cases "f x" p rule: linorder_cases) auto qed (auto intro: prems(1)) qed simp_all termination by (relation "Wellfounded.measure (size \ fst \ snd)") simp_all private lemmas group_part_aux_induct = group_part_aux.induct[split_format (complete), OF groupsort_locale] definition group_part where "group_part p xs = group_part_aux (f p) xs ([], p, [])" private lemma group_part: "group_part p xs = (rev (filter (\x. f x < f p) xs), fold merge (filter (\x. f x = f p) xs) p, rev (filter (\x. f x > f p) xs))" proof- { fix p xs ls eq gs have "fst (group_part_aux p xs (ls, eq, gs)) = rev (filter (\x. f x < p) xs) @ ls" by (induction p xs ls eq gs rule: group_part_aux_induct) simp_all } note A = this { fix p xs ls eq gs have "snd (snd (group_part_aux p xs (ls, eq, gs))) = rev (filter (\x. f x > p) xs) @ gs" by (induction p xs ls eq gs rule: group_part_aux_induct) simp_all } note B = this { fix p xs ls eq gs have "fst (snd (group_part_aux p xs (ls, eq, gs))) = fold merge (filter (\x. f x = p) xs) eq" by (induction p xs ls eq gs rule: group_part_aux_induct) auto } note C = this note ABC = A B C from ABC[of "f p" xs "[]" "p" "[]"] show ?thesis unfolding group_part_def by (intro prod_eqI) simp_all qed function group_sort :: "'a list \ 'a list" where "group_sort [] = []" | "group_sort (x#xs) = (case group_part x xs of (ls, eq, gs) \ group_sort ls @ eq # group_sort gs)" by pat_completeness simp_all termination by (relation "Wellfounded.measure length") (simp_all add: group_part less_Suc_eq_le) private lemma group_append: assumes "\x y. x \ set xs \ y \ set ys \ f x \ f y" shows "group (xs @ ys) = group xs @ group ys" using assms proof (induction xs arbitrary: ys rule: length_induct) case (1 xs') hence IH: "\x xs ys. length xs < length xs' \ (\x y. x \ set xs \ y \ set ys \ f x \ f y) \ group (xs @ ys) = group xs @ group ys" by blast show ?case proof (cases xs') case (Cons x xs) note [simp] = this have "group (xs' @ ys) = fold merge [y\xs@ys . f y = f x] x # group ([xa\xs . f xa \ f x] @ [xa\ys . f xa \ f x])" by (simp add: o_def) also from 1(2) have "[y\xs@ys . f y = f x] = [y\xs . f y = f x]" by (force simp: filter_empty_conv) also from 1(2) have "[xa\ys . f xa \ f x] = ys" by (force simp: filter_id_conv) also have "group ([xa\xs . f xa \ f x] @ ys) = group [xa\xs . f xa \ f x] @ group ys" using 1(2) by (intro IH) (simp_all add: less_Suc_eq_le) finally show ?thesis by (simp add: o_def) qed simp qed private lemma group_empty_iff [simp]: "group xs = [] \ xs = []" by (induction xs rule: group.induct) auto lemma group_sort_correct: "group_sort xs = group (sort xs)" proof (induction xs rule: group_sort.induct) case (2 x xs) have "group_sort (x#xs) = group_sort (rev [xa\xs . f xa < f x]) @ group (x#[xa\xs . f xa = f x]) @ group_sort (rev [xa\xs . f x < f xa])" by (simp add: group_part) also have "group_sort (rev [xa\xs . f xa < f x]) = group (sort (rev [xa\xs . f xa < f x]))" by (rule 2) (simp_all add: group_part) also have "group_sort (rev [xa\xs . f xa > f x]) = group (sort (rev [xa\xs . f xa > f x]))" by (rule 2) (simp_all add: group_part) also have "group (x#[xa\xs . f xa = f x]) @ group (sort (rev [xa\xs . f xa > f x])) = group ((x#[xa\xs . f xa = f x]) @ sort (rev [xa\xs . f xa > f x]))" by (intro group_append[symmetric]) (auto simp: set_sort) also have "group (sort (rev [xa\xs . f xa < f x])) @ ... = group (sort (rev [xa\xs . f xa < f x]) @ (x#[xa\xs . f xa = f x]) @ sort (rev [xa\xs . f xa > f x]))" by (intro group_append[symmetric]) (auto simp: set_sort) also have "sort (rev [xa\xs . f xa < f x]) @ (x#[xa\xs . f xa = f x]) @ sort (rev [xa\xs . f xa > f x]) = sort (x # xs)" by (simp add: part) finally show ?case . qed simp lemma sorted_group_sort: "sorted (map f (group_sort xs))" by (auto simp: group_sort_correct intro!: sorted_group sorted_sort) lemma distinct_group_sort: "distinct (map f (group_sort xs))" by (simp add: group_sort_correct distinct_group) lemma g_group_sort: "g (group_sort xs) = g xs" by (simp add: group_sort_correct g_group g_sort) lemmas [simp del] = group_sort.simps group_part_aux.simps end end end diff --git a/thys/Landau_Symbols/Landau_Library.thy b/thys/Landau_Symbols/Landau_Library.thy --- a/thys/Landau_Symbols/Landau_Library.thy +++ b/thys/Landau_Symbols/Landau_Library.thy @@ -1,234 +1,234 @@ (* File: Landau_Library.thy - Author: Manuel Eberl + Author: Manuel Eberl Auxiliary lemmas that should be merged into HOL. *) section \Auxiliary lemmas\ theory Landau_Library imports Complex_Main begin subsection \Filters\ lemma eventually_at_top_compose: assumes "\c. eventually (\x. (f x:: 'a :: linorder) \ c) F" "eventually P at_top" shows "eventually (\x. P (f x)) F" using assms filterlim_at_top filterlim_iff by blast lemma eventually_False_at_top_linorder [simp]: "eventually (\_::_::linorder. False) at_top \ False" unfolding eventually_at_top_linorder by force lemma eventually_not_equal: "eventually (\x::'a::linordered_semidom. x \ a) at_top" using eventually_ge_at_top[of "a+1"] by eventually_elim (insert less_add_one[of a], auto) lemma eventually_subst': "eventually (\x. f x = g x) F \ eventually (\x. P x (f x)) F = eventually (\x. P x (g x)) F" by (rule eventually_subst, erule eventually_rev_mp) simp lemma eventually_nat_real: assumes "eventually P (at_top :: real filter)" shows "eventually (\x. P (real x)) (at_top :: nat filter)" using assms filterlim_real_sequentially unfolding filterlim_def le_filter_def eventually_filtermap by auto lemma filterlim_cong': assumes "filterlim f F G" assumes "eventually (\x. f x = g x) G" shows "filterlim g F G" using assms by (subst filterlim_cong[OF refl refl, of _ f]) (auto elim: eventually_mono) lemma eventually_ln_at_top: "eventually (\x. P (ln x :: real)) at_top = eventually P at_top" proof fix P assume "eventually (\x. P (ln x :: real)) at_top" then obtain x0 where x0: "\x. x \ x0 \ P (ln x)" by (subst (asm) eventually_at_top_linorder) auto { fix x assume "x \ ln (max 1 x0)" hence "exp x \ max 1 x0" by (subst (2) exp_ln[symmetric], simp, subst exp_le_cancel_iff) hence "exp x \ x0" by simp from x0[OF this] have "P x" by simp } thus "eventually P at_top" by (subst eventually_at_top_linorder) blast next fix P :: "real \ bool" assume "eventually P at_top" then obtain x0 where x0: "\x. x \ x0 \ P x" by (subst (asm) eventually_at_top_linorder) auto { fix x assume "x \ exp x0" hence "ln x \ x0" by (subst ln_exp[symmetric], subst ln_le_cancel_iff) (simp_all add: less_le_trans[OF exp_gt_zero]) from x0[OF this] have "P (ln x)" . } thus "eventually (\x. P (ln x)) at_top" by (subst eventually_at_top_linorder) blast qed lemma filtermap_ln_at_top: "filtermap (ln :: real \ real) at_top = at_top" by (simp add: filter_eq_iff eventually_filtermap eventually_ln_at_top) lemma eventually_ln_not_equal: "eventually (\x::real. ln x \ a) at_top" by (subst eventually_ln_at_top) (rule eventually_not_equal) subsection \Miscellaneous\ lemma ln_mono: "0 < x \ 0 < y \ x \ y \ ln (x::real) \ ln y" by (subst ln_le_cancel_iff) simp_all lemma ln_mono_strict: "0 < x \ 0 < y \ x < y \ ln (x::real) < ln y" by (subst ln_less_cancel_iff) simp_all lemma prod_list_pos: "(\x::_::linordered_semidom. x \ set xs \ x > 0) \ prod_list xs > 0" by (induction xs) auto lemma (in monoid_mult) fold_plus_prod_list_rev: "fold times xs = times (prod_list (rev xs))" proof fix x have "fold times xs x = prod_list (rev xs @ [x])" by (simp add: foldr_conv_fold prod_list.eq_foldr) also have "\ = prod_list (rev xs) * x" by simp finally show "fold times xs x = prod_list (rev xs) * x" . qed subsection \Real powers\ lemma powr_realpow_eventually: assumes "filterlim f at_top F" shows "eventually (\x. f x powr (real n) = f x ^ n) F" proof- from assms have "eventually (\x. f x > 0) F" using filterlim_at_top_dense by blast thus ?thesis by eventually_elim (simp add: powr_realpow) qed lemma zero_powr [simp]: "(0::real) powr x = 0" unfolding powr_def by simp lemma powr_negD: "(a::real) powr b \ 0 \ a = 0" unfolding powr_def by (simp split: if_split_asm) lemma inverse_powr [simp]: assumes "(x::real) \ 0" shows "inverse x powr y = inverse (x powr y)" proof (cases "x > 0") assume x: "x > 0" from x have "inverse x powr y = exp (y * ln (inverse x))" by (simp add: powr_def) also have "ln (inverse x) = -ln x" by (simp add: x ln_inverse) also have "exp (y * -ln x) = inverse (exp (y * ln x))" by (simp add: exp_minus) also from x have "exp (y * ln x) = x powr y" by (simp add: powr_def) finally show ?thesis . qed (insert assms, simp) lemma powr_mono': assumes "(x::real) > 0" "x \ 1" "a \ b" shows "x powr b \ x powr a" proof- have "inverse x powr a \ inverse x powr b" using assms by (intro powr_mono) (simp_all add: field_simps) hence "inverse (x powr a) \ inverse (x powr b)" using assms by simp with assms show ?thesis by (simp add: field_simps) qed lemma powr_less_mono': assumes "(x::real) > 0" "x < 1" "a < b" shows "x powr b < x powr a" proof- have "inverse x powr a < inverse x powr b" using assms by (intro powr_less_mono) (simp_all add: field_simps) hence "inverse (x powr a) < inverse (x powr b)" using assms by simp with assms show ?thesis by (simp add: field_simps) qed lemma powr_lower_bound: "\(l::real) > 0; l \ x; x \ u\ \ min (l powr z) (u powr z) \ x powr z" apply (cases "z \ 0") apply (rule order.trans[OF min.cobounded1 powr_mono2], simp_all) [] apply (rule order.trans[OF min.cobounded2 powr_mono2'], simp_all) [] done lemma powr_upper_bound: "\(l::real) > 0; l \ x; x \ u\ \ max (l powr z) (u powr z) \ x powr z" apply (cases "z \ 0") apply (rule order.trans[OF powr_mono2 max.cobounded2], simp_all) [] apply (rule order.trans[OF powr_mono2' max.cobounded1], simp_all) [] done lemma powr_eventually_exp_ln: "eventually (\x. (x::real) powr p = exp (p * ln x)) at_top" using eventually_gt_at_top[of "0::real"] unfolding powr_def by eventually_elim simp_all lemma powr_eventually_exp_ln': assumes "x > 0" shows "eventually (\x. (x::real) powr p = exp (p * ln x)) (nhds x)" proof- let ?A = "{(0::real)<..}" from assms have "eventually (\x. x > 0) (nhds x)" unfolding eventually_nhds by (intro exI[of _ "{(0::real)<..}"]) simp_all thus ?thesis by eventually_elim (simp add: powr_def) qed lemma powr_at_top: assumes "(p::real) > 0" shows "filterlim (\x. x powr p) at_top at_top" proof- have "LIM x at_top. exp (p * ln x) :> at_top" by (rule filterlim_compose[OF exp_at_top filterlim_tendsto_pos_mult_at_top[OF tendsto_const]]) (simp_all add: ln_at_top assms) thus ?thesis by (subst filterlim_cong[OF refl refl powr_eventually_exp_ln]) qed lemma powr_at_top_neg: assumes "(a::real) > 0" "a < 1" shows "((\x. a powr x) \ 0) at_top" proof- from assms have "LIM x at_top. ln (inverse a) * x :> at_top" by (intro filterlim_tendsto_pos_mult_at_top[OF tendsto_const]) (simp_all add: filterlim_ident field_simps) with assms have "LIM x at_top. ln a * x :> at_bot" by (subst filterlim_uminus_at_bot) (simp add: ln_inverse) hence "((\x. exp (x * ln a)) \ 0) at_top" by (intro filterlim_compose[OF exp_at_bot]) (simp_all add: mult.commute) with assms show ?thesis unfolding powr_def by simp qed lemma powr_at_bot: assumes "(a::real) > 1" shows "((\x. a powr x) \ 0) at_bot" proof- from assms have "filterlim (\x. ln a * x) at_bot at_bot" by (intro filterlim_tendsto_pos_mult_at_bot[OF tendsto_const _ filterlim_ident]) auto hence "((\x. exp (x * ln a)) \ 0) at_bot" by (intro filterlim_compose[OF exp_at_bot]) (simp add: algebra_simps) thus ?thesis using assms unfolding powr_def by simp qed lemma powr_at_bot_neg: assumes "(a::real) > 0" "a < 1" shows "filterlim (\x. a powr x) at_top at_bot" proof- from assms have "LIM x at_bot. ln (inverse a) * -x :> at_top" by (intro filterlim_tendsto_pos_mult_at_top[OF tendsto_const] filterlim_uminus_at_top_at_bot) (simp_all add: ln_inverse) with assms have "LIM x at_bot. x * ln a :> at_top" by (subst (asm) ln_inverse) (simp_all add: mult.commute) hence "LIM x at_bot. exp (x * ln a) :> at_top" by (intro filterlim_compose[OF exp_at_top]) simp thus ?thesis using assms unfolding powr_def by simp qed lemma DERIV_powr: assumes "x > 0" shows "((\x. x powr p) has_real_derivative p * x powr (p - 1)) (at x)" proof- have "((\x. exp (p * ln x)) has_real_derivative exp (p * ln x) * (p * inverse x)) (at x)" unfolding powr_def by (intro DERIV_fun_exp DERIV_cmult DERIV_ln) fact also have "exp (p * ln x) * (p * inverse x) = p * x powr (p - 1)" unfolding powr_def by (simp add: field_simps exp_diff assms) finally show ?thesis using assms by (subst DERIV_cong_ev[OF refl powr_eventually_exp_ln' refl]) qed end diff --git a/thys/Landau_Symbols/Landau_More.thy b/thys/Landau_Symbols/Landau_More.thy --- a/thys/Landau_Symbols/Landau_More.thy +++ b/thys/Landau_Symbols/Landau_More.thy @@ -1,280 +1,280 @@ (* File: Landau_More.thy - Author: Andreas Lochbihler, Manuel Eberl + Author: Andreas Lochbihler, Manuel Eberl Some more facts about Landau symbols. *) theory Landau_More imports "HOL-Library.Landau_Symbols" Landau_Simprocs begin (* Additional theorems, contributed by Andreas Lochbihler and adapted by Manuel Eberl *) lemma bigo_const_inverse [simp]: assumes "filterlim f at_top F" "F \ bot" shows "(\_. c) \ O[F](\x. inverse (f x) :: real) \ c = 0" proof - { assume A: "(\_. 1) \ O[F](\x. inverse (f x))" from assms have "(\_. 1) \ o[F](f)" by (simp add: eventually_nonzero_simps smallomega_iff_smallo filterlim_at_top_iff_smallomega) also from assms A have "f \ O[F](\_. 1)" by (simp add: eventually_nonzero_simps landau_divide_simps) finally have False using assms by (simp add: landau_o.small_refl_iff) } thus ?thesis by (cases "c = 0") auto qed lemma smallo_const_inverse [simp]: "filterlim f at_top F \ F \ bot \ (\_. c :: real) \ o[F](\x. inverse (f x)) \ c = 0" by (auto dest: landau_o.small_imp_big) lemma const_in_smallo_const [simp]: "(\_. b) \ o(\_ :: _ :: linorder. c) \ b = 0" (is "?lhs \ ?rhs") by (cases "b = 0"; cases "c = 0") (simp_all add: landau_o.small_refl_iff) lemma smallomega_1_conv_filterlim: "f \ \[F](\_. 1) \ filterlim f at_infinity F" by (auto intro: smallomegaI_filterlim_at_infinity dest: smallomegaD_filterlim_at_infinity) lemma bigtheta_powr_1 [landau_simp]: "eventually (\x. (f x :: real) \ 0) F \ (\x. f x powr 1) \ \[F](f)" by (intro bigthetaI_cong) (auto elim!: eventually_mono) lemma bigtheta_powr_0 [landau_simp]: "eventually (\x. (f x :: real) \ 0) F \ (\x. f x powr 0) \ \[F](\_. 1)" by (intro bigthetaI_cong) (auto elim!: eventually_mono) lemma bigtheta_powr_nonzero [landau_simp]: "eventually (\x. (f x :: real) \ 0) F \ (\x. if f x = 0 then g x else h x) \ \[F](h)" by (intro bigthetaI_cong) (auto elim!: eventually_mono) lemma bigtheta_powr_nonzero' [landau_simp]: "eventually (\x. (f x :: real) \ 0) F \ (\x. if f x \ 0 then g x else h x) \ \[F](g)" by (intro bigthetaI_cong) (auto elim!: eventually_mono) lemma bigtheta_powr_nonneg [landau_simp]: "eventually (\x. (f x :: real) \ 0) F \ (\x. if f x \ 0 then g x else h x) \ \[F](g)" by (intro bigthetaI_cong) (auto elim!: eventually_mono) lemma bigtheta_powr_nonneg' [landau_simp]: "eventually (\x. (f x :: real) \ 0) F \ (\x. if f x < 0 then g x else h x) \ \[F](h)" by (intro bigthetaI_cong) (auto elim!: eventually_mono) lemma bigo_powr_iff: assumes "0 < p" "eventually (\x. f x \ 0) F" "eventually (\x. g x \ 0) F" shows "(\x. (f x :: real) powr p) \ O[F](\x. g x powr p) \ f \ O[F](g)" (is "?lhs \ ?rhs") proof assume ?lhs with assms bigo_powr[OF this, of "inverse p"] show ?rhs by (simp add: powr_powr landau_simps) qed (insert assms, simp_all add: bigo_powr_nonneg) lemma inverse_powr [simp]: assumes "(x::real) \ 0" shows "inverse x powr y = inverse (x powr y)" proof (cases "x > 0") assume x: "x > 0" from x have "inverse x powr y = exp (y * ln (inverse x))" by (simp add: powr_def) also have "ln (inverse x) = -ln x" by (simp add: x ln_inverse) also have "exp (y * -ln x) = inverse (exp (y * ln x))" by (simp add: exp_minus) also from x have "exp (y * ln x) = x powr y" by (simp add: powr_def) finally show ?thesis . qed (insert assms, simp) lemma bigo_neg_powr_iff: assumes "p < 0" "eventually (\x. f x \ 0) F" "eventually (\x. g x \ 0) F" "eventually (\x. f x \ 0) F" "eventually (\x. g x \ 0) F" shows "(\x. (f x :: real) powr p) \ O[F](\x. g x powr p) \ g \ O[F](f)" (is "?lhs \ ?rhs") proof - have "(\x. f x powr p) \ O[F](\x. g x powr p) \ (\x. (inverse (f x)) powr -p) \ O[F](\x. (inverse (g x)) powr -p)" using assms by (intro landau_o.big.cong_ex) (auto simp: powr_minus elim: eventually_mono) also from assms have "\ \ ((\x. inverse (f x)) \ O[F](\x. inverse (g x)))" by (subst bigo_powr_iff) simp_all also from assms have "\ \ g \ O[F](f)" by (simp add: landau_o.big.inverse_cancel) finally show ?thesis . qed lemma smallo_powr_iff: assumes "0 < p" "eventually (\x. f x \ 0) F" "eventually (\x. g x \ 0) F" shows "(\x. (f x :: real) powr p) \ o[F](\x. g x powr p) \ f \ o[F](g)" (is "?lhs \ ?rhs") proof assume ?lhs with assms smallo_powr[OF this, of "inverse p"] show ?rhs by (simp add: powr_powr landau_simps) qed (insert assms, simp_all add: smallo_powr_nonneg) lemma smallo_neg_powr_iff: assumes "p < 0" "eventually (\x. f x \ 0) F" "eventually (\x. g x \ 0) F" "eventually (\x. f x \ 0) F" "eventually (\x. g x \ 0) F" shows "(\x. (f x :: real) powr p) \ o[F](\x. g x powr p) \ g \ o[F](f)" (is "?lhs \ ?rhs") proof - have "(\x. f x powr p) \ o[F](\x. g x powr p) \ (\x. (inverse (f x)) powr -p) \ o[F](\x. (inverse (g x)) powr -p)" using assms by (intro landau_o.small.cong_ex) (auto simp: powr_minus elim: eventually_mono) also from assms have "\ \ ((\x. inverse (f x)) \ o[F](\x. inverse (g x)))" by (subst smallo_powr_iff) simp_all also from assms have "\ \ g \ o[F](f)" by (simp add: landau_o.small.inverse_cancel) finally show ?thesis . qed lemma const_smallo_powr: assumes "filterlim f at_top F" "F \ bot" shows "(\_. c :: real) \ o[F](\x. f x powr p) \ p > 0 \ c = 0" by (rule linorder_cases[of p 0]; cases "c = 0") (insert assms smallo_powr_iff[of p "\_. 1" F f] smallo_neg_powr_iff[of p f F "\_. 1"], auto simp: landau_simps eventually_nonzero_simps smallo_1_iff[of F f] not_less dest: landau_o.small_asymmetric simp: eventually_False landau_o.small_refl_iff) lemma bigo_const_powr: assumes "filterlim f at_top F" "F \ bot" shows "(\_. c :: real) \ O[F](\x. f x powr p) \ p \ 0 \ c = 0" proof - from assms have A: "(\_. 1) \ o[F](f)" by (simp add: filterlim_at_top_iff_smallomega smallomega_iff_smallo landau_o.small_imp_big) hence B: "(\_. 1) \ O[F](f)" "f \ O[F](\_. 1)" using assms by (auto simp: landau_o.small_imp_big dest: landau_o.small_big_asymmetric) show ?thesis by (rule linorder_cases[of p 0]; cases "c = 0") (insert insert assms A B bigo_powr_iff[of p "\_. 1" F f] bigo_neg_powr_iff[of p "\_. 1" F f], auto simp: landau_simps eventually_nonzero_simps not_less dest: landau_o.small_asymmetric) qed lemma filterlim_powr_at_top: "(b::real) > 1 \ filterlim (\x. b powr x) at_top at_top" unfolding powr_def mult.commute[of _ "ln b"] by (auto intro!: filterlim_compose[OF exp_at_top] filterlim_tendsto_pos_mult_at_top filterlim_ident) lemma power_smallo_exponential: fixes b :: real assumes b: "b > 1" shows "(\x. x powr n) \ o(\x. b powr x)" proof (rule smalloI_tendsto) from assms have "filterlim (\x. x * ln b - n * ln x) at_top at_top" using [[simproc add: simplify_landau_sum]] by (simp add: filterlim_at_top_iff_smallomega eventually_nonzero_simps) hence "((\x. exp (-(x * ln b - n * ln x))) \ 0) at_top" (is ?A) by (intro filterlim_compose[OF exp_at_bot] filterlim_compose[OF filterlim_uminus_at_bot_at_top]) also have "?A \ ((\x. x powr n / b powr x) \ 0) at_top" using b eventually_gt_at_top[of 0] by (intro tendsto_cong) (auto simp: exp_diff powr_def field_simps exp_of_nat_mult elim: eventually_mono) finally show "((\x. x powr n / b powr x) \ 0) at_top" . qed (insert assms, simp_all add: eventually_nonzero_simps) lemma powr_fast_growth_tendsto: assumes gf: "g \ O[F](f)" and n: "n \ 0" and k: "k > 1" and f: "filterlim f at_top F" and g: "eventually (\x. g x \ 0) F" shows "(\x. g x powr n) \ o[F](\x. k powr f x :: real)" proof - from f have f': "eventually (\x. f x \ 0) F" by (simp add: eventually_nonzero_simps) from gf obtain c where c: "c > 0" "eventually (\x. norm (g x) \ c * norm (f x)) F" by (elim landau_o.bigE) from c(2) g f' have "eventually (\x. g x \ c * f x) F" by eventually_elim simp from c(2) g f' have "eventually (\x. norm (g x powr n) \ norm (c powr n * f x powr n)) F" by eventually_elim (insert n c(1), auto simp: powr_mult [symmetric] intro!: powr_mono2) from landau_o.big_mono[OF this] c(1) have "(\x. g x powr n) \ O[F](\x. f x powr n)" by simp also from power_smallo_exponential f have "(\x. f x powr n) \ o[F](\x. k powr f x)" by (rule landau_o.small.compose) fact+ finally show ?thesis . qed (* lemma bigo_const_inverse [simp]: "filterlim f at_top at_top \ (\_ :: _ :: linorder. c) \ O(\x. inverse (f x)) \ c = 0" for f :: "_ \ real" by simp lemma smallo_const_inverse [simp]: "filterlim f at_top at_top \ (\_ :: _ :: linorder. c) \ o(\x. inverse (f x)) \ c = 0" for f :: "_ \ real" by(simp) *) lemma bigo_abs_powr_iff [simp]: "0 < p \ (\x. \f x :: real\ powr p) \ O[F](\x. \g x\ powr p) \ f \ O[F](g)" by(subst bigo_powr_iff; simp) lemma smallo_abs_powr_iff [simp]: "0 < p \ (\x. \f x :: real\ powr p) \ o[F](\x. \g x\ powr p) \ f \ o[F](g)" by(subst smallo_powr_iff; simp) lemma const_smallo_inverse_powr: assumes "filterlim f at_top at_top" shows "(\_ :: _ :: linorder. c :: real) \ o(\x. inverse (f x powr p)) \ (p \ 0 \ c = 0)" proof(cases p "0 :: real" rule: linorder_cases) case p: greater have "(\_. c) \ o(\x. inverse (f x powr p)) \ (\_. \c\) \ o(\x. inverse (f x powr p))" by simp also have "\c\ = \(\c\ powr (inverse p))\ powr p" using p by(simp add: powr_powr) also { have "eventually (\x. f x \ 0) at_top" using assms by(simp add: filterlim_at_top) then have "o(\x. inverse (f x powr p)) = o(\x. \inverse (f x)\ powr p)" by(intro landau_o.small.cong)(auto elim!: eventually_rev_mp) also have "(\_. \(\c\ powr inverse p)\ powr p) \ \ \ (\_. \c\ powr (inverse p)) \ o(\x. inverse (f x))" using p by(rule smallo_abs_powr_iff) also note calculation } also have "(\_. \c\ powr (inverse p)) \ o(\x. inverse (f x)) \ c = 0" using assms by simp finally show ?thesis using p by simp next case equal from assms have "eventually (\x. f x \ 1) at_top" using assms by(simp add: filterlim_at_top) then have "o(\x. inverse (f x powr p)) = o(\x. 1)" by(intro landau_o.small.cong)(auto simp add: equal elim!: eventually_rev_mp) then show ?thesis using equal by simp next case less from assms have nonneg: "\\<^sub>F x in at_top. 0 \ f x" by(simp add: filterlim_at_top) with assms have "\\<^sub>F x in at_top. \\c\ powr (1 / - p)\ / d \ \f x\" (is "\\<^sub>F x in _. ?c \ _") if "d > 0" for d by(fastforce dest!: spec[where x="?c"] simp add: filterlim_at_top elim: eventually_rev_mp) then have "(\_. \c\ powr (1 / - p)) \ o(f)" by(intro landau_o.smallI)(simp add: field_simps) then have "(\_. \\c\ powr (1 / - p)\ powr - p) \ o(\x. \f x\ powr - p)" using less by(subst smallo_powr_iff) simp_all also have "(\_. \\c\ powr (1 / - p)\ powr - p) = (\_. \c\)" using less by(simp add: powr_powr) also have "o(\x. \f x\ powr - p) = o(\x. f x powr - p)" using nonneg by(auto intro!: landau_o.small.cong elim: eventually_rev_mp) finally have "(\_. c) \ o(\x. f x powr - p)" by simp with less show ?thesis by(simp add: powr_minus[symmetric]) qed lemma bigo_const_inverse_powr: assumes "filterlim f at_top at_top" shows "(\_ :: _ :: linorder. c :: real) \ O(\x. inverse (f x powr p)) \ c = 0 \ p \ 0" proof(cases p "0 :: real" rule: linorder_cases) case p_pos: greater have "(\_. c) \ O(\x. inverse (f x powr p)) \ (\_. \c\) \ O(\x. inverse (f x powr p))" by simp also have "\c\ = \(\c\ powr inverse p)\ powr p" using p_pos by(simp add: powr_powr) also { have "eventually (\x. f x \ 0) at_top" using assms by(simp add: filterlim_at_top) then have "O(\x. inverse (f x powr p)) = O(\x. \inverse (f x)\ powr p)" by(intro landau_o.big.cong)(auto elim!: eventually_rev_mp) also have "(\_. \(\c\ powr inverse p)\ powr p) \ \ \ (\_. \c\ powr (inverse p)) \ O(\x. inverse (f x))" using p_pos by (rule bigo_abs_powr_iff) also note calculation } also have "(\_. \c\ powr (inverse p)) \ O(\x. inverse (f x)) \ c = 0" using assms by simp finally show ?thesis using p_pos by simp next case equal from assms have "eventually (\x. f x \ 1) at_top" using assms by(simp add: filterlim_at_top) then have "O(\x. inverse (f x powr p)) = O(\x. 1)" by(intro landau_o.big.cong) (auto simp add: equal elim!: eventually_rev_mp) then show ?thesis using equal by simp next case less from assms have *: "\\<^sub>F x in at_top. 1 \ f x" by(simp add: filterlim_at_top) then have "(\_. \c\ powr (1 / - p)) \ O(f)" by(intro bigoI[where c="\c\ powr (1 / - p)"]) (auto intro: order_trans[OF _ mult_left_mono, rotated] elim!: eventually_rev_mp[OF _ always_eventually]) then have "(\_. \\c\ powr (1 / - p)\ powr - p) \ O(\x. \f x\ powr - p)" using less by (subst bigo_powr_iff) simp_all also have "(\_. \\c\ powr (1 / - p)\ powr - p) = (\_. \c\)" using less by(simp add: powr_powr) also have "O(\x. \f x\ powr - p) = O(\x. f x powr - p)" using * by (auto intro!: landau_o.big.cong elim: eventually_rev_mp) finally have "(\_. c) \ O(\x. f x powr - p)" by simp thus ?thesis using less by (simp add: powr_minus[symmetric]) qed end diff --git a/thys/Landau_Symbols/Landau_Real_Products.thy b/thys/Landau_Symbols/Landau_Real_Products.thy --- a/thys/Landau_Symbols/Landau_Real_Products.thy +++ b/thys/Landau_Symbols/Landau_Real_Products.thy @@ -1,1486 +1,1486 @@ (* File: Landau_Real_Products.thy - Author: Manuel Eberl + Author: Manuel Eberl Mathematical background and reification for a decision procedure for Landau symbols of products of powers of real functions (currently the identity and the natural logarithm) TODO: more functions (exp?), more preprocessing (log) *) section \Decision procedure for real functions\ theory Landau_Real_Products imports Main "HOL-Library.Function_Algebras" "HOL-Library.Set_Algebras" "HOL-Library.Landau_Symbols" Group_Sort begin subsection \Eventual non-negativity/non-zeroness\ text \ For certain transformations of Landau symbols, it is required that the functions involved are eventually non-negative of non-zero. In the following, we set up a system to guide the simplifier to discharge these requirements during simplification at least in obvious cases. \ definition "eventually_nonzero F f \ eventually (\x. (f x :: _ :: real_normed_field) \ 0) F" definition "eventually_nonneg F f \ eventually (\x. (f x :: _ :: linordered_field) \ 0) F" named_theorems eventually_nonzero_simps lemmas [eventually_nonzero_simps] = eventually_nonzero_def [symmetric] eventually_nonneg_def [symmetric] lemma eventually_nonzeroD: "eventually_nonzero F f \ eventually (\x. f x \ 0) F" by (simp add: eventually_nonzero_def) lemma eventually_nonzero_const [eventually_nonzero_simps]: "eventually_nonzero F (\_::_::linorder. c) \ F = bot \ c \ 0" unfolding eventually_nonzero_def by (auto simp add: eventually_False) lemma eventually_nonzero_inverse [eventually_nonzero_simps]: "eventually_nonzero F (\x. inverse (f x)) \ eventually_nonzero F f" unfolding eventually_nonzero_def by simp lemma eventually_nonzero_mult [eventually_nonzero_simps]: "eventually_nonzero F (\x. f x * g x) \ eventually_nonzero F f \ eventually_nonzero F g" unfolding eventually_nonzero_def by (simp_all add: eventually_conj_iff[symmetric]) lemma eventually_nonzero_pow [eventually_nonzero_simps]: "eventually_nonzero F (\x::_::linorder. f x ^ n) \ n = 0 \ eventually_nonzero F f" by (induction n) (auto simp: eventually_nonzero_simps) lemma eventually_nonzero_divide [eventually_nonzero_simps]: "eventually_nonzero F (\x. f x / g x) \ eventually_nonzero F f \ eventually_nonzero F g" unfolding eventually_nonzero_def by (simp_all add: eventually_conj_iff[symmetric]) lemma eventually_nonzero_ident_at_top_linorder [eventually_nonzero_simps]: "eventually_nonzero at_top (\x::'a::{real_normed_field,linordered_field}. x)" unfolding eventually_nonzero_def by simp lemma eventually_nonzero_ident_nhds [eventually_nonzero_simps]: "eventually_nonzero (nhds a) (\x. x) \ a \ 0" using eventually_nhds_in_open[of "-{0}" a] by (auto elim!: eventually_mono simp: eventually_nonzero_def open_Compl dest: eventually_nhds_x_imp_x) lemma eventually_nonzero_ident_at_within [eventually_nonzero_simps]: "eventually_nonzero (at a within A) (\x. x)" using eventually_nonzero_ident_nhds[of a] by (cases "a = 0") (auto simp: eventually_nonzero_def eventually_at_filter elim!: eventually_mono) lemma eventually_nonzero_ln_at_top [eventually_nonzero_simps]: "eventually_nonzero at_top (\x::real. ln x)" unfolding eventually_nonzero_def by (auto intro!: eventually_mono[OF eventually_gt_at_top[of 1]]) lemma eventually_nonzero_ln_const_at_top [eventually_nonzero_simps]: "b > 0 \ eventually_nonzero at_top (\x. ln (b * x :: real))" unfolding eventually_nonzero_def apply (rule eventually_mono [OF eventually_gt_at_top[of "max 1 (inverse b)"]]) by (metis exp_ln exp_minus exp_minus_inverse less_numeral_extra(3) ln_gt_zero max_less_iff_conj mult.commute mult_strict_right_mono) lemma eventually_nonzero_ln_const'_at_top [eventually_nonzero_simps]: "b > 0 \ eventually_nonzero at_top (\x. ln (x * b :: real))" using eventually_nonzero_ln_const_at_top[of b] by (simp add: mult.commute) lemma eventually_nonzero_powr_at_top [eventually_nonzero_simps]: "eventually_nonzero at_top (\x::real. f x powr p) \ eventually_nonzero at_top f" unfolding eventually_nonzero_def by simp lemma eventually_nonneg_const [eventually_nonzero_simps]: "eventually_nonneg F (\_. c) \ F = bot \ c \ 0" unfolding eventually_nonneg_def by (auto simp: eventually_False) lemma eventually_nonneg_inverse [eventually_nonzero_simps]: "eventually_nonneg F (\x. inverse (f x)) \ eventually_nonneg F f" unfolding eventually_nonneg_def by (intro eventually_subst) (auto) lemma eventually_nonneg_add [eventually_nonzero_simps]: assumes "eventually_nonneg F f" "eventually_nonneg F g" shows "eventually_nonneg F (\x. f x + g x)" using assms unfolding eventually_nonneg_def by eventually_elim simp lemma eventually_nonneg_mult [eventually_nonzero_simps]: assumes "eventually_nonneg F f" "eventually_nonneg F g" shows "eventually_nonneg F (\x. f x * g x)" using assms unfolding eventually_nonneg_def by eventually_elim simp lemma eventually_nonneg_mult' [eventually_nonzero_simps]: assumes "eventually_nonneg F (\x. -f x)" "eventually_nonneg F (\x. - g x)" shows "eventually_nonneg F (\x. f x * g x)" using assms unfolding eventually_nonneg_def by eventually_elim (auto intro: mult_nonpos_nonpos) lemma eventually_nonneg_divide [eventually_nonzero_simps]: assumes "eventually_nonneg F f" "eventually_nonneg F g" shows "eventually_nonneg F (\x. f x / g x)" using assms unfolding eventually_nonneg_def by eventually_elim simp lemma eventually_nonneg_divide' [eventually_nonzero_simps]: assumes "eventually_nonneg F (\x. -f x)" "eventually_nonneg F (\x. - g x)" shows "eventually_nonneg F (\x. f x / g x)" using assms unfolding eventually_nonneg_def by eventually_elim (auto intro: divide_nonpos_nonpos) lemma eventually_nonneg_ident_at_top [eventually_nonzero_simps]: "eventually_nonneg at_top (\x. x)" unfolding eventually_nonneg_def by (rule eventually_ge_at_top) lemma eventually_nonneg_ident_nhds [eventually_nonzero_simps]: fixes a :: "'a :: {linorder_topology, linordered_field}" shows "a > 0 \ eventually_nonneg (nhds a) (\x. x)" unfolding eventually_nonneg_def using eventually_nhds_in_open[of "{0<..}" a] by (auto simp: eventually_nonneg_def dest: eventually_nhds_x_imp_x elim!: eventually_mono) lemma eventually_nonneg_ident_at_within [eventually_nonzero_simps]: fixes a :: "'a :: {linorder_topology, linordered_field}" shows "a > 0 \ eventually_nonneg (at a within A) (\x. x)" using eventually_nonneg_ident_nhds[of a] by (auto simp: eventually_nonneg_def eventually_at_filter elim: eventually_mono) lemma eventually_nonneg_pow [eventually_nonzero_simps]: "eventually_nonneg F f \ eventually_nonneg F (\x. f x ^ n)" by (induction n) (auto simp: eventually_nonzero_simps) lemma eventually_nonneg_powr [eventually_nonzero_simps]: "eventually_nonneg F (\x. f x powr y :: real)" by (simp add: eventually_nonneg_def) lemma eventually_nonneg_ln_at_top [eventually_nonzero_simps]: "eventually_nonneg at_top (\x. ln x :: real)" by (auto intro!: eventually_mono[OF eventually_gt_at_top[of "1::real"]] simp: eventually_nonneg_def) lemma eventually_nonneg_ln_const [eventually_nonzero_simps]: "b > 0 \ eventually_nonneg at_top (\x. ln (b*x) :: real)" unfolding eventually_nonneg_def using eventually_ge_at_top[of "inverse b"] by eventually_elim (simp_all add: field_simps) lemma eventually_nonneg_ln_const' [eventually_nonzero_simps]: "b > 0 \ eventually_nonneg at_top (\x. ln (x*b) :: real)" using eventually_nonneg_ln_const[of b] by (simp add: mult.commute) lemma eventually_nonzero_bigtheta': "f \ \[F](g) \ eventually_nonzero F f \ eventually_nonzero F g" unfolding eventually_nonzero_def by (rule eventually_nonzero_bigtheta) lemma eventually_nonneg_at_top: assumes "filterlim f at_top F" shows "eventually_nonneg F f" proof - from assms have "eventually (\x. f x \ 0) F" by (simp add: filterlim_at_top) thus ?thesis unfolding eventually_nonneg_def by eventually_elim simp qed lemma eventually_nonzero_at_top: assumes "filterlim (f :: 'a \ 'b :: {linordered_field, real_normed_field}) at_top F" shows "eventually_nonzero F f" proof - from assms have "eventually (\x. f x \ 1) F" by (simp add: filterlim_at_top) thus ?thesis unfolding eventually_nonzero_def by eventually_elim auto qed lemma eventually_nonneg_at_top_ASSUMPTION [eventually_nonzero_simps]: "ASSUMPTION (filterlim f at_top F) \ eventually_nonneg F f" by (simp add: ASSUMPTION_def eventually_nonneg_at_top) lemma eventually_nonzero_at_top_ASSUMPTION [eventually_nonzero_simps]: "ASSUMPTION (filterlim f (at_top :: 'a :: {linordered_field, real_normed_field} filter) F) \ eventually_nonzero F f" using eventually_nonzero_at_top[of f F] by (simp add: ASSUMPTION_def) lemma filterlim_at_top_iff_smallomega: fixes f :: "_ \ real" shows "filterlim f at_top F \ f \ \[F](\_. 1) \ eventually_nonneg F f" unfolding eventually_nonneg_def proof safe assume A: "filterlim f at_top F" thus B: "eventually (\x. f x \ 0) F" by (simp add: eventually_nonzero_simps) { fix c from A have "filterlim (\x. norm (f x)) at_top F" by (intro filterlim_at_infinity_imp_norm_at_top filterlim_at_top_imp_at_infinity) hence "eventually (\x. norm (f x) \ c) F" by (auto simp: filterlim_at_top) } thus "f \ \[F](\_. 1)" by (rule landau_omega.smallI) next assume A: "f \ \[F](\_. 1)" and B: "eventually (\x. f x \ 0) F" { fix c :: real assume "c > 0" from landau_omega.smallD[OF A this] B have "eventually (\x. f x \ c) F" by eventually_elim simp } thus "filterlim f at_top F" by (subst filterlim_at_top_gt[of _ _ 0]) simp_all qed lemma smallomega_1_iff: "eventually_nonneg F f \ f \ \[F](\_. 1 :: real) \ filterlim f at_top F" by (simp add: filterlim_at_top_iff_smallomega) lemma smallo_1_iff: "eventually_nonneg F f \ (\_. 1 :: real) \ o[F](f) \ filterlim f at_top F" by (simp add: filterlim_at_top_iff_smallomega smallomega_iff_smallo) lemma eventually_nonneg_add1 [eventually_nonzero_simps]: assumes "eventually_nonneg F f" "g \ o[F](f)" shows "eventually_nonneg F (\x. f x + g x :: real)" using landau_o.smallD[OF assms(2) zero_less_one] assms(1) unfolding eventually_nonneg_def by eventually_elim simp_all lemma eventually_nonneg_add2 [eventually_nonzero_simps]: assumes "eventually_nonneg F g" "f \ o[F](g)" shows "eventually_nonneg F (\x. f x + g x :: real)" using landau_o.smallD[OF assms(2) zero_less_one] assms(1) unfolding eventually_nonneg_def by eventually_elim simp_all lemma eventually_nonneg_diff1 [eventually_nonzero_simps]: assumes "eventually_nonneg F f" "g \ o[F](f)" shows "eventually_nonneg F (\x. f x - g x :: real)" using landau_o.smallD[OF assms(2) zero_less_one] assms(1) unfolding eventually_nonneg_def by eventually_elim simp_all lemma eventually_nonneg_diff2 [eventually_nonzero_simps]: assumes "eventually_nonneg F (\x. - g x)" "f \ o[F](g)" shows "eventually_nonneg F (\x. f x - g x :: real)" using landau_o.smallD[OF assms(2) zero_less_one] assms(1) unfolding eventually_nonneg_def by eventually_elim simp_all subsection \Rewriting Landau symbols\ lemma bigtheta_mult_eq: "\[F](\x. f x * g x) = \[F](f) * \[F](g)" proof (intro equalityI subsetI) fix h assume "h \ \[F](f) * \[F](g)" thus "h \ \[F](\x. f x * g x)" by (elim set_times_elim, hypsubst, unfold func_times) (erule (1) landau_theta.mult) next fix h assume "h \ \[F](\x. f x * g x)" then obtain c1 c2 :: real where c: "c1 > 0" "\\<^sub>F x in F. norm (h x) \ c1 * norm (f x * g x)" "c2 > 0" "\\<^sub>F x in F. c2 * norm (f x * g x) \ norm (h x)" unfolding bigtheta_def by (blast elim: landau_o.bigE) define h1 h2 where "h1 x = (if g x = 0 then if f x = 0 then if h x = 0 then h x else 1 else f x else h x / g x)" and "h2 x = (if g x = 0 then if f x = 0 then h x else h x / f x else g x)" for x have "h = h1 * h2" by (intro ext) (auto simp: h1_def h2_def field_simps) moreover have "h1 \ \[F](f)" proof (rule bigthetaI') from c(3) show "min c2 1 > 0" by simp from c(1) show "max c1 1 > 0" by simp from c(2,4) show "eventually (\x. min c2 1 * (norm (f x)) \ norm (h1 x) \ norm (h1 x) \ max c1 1 * (norm (f x))) F" apply eventually_elim proof (rule conjI) fix x assume A: "(norm (h x)) \ c1 * norm (f x * g x)" and B: "(norm (h x)) \ c2 * norm (f x * g x)" have m: "min c2 1 * (norm (f x)) \ 1 * (norm (f x))" by (rule mult_right_mono) simp_all have "min c2 1 * norm (f x * g x) \ c2 * norm (f x * g x)" by (intro mult_right_mono) simp_all also note B finally show "norm (h1 x) \ min c2 1 * (norm (f x))" using m A by (cases "g x = 0") (simp_all add: h1_def norm_mult norm_divide field_simps)+ have m: "1 * (norm (f x)) \ max c1 1 * (norm (f x))" by (rule mult_right_mono) simp_all note A also have "c1 * norm (f x * g x) \ max c1 1 * norm (f x * g x)" by (intro mult_right_mono) simp_all finally show "norm (h1 x) \ max c1 1 * (norm (f x))" using m A by (cases "g x = 0") (simp_all add: h1_def norm_mult norm_divide field_simps)+ qed qed moreover have "h2 \ \[F](g)" proof (rule bigthetaI') from c(3) show "min c2 1 > 0" by simp from c(1) show "max c1 1 > 0" by simp from c(2,4) show "eventually (\x. min c2 1 * (norm (g x)) \ norm (h2 x) \ norm (h2 x) \ max c1 1 * (norm (g x))) F" apply eventually_elim proof (rule conjI) fix x assume A: "(norm (h x)) \ c1 * norm (f x * g x)" and B: "(norm (h x)) \ c2 * norm (f x * g x)" have m: "min c2 1 * (norm (f x)) \ 1 * (norm (f x))" by (rule mult_right_mono) simp_all have "min c2 1 * norm (f x * g x) \ c2 * norm (f x * g x)" by (intro mult_right_mono) simp_all also note B finally show "norm (h2 x) \ min c2 1 * (norm (g x))" using m A B by (cases "g x = 0") (auto simp: h2_def abs_mult field_simps)+ have m: "1 * (norm (g x)) \ max c1 1 * (norm (g x))" by (rule mult_right_mono) simp_all note A also have "c1 * norm (f x * g x) \ max c1 1 * norm (f x * g x)" by (intro mult_right_mono) simp_all finally show "norm (h2 x) \ max c1 1 * (norm (g x))" using m A by (cases "g x = 0") (simp_all add: h2_def abs_mult field_simps)+ qed qed ultimately show "h \ \[F](f) * \[F](g)" by blast qed text \ Since the simplifier does not currently rewriting with relations other than equality, but we want to rewrite terms like @{term "\(\x. log 2 x * x)"} to @{term "\(\x. ln x * x)"}, we need to bring the term into something that contains @{term "\(\x. log 2 x)"} and @{term "\(\x. x)"}, which can then be rewritten individually. For this, we introduce the following constants and rewrite rules. The rules are mainly used by the simprocs, but may be useful for manual reasoning occasionally. \ definition "set_mult A B = {\x. f x * g x |f g. f \ A \ g \ B}" definition "set_inverse A = {\x. inverse (f x) |f. f \ A}" definition "set_divide A B = {\x. f x / g x |f g. f \ A \ g \ B}" definition "set_pow A n = {\x. f x ^ n |f. f \ A}" definition "set_powr A y = {\x. f x powr y |f. f \ A}" lemma bigtheta_mult_eq_set_mult: shows "\[F](\x. f x * g x) = set_mult (\[F](f)) (\[F](g))" unfolding bigtheta_mult_eq set_mult_def set_times_def func_times by blast lemma bigtheta_inverse_eq_set_inverse: shows "\[F](\x. inverse (f x)) = set_inverse (\[F](f))" proof (intro equalityI subsetI) fix g :: "'a \ 'b" assume "g \ \[F](\x. inverse (f x))" hence "(\x. inverse (g x)) \ \[F](\x. inverse (inverse (f x)))" by (subst bigtheta_inverse) also have "(\x. inverse (inverse (f x))) = f" by (rule ext) simp finally show "g \ set_inverse (\[F](f))" unfolding set_inverse_def by force next fix g :: "'a \ 'b" assume "g \ set_inverse (\[F](f))" then obtain g' where "g = (\x. inverse (g' x))" "g' \ \[F](f)" unfolding set_inverse_def by blast hence "(\x. inverse (g' x)) \ \[F](\x. inverse (f x))" by (subst bigtheta_inverse) also from \g = (\x. inverse (g' x))\ have "(\x. inverse (g' x)) = g" by (intro ext) simp finally show "g \ \[F](\x. inverse (f x))" . qed lemma set_divide_inverse: "set_divide (A :: (_ \ (_ :: division_ring)) set) B = set_mult A (set_inverse B)" proof (intro equalityI subsetI) fix f assume "f \ set_divide A B" then obtain g h where "f = (\x. g x / h x)" "g \ A" "h \ B" unfolding set_divide_def by blast hence "f = g * (\x. inverse (h x))" "(\x. inverse (h x)) \ set_inverse B" unfolding set_inverse_def by (auto simp: divide_inverse) with \g \ A\ show "f \ set_mult A (set_inverse B)" unfolding set_mult_def by force next fix f assume "f \ set_mult A (set_inverse B)" then obtain g h where "f = g * (\x. inverse (h x))" "g \ A" "h \ B" unfolding set_times_def set_inverse_def set_mult_def by force hence "f = (\x. g x / h x)" by (intro ext) (simp add: divide_inverse) with \g \ A\ \h \ B\ show "f \ set_divide A B" unfolding set_divide_def by blast qed lemma bigtheta_divide_eq_set_divide: shows "\[F](\x. f x / g x) = set_divide (\[F](f)) (\[F](g))" by (simp only: set_divide_inverse divide_inverse bigtheta_mult_eq_set_mult bigtheta_inverse_eq_set_inverse) primrec bigtheta_pow where "bigtheta_pow F A 0 = \[F](\_. 1)" | "bigtheta_pow F A (Suc n) = set_mult A (bigtheta_pow F A n)" lemma bigtheta_pow_eq_set_pow: "\[F](\x. f x ^ n) = bigtheta_pow F (\[F](f)) n" by (induction n) (simp_all add: bigtheta_mult_eq_set_mult) definition bigtheta_powr where "bigtheta_powr F A y = (if y = 0 then {f. \g\A. eventually_nonneg F g \ f \ \[F](\x. g x powr y)} else {f. \g\A. eventually_nonneg F g \ (\x. (norm (f x)) = g x powr y)})" lemma bigtheta_powr_eq_set_powr: assumes "eventually_nonneg F f" shows "\[F](\x. f x powr (y::real)) = bigtheta_powr F (\[F](f)) y" proof (cases "y = 0") assume [simp]: "y = 0" show ?thesis proof (intro equalityI subsetI) fix h assume "h \ bigtheta_powr F \[F](f) y" then obtain g where g: "g \ \[F](f)" "eventually_nonneg F g" "h \ \[F](\x. g x powr 0)" unfolding bigtheta_powr_def by force note this(3) also have "(\x. g x powr 0) \ \[F](\x. \g x\ powr 0)" using assms unfolding eventually_nonneg_def by (intro bigthetaI_cong) (auto elim!: eventually_mono) also from g(1) have "(\x. \g x\ powr 0) \ \[F](\x. \f x\ powr 0)" by (rule bigtheta_powr) also from g(2) have "(\x. f x powr 0) \ \[F](\x. \f x\ powr 0)" unfolding eventually_nonneg_def by (intro bigthetaI_cong) (auto elim!: eventually_mono) finally show "h \ \[F](\x. f x powr y)" by simp next fix h assume "h \ \[F](\x. f x powr y)" with assms have "\g\\[F](f). eventually_nonneg F g \ h \ \[F](\x. g x powr 0)" by (intro bexI[of _ f] conjI) simp_all thus "h \ bigtheta_powr F \[F](f) y" unfolding bigtheta_powr_def by simp qed next assume y: "y \ 0" show ?thesis proof (intro equalityI subsetI) fix h assume h: "h \ \[F](\x. f x powr y)" let ?h' = "\x. \h x\ powr inverse y" from bigtheta_powr[OF h, of "inverse y"] y have "?h' \ \[F](\x. f x powr 1)" by (simp add: powr_powr) also have "(\x. f x powr 1) \ \[F](f)" using assms unfolding eventually_nonneg_def by (intro bigthetaI_cong) (auto elim!: eventually_mono) finally have "?h' \ \[F](f)" . with y have "\g\\[F](f). eventually_nonneg F g \ (\x. (norm (h x)) = g x powr y)" by (intro bexI[of _ ?h']) (simp_all add: powr_powr eventually_nonneg_def) thus "h \ bigtheta_powr F \[F](f) y" using y unfolding bigtheta_powr_def by simp next fix h assume "h \ bigtheta_powr F (\[F](f)) y" with y obtain g where A: "g \ \[F](f)" "\x. \h x\ = g x powr y" "eventually_nonneg F g" unfolding bigtheta_powr_def by force from this(3) have "(\x. g x powr y) \ \[F](\x. \g x\ powr y)" unfolding eventually_nonneg_def by (intro bigthetaI_cong) (auto elim!: eventually_mono) also from A(1) have "(\x. \g x\ powr y) \ \[F](\x. \f x\ powr y)" by (rule bigtheta_powr) also have "(\x. \f x\ powr y) \ \[F](\x. f x powr y)" using assms unfolding eventually_nonneg_def by (intro bigthetaI_cong) (auto elim!: eventually_mono) finally have "(\x. \h x\) \ \[F](\x. f x powr y)" by (subst A(2)) thus "(\x. h x) \ \[F](\x. f x powr y)" by simp qed qed lemmas bigtheta_factors_eq = bigtheta_mult_eq_set_mult bigtheta_inverse_eq_set_inverse bigtheta_divide_eq_set_divide bigtheta_pow_eq_set_pow bigtheta_powr_eq_set_powr lemmas landau_bigtheta_congs = landau_symbols[THEN landau_symbol.cong_bigtheta] lemma (in landau_symbol) meta_cong_bigtheta: "\[F](f) \ \[F](g) \ L F (f) \ L F (g)" using bigtheta_refl[of f] by (intro eq_reflection cong_bigtheta) blast lemmas landau_bigtheta_meta_congs = landau_symbols[THEN landau_symbol.meta_cong_bigtheta] subsection \Preliminary facts\ lemma real_powr_at_top: assumes "(p::real) > 0" shows "filterlim (\x. x powr p) at_top at_top" proof (subst filterlim_cong[OF refl refl]) show "LIM x at_top. exp (p * ln x) :> at_top" by (rule filterlim_compose[OF exp_at_top filterlim_tendsto_pos_mult_at_top[OF tendsto_const]]) (simp_all add: ln_at_top assms) show "eventually (\x. x powr p = exp (p * ln x)) at_top" using eventually_gt_at_top[of 0] by eventually_elim (simp add: powr_def) qed lemma tendsto_ln_over_powr: assumes "(a::real) > 0" shows "((\x. ln x / x powr a) \ 0) at_top" proof (rule lhospital_at_top_at_top) from assms show "LIM x at_top. x powr a :> at_top" by (rule real_powr_at_top) show "eventually (\x. a * x powr (a - 1) \ 0) at_top" using eventually_gt_at_top[of "0::real"] by eventually_elim (insert assms, simp) show "eventually (\x::real. (ln has_real_derivative (inverse x)) (at x)) at_top" using eventually_gt_at_top[of "0::real"] DERIV_ln by (elim eventually_mono) simp show "eventually (\x. ((\x. x powr a) has_real_derivative a * x powr (a - 1)) (at x)) at_top" using eventually_gt_at_top[of "0::real"] by eventually_elim (auto intro!: derivative_eq_intros) have "eventually (\x. inverse a * x powr -a = inverse x / (a*x powr (a-1))) at_top" using eventually_gt_at_top[of "0::real"] by (elim eventually_mono) (simp add: field_simps powr_diff powr_minus) moreover from assms have "((\x. inverse a * x powr -a) \ 0) at_top" by (intro tendsto_mult_right_zero tendsto_neg_powr filterlim_ident) simp_all ultimately show "((\x. inverse x / (a * x powr (a - 1))) \ 0) at_top" by (subst (asm) tendsto_cong) simp_all qed lemma tendsto_ln_powr_over_powr: assumes "(a::real) > 0" "b > 0" shows "((\x. ln x powr a / x powr b) \ 0) at_top" proof- have "eventually (\x. ln x powr a / x powr b = (ln x / x powr (b/a)) powr a) at_top" using assms eventually_gt_at_top[of "1::real"] by (elim eventually_mono) (simp add: powr_divide powr_powr) moreover have "eventually (\x. 0 < ln x / x powr (b / a)) at_top" using eventually_gt_at_top[of "1::real"] by (elim eventually_mono) simp with assms have "((\x. (ln x / x powr (b/a)) powr a) \ 0) at_top" by (intro tendsto_zero_powrI tendsto_ln_over_powr) (simp_all add: eventually_mono) ultimately show ?thesis by (subst tendsto_cong) simp_all qed lemma tendsto_ln_powr_over_powr': assumes "b > 0" shows "((\x::real. ln x powr a / x powr b) \ 0) at_top" proof (cases "a \ 0") assume a: "a \ 0" show ?thesis proof (rule tendsto_sandwich[of "\_::real. 0"]) have "eventually (\x. ln x powr a \ 1) at_top" unfolding eventually_at_top_linorder proof (intro allI exI impI) fix x :: real assume x: "x \ exp 1" have "0 < exp (1::real)" by simp also have "\ \ x" by fact finally have "ln x \ ln (exp 1)" using x by (subst ln_le_cancel_iff) auto hence "ln x powr a \ ln (exp 1) powr a" using a by (intro powr_mono2') simp_all thus "ln x powr a \ 1" by simp qed thus "eventually (\x. ln x powr a / x powr b \ x powr -b) at_top" by eventually_elim (insert a, simp add: field_simps powr_minus divide_right_mono) qed (auto intro!: filterlim_ident tendsto_neg_powr assms) qed (intro tendsto_ln_powr_over_powr, simp_all add: assms) lemma tendsto_ln_over_ln: assumes "(a::real) > 0" "c > 0" shows "((\x. ln (a*x) / ln (c*x)) \ 1) at_top" proof (rule lhospital_at_top_at_top) show "LIM x at_top. ln (c*x) :> at_top" by (intro filterlim_compose[OF ln_at_top] filterlim_tendsto_pos_mult_at_top[OF tendsto_const] filterlim_ident assms(2)) show "eventually (\x. ((\x. ln (a*x)) has_real_derivative (inverse x)) (at x)) at_top" using eventually_gt_at_top[of "inverse a"] assms by (auto elim!: eventually_mono intro!: derivative_eq_intros simp: field_simps) show "eventually (\x. ((\x. ln (c*x)) has_real_derivative (inverse x)) (at x)) at_top" using eventually_gt_at_top[of "inverse c"] assms by (auto elim!: eventually_mono intro!: derivative_eq_intros simp: field_simps) show "((\x::real. inverse x / inverse x) \ 1) at_top" by (subst tendsto_cong[of _ "\_. 1"]) simp_all qed simp_all lemma tendsto_ln_powr_over_ln_powr: assumes "(a::real) > 0" "c > 0" shows "((\x. ln (a*x) powr d / ln (c*x) powr d) \ 1) at_top" proof- have "eventually (\x. ln (a*x) powr d / ln (c*x) powr d = (ln (a*x) / ln (c*x)) powr d) at_top" using assms eventually_gt_at_top[of "max (inverse a) (inverse c)"] by (auto elim!: eventually_mono simp: powr_divide field_simps) moreover have "((\x. (ln (a*x) / ln (c*x)) powr d) \ 1) at_top" using assms by (intro tendsto_eq_rhs[OF tendsto_powr[OF tendsto_ln_over_ln tendsto_const]]) simp_all ultimately show ?thesis by (subst tendsto_cong) qed lemma tendsto_ln_powr_over_ln_powr': "c > 0 \ ((\x::real. ln x powr d / ln (c*x) powr d) \ 1) at_top" using tendsto_ln_powr_over_ln_powr[of 1 c d] by simp lemma tendsto_ln_powr_over_ln_powr'': "a > 0 \ ((\x::real. ln (a*x) powr d / ln x powr d) \ 1) at_top" using tendsto_ln_powr_over_ln_powr[of _ 1] by simp lemma bigtheta_const_ln_powr [simp]: "a > 0 \ (\x::real. ln (a*x) powr d) \ \(\x. ln x powr d)" by (intro bigthetaI_tendsto[of 1] tendsto_ln_powr_over_ln_powr'') simp lemma bigtheta_const_ln_pow [simp]: "a > 0 \ (\x::real. ln (a*x) ^ d) \ \(\x. ln x ^ d)" proof- assume a: "a > 0" have "\\<^sub>F x in at_top. ln (a * x) ^ d = ln (a * x) powr real d" using eventually_gt_at_top[of "1/a"] by eventually_elim (insert a, subst powr_realpow, auto simp: field_simps) hence "(\x::real. ln (a*x) ^ d) \ \(\x. ln (a*x) powr real d)" by (rule bigthetaI_cong) also from a have "(\x. ln (a*x) powr real d) \ \(\x. ln x powr real d)" by simp also have "\\<^sub>F x in at_top. ln x powr real d = ln x ^ d" using eventually_gt_at_top[of 1] by eventually_elim (subst powr_realpow, auto simp: field_simps) hence "(\x. ln x powr real d) \ \(\x. ln x ^ d)" by (rule bigthetaI_cong) finally show ?thesis . qed lemma bigtheta_const_ln [simp]: "a > 0 \ (\x::real. ln (a*x)) \ \(\x. ln x)" using tendsto_ln_over_ln[of a 1] by (intro bigthetaI_tendsto[of 1]) simp_all text \ If there are two functions @{term "f"} and @{term "g"} where any power of @{term "g"} is asymptotically smaller than @{term "f"}, propositions like @{term "(\x. f x ^ p1 * g x ^ q1) \ O(\x. f x ^ p2 * g x ^ q2)"} can be decided just by looking at the exponents: the proposition is true iff @{term "p1 < p2"} or @{term "p1 = p2 \ q1 \ q2"}. The functions @{term "\x. x"}, @{term "\x. ln x"}, @{term "\x. ln (ln x)"}, $\ldots$ form a chain in which every function dominates all succeeding functions in the above sense, allowing to decide propositions involving Landau symbols and functions that are products of powers of functions from this chain by reducing the proposition to a statement involving only logical connectives and comparisons on the exponents. We will now give the mathematical background for this and implement reification to bring functions from this class into a canonical form, allowing the decision procedure to be implemented in a simproc. \ subsection \Decision procedure\ definition "powr_closure f \ {\x. f x powr p :: real |p. True}" lemma powr_closureI [simp]: "(\x. f x powr p) \ powr_closure f" unfolding powr_closure_def by force lemma powr_closureE: assumes "g \ powr_closure f" obtains p where "g = (\x. f x powr p)" using assms unfolding powr_closure_def by force locale landau_function_family = fixes F :: "'a filter" and H :: "('a \ real) set" assumes F_nontrivial: "F \ bot" assumes pos: "h \ H \ eventually (\x. h x > 0) F" assumes linear: "h1 \ H \ h2 \ H \ h1 \ o[F](h2) \ h2 \ o[F](h1) \ h1 \ \[F](h2)" assumes mult: "h1 \ H \ h2 \ H \ (\x. h1 x * h2 x) \ H" assumes inverse: "h \ H \ (\x. inverse (h x)) \ H" begin lemma div: "h1 \ H \ h2 \ H \ (\x. h1 x / h2 x) \ H" by (subst divide_inverse) (intro mult inverse) lemma nonzero: "h \ H \ eventually (\x. h x \ 0) F" by (drule pos) (auto elim: eventually_mono) lemma landau_cases: assumes "h1 \ H" "h2 \ H" obtains "h1 \ o[F](h2)" | "h2 \ o[F](h1)" | "h1 \ \[F](h2)" using linear[OF assms] by blast lemma small_big_antisym: assumes "h1 \ H" "h2 \ H" "h1 \ o[F](h2)" "h2 \ O[F](h1)" shows False proof- from nonzero[OF assms(1)] nonzero[OF assms(2)] landau_o.small_big_asymmetric[OF assms(3,4)] have "eventually (\_::'a. False) F" by eventually_elim simp thus False by (simp add: eventually_False F_nontrivial) qed lemma small_antisym: assumes "h1 \ H" "h2 \ H" "h1 \ o[F](h2)" "h2 \ o[F](h1)" shows False using assms by (blast intro: small_big_antisym landau_o.small_imp_big) end locale landau_function_family_pair = G: landau_function_family F G + H: landau_function_family F H for F G H + fixes g assumes gs_dominate: "g1 \ G \ g2 \ G \ h1 \ H \ h2 \ H \ g1 \ o[F](g2) \ (\x. g1 x * h1 x) \ o[F](\x. g2 x * h2 x)" assumes g: "g \ G" assumes g_dominates: "h \ H \ h \ o[F](g)" begin sublocale GH: landau_function_family F "G * H" proof (unfold_locales; (elim set_times_elim; hypsubst)?) fix g h assume "g \ G" "h \ H" from G.pos[OF this(1)] H.pos[OF this(2)] show "eventually (\x. (g*h) x > 0) F" by eventually_elim simp next fix g h assume A: "g \ G" "h \ H" have "(\x. inverse ((g * h) x)) = (\x. inverse (g x)) * (\x. inverse (h x))" by (rule ext) simp also from A have "... \ G * H" by (intro G.inverse H.inverse set_times_intro) finally show "(\x. inverse ((g * h) x)) \ G * H" . next fix g1 g2 h1 h2 assume A: "g1 \ G" "g2 \ G" "h1 \ H" "h2 \ H" from gs_dominate[OF this] gs_dominate[OF this(2,1,4,3)] G.linear[OF this(1,2)] H.linear[OF this(3,4)] show "g1 * h1 \ o[F](g2 * h2) \ g2 * h2 \ o[F](g1 * h1) \ g1 * h1 \ \[F](g2 * h2)" by (elim disjE) (force simp: func_times bigomega_iff_bigo intro: landau_theta.mult landau_o.small.mult landau_o.small_big_mult landau_o.big_small_mult)+ have B: "(\x. (g1 * h1) x * (g2 * h2) x) = (g1 * g2) * (h1 * h2)" by (rule ext) (simp add: func_times mult_ac) from A show "(\x. (g1 * h1) x * (g2 * h2) x) \ G * H" by (subst B, intro set_times_intro) (auto intro: G.mult H.mult simp: func_times) qed (fact G.F_nontrivial) lemma smallo_iff: assumes "g1 \ G" "g2 \ G" "h1 \ H" "h2 \ H" shows "(\x. g1 x * h1 x) \ o[F](\x. g2 x * h2 x) \ g1 \ o[F](g2) \ (g1 \ \[F](g2) \ h1 \ o[F](h2))" (is "?P \ ?Q") proof (rule G.landau_cases[OF assms(1,2)]) assume "g1 \ o[F](g2)" thus ?thesis by (auto intro!: gs_dominate assms) next assume A: "g1 \ \[F](g2)" hence B: "g2 \ O[F](g1)" by (subst (asm) bigtheta_sym) (rule bigthetaD1) hence "g1 \ o[F](g2)" using assms by (auto dest: G.small_big_antisym) moreover from A have "o[F](\x. g2 x * h2 x) = o[F](\x. g1 x * h2 x)" by (intro landau_o.small.cong_bigtheta landau_theta.mult_right, subst bigtheta_sym) ultimately show ?thesis using G.nonzero[OF assms(1)] A by (auto simp add: landau_o.small.mult_cancel_left) next assume A: "g2 \ o[F](g1)" from gs_dominate[OF assms(2,1,4,3) this] have B: "g2 * h2 \ o[F](g1 * h1)" by (simp add: func_times) have "g1 \ o[F](g2)" "g1 \ \[F](g2)" using assms A by (auto dest: G.small_antisym G.small_big_antisym simp: bigomega_iff_bigo) moreover have "\?P" by (intro notI GH.small_antisym[OF _ _ B] set_times_intro) (simp_all add: func_times assms) ultimately show ?thesis by blast qed lemma bigo_iff: assumes "g1 \ G" "g2 \ G" "h1 \ H" "h2 \ H" shows "(\x. g1 x * h1 x) \ O[F](\x. g2 x * h2 x) \ g1 \ o[F](g2) \ (g1 \ \[F](g2) \ h1 \ O[F](h2))" (is "?P \ ?Q") proof (rule G.landau_cases[OF assms(1,2)]) assume "g1 \ o[F](g2)" thus ?thesis by (auto intro!: gs_dominate assms landau_o.small_imp_big) next assume A: "g2 \ o[F](g1)" hence "g1 \ O[F](g2)" using assms by (auto dest: G.small_big_antisym) moreover from gs_dominate[OF assms(2,1,4,3) A] have "g2*h2 \ o[F](g1*h1)" by (simp add: func_times) hence "g1*h1 \ O[F](g2*h2)" by (blast intro: GH.small_big_antisym assms) ultimately show ?thesis using A assms by (auto simp: func_times dest: landau_o.small_imp_big) next assume A: "g1 \ \[F](g2)" hence "g1 \ o[F](g2)" unfolding bigtheta_def using assms by (auto dest: G.small_big_antisym simp: bigomega_iff_bigo) moreover have "O[F](\x. g2 x * h2 x) = O[F](\x. g1 x * h2 x)" by (subst landau_o.big.cong_bigtheta[OF landau_theta.mult_right[OF A]]) (rule refl) ultimately show ?thesis using A G.nonzero[OF assms(2)] by (auto simp: landau_o.big.mult_cancel_left eventually_nonzero_bigtheta) qed lemma bigtheta_iff: "g1 \ G \ g2 \ G \ h1 \ H \ h2 \ H \ (\x. g1 x * h1 x) \ \[F](\x. g2 x * h2 x) \ g1 \ \[F](g2) \ h1 \ \[F](h2)" by (auto simp: bigtheta_def bigo_iff bigomega_iff_bigo intro: landau_o.small_imp_big dest: G.small_antisym G.small_big_antisym) end lemma landau_function_family_powr_closure: assumes "F \ bot" "filterlim f at_top F" shows "landau_function_family F (powr_closure f)" proof (unfold_locales; (elim powr_closureE; hypsubst)?) from assms have "eventually (\x. f x \ 1) F" using filterlim_at_top by auto hence A: "eventually (\x. f x \ 0) F" by eventually_elim simp { fix p q :: real show "(\x. f x powr p) \ o[F](\x. f x powr q) \ (\x. f x powr q) \ o[F](\x. f x powr p) \ (\x. f x powr p) \ \[F](\x. f x powr q)" by (cases p q rule: linorder_cases) (force intro!: smalloI_tendsto tendsto_neg_powr simp: powr_diff [symmetric] assms A)+ } fix p show "eventually (\x. f x powr p > 0) F" using A by simp qed (auto simp: powr_add[symmetric] powr_minus[symmetric] \F \ bot\ intro: powr_closureI) lemma landau_function_family_pair_trans: assumes "landau_function_family_pair Ftr F G f" assumes "landau_function_family_pair Ftr G H g" shows "landau_function_family_pair Ftr F (G*H) f" proof- interpret FG: landau_function_family_pair Ftr F G f by fact interpret GH: landau_function_family_pair Ftr G H g by fact show ?thesis proof (unfold_locales; (elim set_times_elim)?; (clarify)?; (unfold func_times mult.assoc[symmetric])?) fix f1 f2 g1 g2 h1 h2 assume A: "f1 \ F" "f2 \ F" "g1 \ G" "g2 \ G" "h1 \ H" "h2 \ H" "f1 \ o[Ftr](f2)" from A have "(\x. f1 x * g1 x * h1 x) \ o[Ftr](\x. f1 x * g1 x * g x)" by (intro landau_o.small.mult_left GH.g_dominates) also have "(\x. f1 x * g1 x * g x) = (\x. f1 x * (g1 x * g x))" by (simp only: mult.assoc) also from A have "... \ o[Ftr](\x. f2 x * (g2 x / g x))" by (intro FG.gs_dominate FG.H.mult FG.H.div GH.g) also from A have "(\x. inverse (h2 x)) \ o[Ftr](g)" by (intro GH.g_dominates GH.H.inverse) with GH.g A have "(\x. f2 x * (g2 x / g x)) \ o[Ftr](\x. f2 x * (g2 x * h2 x))" by (auto simp: FG.H.nonzero GH.H.nonzero divide_inverse intro!: landau_o.small.mult_left intro: landau_o.small.inverse_flip) also have "... = o[Ftr](\x. f2 x * g2 x * h2 x)" by (simp only: mult.assoc) finally show "(\x. f1 x * g1 x * h1 x) \ o[Ftr](\x. f2 x * g2 x * h2 x)" . next fix g1 h1 assume A: "g1 \ G" "h1 \ H" hence "(\x. g1 x * h1 x) \ o[Ftr](\x. g1 x * g x)" by (intro landau_o.small.mult_left GH.g_dominates) also from A have "(\x. g1 x * g x) \ o[Ftr](f)" by (intro FG.g_dominates FG.H.mult GH.g) finally show "(\x. g1 x * h1 x) \ o[Ftr](f)" . qed (simp_all add: FG.g) qed lemma landau_function_family_pair_trans_powr: assumes "landau_function_family_pair F (powr_closure g) H (\x. g x powr 1)" assumes "filterlim f at_top F" assumes "\p. (\x. g x powr p) \ o[F](f)" shows "landau_function_family_pair F (powr_closure f) (powr_closure g * H) (\x. f x powr 1)" proof (rule landau_function_family_pair_trans[OF _ assms(1)]) interpret GH: landau_function_family_pair F "powr_closure g" H "\x. g x powr 1" by fact interpret F: landau_function_family F "powr_closure f" by (rule landau_function_family_powr_closure) (rule GH.G.F_nontrivial, rule assms) show "landau_function_family_pair F (powr_closure f) (powr_closure g) (\x. f x powr 1)" proof (unfold_locales; (elim powr_closureE; hypsubst)?) show "(\x. f x powr 1) \ powr_closure f" by (rule powr_closureI) next fix p ::real note assms(3)[of p] also from assms(2) have "eventually (\x. f x \ 1) F" by (force simp: filterlim_at_top) hence "f \ \[F](\x. f x powr 1)" by (auto intro!: bigthetaI_cong elim!: eventually_mono) finally show "(\x. g x powr p) \ o[F](\x. f x powr 1)" . next fix p p1 p2 p3 :: real assume A: "(\x. f x powr p) \ o[F](\x. f x powr p1)" have p: "p < p1" proof (cases p p1 rule: linorder_cases) assume "p > p1" moreover from assms(2) have "eventually (\x. f x \ 1) F" by (force simp: filterlim_at_top) hence "eventually (\x. f x \ 0) F" by eventually_elim simp ultimately have "(\x. f x powr p1) \ o[F](\x. f x powr p)" using assms by (auto intro!: smalloI_tendsto tendsto_neg_powr simp: powr_diff [symmetric] ) from F.small_antisym[OF _ _ this A] show ?thesis by (auto simp: powr_closureI) next assume "p = p1" hence "(\x. f x powr p1) \ O[F](\x. f x powr p)" by (intro bigthetaD1) simp with F.small_big_antisym[OF _ _ A this] show ?thesis by (auto simp: powr_closureI) qed from assms(2) have f_pos: "eventually (\x. f x \ 1) F" by (force simp: filterlim_at_top) from assms have "(\x. g x powr ((p2 - p3)/(p1 - p))) \ o[F](f)" by simp from smallo_powr[OF this, of "p1 - p"] p have "(\x. g x powr (p2 - p3)) \ o[F](\x. \f x\ powr (p1 - p))" by (simp add: powr_powr) hence "(\x. \f x\ powr p * g x powr p2) \ o[F](\x. \f x\ powr p1 * g x powr p3)" (is ?P) using GH.G.nonzero[OF GH.g] F.nonzero[OF powr_closureI] by (simp add: powr_diff landau_o.small.divide_eq1 landau_o.small.divide_eq2 mult.commute) also have "?P \ (\x. f x powr p * g x powr p2) \ o[F](\x. f x powr p1 * g x powr p3)" using f_pos by (intro landau_o.small.cong_ex) (auto elim!: eventually_mono) finally show "(\x. f x powr p * g x powr p2) \ o[F](\x. f x powr p1 * g x powr p3)" . qed qed definition dominates :: "'a filter \ ('a \ real) \ ('a \ real) \ bool" where "dominates F f g = (\p. (\x. g x powr p) \ o[F](f))" lemma dominates_trans: assumes "eventually (\x. g x > 0) F" assumes "dominates F f g" "dominates F g h" shows "dominates F f h" unfolding dominates_def proof fix p :: real from assms(3) have "(\x. h x powr p) \ o[F](g)" unfolding dominates_def by simp also from assms(1) have "g \ \[F](\x. g x powr 1)" by (intro bigthetaI_cong) (auto elim!: eventually_mono) also from assms(2) have "(\x. g x powr 1) \ o[F](f)" unfolding dominates_def by simp finally show "(\x. h x powr p) \ o[F](f)" . qed fun landau_dominating_chain where "landau_dominating_chain F (f # g # gs) \ dominates F f g \ landau_dominating_chain F (g # gs)" | "landau_dominating_chain F [f] \ (\x. 1) \ o[F](f)" | "landau_dominating_chain F [] \ True" primrec landau_dominating_chain' where "landau_dominating_chain' F [] \ True" | "landau_dominating_chain' F (f # gs) \ landau_function_family_pair F (powr_closure f) (prod_list (map powr_closure gs)) (\x. f x powr 1) \ landau_dominating_chain' F gs" primrec nonneg_list where "nonneg_list [] \ True" | "nonneg_list (x#xs) \ x > 0 \ (x = 0 \ nonneg_list xs)" primrec pos_list where "pos_list [] \ False" | "pos_list (x#xs) \ x > 0 \ (x = 0 \ pos_list xs)" lemma dominating_chain_imp_dominating_chain': "Ftr \ bot \ (\g. g \ set gs \ filterlim g at_top Ftr) \ landau_dominating_chain Ftr gs \ landau_dominating_chain' Ftr gs" proof (induction gs rule: landau_dominating_chain.induct) case (1 F f g gs) from 1 show ?case by (auto intro!: landau_function_family_pair_trans_powr simp add: dominates_def) next case (2 F f) then interpret F: landau_function_family F "powr_closure f" by (intro landau_function_family_powr_closure) simp_all from 2 have "eventually (\x. f x \ 1) F" by (force simp: filterlim_at_top) hence "o[F](\x. f x powr 1) = o[F](\x. f x)" by (intro landau_o.small.cong) (auto elim!: eventually_mono) with 2 have "landau_function_family_pair F (powr_closure f) {\_. 1} (\x. f x powr 1)" by unfold_locales (auto intro: powr_closureI) thus ?case by (simp add: one_fun_def) next case 3 then show ?case by simp qed locale landau_function_family_chain = fixes F :: "'b filter" fixes gs :: "'a list" fixes get_param :: "'a \ real" fixes get_fun :: "'a \ ('b \ real)" assumes F_nontrivial: "F \ bot" assumes gs_pos: "g \ set (map get_fun gs) \ filterlim g at_top F" assumes dominating_chain: "landau_dominating_chain F (map get_fun gs)" begin lemma dominating_chain': "landau_dominating_chain' F (map get_fun gs)" by (intro dominating_chain_imp_dominating_chain' gs_pos dominating_chain F_nontrivial) lemma gs_powr_0_eq_one: "eventually (\x. (\g\gs. get_fun g x powr 0) = 1) F" using gs_pos proof (induction gs) case (Cons g gs) from Cons have "eventually (\x. get_fun g x > 0) F" by (auto simp: filterlim_at_top_dense) moreover from Cons have "eventually (\x. (\g\gs. get_fun g x powr 0) = 1) F" by simp ultimately show ?case by eventually_elim simp qed simp_all lemma listmap_gs_in_listmap: "(\x. \g\fs. h g x powr p g) \ prod_list (map powr_closure (map h fs))" proof- have "(\x. \g\fs. h g x powr p g) = (\g\fs. (\x. h g x powr p g))" by (rule ext, induction fs) simp_all also have "... \ prod_list (map powr_closure (map h fs))" apply (induction fs) apply (simp add: fun_eq_iff) apply (simp only: list.map prod_list.Cons, rule set_times_intro) apply simp_all done finally show ?thesis . qed lemma smallo_iff: "(\_. 1) \ o[F](\x. \g\gs. get_fun g x powr get_param g) \ pos_list (map get_param gs)" proof- have "((\_. 1) \ o[F](\x. \g\gs. get_fun g x powr get_param g)) \ ((\x. \g\gs. get_fun g x powr 0) \ o[F](\x. \g\gs. get_fun g x powr get_param g))" by (rule sym, intro landau_o.small.in_cong gs_powr_0_eq_one) also from gs_pos dominating_chain' have "... \ pos_list (map get_param gs)" proof (induction gs) case Nil have "(\x::'b. 1::real) \ o[F](\x. 1)" using F_nontrivial by (auto dest!: landau_o.small_big_asymmetric) thus ?case by simp next case (Cons g gs) then interpret G: landau_function_family_pair F "powr_closure (get_fun g)" "prod_list (map powr_closure (map get_fun gs))" "\x. get_fun g x powr 1" by simp from Cons show ?case using listmap_gs_in_listmap[of get_fun _ gs] F_nontrivial by (simp_all add: G.smallo_iff listmap_gs_in_listmap powr_smallo_iff powr_bigtheta_iff del: powr_zero_eq_one) qed finally show ?thesis . qed lemma bigo_iff: "(\_. 1) \ O[F](\x. \g\gs. get_fun g x powr get_param g) \ nonneg_list (map get_param gs)" proof- have "((\_. 1) \ O[F](\x. \g\gs. get_fun g x powr get_param g)) \ ((\x. \g\gs. get_fun g x powr 0) \ O[F](\x. \g\gs. get_fun g x powr get_param g))" by (rule sym, intro landau_o.big.in_cong gs_powr_0_eq_one) also from gs_pos dominating_chain' have "... \ nonneg_list (map get_param gs)" proof (induction gs) case Nil then show ?case by (simp add: func_one) next case (Cons g gs) then interpret G: landau_function_family_pair F "powr_closure (get_fun g)" "prod_list (map powr_closure (map get_fun gs))" "\x. get_fun g x powr 1" by simp from Cons show ?case using listmap_gs_in_listmap[of get_fun _ gs] F_nontrivial by (simp_all add: G.bigo_iff listmap_gs_in_listmap powr_smallo_iff powr_bigtheta_iff del: powr_zero_eq_one) qed finally show ?thesis . qed lemma bigtheta_iff: "(\_. 1) \ \[F](\x. \g\gs. get_fun g x powr get_param g) \ list_all ((=) 0) (map get_param gs)" proof- have "((\_. 1) \ \[F](\x. \g\gs. get_fun g x powr get_param g)) \ ((\x. \g\gs. get_fun g x powr 0) \ \[F](\x. \g\gs. get_fun g x powr get_param g))" by (rule sym, intro landau_theta.in_cong gs_powr_0_eq_one) also from gs_pos dominating_chain' have "... \ list_all ((=) 0) (map get_param gs)" proof (induction gs) case Nil then show ?case by (simp add: func_one) next case (Cons g gs) then interpret G: landau_function_family_pair F "powr_closure (get_fun g)" "prod_list (map powr_closure (map get_fun gs))" "\x. get_fun g x powr 1" by simp from Cons show ?case using listmap_gs_in_listmap[of get_fun _ gs] F_nontrivial by (simp_all add: G.bigtheta_iff listmap_gs_in_listmap powr_smallo_iff powr_bigtheta_iff del: powr_zero_eq_one) qed finally show ?thesis . qed end lemma fun_chain_at_top_at_top: assumes "filterlim (f :: ('a::order) \ 'a) at_top at_top" shows "filterlim (f ^^ n) at_top at_top" by (induction n) (auto intro: filterlim_ident filterlim_compose[OF assms]) lemma const_smallo_ln_chain: "(\_. 1) \ o((ln::real\real)^^n)" proof (intro smalloI_tendsto) show "((\x::real. 1 / (ln^^n) x) \ 0) at_top" by (rule tendsto_divide_0 tendsto_const filterlim_at_top_imp_at_infinity fun_chain_at_top_at_top ln_at_top)+ next from fun_chain_at_top_at_top[OF ln_at_top, of n] have "eventually (\x::real. (ln^^n) x > 0) at_top" by (simp add: filterlim_at_top_dense) thus "eventually (\x::real. (ln^^n) x \ 0) at_top" by eventually_elim simp_all qed lemma ln_fun_in_smallo_fun: assumes "filterlim f at_top at_top" shows "(\x. ln (f x) powr p :: real) \ o(f)" proof (rule smalloI_tendsto) have "((\x. ln x powr p / x powr 1) \ 0) at_top" by (rule tendsto_ln_powr_over_powr') simp moreover have "eventually (\x. ln x powr p / x powr 1 = ln x powr p / x) at_top" using eventually_gt_at_top[of "0::real"] by eventually_elim simp ultimately have "((\x. ln x powr p / x) \ 0) at_top" by (subst (asm) tendsto_cong) from this assms show "((\x. ln (f x) powr p / f x) \ 0) at_top" by (rule filterlim_compose) from assms have "eventually (\x. f x \ 1) at_top" by (simp add: filterlim_at_top) thus "eventually (\x. f x \ 0) at_top" by eventually_elim simp qed lemma ln_chain_dominates: "m > n \ dominates at_top ((ln::real \ real)^^n) (ln^^m)" proof (erule less_Suc_induct) fix n show "dominates at_top ((ln::real\real)^^n) (ln^^(Suc n))" unfolding dominates_def by (force intro: ln_fun_in_smallo_fun fun_chain_at_top_at_top ln_at_top) next fix k m n assume A: "dominates at_top ((ln::real \ real)^^k) (ln^^m)" "dominates at_top ((ln::real \ real)^^m) (ln^^n)" from fun_chain_at_top_at_top[OF ln_at_top, of m] have "eventually (\x::real. (ln^^m) x > 0) at_top" by (simp add: filterlim_at_top_dense) from this A show "dominates at_top ((ln::real \ real)^^k) ((ln::real \ real)^^n)" by (rule dominates_trans) qed datatype primfun = LnChain nat instantiation primfun :: linorder begin fun less_eq_primfun :: "primfun \ primfun \ bool" where "LnChain x \ LnChain y \ x \ y" fun less_primfun :: "primfun \ primfun \ bool" where "LnChain x < LnChain y \ x < y" instance proof (standard, goal_cases) case (1 x y) show ?case by (induction x y rule: less_eq_primfun.induct) auto next case (2 x) show ?case by (cases x) auto next case (3 x y z) thus ?case by (induction x y rule: less_eq_primfun.induct, cases z) auto next case (4 x y) thus ?case by (induction x y rule: less_eq_primfun.induct) auto next case (5 x y) thus ?case by (induction x y rule: less_eq_primfun.induct) auto qed end fun eval_primfun' :: "_ \ _ \ real" where "eval_primfun' (LnChain n) = (\x. (ln^^n) x)" fun eval_primfun :: "_ \ _ \ real" where "eval_primfun (f, e) = (\x. eval_primfun' f x powr e)" lemma eval_primfun_altdef: "eval_primfun f x = eval_primfun' (fst f) x powr snd f" by (cases f) simp fun merge_primfun where "merge_primfun (x::primfun, a) (y, b) = (x, a + b)" fun inverse_primfun where "inverse_primfun (x::primfun, a) = (x, -a)" fun powr_primfun where "powr_primfun (x::primfun, a) e = (x, e*a)" lemma primfun_cases: assumes "(\n e. P (LnChain n, e))" shows "P x" proof (cases x, hypsubst) fix a b show "P (a, b)" by (cases a; hypsubst, rule assms) qed lemma eval_primfun'_at_top: "filterlim (eval_primfun' f) at_top at_top" by (cases f) (auto intro!: fun_chain_at_top_at_top ln_at_top) lemma primfun_dominates: "f < g \ dominates at_top (eval_primfun' f) (eval_primfun' g)" by (elim less_primfun.elims; hypsubst) (simp_all add: ln_chain_dominates) lemma eval_primfun_pos: "eventually (\x::real. eval_primfun f x > 0) at_top" proof (cases f, hypsubst) fix f e from eval_primfun'_at_top have "eventually (\x. eval_primfun' f x > 0) at_top" by (auto simp: filterlim_at_top_dense) thus "eventually (\x::real. eval_primfun (f,e) x > 0) at_top" by eventually_elim simp qed lemma eventually_nonneg_primfun: "eventually_nonneg at_top (eval_primfun f)" unfolding eventually_nonneg_def using eval_primfun_pos[of f] by eventually_elim simp lemma eval_primfun_nonzero: "eventually (\x. eval_primfun f x \ 0) at_top" using eval_primfun_pos[of f] by eventually_elim simp lemma eval_merge_primfun: "fst f = fst g \ eval_primfun (merge_primfun f g) x = eval_primfun f x * eval_primfun g x" by (induction f g rule: merge_primfun.induct) (simp_all add: powr_add) lemma eval_inverse_primfun: "eval_primfun (inverse_primfun f) x = inverse (eval_primfun f x)" by (induction f rule: inverse_primfun.induct) (simp_all add: powr_minus) lemma eval_powr_primfun: "eval_primfun (powr_primfun f e) x = eval_primfun f x powr e" by (induction f e rule: powr_primfun.induct) (simp_all add: powr_powr mult.commute) definition eval_primfuns where "eval_primfuns fs x = (\f\fs. eval_primfun f x)" lemma eval_primfuns_pos: "eventually (\x. eval_primfuns fs x > 0) at_top" proof- have prod_list_pos: "(\x::_::linordered_semidom. x \ set xs \ x > 0) \ prod_list xs > 0" for xs :: "real list" by (induction xs) auto have "eventually (\x. \f\set fs. eval_primfun f x > 0) at_top" by (intro eventually_ball_finite ballI eval_primfun_pos finite_set) thus ?thesis unfolding eval_primfuns_def by eventually_elim (rule prod_list_pos, auto) qed lemma eval_primfuns_nonzero: "eventually (\x. eval_primfuns fs x \ 0) at_top" using eval_primfuns_pos[of fs] by eventually_elim simp subsection \Reification\ definition LANDAU_PROD' where "LANDAU_PROD' L c f = L(\x. c * f x)" definition LANDAU_PROD where "LANDAU_PROD L c1 c2 fs \ (\_. c1) \ L(\x. c2 * eval_primfuns fs x)" definition BIGTHETA_CONST' where "BIGTHETA_CONST' c = \(\x. c)" definition BIGTHETA_CONST where "BIGTHETA_CONST c A = set_mult \(\_. c) A" definition BIGTHETA_FUN where "BIGTHETA_FUN f = \(f)" lemma BIGTHETA_CONST'_tag: "\(\x. c) = BIGTHETA_CONST' c" using BIGTHETA_CONST'_def .. lemma BIGTHETA_CONST_tag: "\(f) = BIGTHETA_CONST 1 \(f)" by (simp add: BIGTHETA_CONST_def bigtheta_mult_eq_set_mult[symmetric]) lemma BIGTHETA_FUN_tag: "\(f) = BIGTHETA_FUN f" by (simp add: BIGTHETA_FUN_def) lemma set_mult_is_times: "set_mult A B = A * B" unfolding set_mult_def set_times_def func_times by blast lemma set_powr_mult: assumes "eventually_nonneg F f" and "eventually_nonneg F g" shows "\[F](\x. (f x * g x :: real) powr p) = set_mult (\[F](\x. f x powr p)) (\[F](\x. g x powr p))" proof- from assms have "eventually (\x. f x \ 0) F" "eventually (\x. g x \ 0) F" by (simp_all add: eventually_nonneg_def) hence "eventually (\x. (f x * g x :: real) powr p = f x powr p * g x powr p) F" by eventually_elim (simp add: powr_mult) hence "\[F](\x. (f x * g x :: real) powr p) = \[F](\x. f x powr p * g x powr p)" by (rule landau_theta.cong) also have "... = set_mult (\[F](\x. f x powr p)) (\[F](\x. g x powr p))" by (simp add: bigtheta_mult_eq_set_mult) finally show ?thesis . qed lemma eventually_nonneg_bigtheta_pow_realpow: "\(\x. eval_primfun f x ^ e) = \(\x. eval_primfun f x powr real e)" using eval_primfun_pos[of f] by (auto intro!: landau_theta.cong elim!: eventually_mono simp: powr_realpow) lemma BIGTHETA_CONST_fold: "BIGTHETA_CONST (c::real) (BIGTHETA_CONST d A) = BIGTHETA_CONST (c*d) A" "bigtheta_pow at_top (BIGTHETA_CONST c \(eval_primfun pf)) k = BIGTHETA_CONST (c ^ k) \(\x. eval_primfun pf x powr k)" "set_inverse (BIGTHETA_CONST c \(f)) = BIGTHETA_CONST (inverse c) \(\x. inverse (f x))" "set_mult (BIGTHETA_CONST c \(f)) (BIGTHETA_CONST d \(g)) = BIGTHETA_CONST (c*d) \(\x. f x*g x)" "BIGTHETA_CONST' (c::real) = BIGTHETA_CONST c \(\_. 1)" "BIGTHETA_FUN (f::real\real) = BIGTHETA_CONST 1 \(f)" apply (simp add: BIGTHETA_CONST_def set_mult_is_times bigtheta_mult_eq_set_mult mult_ac) apply (simp only: BIGTHETA_CONST_def bigtheta_mult_eq_set_mult[symmetric] bigtheta_pow_eq_set_pow[symmetric] power_mult_distrib mult_ac) apply (simp add: bigtheta_mult_eq_set_mult eventually_nonneg_bigtheta_pow_realpow) by (simp_all add: BIGTHETA_CONST_def BIGTHETA_CONST'_def BIGTHETA_FUN_def bigtheta_mult_eq_set_mult[symmetric] set_mult_is_times[symmetric] bigtheta_pow_eq_set_pow[symmetric] bigtheta_inverse_eq_set_inverse[symmetric] mult_ac power_mult_distrib) lemma fold_fun_chain: "g x = (g ^^ 1) x" "(g ^^ m) ((g ^^ n) x) = (g ^^ (m+n)) x" by (simp_all add: funpow_add) lemma reify_ln_chain1: "\(\x. (ln ^^ n) x) = \(eval_primfun (LnChain n, 1))" proof (intro landau_theta.cong) have "filterlim ((ln :: real \ real) ^^ n) at_top at_top" by (intro fun_chain_at_top_at_top ln_at_top) hence "eventually (\x::real. (ln ^^ n) x > 0) at_top" using filterlim_at_top_dense by auto thus "eventually (\x. (ln ^^ n) x = eval_primfun (LnChain n, 1) x) at_top" by eventually_elim simp qed lemma reify_monom1: "\(\x::real. x) = \(eval_primfun (LnChain 0, 1))" proof (intro landau_theta.cong) from eventually_gt_at_top[of "0::real"] show "eventually (\x. x = eval_primfun (LnChain 0, 1) x) at_top" by eventually_elim simp qed lemma reify_monom_pow: "\(\x::real. x ^ e) = \(eval_primfun (LnChain 0, real e))" proof- have "\(eval_primfun (LnChain 0, real e)) = \(\x. x powr (real e))" by simp also have "eventually (\x. x powr (real e) = x ^ e) at_top" using eventually_gt_at_top[of 0] by eventually_elim (simp add: powr_realpow) hence "\(\x. x powr (real e)) = \(\x. x ^ e)" by (rule landau_theta.cong) finally show ?thesis .. qed lemma reify_monom_powr: "\(\x::real. x powr e) = \(eval_primfun (LnChain 0, e))" by (rule landau_theta.cong) simp lemmas reify_monom = reify_monom1 reify_monom_pow reify_monom_powr lemma reify_ln_chain_pow: "\(\x. (ln ^^ n) x ^ e) = \(eval_primfun (LnChain n, real e))" proof- have "\(eval_primfun (LnChain n, real e)) = \(\x. (ln ^^ n) x powr (real e))" by simp also have "eventually (\x::real. (ln ^^ n) x > 0) at_top" using fun_chain_at_top_at_top[OF ln_at_top] unfolding filterlim_at_top_dense by blast hence "eventually (\x. (ln ^^ n) x powr (real e) = (ln ^^ n) x ^ e) at_top" by eventually_elim (subst powr_realpow, auto) hence "\(\x. (ln ^^ n) x powr (real e)) = \(\x. (ln ^^ n) x^e)" by (rule landau_theta.cong) finally show ?thesis .. qed lemma reify_ln_chain_powr: "\(\x. (ln ^^ n) x powr e) = \(eval_primfun (LnChain n, e))" by (intro landau_theta.cong) simp lemmas reify_ln_chain = reify_ln_chain1 reify_ln_chain_pow reify_ln_chain_powr lemma numeral_power_Suc: "numeral n ^ Suc a = numeral n * numeral n ^ a" by (rule power.simps) lemmas landau_product_preprocess = one_add_one one_plus_numeral numeral_plus_one arith_simps numeral_power_Suc power_0 fold_fun_chain[where g = ln] reify_ln_chain reify_monom lemma LANDAU_PROD'_fold: "BIGTHETA_CONST e \(\_. d) = BIGTHETA_CONST (e*d) \(eval_primfuns [])" "LANDAU_PROD' c (\_. 1) = LANDAU_PROD' c (eval_primfuns [])" "eval_primfun f = eval_primfuns [f]" "eval_primfuns fs x * eval_primfuns gs x = eval_primfuns (fs @ gs) x" apply (simp only: BIGTHETA_CONST_def set_mult_is_times eval_primfuns_def[abs_def] bigtheta_mult_eq) apply (simp add: bigtheta_mult_eq[symmetric]) by (simp_all add: eval_primfuns_def[abs_def] BIGTHETA_CONST_def) lemma inverse_prod_list_field: "prod_list (map (\x. inverse (f x)) xs) = inverse (prod_list (map f xs :: _ :: field list))" by (induction xs) simp_all lemma landau_prod_meta_cong: assumes "landau_symbol L L' Lr" assumes "\(f) \ BIGTHETA_CONST c1 (\(eval_primfuns fs))" assumes "\(g) \ BIGTHETA_CONST c2 (\(eval_primfuns gs))" shows "f \ L at_top (g) \ LANDAU_PROD (L at_top) c1 c2 (map inverse_primfun fs @ gs)" proof- interpret landau_symbol L L' Lr by fact have "f \ L at_top (g) \ (\x. c1 * eval_primfuns fs x) \ L at_top (\x. c2 * eval_primfuns gs x)" using assms(2,3)[symmetric] unfolding BIGTHETA_CONST_def by (intro cong_ex_bigtheta) (simp_all add: bigtheta_mult_eq_set_mult[symmetric]) also have "... \ (\x. c1) \ L at_top (\x. c2 * eval_primfuns gs x / eval_primfuns fs x)" by (simp_all add: eval_primfuns_nonzero divide_eq1) finally show "f \ L at_top (g) \ LANDAU_PROD (L at_top) c1 c2 (map inverse_primfun fs @ gs)" by (simp add: LANDAU_PROD_def eval_primfuns_def eval_inverse_primfun divide_inverse o_def inverse_prod_list_field mult_ac) qed fun pos_primfun_list where "pos_primfun_list [] \ False" | "pos_primfun_list ((_,x)#xs) \ x > 0 \ (x = 0 \ pos_primfun_list xs)" fun nonneg_primfun_list where "nonneg_primfun_list [] \ True" | "nonneg_primfun_list ((_,x)#xs) \ x > 0 \ (x = 0 \ nonneg_primfun_list xs)" fun iszero_primfun_list where "iszero_primfun_list [] \ True" | "iszero_primfun_list ((_,x)#xs) \ x = 0 \ iszero_primfun_list xs" definition "group_primfuns \ groupsort.group_sort fst merge_primfun" lemma list_ConsCons_induct: assumes "P []" "\x. P [x]" "\x y xs. P (y#xs) \ P (x#y#xs)" shows "P xs" proof (induction xs rule: length_induct) case (1 xs) show ?case proof (cases xs) case (Cons x xs') note A = this from assms 1 show ?thesis proof (cases xs') case (Cons y xs'') with 1 A have "P (y#xs'')" by simp with Cons A assms show ?thesis by simp qed (simp add: assms A) qed (simp add: assms) qed lemma landau_function_family_chain_primfuns: assumes "sorted (map fst fs)" assumes "distinct (map fst fs)" shows "landau_function_family_chain at_top fs (eval_primfun' o fst)" proof (standard, goal_cases) case 3 from assms show ?case proof (induction fs rule: list_ConsCons_induct) case (2 g) from eval_primfun'_at_top[of "fst g"] have "eval_primfun' (fst g) \ \(\_. 1)" by (intro smallomegaI_filterlim_at_infinity filterlim_at_top_imp_at_infinity) simp thus ?case by (simp add: smallomega_iff_smallo) next case (3 f g gs) thus ?case by (auto simp: primfun_dominates) qed simp qed (auto simp: eval_primfun'_at_top) lemma (in monoid_mult) fold_plus_prod_list_rev: "fold times xs = times (prod_list (rev xs))" proof fix x have "fold times xs x = prod_list (rev xs @ [x])" by (simp add: foldr_conv_fold prod_list.eq_foldr) also have "\ = prod_list (rev xs) * x" by simp finally show "fold times xs x = prod_list (rev xs) * x" . qed interpretation groupsort_primfun: groupsort fst merge_primfun eval_primfuns proof (standard, goal_cases) case (1 x y) thus ?case by (induction x y rule: merge_primfun.induct) simp_all next case (2 fs gs) show ?case proof fix x have "eval_primfuns fs x = fold (*) (map (\f. eval_primfun f x) fs) 1" unfolding eval_primfuns_def by (simp add: fold_plus_prod_list_rev) also have "fold (*) (map (\f. eval_primfun f x) fs) = fold (*) (map (\f. eval_primfun f x) gs)" using 2 by (intro fold_multiset_equiv ext) auto also have "... 1 = eval_primfuns gs x" unfolding eval_primfuns_def by (simp add: fold_plus_prod_list_rev) finally show "eval_primfuns fs x = eval_primfuns gs x" . qed qed (auto simp: fun_eq_iff eval_merge_primfun eval_primfuns_def) lemma nonneg_primfun_list_iff: "nonneg_primfun_list fs = nonneg_list (map snd fs)" by (induction fs rule: nonneg_primfun_list.induct) simp_all lemma pos_primfun_list_iff: "pos_primfun_list fs = pos_list (map snd fs)" by (induction fs rule: pos_primfun_list.induct) simp_all lemma iszero_primfun_list_iff: "iszero_primfun_list fs = list_all ((=) 0) (map snd fs)" by (induction fs rule: iszero_primfun_list.induct) simp_all lemma landau_primfuns_iff: "((\_. 1) \ O(eval_primfuns fs)) = nonneg_primfun_list (group_primfuns fs)" (is "?A") "((\_. 1) \ o(eval_primfuns fs)) = pos_primfun_list (group_primfuns fs)" (is "?B") "((\_. 1) \ \(eval_primfuns fs)) = iszero_primfun_list (group_primfuns fs)" (is "?C") proof- interpret landau_function_family_chain at_top "group_primfuns fs" snd "eval_primfun' o fst" by (rule landau_function_family_chain_primfuns) (simp_all add: group_primfuns_def groupsort_primfun.sorted_group_sort groupsort_primfun.distinct_group_sort) have "(\_. 1) \ O(eval_primfuns fs) \ (\_. 1) \ O(eval_primfuns (group_primfuns fs))" by (simp_all add: groupsort_primfun.g_group_sort group_primfuns_def) also have "... \ nonneg_list (map snd (group_primfuns fs))" using bigo_iff by (simp add: eval_primfuns_def[abs_def] eval_primfun_altdef) finally show ?A by (simp add: nonneg_primfun_list_iff) have "(\_. 1) \ o(eval_primfuns fs) \ (\_. 1) \ o(eval_primfuns (group_primfuns fs))" by (simp_all add: groupsort_primfun.g_group_sort group_primfuns_def) also have "... \ pos_list (map snd (group_primfuns fs))" using smallo_iff by (simp add: eval_primfuns_def[abs_def] eval_primfun_altdef) finally show ?B by (simp add: pos_primfun_list_iff) have "(\_. 1) \ \(eval_primfuns fs) \ (\_. 1) \ \(eval_primfuns (group_primfuns fs))" by (simp_all add: groupsort_primfun.g_group_sort group_primfuns_def) also have "... \ list_all ((=) 0) (map snd (group_primfuns fs))" using bigtheta_iff by (simp add: eval_primfuns_def[abs_def] eval_primfun_altdef) finally show ?C by (simp add: iszero_primfun_list_iff) qed lemma LANDAU_PROD_bigo_iff: "LANDAU_PROD (bigo at_top) c1 c2 fs \ c1 = 0 \ (c2 \ 0 \ nonneg_primfun_list (group_primfuns fs))" unfolding LANDAU_PROD_def by (cases "c1 = 0", simp, cases "c2 = 0", simp) (simp_all add: landau_primfuns_iff) lemma LANDAU_PROD_smallo_iff: "LANDAU_PROD (smallo at_top) c1 c2 fs \ c1 = 0 \ (c2 \ 0 \ pos_primfun_list (group_primfuns fs))" unfolding LANDAU_PROD_def by (cases "c1 = 0", simp, cases "c2 = 0", simp) (simp_all add: landau_primfuns_iff) lemma LANDAU_PROD_bigtheta_iff: "LANDAU_PROD (bigtheta at_top) c1 c2 fs \ (c1 = 0 \ c2 = 0) \ (c1 \ 0 \ c2 \ 0 \ iszero_primfun_list (group_primfuns fs))" proof- have A: "\P x. (x = 0 \ P) \ (x \ 0 \ P) \ P" by blast { assume "eventually (\x. eval_primfuns fs x = 0) at_top" with eval_primfuns_nonzero[of fs] have "eventually (\x::real. False) at_top" by eventually_elim simp hence False by simp } note B = this show ?thesis by (rule A[of c1, case_product A[of c2]]) (insert B, auto simp: LANDAU_PROD_def landau_primfuns_iff) qed lemmas LANDAU_PROD_iff = LANDAU_PROD_bigo_iff LANDAU_PROD_smallo_iff LANDAU_PROD_bigtheta_iff lemmas landau_real_prod_simps [simp] = groupsort_primfun.group_part_def group_primfuns_def groupsort_primfun.group_sort.simps groupsort_primfun.group_part_aux.simps pos_primfun_list.simps nonneg_primfun_list.simps iszero_primfun_list.simps end diff --git a/thys/Landau_Symbols/Landau_Simprocs.thy b/thys/Landau_Symbols/Landau_Simprocs.thy --- a/thys/Landau_Symbols/Landau_Simprocs.thy +++ b/thys/Landau_Symbols/Landau_Simprocs.thy @@ -1,214 +1,214 @@ (* File: Landau_Simprocs.thy - Author: Manuel Eberl + Author: Manuel Eberl Simplification procedures for Landau symbols, with a particular focus on functions into the reals. *) section \Simplification procedures\ theory Landau_Simprocs imports Landau_Real_Products begin subsection \Simplification under Landau symbols\ text \ The following can be seen as simpset for terms under Landau symbols. When given a rule @{term "f \ \(g)"}, the simproc will attempt to rewrite any occurrence of @{term "f"} under a Landau symbol to @{term "g"}. \ named_theorems landau_simp "BigTheta rules for simplification of Landau symbols" setup \ let val eq_thms = @{thms landau_theta.cong_bigtheta} fun eq_rule thm = get_first (try (fn eq_thm => eq_thm OF [thm])) eq_thms in Global_Theory.add_thms_dynamic (@{binding landau_simps}, fn context => Named_Theorems.get (Context.proof_of context) @{named_theorems landau_simp} |> map_filter eq_rule) end \ lemma bigtheta_const [landau_simp]: "NO_MATCH 1 c \ c \ 0 \ (\x. c) \ \(\x. 1)" by simp lemmas [landau_simp] = bigtheta_const_ln bigtheta_const_ln_powr bigtheta_const_ln_pow lemma bigtheta_const_ln' [landau_simp]: "0 < a \ (\x::real. ln (x * a)) \ \(ln)" by (subst mult.commute) (rule bigtheta_const_ln) lemma bigtheta_const_ln_powr' [landau_simp]: "0 < a \ (\x::real. ln (x * a) powr p) \ \(\x. ln x powr p)" by (subst mult.commute) (rule bigtheta_const_ln_powr) lemma bigtheta_const_ln_pow' [landau_simp]: "0 < a \ (\x::real. ln (x * a) ^ p) \ \(\x. ln x ^ p)" by (subst mult.commute) (rule bigtheta_const_ln_pow) subsection \Simproc setup\ lemma landau_gt_1_cong: "landau_symbol L L' Lr \ (\x::real. x > 1 \ f x = g x) \ L at_top (f) = L at_top (g)" by (auto intro: eventually_mono [OF eventually_gt_at_top[of 1]] elim!: landau_symbol.cong) lemma landau_gt_1_in_cong: "landau_symbol L L' Lr \ (\x::real. x > 1 \ f x = g x) \ f \ L at_top (h) \ g \ L at_top (h)" by (auto intro: eventually_mono [OF eventually_gt_at_top[of 1]] elim!: landau_symbol.in_cong) lemma landau_prop_equalsI: "landau_symbol L L' Lr \ (\x::real. x > 1 \ f1 x = f2 x) \ (\x. x > 1 \ g1 x = g2 x) \ f1 \ L at_top (g1) \ f2 \ L at_top (g2)" apply (subst landau_gt_1_cong, assumption+) apply (subst landau_gt_1_in_cong, assumption+) apply (rule refl) done lemma ab_diff_conv_add_uminus': "(a::_::ab_group_add) - b = -b + a" by simp lemma extract_diff_middle: "(a::_::ab_group_add) - (x + b) = -x + (a - b)" by simp lemma divide_inverse': "(a::_::{division_ring,ab_semigroup_mult}) / b = inverse b * a" by (simp add: divide_inverse mult.commute) lemma extract_divide_middle:"(a::_::{field}) / (x * b) = inverse x * (a / b)" by (simp add: divide_inverse algebra_simps) lemmas landau_cancel = landau_symbol.mult_cancel_left lemmas mult_cancel_left' = landau_symbol.mult_cancel_left[OF _ bigtheta_refl eventually_nonzeroD] lemma mult_cancel_left_1: assumes "landau_symbol L L' Lr" "eventually_nonzero F f" shows "f \ L F (\x. f x * g2 x) \ (\_. 1) \ L F (g2)" "(\x. f x * f2 x) \ L F (f) \ f2 \ L F (\_. 1)" "f \ L F (f) \ (\_. 1) \ L F (\_. 1)" using mult_cancel_left'[OF assms, of "\_. 1"] mult_cancel_left'[OF assms, of _ "\_. 1"] mult_cancel_left'[OF assms, of "\_. 1" "\_. 1"] by simp_all lemmas landau_mult_cancel_simps = mult_cancel_left' mult_cancel_left_1 ML_file \landau_simprocs.ML\ lemmas bigtheta_simps = landau_theta.cong_bigtheta[OF bigtheta_const_ln] landau_theta.cong_bigtheta[OF bigtheta_const_ln_powr] text \ The following simproc attempts to cancel common factors in Landau symbols, i.\,e.\ in a goal like $f(x) h(x) \in L(g(x) h(x))$, the common factor $h(x)$ will be cancelled. This only works if the simproc can prove that $h(x)$ is eventually non-zero, for which it uses some heuristics. \ simproc_setup landau_cancel_factor ( "f \ o[F](g)" | "f \ O[F](g)" | "f \ \[F](g)" | "f \ \[F](g)" | "f \ \[F](g)" ) = \K Landau.cancel_factor_simproc\ text \ The next simproc attempts to cancel dominated summands from Landau symbols; e.\,g.\ $O(x + \ln x)$ is simplified to $O(x)$, since $\ln x \in o(x)$. This can be very slow on large terms, so it is not enabled by default. \ simproc_setup simplify_landau_sum ( "o[F](\x. f x)" | "O[F](\x. f x)" | "\[F](\x. f x)" | "\[F](\x. f x)" | "\[F](\x. f x)" | "f \ o[F](g)" | "f \ O[F](g)" | "f \ \[F](g)" | "f \ \[F](g)" | "f \ \[F](g)" ) = \K (Landau.lift_landau_simproc Landau.simplify_landau_sum_simproc)\ text \ This simproc attempts to simplify factors of an expression in a Landau symbol statement independently from another, i.\,e.\ in something like $O(f(x) g(x)$, a simp rule that rewrites $O(f(x))$ to $O(f'(x))$ will also rewrite $O(f(x) g(x))$ to $O(f'(x) g(x))$ without any further setup. \ simproc_setup simplify_landau_product ( "o[F](\x. f x)" | "O[F](\x. f x)" | "\[F](\x. f x)" | "\[F](\x. f x)" | "\[F](\x. f x)" | "f \ o[F](g)" | "f \ O[F](g)" | "f \ \[F](g)" | "f \ \[F](g)" | "f \ \[F](g)" ) = \K (Landau.lift_landau_simproc Landau.simplify_landau_product_simproc)\ text \ Lastly, the next very specialised simproc can solve goals of the form $f(x) \in L(g(x))$ where $f$ and $g$ are real-valued functions consisting only of multiplications, powers of $x$, and powers of iterated logarithms of $x$. This is done by rewriting both sides into the form $x^a (\ln x)^b (\ln \ln x)^c$ etc.\ and then comparing the exponents lexicographically. Note that for historic reasons, this only works for $x\to\infty$. \ simproc_setup landau_real_prod ( "(f :: real \ real) \ o(g)" | "(f :: real \ real) \ O(g)" | "(f :: real \ real) \ \(g)" | "(f :: real \ real) \ \(g)" | "(f :: real \ real) \ \(g)" ) = \K Landau.simplify_landau_real_prod_prop_simproc\ subsection \Tests\ lemma asymp_equiv_plus_const_left: "(\n. c + real n) \[at_top] (\n. real n)" by (subst asymp_equiv_add_left) (auto intro!: asymp_equiv_intros eventually_gt_at_top) lemma asymp_equiv_plus_const_right: "(\n. real n + c) \[at_top] (\n. real n)" using asymp_equiv_plus_const_left[of c] by (simp add: add.commute) subsubsection \Product simplification tests\ lemma "(\x::real. f x * x) \ O(\x. g x / (h x / x)) \ f \ O(\x. g x / h x)" by simp lemma "(\x::real. x) \ \(\x. g x / (h x / x)) \ (\x. 1) \ \(\x. g x / h x)" by simp subsubsection \Real product decision procure tests\ lemma "(\x. x powr 1) \ O(\x. x powr 2 :: real)" by simp lemma "\(\x::real. 2*x powr 3 - 4*x powr 2) = \(\x::real. x powr 3)" by (simp add: landau_theta.absorb) lemma "p < q \ (\x::real. c * x powr p * ln x powr r) \ o(\x::real. x powr q)" by simp lemma "c \ 0 \ p > q \ (\x::real. c * x powr p * ln x powr r) \ \(\x::real. x powr q)" by simp lemma "b > 0 \ (\x::real. x / ln (2*b*x) * 2) \ o(\x. x * ln (b*x))" by simp lemma "o(\x::real. x * ln (3*x)) = o(\x. ln x * x)" by (simp add: mult.commute) lemma "(\x::real. x) \ o(\x. x * ln (3*x))" by simp ML_val \ Landau.simplify_landau_real_prod_prop_conv @{context} @{cterm "(\x::real. 5 * ln (ln x) ^ 2 / (2*x) powr 1.5 * inverse 2) \ \(\x. 3 * ln x * ln x / x * ln (ln (ln (ln x))))"} \ lemma "(\x. 3 * ln x * ln x / x * ln (ln (ln (ln x)))) \ \(\x::real. 5 * ln (ln x) ^ 2 / (2*x) powr 1.5 * inverse 2)" by simp subsubsection \Sum cancelling tests\ lemma "\(\x::real. 2 * x powr 3 + x * x^2/ln x) = \(\x::real. x powr 3)" by simp (* TODO: tweak simproc with size threshold *) lemma "\(\x::real. 2 * x powr 3 + x * x^2/ln x + 42 * x powr 9 + 213 * x powr 5 - 4 * x powr 7) = \(\x::real. x ^ 3 + x / ln x * x powr (3/2) - 2*x powr 9)" using [[landau_sum_limit = 5]] by simp lemma "(\x::real. x + x * ln (3*x)) \ o(\x::real. x^2 + ln (2*x) powr 3)" by simp end diff --git a/thys/Landau_Symbols/landau_simprocs.ML b/thys/Landau_Symbols/landau_simprocs.ML --- a/thys/Landau_Symbols/landau_simprocs.ML +++ b/thys/Landau_Symbols/landau_simprocs.ML @@ -1,398 +1,398 @@ (* File: landau_simprocs.ML - Author: Manuel Eberl + Author: Manuel Eberl Simprocs for Landau symbols. *) signature LANDAU = sig val landau_const_names : string list val dest_landau : term -> term * term * term val lift_landau_conv : conv -> conv val lift_landau_simproc : (Proof.context -> cterm -> thm option) -> Proof.context -> cterm -> thm option val cancel_factor_conv : Proof.context -> cterm -> thm val cancel_factor_simproc : Proof.context -> cterm -> thm option val simplify_landau_sum_conv : Proof.context -> conv val simplify_landau_sum_simproc : Proof.context -> cterm -> thm option val simplify_landau_product_conv : Proof.context -> conv val simplify_landau_product_simproc : Proof.context -> cterm -> thm option val simplify_landau_real_prod_prop_conv : Proof.context -> conv val simplify_landau_real_prod_prop_simproc : Proof.context -> cterm -> thm option val landau_sum_limit : int Config.T end structure Landau: LANDAU = struct val landau_sum_limit = Attrib.setup_config_int @{binding landau_sum_limit} (K 3) fun landau_simprocs ctxt = map (Simplifier.the_simproc ctxt) ["Landau_Simprocs.simplify_landau_product"] val landau_const_names = [@{const_name "bigo"},@{const_name "smallo"},@{const_name "bigomega"}, @{const_name "smallomega"},@{const_name "bigtheta"}] fun get_landau_id (t as Const (s, _)) = let val i = find_index (fn s' => s = s') landau_const_names in if i < 0 then raise TERM ("get_landau_id", [t]) else i end | get_landau_id t = raise TERM ("get_landau_id", [t]) fun get_landau_symbol_thm t = nth @{thms landau_symbols} (get_landau_id t) fun get_bigtheta_cong t = nth @{thms landau_bigtheta_meta_congs} (get_landau_id t) fun dest_landau (t as Const (s, T) $ fltr $ f) = if member op= landau_const_names s then (Const (s, T), fltr, f) else raise TERM ("dest_landau", [t]) | dest_landau t = raise TERM ("dest_landau", [t]) fun dest_bigtheta (Const (@{const_name bigtheta}, _) $ fltr $ a) = (fltr, a) | dest_bigtheta t = raise TERM ("dest_bigtheta", [t]) fun dest_member (Const (@{const_name Set.member}, _) $ a $ b) = (a, b) | dest_member t = raise TERM ("dest_member", [t]) (* Turn a conversion that rewrites a Landau symbol L(f) into a conversion that rewrites f \ L(g) *) fun lift_landau_conv conv ct = case Thm.term_of ct of (Const (@{const_name "Set.member"}, _) $ _ $ _) => ct |> ( Conv.rewrs_conv @{thms landau_flip[THEN eq_reflection]} then_conv (Conv.arg_conv conv) then_conv Conv.rewrs_conv @{thms landau_flip[THEN eq_reflection]}) | _ => conv ct fun lift_landau_simproc simproc ctxt = let fun conv ct = case simproc ctxt ct of NONE => raise CTERM ("lift_landau_simproc", [ct]) | SOME thm => thm in try (lift_landau_conv conv) end datatype operator = MULT | DIVIDE datatype 'a breadcrumb = LEFT of 'a | RIGHT of 'a fun inverse T = Const (@{const_name Fields.inverse}, T --> T) fun mult T = Const (@{const_name Groups.times}, T --> T --> T) fun divide T = Const (@{const_name Rings.divide_class.divide}, T --> T --> T) fun map_crumb f (LEFT x) = LEFT (f x) | map_crumb f (RIGHT x) = RIGHT (f x) fun reconstruct_crumbs T crumbs = let fun binop MULT (SOME x) (SOME y) = SOME (mult T $ x $ y) | binop DIVIDE (SOME x) (SOME y) = SOME (divide T $ x $ y) | binop _ x NONE = x | binop MULT NONE y = y | binop DIVIDE NONE (SOME y) = SOME (inverse T $ y) fun go t [] = t | go t (LEFT (opr,r) :: crumbs) = go (binop opr t (SOME r)) crumbs | go t (RIGHT (opr,l) :: crumbs) = go (binop opr (SOME l) t) crumbs in go NONE crumbs end (* Pick a leaf in the arithmetic tree (i.e. a summand), remove it and return both it and the remaining tree (NONE if it is empty). Return a list of all possible results *) fun pick_leaf t T = let fun go ((Const (@{const_name "Groups.times"}, _)) $ a $ b) neg crumbs acc = acc |> go b neg (RIGHT (MULT,a) :: crumbs) |> go a neg (LEFT (MULT,b) :: crumbs) | go ((Const (@{const_name "Rings.divide_class.divide"}, _)) $ a $ b) neg crumbs acc = acc |> go b (not neg) (RIGHT (DIVIDE,a) :: crumbs) |> go a neg (LEFT (DIVIDE,b) :: crumbs) | go a neg crumbs acc = let val a = if neg then inverse T $ a else a in (a, reconstruct_crumbs T crumbs, rev (map (map_crumb fst) crumbs)) :: acc end in go t false [] [] end local fun commute_conv MULT = Conv.rewr_conv @{thm mult.commute[THEN eq_reflection]} | commute_conv DIVIDE = Conv.rewr_conv @{thm divide_inverse'[THEN eq_reflection]} fun assoc_conv MULT = Conv.rewr_conv @{thm mult.assoc[THEN eq_reflection]} | assoc_conv DIVIDE = Conv.rewr_conv @{thm times_divide_eq_right[symmetric, THEN eq_reflection]} fun to_mult_conv MULT = Conv.all_conv | to_mult_conv DIVIDE = Conv.rewr_conv @{thm divide_inverse[THEN eq_reflection]} fun extract_middle_conv MULT = Conv.rewr_conv @{thm mult.left_commute[THEN eq_reflection]} | extract_middle_conv DIVIDE = Conv.rewr_conv @{thm extract_divide_middle[THEN eq_reflection]} fun repeat_conv 0 _ = Conv.all_conv | repeat_conv n conv = conv then_conv repeat_conv (n - 1) conv val eliminate_double_inverse_conv = Conv.rewr_conv @{thm inverse_inverse_eq[THEN eq_reflection]} in fun extract_leaf_conv path = let fun count_inversions [] acc = acc div 2 | count_inversions (RIGHT DIVIDE :: xs) acc = count_inversions xs (acc+1) | count_inversions (_ :: xs) acc = count_inversions xs acc val l_conv = Conv.fun_conv o Conv.arg_conv val r_conv = Conv.arg_conv fun go [] = Conv.all_conv | go [LEFT oper] = to_mult_conv oper | go [RIGHT oper] = commute_conv oper | go (LEFT oper :: path) = l_conv (go path) then_conv assoc_conv oper | go (RIGHT oper :: path) = r_conv (go path) then_conv extract_middle_conv oper in go path then_conv repeat_conv (count_inversions path 0) (l_conv eliminate_double_inverse_conv) end end fun filterT T = Type (@{type_name Filter.filter}, [T]) fun cancel_factor_conv' ctxt ct = let val t = Thm.term_of ct val (f, (L, fltr, g)) = dest_member t ||> dest_landau val landau_symbol_thm = get_landau_symbol_thm L fun dest_abs t = case t of Abs a => a | _ => raise CTERM ("cancel_factor_simproc", [ct]) val ((x_name1, S, f_body), (x_name2, _, g_body)) = (dest_abs f, dest_abs g) val T = Term.fastype_of f |> Term.dest_funT |> snd fun abs x body = Abs (x, S, body) fun mk_eventually_nonzero t = Const (@{const_name eventually_nonzero}, filterT S --> (S --> T) --> HOLogic.boolT) $ fltr $ t val (f_leaves, g_leaves) = (pick_leaf f_body T, pick_leaf g_body T) fun cancel' (t, rest1, path1) (_, rest2, path2) = let val prop = HOLogic.mk_Trueprop (mk_eventually_nonzero (abs x_name1 t)) fun tac {context = ctxt, ...} = let val simps = Named_Theorems.get ctxt @{named_theorems eventually_nonzero_simps} in ALLGOALS (Simplifier.asm_full_simp_tac (ctxt addsimps simps)) end fun do_cancel thm = let val thms = map (fn thm' => thm' OF [landau_symbol_thm, thm] RS @{thm eq_reflection}) @{thms landau_mult_cancel_simps} in ct |> ( Conv.fun_conv (Conv.arg_conv (Conv.abs_conv (K (extract_leaf_conv path1)) ctxt)) then_conv (Conv.arg_conv (Conv.arg_conv (Conv.abs_conv (K (extract_leaf_conv path2)) ctxt))) then_conv (Conv.rewrs_conv thms) ) end in Option.map do_cancel (try (fn () => Goal.prove ctxt [] [] prop tac) ()) end fun not_one (Const (@{const_name Groups.one}, _)) = false | not_one _ = true fun cancel (leaf1 as (t1, _, _)) (leaf2 as (t2, _, _)) = if t1 = t2 andalso not_one t1 then cancel' leaf1 leaf2 else NONE in case (get_first (fn leaf1 => get_first (cancel leaf1) g_leaves) f_leaves) of NONE => raise CTERM ("cancel_factor_conv", [ct]) | SOME thm => thm end fun cancel_factor_conv ctxt = Conv.fun_conv (Conv.arg_conv Thm.eta_long_conversion) then_conv Conv.arg_conv (Conv.arg_conv Thm.eta_long_conversion) then_conv cancel_factor_conv' ctxt val cancel_factor_simproc = try o cancel_factor_conv val plus_absorb_thms1 = @{thms landau_symbols[THEN landau_symbol.plus_absorb1]} val plus_absorb_thms2 = @{thms landau_symbols[THEN landau_symbol.plus_absorb2]} val minus_absorb_thms1 = @{thms landau_symbols[THEN landau_symbol.diff_absorb1]} val minus_absorb_thms2 = @{thms landau_symbols[THEN landau_symbol.diff_absorb2]} val sum_term_size = let fun go acc (Const (@{const_name "Groups.plus"}, _) $ l $ r) = go (go acc l) r | go acc (Const (@{const_name "Groups.minus"}, _) $ l $ r) = go (go acc l) r | go acc _ = acc + 1 in go 0 end local fun mk_smallo fltr S T = Const (@{const_name smallo}, filterT S --> (S --> T) --> HOLogic.mk_setT (S --> T)) $ fltr fun mk_member T = Const (@{const_name Set.member}, T --> HOLogic.mk_setT T --> HOLogic.boolT) fun mk_in_smallo fltr S T f g = mk_member (S --> T) $ f $ (mk_smallo fltr S T $ g) in fun simplify_landau_sum_simproc ctxt ct = let val t = Thm.term_of ct val (L, fltr, f) = dest_landau t val L_name = dest_Const L |> fst val (x_name, S, f_body) = case f of Abs a => a | _ => raise CTERM ("simplify_landau_sum_conv", [ct]) val limit = Config.get ctxt landau_sum_limit val _ = if limit < 0 orelse sum_term_size f_body <= limit then () else raise CTERM ("simplify_landau_sum_conv", [ct]) val T = Term.fastype_of f |> Term.dest_funT |> snd fun abs t = Abs (x_name, S, t) val (minus, l, r) = case f_body of Const (@{const_name "Groups.plus"}, _) $ l $ r => (false, abs l, abs r) | Const (@{const_name "Groups.minus"}, _) $ l $ r => (true, abs l, abs r) | _ => raise CTERM ("simplify_landau_sum_simproc", [ct]) fun mk_absorb_thm absorb_thms thm = let fun go (s :: ss) (thm :: thms) = if s = L_name then thm else go ss thms | go _ _ = raise CTERM ("simplify_landau_sum_conv", [ct]) in (thm RS go landau_const_names absorb_thms) RS @{thm eq_reflection} end val absorb_thms1 = if minus then minus_absorb_thms1 else plus_absorb_thms1 val absorb_thms2 = if minus then minus_absorb_thms2 else plus_absorb_thms2 fun eliminate (absorb_thms, l, r) = let fun tac {context = ctxt, ...} = Simplifier.asm_full_simp_tac ctxt 1 THEN TRY (resolve_tac ctxt @{thms TrueI} 1) val prop = HOLogic.mk_Trueprop (mk_in_smallo fltr S T l r) in case try (fn () => Goal.prove ctxt [] [] prop tac) () of NONE => NONE | SOME thm => SOME (mk_absorb_thm absorb_thms thm) end in get_first eliminate [(absorb_thms1, l, r), (absorb_thms2, r, l)] end handle TERM _ => NONE | CTERM _ => NONE end fun simplify_landau_sum_conv ctxt ct = case simplify_landau_sum_simproc ctxt ct of SOME thm => thm | NONE => raise CTERM ("simplify_landau_sum_conv", [ct]) fun changed_conv conv ct = let val thm = conv ct fun is_reflexive (ct1, ct2) = Envir.beta_eta_contract ct1 aconv Envir.beta_eta_contract ct2 in if is_reflexive (Logic.dest_equals (Thm.prop_of thm)) then raise CTERM ("changed_conv", [ct]) else thm handle TERM _ => thm end fun landau_conv conv ctxt = changed_conv (fn ct => let val t = Thm.term_of ct val (L as (Const (_, T)), fltr, f) = dest_landau t val cong = get_bigtheta_cong L val ct' = Const (@{const_name bigtheta}, T) $ fltr $ f |> Thm.cterm_of ctxt in conv ct' RS cong end) fun simplify_landau_product_conv ctxt ct = let val ctxt1 = put_simpset HOL_basic_ss ctxt addsimps @{thms bigtheta_factors_eq} val ctxt2 = ctxt addsimps @{thms landau_simps} delsimprocs (landau_simprocs ctxt) val ctxt3 = put_simpset HOL_basic_ss ctxt addsimps @{thms bigtheta_factors_eq[symmetric]} val conv = Simplifier.rewrite ctxt1 then_conv Simplifier.asm_full_rewrite ctxt2 then_conv Simplifier.rewrite ctxt3 in landau_conv (changed_conv conv) ctxt ct end val simplify_landau_product_simproc = try o simplify_landau_product_conv fun reify_prod_bigtheta_conv ctxt = let val ss = simpset_of (ctxt addsimps @{thms eventually_nonzero_simps eventually_nonneg_primfun}) val set_subgoaler = Simplifier.set_subgoaler (asm_full_simp_tac o put_simpset ss) fun put_ss thms ctxt = put_simpset HOL_basic_ss ctxt addsimps thms val ctxt_transforms = [ set_subgoaler o put_ss @{thms set_divide_inverse eventually_nonzero_simps bigtheta_mult_eq_set_mult bigtheta_inverse_eq_set_inverse bigtheta_divide_eq_set_divide bigtheta_pow_eq_set_pow landau_product_preprocess mult_1_left mult_1_right inverse_1 set_powr_mult power_one}, put_ss @{thms BIGTHETA_CONST'_tag mult_1_left mult_1_right inverse_1 power_one}, put_ss @{thms BIGTHETA_FUN_tag mult_1_left mult_1_right inverse_1 power_one}, put_ss @{thms BIGTHETA_CONST_fold mult_1_left mult_1_right inverse_1 power_one}, put_ss @{thms bigtheta_factors_eq[symmetric] eval_inverse_primfun[symmetric] eval_powr_primfun[symmetric] inverse_primfun.simps powr_primfun.simps}, put_ss @{thms LANDAU_PROD'_fold append.simps mult_1_left mult_1_right minus_minus power_one} ] val convs = map (fn f => Simplifier.rewrite (f ctxt)) ctxt_transforms in Conv.try_conv (Conv.arg_conv Thm.eta_long_conversion) then_conv Conv.rewr_conv @{thm BIGTHETA_CONST_tag[THEN eq_reflection]} then_conv Conv.every_conv convs end fun reify_landau_prod_prop_conv ctxt ct = let val t = Thm.term_of ct val (f, t) = dest_member t val (L as (Const (_, T)), fltr, g) = dest_landau t val cong = nth @{thms landau_symbols[THEN landau_prod_meta_cong]} (get_landau_id L) fun mk_thm f = Const (@{const_name bigtheta}, T) $ fltr $ f |> Thm.cterm_of ctxt |> reify_prod_bigtheta_conv ctxt val (thm1, thm2) = (mk_thm f, mk_thm g) val thm = cong OF [thm1, thm2] in thm end fun simplify_landau_real_prod_prop_conv ctxt = let val ctxt' = put_simpset HOL_ss ctxt addsimps @{thms list.map inverse_primfun.simps minus_minus append.simps} in Conv.try_conv (Conv.rewrs_conv (@{thms bigomega_iff_bigo[THEN eq_reflection] smallomega_iff_smallo[THEN eq_reflection]})) then_conv reify_landau_prod_prop_conv ctxt then_conv Simplifier.rewrite ctxt' then_conv Conv.rewrs_conv @{thms LANDAU_PROD_iff[THEN eq_reflection]} end val simplify_landau_real_prod_prop_simproc = try o simplify_landau_real_prod_prop_conv end diff --git a/thys/Linear_Recurrences/Partial_Fraction_Decomposition.thy b/thys/Linear_Recurrences/Partial_Fraction_Decomposition.thy --- a/thys/Linear_Recurrences/Partial_Fraction_Decomposition.thy +++ b/thys/Linear_Recurrences/Partial_Fraction_Decomposition.thy @@ -1,384 +1,384 @@ (* File: Partial_Fraction_Decomposition.thy - Author: Manuel Eberl + Author: Manuel Eberl Partial fraction decomposition on Euclidean rings, i.e. decomposing a quotient into a sum of quotients where each denominator is a power of an irreducible element. (and possibly one summand that is an entire element) The most interesting setting is when the Euclidean ring is a polynomial ring. *) section \Partial Fraction Decomposition\ theory Partial_Fraction_Decomposition imports Main "HOL-Computational_Algebra.Computational_Algebra" "HOL-Computational_Algebra.Polynomial_Factorial" "HOL-Library.Sublist" Linear_Recurrences_Misc begin subsection \Decomposition on general Euclidean rings\ text \ Consider elements $x, y_1, \ldots, y_n$ of a ring $R$, where the $y_i$ are pairwise coprime. A \emph{Partial Fraction Decomposition} of these elements (or rather the formal quotient $x / (y_1 \ldots y_n)$ that they represent) is a finite sum of summands of the form $a / y_i ^ k$. Obviously, the sum can be arranged such that there is at most one summand with denominator $y_i ^ n$ for any combination of $i$ and $n$; in particular, there is at most one summand with denominator 1. We can decompose the summands further by performing division with remainder until in all quotients, the numerator's Euclidean size is less than that of the denominator. \ text \ The following function performs the first step of the above process: it takes the values $x$ and $y_1,\ldots, y_n$ and returns the numerators of the summands in the decomposition. (the denominators are simply the $y_i$ from the input) \ fun decompose :: "('a :: euclidean_ring_gcd) \ 'a list \ 'a list" where "decompose x [] = []" | "decompose x [y] = [x]" | "decompose x (y#ys) = (case bezout_coefficients y (prod_list ys) of (a, b) \ (b*x) # decompose (a*x) ys)" lemma decompose_rec: "ys \ [] \ decompose x (y#ys) = (case bezout_coefficients y (prod_list ys) of (a, b) \ (b*x) # decompose (a*x) ys)" by (cases ys) simp_all lemma length_decompose [simp]: "length (decompose x ys) = length ys" proof (induction x ys rule: decompose.induct) case (3 x y z ys) obtain a b where ab: "(a,b) = bezout_coefficients y (prod_list (z#ys))" by (cases "bezout_coefficients y (z * prod_list ys)") simp_all from 3[OF ab] ab[symmetric] show ?case by simp qed simp_all fun decompose' :: "('a :: euclidean_ring_gcd) \ 'a list \ 'a list \ 'a list" where "decompose' x [] _ = []" | "decompose' x [y] _ = [x]" | "decompose' _ _ [] = []" | "decompose' x (y#ys) (p#ps) = (case bezout_coefficients y p of (a, b) \ (b*x) # decompose' (a*x) ys ps)" primrec decompose_aux :: "'a :: {ab_semigroup_mult,monoid_mult} \ _" where "decompose_aux acc [] = [acc]" | "decompose_aux acc (x#xs) = acc # decompose_aux (x * acc) xs" lemma decompose_code [code]: "decompose x ys = decompose' x ys (tl (rev (decompose_aux 1 (rev ys))))" proof (induction x ys rule: decompose.induct) case (3 x y1 y2 ys) have [simp]: "decompose_aux acc xs = map (\x. prod_list x * acc) (prefixes xs)" for acc :: 'a and xs by (induction xs arbitrary: acc) (simp_all add: mult_ac) show ?case using 3[of "fst (bezout_coefficients y1 (y2 * prod_list ys))" "snd (bezout_coefficients y1 (y2 * prod_list ys))"] by (simp add: case_prod_unfold rev_map prefixes_conv_suffixes o_def mult_ac) qed simp_all text \ The next function performs the second step: Given a quotient of the form $x / y^n$, it returns a list of $x_0, \ldots, x_n$ such that $x / y^n = x_0 / y^n + \ldots + x_{n-1} / y + x_n$ and all $x_i$ have a Euclidean size less than that of $y$. \ fun normalise_decomp :: "('a :: semiring_modulo) \ 'a \ nat \ 'a \ ('a list)" where "normalise_decomp x y 0 = (x, [])" | "normalise_decomp x y (Suc n) = ( case normalise_decomp (x div y) y n of (z, rs) \ (z, x mod y # rs))" lemma length_normalise_decomp [simp]: "length (snd (normalise_decomp x y n)) = n" by (induction x y n rule: normalise_decomp.induct) (auto split: prod.split) text \ The following constant implements the full process of partial fraction decomposition: The input is a quotient $x / (y_1 ^ {k_1} \ldots y_n ^ {k_n})$ and the output is a sum of an entire element and terms of the form $a / y_i ^ k$ where $a$ has a Euclidean size less than $y_i$. \ definition partial_fraction_decomposition :: "'a :: euclidean_ring_gcd \ ('a \ nat) list \ 'a \ 'a list list" where "partial_fraction_decomposition x ys = (if ys = [] then (x, []) else (let zs = [let (y, n) = ys ! i in normalise_decomp (decompose x (map (\(y,n). y ^ Suc n) ys) ! i) y (Suc n). i \ [0.. length (snd (partial_fraction_decomposition x ys) ! i) = snd (ys ! i) + 1" by (auto simp: partial_fraction_decomposition_def case_prod_unfold Let_def) lemma size_normalise_decomp: "a \ set (snd (normalise_decomp x y n)) \ y \ 0 \ euclidean_size a < euclidean_size y" by (induction x y n rule: normalise_decomp.induct) (auto simp: case_prod_unfold Let_def mod_size_less) lemma size_partial_fraction_decomposition: "i < length xs \ fst (xs ! i) \ 0 \ x \ set (snd (partial_fraction_decomposition y xs) ! i) \ euclidean_size x < euclidean_size (fst (xs ! i))" by (auto simp: partial_fraction_decomposition_def Let_def case_prod_unfold simp del: normalise_decomp.simps split: if_split_asm intro!: size_normalise_decomp) text \ A homomorphism $\varphi$ from a Euclidean ring $R$ into another ring $S$ with a notion of division. We will show that for any $x,y\in R$ such that $\phi(y)$ is a unit, we can perform partial fraction decomposition on the quotient $\varphi(x) / \varphi(y)$. The obvious choice for $S$ is the fraction field of $R$, but other choices may also make sense: If, for example, $R$ is a ring of polynomials $K[X]$, then one could let $S = K$ and $\varphi$ the evaluation homomorphism. Or one could let $S = K[[X]]$ (the ring of formal power series) and $\varphi$ the canonical homomorphism from polynomials to formal power series. \ locale pfd_homomorphism = fixes lift :: "('a :: euclidean_ring_gcd) \ ('b :: euclidean_semiring_cancel)" assumes lift_add: "lift (a + b) = lift a + lift b" assumes lift_mult: "lift (a * b) = lift a * lift b" assumes lift_0 [simp]: "lift 0 = 0" assumes lift_1 [simp]: "lift 1 = 1" begin lemma lift_power: "lift (a ^ n) = lift a ^ n" by (induction n) (simp_all add: lift_mult) definition from_decomp :: "'a \ 'a \ nat \ 'b" where "from_decomp x y n = lift x div lift y ^ n" lemma decompose: assumes "ys \ []" "pairwise coprime (set ys)" "distinct ys" "\y. y \ set ys \ is_unit (lift y)" shows "(\iy\set ys. is_unit (lift y)" by simp hence unit': "is_unit (lift (prod_list ys))" by (induction ys) (auto simp: lift_mult) ultimately have unit: "lift y dvd b" "lift (prod_list ys) dvd b" for b by auto obtain s t where st: "bezout_coefficients y (prod_list ys) = (s, t)" by (cases "bezout_coefficients y (prod_list ys)") simp_all from \pairwise coprime (set (y#ys))\ have coprime:"pairwise coprime (set ys)" by (rule pairwise_subset) auto have "(\i = lift (prod_list ys * t * x + y * s * x)" using assms unit by (simp add: lift_mult lift_add algebra_simps) finally have "(\i = 1" using \coprime (prod_list ys) y\ by simp finally show ?case by simp qed simp_all lemma normalise_decomp: fixes x y :: 'a and n :: nat assumes "is_unit (lift y)" defines "xs \ snd (normalise_decomp x y n)" shows "lift (fst (normalise_decomp x y n)) + (\iiii + from_decomp (x mod y) y (Suc n)) * lift y = (lift ((x div y) * y + x mod y) div lift y ^ n)" (is "?A * _ = ?B div _") unfolding lift_add lift_mult apply (subst div_add) apply (auto simp add: from_decomp_def algebra_simps dvd_div_mult2_eq unit_div_mult_swap dvd_div_mult2_eq[OF unit_imp_dvd] is_unit_mult_iff) done with 2(2) have "?A = \ div lift y" by (subst eq_commute, subst dvd_div_eq_mult) auto also from 2(2) unit have "\ = ?B div (lift y ^ Suc n)" by (subst is_unit_div_mult2_eq [symmetric]) (auto simp: mult_ac) also have "x div y * y + x mod y = x" by (rule div_mult_mod_eq) finally show ?case . qed simp_all lemma lift_prod_list: "lift (prod_list xs) = prod_list (map lift xs)" by (induction xs) (simp_all add: lift_mult) lemma lift_sum: "lift (sum f A) = sum (\x. lift (f x)) A" by (cases "finite A", induction A rule: finite_induct) (simp_all add: lift_add) lemma partial_fraction_decomposition: fixes ys :: "('a \ nat) list" defines "ys' \ map (\(x,n). x ^ Suc n) ys :: 'a list" assumes unit: "\y. y \ fst ` set ys \ is_unit (lift y)" assumes coprime: "pairwise coprime (set ys')" assumes distinct: "distinct ys'" assumes "partial_fraction_decomposition x ys = (a, zs)" shows "lift a + (\ij\snd (ys!i). from_decomp (zs!i!j) (fst (ys!i)) (snd (ys!i)+1 - j)) = lift x div lift (prod_list ys')" proof (cases "ys = []") assume [simp]: "ys \ []" define n where "n = length ys" have "lift x div lift (prod_list ys') = (\i = (\iij\snd (ys!i). from_decomp (zs!i!j) (fst (ys!i)) (snd (ys!i)+1 - j)))" (is "_ = ?A + ?B") proof (subst sum.distrib [symmetric], intro sum.cong refl, goal_cases) case (1 i) from 1 have "lift (ys' ! i) = lift (fst (ys ! i)) ^ Suc (snd (ys ! i))" by (simp add: ys'_def n_def lift_power lift_mult split: prod.split) also from 1 have "lift (decompose x ys' ! i) div \ = lift (fst (normalise_decomp (decompose x ys' ! i) (fst (ys!i)) (snd (ys!i)+1))) + (\jj\snd (ys!i). from_decomp (zs!i!j) (fst (ys!i)) (snd (ys!i)+1 - j))" using assms 1 by (intro sum.cong refl) (auto simp: partial_fraction_decomposition_def case_prod_unfold Let_def o_def n_def simp del: normalise_decomp.simps) finally show ?case . qed also from assms have "?A = lift a" by (auto simp: partial_fraction_decomposition_def o_def sum_list_sum_nth atLeast0LessThan case_prod_unfold Let_def lift_sum n_def intro!: sum.cong) finally show ?thesis by (simp add: n_def) qed (insert assms, simp add: partial_fraction_decomposition_def) end subsection \Specific results for polynomials\ definition divmod_field_poly :: "'a :: field poly \ 'a poly \ 'a poly \ 'a poly" where "divmod_field_poly p q = (p div q, p mod q)" lemma divmod_field_poly_code [code]: "divmod_field_poly p q = (let cg = coeffs q in if cg = [] then (0, p) else let cf = coeffs p; ilc = inverse (last cg); ch = map ((*) ilc) cg; (q, r) = divmod_poly_one_main_list [] (rev cf) (rev ch) (1 + length cf - length cg) in (poly_of_list (map ((*) ilc) q), poly_of_list (rev r)))" unfolding divmod_field_poly_def by (rule pdivmod_via_divmod_list) definition normalise_decomp_poly :: "'a::field_gcd poly \ 'a poly \ nat \ 'a poly \ 'a poly list" where [simp]: "normalise_decomp_poly (p :: _ poly) q n = normalise_decomp p q n" lemma normalise_decomp_poly_code [code]: "normalise_decomp_poly x y 0 = (x, [])" "normalise_decomp_poly x y (Suc n) = ( let (x', r) = divmod_field_poly x y; (z, rs) = normalise_decomp_poly x' y n in (z, r # rs))" by (simp_all add: divmod_field_poly_def) definition poly_pfd_simple where "poly_pfd_simple x cs = (if cs = [] then (x, []) else (let zs = [let (c, n) = cs ! i in normalise_decomp_poly (decompose x (map (\(c,n). [:1,-c:] ^ Suc n) cs) ! i) [:1,-c:] (n+1). i \ [0..p. coeff p 0) \ snd) zs)))" lemma poly_pfd_simple_code [code]: "poly_pfd_simple x cs = (if cs = [] then (x, []) else let zs = zip_with (\(c,n) decomp. normalise_decomp_poly decomp [:1,-c:] (n+1)) cs (decompose x (map (\(c,n). [:1,-c:] ^ Suc n) cs)) in (sum_list (map fst zs), map (map (\p. coeff p 0) \ snd) zs))" unfolding poly_pfd_simple_def zip_with_altdef' by (simp add: Let_def case_prod_unfold) lemma fst_poly_pfd_simple: "fst (poly_pfd_simple x cs) = fst (partial_fraction_decomposition x (map (\(c,n). ([:1,-c:],n)) cs))" by (auto simp: poly_pfd_simple_def partial_fraction_decomposition_def o_def case_prod_unfold Let_def sum_list_sum_nth intro!: sum.cong) lemma const_polyI: "degree p = 0 \ [:coeff p 0:] = p" by (elim degree_eq_zeroE) simp_all lemma snd_poly_pfd_simple: "map (map (\c. [:c :: 'a :: field_gcd:])) (snd (poly_pfd_simple x cs)) = (snd (partial_fraction_decomposition x (map (\(c,n). ([:1,-c:],n)) cs)))" proof - have "snd (poly_pfd_simple x cs) = map (map (\p. coeff p 0)) (snd (partial_fraction_decomposition x (map (\(c,n). ([:1,-c:],n)) cs)))" (is "_ = map ?f ?B") by (auto simp: poly_pfd_simple_def partial_fraction_decomposition_def o_def case_prod_unfold Let_def sum_list_sum_nth intro!: sum.cong) also have "map (map (\c. [:c:])) (map ?f ?B) = map (map (\x. x)) ?B" unfolding map_map o_def proof (intro map_cong refl const_polyI, goal_cases) case (1 ys y) from 1 obtain i where i: "i < length cs" "ys = snd (partial_fraction_decomposition x (map (\(c,n). ([:1,-c:],n)) cs)) ! i" by (auto simp: in_set_conv_nth) with 1 have "euclidean_size y < euclidean_size (fst (map (\(c,n). ([:1,-c:],n)) cs ! i))" by (intro size_partial_fraction_decomposition[of i _ _ x]) (auto simp: case_prod_unfold Let_def) with i(1) have "euclidean_size y < 2" by (auto simp: case_prod_unfold Let_def euclidean_size_poly_def split: if_split_asm) thus ?case by (cases y rule: pCons_cases) (auto simp: euclidean_size_poly_def split: if_split_asm) qed finally show ?thesis by simp qed lemma poly_pfd_simple: "partial_fraction_decomposition x (map (\(c,n). ([:1,-c:],n)) cs) = (fst (poly_pfd_simple x cs), map (map (\c. [:c:])) (snd (poly_pfd_simple x cs)))" by (simp add: fst_poly_pfd_simple snd_poly_pfd_simple) end diff --git a/thys/Liouville_Numbers/Liouville_Numbers.thy b/thys/Liouville_Numbers/Liouville_Numbers.thy --- a/thys/Liouville_Numbers/Liouville_Numbers.thy +++ b/thys/Liouville_Numbers/Liouville_Numbers.thy @@ -1,388 +1,388 @@ (* File: Liouville_Numbers.thy - Author: Manuel Eberl + Author: Manuel Eberl The definition of Liouville numbers and their standard construction, plus the proof that any Liouville number is transcendental. *) theory Liouville_Numbers imports Complex_Main "HOL-Computational_Algebra.Polynomial" Liouville_Numbers_Misc begin (* TODO: Move definition of algebraic numbers out of Algebraic_Numbers to reduce unnecessary dependencies. *) text \ A Liouville number is a real number that can be approximated well -- but not perfectly -- by a sequence of rational numbers. ``Well``, in this context, means that the error of the $n$-th rational in the sequence is bounded by the $n$-th power of its denominator. Our approach will be the following: \begin{itemize} \item Liouville numbers cannot be rational. \item Any irrational algebraic number cannot be approximated in the Liouville sense \item Therefore, all Liouville numbers are transcendental. \item The standard construction fulfils all the properties of Liouville numbers. \end{itemize} \ subsection \Definition of Liouville numbers\ text \ The following definitions and proofs are largely adapted from those in the Wikipedia article on Liouville numbers.~\cite{wikipedia} \ text \ A Liouville number is a real number that can be approximated well -- but not perfectly -- by a sequence of rational numbers. The error of the $n$-th term $\frac{p_n}{q_n}$ is at most $q_n^{-n}$, where $p_n\in\isasymint$ and $q_n \in\isasymint_{\geq 2}$. We will say that such a number can be approximated in the Liouville sense. \ locale liouville = fixes x :: real and p q :: "nat \ int" assumes approx_int_pos: "abs (x - p n / q n) > 0" and denom_gt_1: "q n > 1" and approx_int: "abs (x - p n / q n) < 1 / of_int (q n) ^ n" text \ First, we show that any Liouville number is irrational. \ lemma (in liouville) irrational: "x \ \" proof assume "x \ \" then obtain c d :: int where d: "x = of_int c / of_int d" "d > 0" by (elim Rats_cases') simp define n where "n = Suc (nat \log 2 d\)" note q_gt_1 = denom_gt_1[of n] have neq: "c * q n \ d * p n" proof assume "c * q n = d * p n" hence "of_int (c * q n) = of_int (d * p n)" by (simp only: ) with approx_int_pos[of n] d q_gt_1 show False by (auto simp: field_simps) qed hence abs_pos: "0 < abs (c * q n - d * p n)" by simp from q_gt_1 d have "of_int d = 2 powr log 2 d" by (subst powr_log_cancel) simp_all also from d have "log 2 (of_int d) \ log 2 1" by (subst log_le_cancel_iff) simp_all hence "2 powr log 2 d \ 2 powr of_nat (nat \log 2 d\)" by (intro powr_mono) simp_all also have "\ = of_int (2 ^ nat \log 2 d\)" by (subst powr_realpow) simp_all finally have "d \ 2 ^ nat \log 2 (of_int d)\" by (subst (asm) of_int_le_iff) also have "\ * q n \ q n ^ Suc (nat \log 2 (of_int d)\)" by (subst power_Suc, subst mult.commute, intro mult_left_mono power_mono, insert q_gt_1) simp_all also from q_gt_1 have "\ = q n ^ n" by (simp add: n_def) finally have "1 / of_int (q n ^ n) \ 1 / real_of_int (d * q n)" using q_gt_1 d by (intro divide_left_mono Rings.mult_pos_pos of_int_pos, subst of_int_le_iff) simp_all also have "\ \ of_int (abs (c * q n - d * p n)) / real_of_int (d * q n)" using q_gt_1 d abs_pos by (intro divide_right_mono) (linarith, simp) also have "\ = abs (x - of_int (p n) / of_int (q n))" using q_gt_1 d(2) by (simp_all add: divide_simps d(1) mult_ac) finally show False using approx_int[of n] by simp qed text \ Next, any irrational algebraic number cannot be approximated with rational numbers in the Liouville sense. \ lemma liouville_irrational_algebraic: fixes x :: real assumes irrationsl: "x \ \" and "algebraic x" obtains c :: real and n :: nat where "c > 0" and "\(p::int) (q::int). q > 0 \ abs (x - p / q) > c / of_int q ^ n" proof - from \algebraic x\ obtain p where p: "\i. coeff p i \ \" "p \ 0" "poly p x = 0" by (elim algebraicE) blast define n where "n = degree p" \ \The derivative of @{term p} is bounded within @{term "{x-1..x+1}"}.\ let ?f = "\t. \poly (pderiv p) t\" define M where "M = (SUP t\{x-1..x+1}. ?f t)" define roots where "roots = {x. poly p x = 0} - {x}" define A_set where "A_set = {1, 1/M} \ {abs (x' - x) |x'. x' \ roots}" define A' where "A' = Min A_set" define A where "A = A' / 2" \ \We define @{term A} to be a positive real number that is less than @{term 1}, @{term "1/M"} and any distance from @{term x} to another root of @{term p}.\ \ \Properties of @{term M}, our upper bound for the derivative of @{term p}:\ have "\s\{x-1..x+1}. \y\{x-1..x+1}. ?f s \ ?f y" by (intro continuous_attains_sup) (auto intro!: continuous_intros) hence bdd: "bdd_above (?f ` {x-1..x+1})" by auto have M_pos: "M > 0" proof - from p have "pderiv p \ 0" by (auto dest!: pderiv_iszero) hence "finite {x. poly (pderiv p) x = 0}" using poly_roots_finite by blast moreover have "\finite {x-1..x+1}" by (simp add: infinite_Icc) ultimately have "\finite ({x-1..x+1} - {x. poly (pderiv p) x = 0})" by simp hence "{x-1..x+1} - {x. poly (pderiv p) x = 0} \ {}" by (intro notI) simp then obtain t where t: "t \ {x-1..x+1}" and "poly (pderiv p) t \ 0" by blast hence "0 < ?f t" by simp also from t and bdd have "\ \ M" unfolding M_def by (rule cSUP_upper) finally show "M > 0" . qed have M_sup: "?f t \ M" if "t \ {x-1..x+1}" for t proof - from that and bdd show "?f t \ M" unfolding M_def by (rule cSUP_upper) qed \ \Properties of @{term A}:\ from p poly_roots_finite[of p] have "finite A_set" unfolding A_set_def roots_def by simp have "x \ roots" unfolding roots_def by auto hence "A' > 0" using Min_gr_iff[OF \finite A_set\, folded A'_def, of 0] by (auto simp: A_set_def M_pos) hence A_pos: "A > 0" by (simp add: A_def) from \A' > 0\ have "A < A'" by (simp add: A_def) moreover from Min_le[OF \finite A_set\, folded A'_def] have "A' \ 1" "A' \ 1/M" "\x'. x' \ x \ poly p x' = 0 \ A' \ abs (x' - x)" unfolding A_set_def roots_def by auto ultimately have A_less: "A < 1" "A < 1/M" "\x'. x' \ x \ poly p x' = 0 \ A < abs (x' - x)" by fastforce+ \ \Finally: no rational number can approximate @{term x} ``well enough''.\ have "\(a::int) (b :: int). b > 0 \ \x - of_int a / of_int b\ > A / of_int b ^ n" proof (intro allI impI, rule ccontr) fix a b :: int assume b: "b > 0" and "\(A / of_int b ^ n < \x - of_int a / of_int b\)" hence ab: "abs (x - of_int a / of_int b) \ A / of_int b ^ n" by simp also from A_pos b have "A / of_int b ^ n \ A / 1" by (intro divide_left_mono) simp_all finally have ab': "abs (x - a / b) \ A" by simp also have "\ \ 1" using A_less by simp finally have ab'': "a / b \ {x-1..x+1}" by auto have no_root: "poly p (a / b) \ 0" proof assume "poly p (a / b) = 0" moreover from \x \ \\ have "x \ a / b" by auto ultimately have "A < abs (a / b - x)" using A_less(3) by simp with ab' show False by simp qed have "\x0\{x-1..x+1}. poly p (a / b) - poly p x = (a / b - x) * poly (pderiv p) x0" using ab'' by (intro poly_MVT') (auto simp: min_def max_def) with p obtain x0 :: real where x0: "x0 \ {x-1..x+1}" "poly p (a / b) = (a / b - x) * poly (pderiv p) x0" by auto from x0(2) no_root have deriv_pos: "poly (pderiv p) x0 \ 0" by auto from b p no_root have p_ab: "abs (poly p (a / b)) \ 1 / of_int b ^ n" unfolding n_def by (intro int_poly_rat_no_root_ge) note ab also from A_less b have "A / of_int b ^ n < (1/M) / of_int b ^ n" by (intro divide_strict_right_mono) simp_all also have "\ = (1 / b ^ n) / M" by simp also from M_pos ab p_ab have "\ \ abs (poly p (a / b)) / M" by (intro divide_right_mono) simp_all also from deriv_pos M_pos x0(1) have "\ \ abs (poly p (a / b)) / abs (poly (pderiv p) x0)" by (intro divide_left_mono M_sup) simp_all also have "\poly p (a / b)\ = \a / b - x\ * \poly (pderiv p) x0\" by (subst x0(2)) (simp add: abs_mult) with deriv_pos have "\poly p (a / b)\ / \poly (pderiv p) x0\ = \x - a / b\" by (subst nonzero_divide_eq_eq) simp_all finally show False by simp qed with A_pos show ?thesis using that[of A n] by blast qed text \ Since Liouville numbers are irrational, but can be approximated well by rational numbers in the Liouville sense, they must be transcendental. \ lemma (in liouville) transcendental: "\algebraic x" proof assume "algebraic x" from liouville_irrational_algebraic[OF irrational this] obtain c n where cn: "c > 0" "\p q. q > 0 \ c / real_of_int q ^ n < \x - real_of_int p / real_of_int q\" by auto define r where "r = nat \log 2 (1 / c)\" define m where "m = n + r" from cn(1) have "(1/c) = 2 powr log 2 (1/c)" by (subst powr_log_cancel) simp_all also have "log 2 (1/c) \ of_nat (nat \log 2 (1/c)\)" by linarith hence "2 powr log 2 (1/c) \ 2 powr \" by (intro powr_mono) simp_all also have "\ = 2 ^ r" unfolding r_def by (simp add: powr_realpow) finally have "1 / (2^r) \ c" using cn(1) by (simp add: field_simps) have "abs (x - p m / q m) < 1 / of_int (q m) ^ m" by (rule approx_int) also have "\ = (1 / of_int (q m) ^ r) * (1 / real_of_int (q m) ^ n)" by (simp add: m_def power_add) also from denom_gt_1[of m] have "1 / real_of_int (q m) ^ r \ 1 / 2 ^ r" by (intro divide_left_mono power_mono) simp_all also have "\ \ c" by fact finally have "abs (x - p m / q m) < c / of_int (q m) ^ n" using denom_gt_1[of m] by - (simp_all add: divide_right_mono) with cn(2)[of "q m" "p m"] denom_gt_1[of m] show False by simp qed subsection \Standard construction for Liouville numbers\ text \ We now define the standard construction for Liouville numbers. \ definition standard_liouville :: "(nat \ int) \ int \ real" where "standard_liouville p q = (\k. p k / of_int q ^ fact (Suc k))" lemma standard_liouville_summable: fixes p :: "nat \ int" and q :: int assumes "q > 1" "range p \ {0..k. p k / of_int q ^ fact (Suc k))" proof (rule summable_comparison_test') from assms(1) show "summable (\n. (1 / q) ^ n)" by (intro summable_geometric) simp_all next fix n :: nat from assms have "p n \ {0.. q / of_int q ^ (fact (Suc n))" by (auto simp: field_simps) also from assms(1) have "\ = 1 / of_int q ^ (fact (Suc n) - 1)" by (subst power_diff) (auto simp del: fact_Suc) also have "Suc n \ fact (Suc n)" by (rule fact_ge_self) with assms(1) have "1 / real_of_int q ^ (fact (Suc n) - 1) \ 1 / of_int q ^ n" by (intro divide_left_mono power_increasing) (auto simp del: fact_Suc simp add: algebra_simps) finally show "norm (p n / of_int q ^ fact (Suc n)) \ (1 / q) ^ n" by (simp add: power_divide) qed lemma standard_liouville_sums: assumes "q > 1" "range p \ {0..k. p k / of_int q ^ fact (Suc k)) sums standard_liouville p q" using standard_liouville_summable[OF assms] unfolding standard_liouville_def by (simp add: summable_sums) text \ Now we prove that the standard construction indeed yields Liouville numbers. \ lemma standard_liouville_is_liouville: assumes "q > 1" "range p \ {0..n. p n \ 0) sequentially" defines "b \ \n. q ^ fact (Suc n)" defines "a \ \n. (\k\n. p k * q ^ (fact (Suc n) - fact (Suc k)))" shows "liouville (standard_liouville p q) a b" proof fix n :: nat from assms(1) have "1 < q ^ 1" by simp also from assms(1) have "\ \ b n" unfolding b_def by (intro power_increasing) (simp_all del: fact_Suc) finally show "b n > 1" . note summable = standard_liouville_summable[OF assms(1,2)] let ?S = "\k. p (k + n + 1) / of_int q ^ (fact (Suc (k + n + 1)))" let ?C = "(q - 1) / of_int q ^ (fact (n+2))" have "a n / b n = (\k\n. p k * (of_int q ^ (fact (n+1) - fact (k+1)) / of_int q ^ (fact (n+1))))" by (simp add: a_def b_def sum_divide_distrib of_int_sum) also have "\ = (\k\n. p k / of_int q ^ (fact (Suc k)))" by (intro sum.cong refl, subst inverse_divide [symmetric], subst power_diff [symmetric]) (insert assms(1), simp_all add: divide_simps fact_mono_nat del: fact_Suc) also have "standard_liouville p q - \ = ?S" unfolding standard_liouville_def by (subst diff_eq_eq) (intro suminf_split_initial_segment' summable) finally have "abs (standard_liouville p q - a n / b n) = abs ?S" by (simp only: ) moreover from assms have "?S \ 0" by (intro suminf_nonneg allI divide_nonneg_pos summable_ignore_initial_segment summable) force+ ultimately have eq: "abs (standard_liouville p q - a n / b n) = ?S" by simp also have "?S \ (\k. ?C * (1 / q) ^ k)" proof (intro suminf_le allI summable_ignore_initial_segment summable) from assms show "summable (\k. ?C * (1 / q) ^ k)" by (intro summable_mult summable_geometric) simp_all next fix k :: nat from assms have "p (k + n + 1) \ q - 1" by force with \q > 1\ have "p (k + n + 1) / of_int q ^ fact (Suc (k + n + 1)) \ (q - 1) / of_int q ^ (fact (Suc (k + n + 1)))" by (intro divide_right_mono) (simp_all del: fact_Suc) also from \q > 1\ have "\ \ (q - 1) / of_int q ^ (fact (n+2) + k)" using fact_ineq[of "n+2" k] by (intro divide_left_mono power_increasing) (simp_all add: add_ac) also have "\ = ?C * (1 / q) ^ k" by (simp add: field_simps power_add del: fact_Suc) finally show "p (k + n + 1) / of_int q ^ fact (Suc (k + n + 1)) \ \" . qed also from assms have "\ = ?C * (\k. (1 / q) ^ k)" by (intro suminf_mult summable_geometric) simp_all also from assms have "(\k. (1 / q) ^ k) = 1 / (1 - 1 / q)" by (intro suminf_geometric) simp_all also from assms(1) have "?C * \ = of_int q ^ 1 / of_int q ^ fact (n + 2)" by (simp add: field_simps) also from assms(1) have "\ \ of_int q ^ fact (n + 1) / of_int q ^ fact (n + 2)" by (intro divide_right_mono power_increasing) (simp_all add: field_simps del: fact_Suc) also from assms(1) have "\ = 1 / (of_int q ^ (fact (n + 2) - fact (n + 1)))" by (subst power_diff) simp_all also have "fact (n + 2) - fact (n + 1) = (n + 1) * fact (n + 1)" by (simp add: algebra_simps) also from assms(1) have "1 / (of_int q ^ \) < 1 / (real_of_int q ^ (fact (n + 1) * n))" by (intro divide_strict_left_mono power_increasing mult_right_mono) simp_all also have "\ = 1 / of_int (b n) ^ n" by (simp add: power_mult b_def power_divide del: fact_Suc) finally show "\standard_liouville p q - a n / b n\ < 1 / of_int (b n) ^ n" . from assms(3) obtain k where k: "k \ n + 1" "p k \ 0" by (auto simp: frequently_def eventually_at_top_linorder) define k' where "k' = k - n - 1" from assms k have "p k \ 0" by force with k assms have k': "p (k' + n + 1) > 0" unfolding k'_def by force with assms(1,2) have "?S > 0" by (intro suminf_pos2[of _ k'] summable_ignore_initial_segment summable) (force intro!: divide_pos_pos divide_nonneg_pos)+ with eq show "\standard_liouville p q - a n / b n\ > 0" by (simp only: ) qed text \ We can now show our main result: any standard Liouville number is transcendental. \ theorem transcendental_standard_liouville: assumes "q > 1" "range p \ {0..k. p k \ 0) sequentially" shows "\algebraic (standard_liouville p q)" proof - from assms interpret liouville "standard_liouville p q" "\n. (\k\n. p k * q ^ (fact (Suc n) - fact (Suc k)))" "\n. q ^ fact (Suc n)" by (rule standard_liouville_is_liouville) from transcendental show ?thesis . qed text \ In particular: The the standard construction for constant sequences, such as the ``classic'' Liouville constant $\sum_{n=1}^\infty 10^{-n!} = 0.11000100\ldots$, are transcendental. This shows that Liouville numbers exists and therefore gives a concrete and elementary proof that transcendental numbers exist. \ corollary transcendental_standard_standard_liouville: "a \ {0<.. \algebraic (standard_liouville (\_. int a) (int b))" by (intro transcendental_standard_liouville) auto corollary transcendental_liouville_constant: "\algebraic (standard_liouville (\_. 1) 10)" by (intro transcendental_standard_liouville) auto end diff --git a/thys/Liouville_Numbers/Liouville_Numbers_Misc.thy b/thys/Liouville_Numbers/Liouville_Numbers_Misc.thy --- a/thys/Liouville_Numbers/Liouville_Numbers_Misc.thy +++ b/thys/Liouville_Numbers/Liouville_Numbers_Misc.thy @@ -1,78 +1,78 @@ (* File: Liouville_Numbers_Misc.thy - Author: Manuel Eberl + Author: Manuel Eberl *) section \Liouville Numbers\ subsection \Preliminary lemmas\ theory Liouville_Numbers_Misc imports Complex_Main "HOL-Computational_Algebra.Polynomial" begin text \ We will require these inequalities on factorials to show properties of the standard construction later. \ lemma fact_ineq: "n \ 1 \ fact n + k \ fact (n + k)" proof (induction k) case (Suc k) from Suc have "fact n + Suc k \ fact (n + k) + 1" by simp also from Suc have "\ \ fact (n + Suc k)" by simp finally show ?case . qed simp_all lemma Ints_sum: assumes "\x. x \ A \ f x \ \" shows "sum f A \ \" by (cases "finite A", insert assms, induction A rule: finite_induct) (auto intro!: Ints_add) lemma suminf_split_initial_segment': "summable (f :: nat \ 'a::real_normed_vector) \ suminf f = (\n. f (n + k + 1)) + sum f {..k}" by (subst suminf_split_initial_segment[of _ "Suc k"], assumption, subst lessThan_Suc_atMost) simp_all lemma Rats_eq_int_div_int': "(\ :: real set) = {of_int p / of_int q |p q. q > 0}" proof safe fix x :: real assume "x \ \" then obtain p q where pq: "x = of_int p / of_int q" "q \ 0" by (subst (asm) Rats_eq_int_div_int) auto show "\p q. x = real_of_int p / real_of_int q \ 0 < q" proof (cases "q > 0") case False show ?thesis by (rule exI[of _ "-p"], rule exI[of _ "-q"]) (insert False pq, auto) qed (insert pq, force) qed auto lemma Rats_cases': assumes "(x :: real) \ \" obtains p q where "q > 0" "x = of_int p / of_int q" using assms by (subst (asm) Rats_eq_int_div_int') auto text \ The following inequality gives a lower bound for the absolute value of an integer polynomial at a rational point that is not a root. \ lemma int_poly_rat_no_root_ge: fixes p :: "real poly" and a b :: int assumes "\n. coeff p n \ \" assumes "b > 0" "poly p (a / b) \ 0" defines "n \ degree p" shows "abs (poly p (a / b)) \ 1 / of_int b ^ n" proof - let ?S = "(\i\n. coeff p i * of_int a ^ i * (of_int b ^ (n - i)))" from \b > 0\ have eq: "?S = of_int b ^ n * poly p (a / b)" by (simp add: poly_altdef power_divide mult_ac n_def sum_distrib_left power_diff) have "?S \ \" by (intro Ints_sum Ints_mult assms Ints_power) simp_all moreover from assms have "?S \ 0" by (subst eq) auto ultimately have "abs ?S \ 1" by (elim Ints_cases) simp with eq \b > 0\ show ?thesis by (simp add: field_simps abs_mult) qed end diff --git a/thys/Minkowskis_Theorem/Minkowskis_Theorem.thy b/thys/Minkowskis_Theorem/Minkowskis_Theorem.thy --- a/thys/Minkowskis_Theorem/Minkowskis_Theorem.thy +++ b/thys/Minkowskis_Theorem/Minkowskis_Theorem.thy @@ -1,526 +1,526 @@ (* File: Minkowskis_Theorem.thy - Author: Manuel Eberl + Author: Manuel Eberl A proof of Blichfeldt's and Minkowski's theorem about the relation between subsets of the Euclidean space, the Lebesgue measure, and the integer lattice. *) section \Minkowski's theorem\ theory Minkowskis_Theorem imports "HOL-Analysis.Equivalence_Lebesgue_Henstock_Integration" begin (* Could be generalised to arbitrary euclidean spaces and full-dimensional lattices *) subsection \Miscellaneous material\ lemma bij_betw_UN: assumes "bij_betw f A B" shows "(\n\A. g (f n)) = (\n\B. g n)" using assms by (auto simp: bij_betw_def) definition of_int_vec where "of_int_vec v = (\ i. of_int (v $ i))" lemma of_int_vec_nth [simp]: "of_int_vec v $ n = of_int (v $ n)" by (simp add: of_int_vec_def) lemma of_int_vec_eq_iff [simp]: "(of_int_vec a :: ('a :: ring_char_0) ^ 'n) = of_int_vec b \ a = b" by (simp add: of_int_vec_def vec_eq_iff) lemma inj_axis: assumes "c \ 0" shows "inj (\k. axis k c :: ('a :: {zero}) ^ 'n)" proof fix x y :: 'n assume *: "axis x c = axis y c" have "axis x c $ x = axis x c $ y" by (subst *) simp thus "x = y" using assms by (auto simp: axis_def split: if_splits) qed lemma compactD: assumes "compact (A :: 'a :: metric_space set)" "range f \ A" shows "\h l. strict_mono (h::nat\nat) \ (f \ h) \ l" using assms unfolding compact_def by blast lemma closed_lattice: fixes A :: "(real ^ 'n) set" assumes "\v i. v \ A \ v $ i \ \" shows "closed A" proof (rule discrete_imp_closed[OF zero_less_one], safe, goal_cases) case (1 x y) have "x $ i = y $ i" for i proof - from 1 and assms have "x $ i - y $ i \ \" by auto then obtain m where m: "of_int m = (x $ i - y $ i)" by (elim Ints_cases) auto hence "of_int (abs m) = abs ((x - y) $ i)" by simp also have "\ \ norm (x - y)" by (rule component_le_norm_cart) also have "\ < of_int 1" using 1 by (simp add: dist_norm norm_minus_commute) finally have "abs m < 1" by (subst (asm) of_int_less_iff) thus "x $ i = y $ i" using m by simp qed thus "y = x" by (simp add: vec_eq_iff) qed subsection \Auxiliary theorems about measure theory\ lemma emeasure_lborel_cbox_eq': "emeasure lborel (cbox a b) = ennreal (\e\Basis. max 0 ((b - a) \ e))" proof (cases "\ba\Basis. a \ ba \ b \ ba") case True hence "emeasure lborel (cbox a b) = ennreal (prod ((\) (b - a)) Basis)" unfolding emeasure_lborel_cbox_eq by auto also have "prod ((\) (b - a)) Basis = (\e\Basis. max 0 ((b - a) \ e))" using True by (intro prod.cong refl) (auto simp: max_def inner_simps) finally show ?thesis . next case False hence "emeasure lborel (cbox a b) = ennreal 0" by (auto simp: emeasure_lborel_cbox_eq) also from False have "0 = (\e\Basis. max 0 ((b - a) \ e))" by (auto simp: max_def inner_simps) finally show ?thesis . qed lemma emeasure_lborel_cbox_cart_eq: fixes a b :: "real ^ ('n :: finite)" shows "emeasure lborel (cbox a b) = ennreal (\i \ UNIV. max 0 ((b - a) $ i))" proof - have "emeasure lborel (cbox a b) = ennreal (\e\Basis. max 0 ((b - a) \ e))" unfolding emeasure_lborel_cbox_eq' .. also have "(Basis :: (real ^ 'n) set) = range (\k. axis k 1)" unfolding Basis_vec_def by auto also have "(\e\\. max 0 ((b - a) \ e)) = (\ i \ UNIV . max 0 ((b - a) $ i))" by (subst prod.reindex) (auto intro!: inj_axis simp: algebra_simps inner_axis) finally show ?thesis . qed lemma sum_emeasure': assumes [simp]: "finite A" assumes [measurable]: "\x. x \ A \ B x \ sets M" assumes "\x y. x \ A \ y \ A \ x \ y \ emeasure M (B x \ B y) = 0" shows "(\x\A. emeasure M (B x)) = emeasure M (\x\A. B x)" proof - define C where "C = (\x\A. \y\(A-{x}). B x \ B y)" have C: "C \ null_sets M" unfolding C_def using assms by (intro null_sets.finite_UN) (auto simp: null_sets_def) hence [measurable]: "C \ sets M" and [simp]: "emeasure M C = 0" by (simp_all add: null_sets_def) have "(\x\A. B x) = (\x\A. B x - C) \ C" by (auto simp: C_def) also have "emeasure M \ = emeasure M (\x\A. B x - C)" by (subst emeasure_Un_null_set) (auto intro!: sets.Un sets.Diff) also from assms have "\ = (\x\A. emeasure M (B x - C))" by (subst sum_emeasure) (auto simp: disjoint_family_on_def C_def intro!: sets.Diff sets.finite_UN) also have "\ = (\x\A. emeasure M (B x))" by (intro sum.cong refl emeasure_Diff_null_set) auto finally show ?thesis .. qed lemma sums_emeasure': assumes [measurable]: "\x. B x \ sets M" assumes "\x y. x \ y \ emeasure M (B x \ B y) = 0" shows "(\x. emeasure M (B x)) sums emeasure M (\x. B x)" proof - define C where "C = (\x. \y\-{x}. B x \ B y)" have C: "C \ null_sets M" unfolding C_def using assms by (intro null_sets_UN') (auto simp: null_sets_def) hence [measurable]: "C \ sets M" and [simp]: "emeasure M C = 0" by (simp_all add: null_sets_def) have "(\x. B x) = (\x. B x - C) \ C" by (auto simp: C_def) also have "emeasure M \ = emeasure M (\x. B x - C)" by (subst emeasure_Un_null_set) (auto intro!: sets.Un sets.Diff) also from assms have "(\x. emeasure M (B x - C)) sums \ " by (intro sums_emeasure) (auto simp: disjoint_family_on_def C_def intro!: sets.Diff sets.finite_UN) also have "(\x. emeasure M (B x - C)) = (\x. emeasure M (B x))" by (intro ext emeasure_Diff_null_set) auto finally show ?thesis . qed subsection \Blichfeldt's theorem\ text \ Blichfeldt's theorem states that, given a subset of $\mathbb{R}^n$ with $n > 0$ and a volume of more than 1, there exist two different points in that set whose difference vector has integer components. This will be the key ingredient in proving Minkowski's theorem. Note that in the HOL Light version, it is additionally required -- both for Blichfeldt's theorem and for Minkowski's theorem -- that the set is bounded, which we do not need. \ proposition blichfeldt: fixes S :: "(real ^ 'n) set" assumes [measurable]: "S \ sets lebesgue" assumes "emeasure lebesgue S > 1" obtains x y where "x \ y" and "x \ S" and "y \ S" and "\i. (x - y) $ i \ \" proof - \ \We define for each lattice point in $\mathbb{Z}^n$ the corresponding cell in $\mathbb{R}^n$.\ define R :: "int ^ 'n \ (real ^ 'n) set" where "R = (\a. cbox (of_int_vec a) (of_int_vec (a + 1)))" \ \For each lattice point, we can intersect the cell it defines with our set @{term S} to obtain a partitioning of @{term S}.\ define T :: "int ^ 'n \ (real ^ 'n) set" where "T = (\a. S \ R a)" \ \We can then translate each such partition into the cell at the origin, i.\,e. the unit box @{term "R 0"}.\ define T' :: "int ^ 'n \ (real ^ 'n) set" where "T' = (\a. (\x. x - of_int_vec a) ` T a)" have T'_altdef: "T' a = (\x. x + of_int_vec a) -` T a" for a unfolding T'_def by force \ \We need to show measurability of all the defined sets.\ have [measurable, simp]: "R a \ sets lebesgue" for a unfolding R_def by simp have [measurable, simp]: "T a \ sets lebesgue" for a unfolding T_def by auto have "(\x::real^'n. x + of_int_vec a) \ lebesgue \\<^sub>M lebesgue" for a using lebesgue_affine_measurable[of "\_. 1" "of_int_vec a"] by (auto simp: euclidean_representation add_ac) from measurable_sets[OF this, of "T a" a for a] have [measurable, simp]: "T' a \ sets lebesgue" for a unfolding T'_altdef by simp \ \Obviously, the original set @{term S} is the union of all the lattice point cell partitions.\ have S_decompose: "S = (\a. T a)" unfolding T_def proof safe fix x assume x: "x \ S" define a where "a = (\ i. \x $ i\)" have "x \ R a" unfolding R_def by (auto simp: cbox_interval less_eq_vec_def of_int_vec_def a_def) with x show "x \ (\a. S \ R a)" by auto qed \ \Translating the partitioned subsets does not change their volume.\ have emeasure_T': "emeasure lebesgue (T' a) = emeasure lebesgue (T a)" for a proof - have "T' a = (\x. 1 *\<^sub>R x + (- of_int_vec a)) ` T a" by (simp add: T'_def) also have "emeasure lebesgue \ = emeasure lebesgue (T a)" by (subst emeasure_lebesgue_affine) auto finally show ?thesis by simp qed \ \Each translated partition of @{term S} is a subset of the unit cell at the origin.\ have T'_subset: "T' a \ cbox 0 1" for a unfolding T'_def T_def R_def by (auto simp: algebra_simps cbox_interval of_int_vec_def less_eq_vec_def) \ \It is clear that the intersection of two different lattice point cells is a null set.\ have R_Int: "R a \ R b \ null_sets lebesgue" if "a \ b" for a b proof - from that obtain i where i: "a $ i \ b $ i" by (auto simp: vec_eq_iff) have "R a \ R b = cbox (\ i. max (a $ i) (b $ i)) (\ i. min (a $ i + 1) (b $ i + 1))" unfolding Int_interval_cart R_def interval_cbox by (simp add: of_int_vec_def max_def min_def if_distrib cong: if_cong) hence "emeasure lebesgue (R a \ R b) = emeasure lborel \" by simp also have "\ = ennreal (\i\UNIV. max 0 (((\ x. real_of_int (min (a $ x + 1) (b $ x + 1))) - (\ x. real_of_int (max (a $ x) (b $ x)))) $ i))" (is "_ = ennreal ?P") unfolding emeasure_lborel_cbox_cart_eq by simp also have "?P = 0" using i by (auto simp: max_def intro!: exI[of _ i]) finally show ?thesis by (auto simp: null_sets_def R_def) qed \ \Therefore, the intersection of two lattice point cell partitionings of @{term S} is also a null set.\ have T_Int: "T a \ T b \ null_sets lebesgue" if "a \ b" for a b proof - have "T a \ T b = (R a \ R b) \ S" by (auto simp: T_def) also have "\ \ null_sets lebesgue" by (rule null_set_Int2) (insert that, auto intro: R_Int assms) finally show ?thesis . qed have emeasure_T_Int: "emeasure lebesgue (T a \ T b) = 0" if "a \ b" for a b using T_Int[OF that] unfolding null_sets_def by blast \ \The set of lattice points $\mathbb{Z}^n$ is countably infinite, so there exists a bijection $f: \mathbb{N} \to \mathbb{Z}^n$. We need this for summing over all lattice points.\ define f :: "nat \ int ^ 'n" where "f = from_nat_into UNIV" have "countable (UNIV :: (int ^ 'n) set)" "infinite (UNIV :: (int ^ 'n) set)" using infinite_UNIV_char_0 by simp_all from bij_betw_from_nat_into [OF this] have f: "bij f" by (simp add: f_def) \ \Suppose all the translated cell partitions @{term T'} are disjoint.\ { assume disjoint: "\a b. a \ b \ T' a \ T' b = {}" \ \We know by assumption that the volume of @{term S} is greater than 1.\ have "1 < emeasure lebesgue S" by fact also have "emeasure lebesgue S = emeasure lebesgue (\n. T' (f n))" proof - \ \The sum of the volumes of all the @{term T'} is precisely the volume of their union, which is @{term "S"}.\ have "S = (\a. T a)" by (rule S_decompose) also have "\ = (\n. T (f n))" by (rule bij_betw_UN [OF f, symmetric]) also have "(\n. emeasure lebesgue (T (f n))) sums emeasure lebesgue \" by (intro sums_emeasure' emeasure_T_Int) (insert f, auto simp: bij_betw_def inj_on_def) also have "(\n. emeasure lebesgue (T (f n))) = (\n. emeasure lebesgue (T' (f n)))" by (simp add: emeasure_T') finally have "(\n. emeasure lebesgue (T' (f n))) sums emeasure lebesgue S" . moreover have "(\n. emeasure lebesgue (T' (f n))) sums emeasure lebesgue (\n. T' (f n))" using disjoint by (intro sums_emeasure) (insert f, auto simp: disjoint_family_on_def bij_betw_def inj_on_def) ultimately show ?thesis by (auto simp: sums_iff) qed \ \On the other hand, all the translated partitions lie in the unit cell @{term "cbox (0 :: real ^ 'n) 1"}, so their combined volume cannot be greater than 1.\ also have "emeasure lebesgue (\n. T' (f n)) \ emeasure lebesgue (cbox 0 (1 :: real ^ 'n))" using T'_subset by (intro emeasure_mono) auto also have "\ = 1" by (simp add: emeasure_lborel_cbox_cart_eq) \ \This leads to a contradiction.\ finally have False by simp } \ \Therefore, there exists a point that lies in two different translated partitions, which obviously corresponds two two points in the non-translated partitions whose difference is the difference between two lattice points and therefore has integer components.\ then obtain a b x where "a \ b" "x \ T' a" "x \ T' b" by auto thus ?thesis by (intro that[of "x + of_int_vec a" "x + of_int_vec b"]) (auto simp: T'_def T_def algebra_simps) qed subsection \Minkowski's theorem\ text \ Minkowski's theorem now states that, given a convex subset of $\mathbb{R}^n$ that is symmetric around the origin and has a volume greater than $2^n$, that set must contain a non-zero point with integer coordinates. \ theorem minkowski: fixes B :: "(real ^ 'n) set" assumes "convex B" and symmetric: "uminus ` B \ B" assumes meas_B [measurable]: "B \ sets lebesgue" assumes measure_B: "emeasure lebesgue B > 2 ^ CARD('n)" obtains x where "x \ B" and "x \ 0" and "\i. x $ i \ \" proof - \ \We scale @{term B} with $\frac{1}{2}$.\ define B' where "B' = (\x. 2 *\<^sub>R x) -` B" have meas_B' [measurable]: "B' \ sets lebesgue" using measurable_sets[OF lebesgue_measurable_scaling[of 2] meas_B] by (simp add: B'_def) have B'_altdef: "B' = (\x. (1/2) *\<^sub>R x) ` B" unfolding B'_def by force \ \The volume of the scaled set is $2^n$ times smaller than the original set, and therefore still has a volume greater than 1.\ have "1 < ennreal ((1 / 2) ^ CARD('n)) * emeasure lebesgue B" proof (cases "emeasure lebesgue B") case (real x) have "ennreal (2 ^ CARD('n)) = 2 ^ CARD('n)" by (subst ennreal_power [symmetric]) auto also from measure_B and real have "\ < ennreal x" by simp finally have "(2 ^ CARD('n)) < x" by (subst (asm) ennreal_less_iff) auto thus ?thesis using real by (simp add: ennreal_1 [symmetric] ennreal_mult' [symmetric] ennreal_less_iff field_simps del: ennreal_1) qed (simp_all add: ennreal_mult_top) also have "\ = emeasure lebesgue B'" unfolding B'_altdef using emeasure_lebesgue_affine[of "1/2" 0 B] by simp finally have *: "emeasure lebesgue B' > 1" . \ \We apply Blichfeldt's theorem to get two points whose difference vector has integer coefficients. It only remains to show that that difference vector is itself a point in the original set.\ obtain x y where xy: "x \ y" "x \ B'" "y \ B'" "\i. (x - y) $ i \ \" by (erule blichfeldt [OF meas_B' *]) hence "2 *\<^sub>R x \ B" "2 *\<^sub>R y \ B" by (auto simp: B'_def) \ \Exploiting the symmetric of @{term B}, the reflection of @{term "2 *\<^sub>R y"} is also in @{term B}.\ moreover from this and symmetric have "-(2 *\<^sub>R y) \ B" by blast \ \Since @{term B} is convex, the mid-point between @{term "2 *\<^sub>R x"} and @{term "-2 *\<^sub>R y"} is also in @{term B}, and that point is simply @{term "x - y"} as desired.\ ultimately have "(1 / 2) *\<^sub>R 2 *\<^sub>R x + (1 / 2) *\<^sub>R (- 2 *\<^sub>R y) \ B" using \convex B\ by (intro convexD) auto also have "(1 / 2) *\<^sub>R 2 *\<^sub>R x + (1 / 2) *\<^sub>R (- 2 *\<^sub>R y) = x - y" by simp finally show ?thesis using xy by (intro that[of "x - y"]) auto qed text \ If the set in question is compact, the restriction to the volume can be weakened to ``at least 1'' from ``greater than 1''. \ theorem minkowski_compact: fixes B :: "(real ^ 'n) set" assumes "convex B" and "compact B" and symmetric: "uminus ` B \ B" assumes measure_B: "emeasure lebesgue B \ 2 ^ CARD('n)" obtains x where "x \ B" and "x \ 0" and "\i. x $ i \ \" proof (cases "emeasure lebesgue B = 2 ^ CARD('n)") \ \If the volume is greater than 1, we can just apply the theorem from before.\ case False with measure_B have less: "emeasure lebesgue B > 2 ^ CARD('n)" by simp from \compact B\ have meas: "B \ sets lebesgue" by (intro sets_completionI_sets lborelD borel_closed compact_imp_closed) from minkowski[OF assms(1) symmetric meas less] and that show ?thesis by blast next case True \ \If the volume is precisely one, we look at what happens when @{term B} is scaled with a factor of $1 + \varepsilon$.\ define B' where "B' = (\\. (*\<^sub>R) (1 + \) ` B)" from \compact B\ have compact': "compact (B' \)" for \ unfolding B'_def by (intro compact_scaling) have B'_altdef: "B' \ = (*\<^sub>R) (inverse (1 + \)) -` B" if \: "\ > 0" for \ using \ unfolding B'_def by force \ \Since the scaled sets are convex, they are stable under scaling.\ have B_scale: "a *\<^sub>R x \ B" if "x \ B" "a \ {0..1}" for a x proof - have "((a + 1) / 2) *\<^sub>R x + (1 - ((a + 1) / 2)) *\<^sub>R (-x) \ B" using that and \convex B\ and symmetric by (intro convexD) auto also have "((a + 1) / 2) *\<^sub>R x + (1 - ((a + 1) / 2)) *\<^sub>R (-x) = (1 + a) *\<^sub>R ((1/2) *\<^sub>R (x + x)) - x" by (simp add: algebra_simps del: scaleR_half_double) also have "\ = a *\<^sub>R x" by (subst scaleR_half_double) (simp add: algebra_simps) finally show "\ \ B" . qed \ \This means that @{term B'} is monotonic.\ have B'_subset: "B' a \ B' b" if "0 \ a" "a \ b" for a b proof fix x assume "x \ B' a" then obtain y where "x = (1 + a) *\<^sub>R y" "y \ B" by (auto simp: B'_def) moreover then have "(inverse (1 + b) * (1 + a)) *\<^sub>R y \ B" using that by (intro B_scale) (auto simp: field_simps) ultimately show "x \ B' b" using that by (force simp: B'_def) qed \ \We obtain some upper bound on the norm of @{term B}.\ from \compact B\ have "bounded B" by (rule compact_imp_bounded) then obtain C where C: "norm x \ C" if "x \ B" for x unfolding bounded_iff by blast \ \We can then bound the distance of any point in a scaled set to the original set.\ have setdist_le: "setdist {x} B \ \ * C" if "x \ B' \" and "\ \ 0" for x \ proof - from that obtain y where y: "y \ B" and [simp]: "x = (1 + \) *\<^sub>R y" by (auto simp: B'_def) from y have "setdist {x} B \ dist x y" by (intro setdist_le_dist) auto also from that have "dist x y = \ * norm y" by (simp add: dist_norm algebra_simps) also from y have "norm y \ C" by (rule C) finally show "setdist {x} B \ \ * C" using that by (simp add: mult_left_mono) qed \ \By applying the standard Minkowski theorem to the a scaled set, we can see that any scaled set contains a non-zero point with integer coordinates.\ have "\v. v \ B' \ - {0} \ (\i. v $ i \ \)" if \: "\ > 0" for \ proof - from \convex B\ have convex': "convex (B' \)" unfolding B'_def by (rule convex_scaling) from \compact B\ have meas: "B' \ \ sets lebesgue" unfolding B'_def by (intro sets_completionI_sets lborelD borel_closed compact_imp_closed compact_scaling) from symmetric have symmetric': "uminus ` B' \ \ B' \" by (auto simp: B'_altdef[OF \]) have "2 ^ CARD('n) = ennreal (2 ^ CARD('n))" by (subst ennreal_power [symmetric]) auto hence "1 * emeasure lebesgue B < ennreal ((1 + \) ^ CARD('n)) * emeasure lebesgue B" using True and \ by (intro ennreal_mult_strict_right_mono) (auto) also have "\ = emeasure lebesgue (B' \)" using emeasure_lebesgue_affine[of "1+\" 0 B] and \ by (simp add: B'_def) finally have measure_B': "emeasure lebesgue (B' \) > 2 ^ CARD('n)" using True by simp obtain v where "v \ B' \" "v \ 0" "\i. v $ i \ \" by (erule minkowski[OF convex' symmetric' meas measure_B']) thus ?thesis by blast qed hence "\n. \v. v \ B' (1/Suc n) - {0} \ (\i. v $ i \ \)" by auto \ \In particular, this means we can choose some sequence tending to zero -- say $\frac{1}{n+1}$ -- and always find a lattice point in the scaled set.\ hence "\v. \n. v n \ B' (1/Suc n) - {0} \ (\i. v n $ i \ \)" by (subst (asm) choice_iff) then obtain v where v: "v n \ B' (1/Suc n) - {0}" "v n $ i \ \" for i n by blast \ \By the Bolzano--Weierstra{\ss} theorem, there exists a convergent subsequence of @{term v}.\ have "\h l. strict_mono (h::nat\nat) \ (v \ h) \ l" proof (rule compactD) show "compact (B' 1)" by (rule compact') show "range v \ B' 1" using B'_subset[of "1/Suc n" 1 for n] and v by auto qed then obtain h l where h: "strict_mono h" and l: "(v \ h) \ l" by blast \ \Since the convergent subsequence tends to @{term l}, the distance of the sequence elements to @{term B} tends to the distance of @{term l} and @{term B}. Furthermore, the distance of the sequence elements is bounded by $(1+\varepsilon)C$, which tends to 0, so the distance of @{term l} to @{term B} must be 0.\ have "setdist {l} B \ 0" proof (rule tendsto_le) show "((\x. setdist {x} B) \ (v \ h)) \ setdist {l} B" by (intro continuous_imp_tendsto l continuous_at_setdist) show "(\n. inverse (Suc (h n)) * C) \ 0" by (intro tendsto_mult_left_zero filterlim_compose[OF _ filterlim_subseq[OF h]] LIMSEQ_inverse_real_of_nat) show "\\<^sub>F x in sequentially. ((\x. setdist {x} B) \ (v \ h)) x \ inverse (real (Suc (h x))) * C" using setdist_le and v unfolding o_def by (intro always_eventually allI setdist_le) (auto simp: field_simps) qed auto hence "setdist {l} B = 0" by (intro antisym setdist_pos_le) with assms and \compact B\ have "l \ B" by (subst (asm) setdist_eq_0_closed) (auto intro: compact_imp_closed) \ \It is also easy to see that, since the lattice is a closed set and all sequence elements lie on it, the limit @{term l} also lies on it.\ moreover have "l \ {l. \i. l $ i \ \} - {0}" using v by (intro closed_sequentially[OF closed_lattice _ l]) auto ultimately show ?thesis using that by blast qed end diff --git a/thys/Myhill-Nerode/Non_Regular_Languages.thy b/thys/Myhill-Nerode/Non_Regular_Languages.thy --- a/thys/Myhill-Nerode/Non_Regular_Languages.thy +++ b/thys/Myhill-Nerode/Non_Regular_Languages.thy @@ -1,272 +1,272 @@ (* File: Non_Regular_Languages.thy - Author: Manuel Eberl + Author: Manuel Eberl This file provides some tools for showing the non-regularity of a language, either via an infinite set of equivalence classes or via the Pumping Lemma. *) section \Tools for showing non-regularity of a language\ theory Non_Regular_Languages imports Myhill begin subsection \Auxiliary material\ lemma bij_betw_image_quotient: "bij_betw (\y. f -` {y}) (f ` A) (A // {(a,b). f a = f b})" by (force simp: bij_betw_def inj_on_def image_image quotient_def) lemma regular_Derivs_finite: fixes r :: "'a :: finite rexp" shows "finite (range (\w. Derivs w (lang r)))" proof - have "?thesis \ finite (UNIV // \lang r)" unfolding str_eq_conv_Derivs by (rule bij_betw_finite bij_betw_image_quotient)+ also have "\" by (subst Myhill_Nerode [symmetric]) auto finally show ?thesis . qed lemma Nil_in_Derivs_iff: "[] \ Derivs w A \ w \ A" by (auto simp: Derivs_def) (* TODO: Move to distribution? *) text \ The following operation repeats a list $n$ times (usually written as $w ^ n$). \ primrec repeat :: "nat \ 'a list \ 'a list" where "repeat 0 xs = []" | "repeat (Suc n) xs = xs @ repeat n xs" lemma repeat_Cons_left: "repeat (Suc n) xs = xs @ repeat n xs" by simp lemma repeat_Cons_right: "repeat (Suc n) xs = repeat n xs @ xs" by (induction n) simp_all lemma repeat_Cons_append_commute [simp]: "repeat n xs @ xs = xs @ repeat n xs" by (subst repeat_Cons_right [symmetric]) simp lemma repeat_Cons_add [simp]: "repeat (m + n) xs = repeat m xs @ repeat n xs" by (induction m) simp_all lemma repeat_Nil [simp]: "repeat n [] = []" by (induction n) simp_all lemma repeat_conv_replicate: "repeat n xs = concat (replicate n xs)" by (induction n) simp_all (* TODO: Move to distribution? *) lemma nth_prefixes [simp]: "n \ length xs \ prefixes xs ! n = take n xs" by (induction xs arbitrary: n) (auto simp: nth_Cons split: nat.splits) lemma nth_suffixes [simp]: "n \ length xs \ suffixes xs ! n = drop (length xs - n) xs" by (subst suffixes_conv_prefixes) (simp_all add: rev_take) lemma length_take_prefixes: assumes "xs \ set (take n (prefixes ys))" shows "length xs < n" proof (cases "n \ Suc (length ys)") case True with assms obtain i where "i < n" "xs = take i ys" by (subst (asm) nth_image [symmetric]) auto thus ?thesis by simp next case False with assms have "prefix xs ys" by simp hence "length xs \ length ys" by (rule prefix_length_le) also from False have "\ < n" by simp finally show ?thesis . qed subsection \Non-regularity by giving an infinite set of equivalence classes\ text \ Non-regularity can be shown by giving an infinite set of non-equivalent words (w.r.t. the Myhill--Nerode relation). \ lemma not_regular_langI: assumes "infinite B" "\x y. x \ B \ y \ B \ x \ y \ \w. \(x @ w \ A \ y @ w \ A)" shows "\regular_lang (A :: 'a :: finite list set)" proof - have "(\w. Derivs w A) ` B \ range (\w. Derivs w A)" by blast moreover from assms(2) have "inj_on (\w. Derivs w A) B" by (auto simp: inj_on_def Derivs_def) with assms(1) have "infinite ((\w. Derivs w A) ` B)" by (blast dest: finite_imageD) ultimately have "infinite (range (\w. Derivs w A))" by (rule infinite_super) with regular_Derivs_finite show ?thesis by blast qed lemma not_regular_langI': assumes "infinite B" "\x y. x \ B \ y \ B \ x \ y \ \w. \(f x @ w \ A \ f y @ w \ A)" shows "\regular_lang (A :: 'a :: finite list set)" proof (rule not_regular_langI) from assms(2) have "inj_on f B" by (force simp: inj_on_def) with \infinite B\ show "infinite (f ` B)" by (simp add: finite_image_iff) qed (insert assms, auto) subsection \The Pumping Lemma\ text \ The Pumping lemma can be shown very easily from the Myhill--Nerode theorem: if we have a word whose length is more than the (finite) number of equivalence classes, then it must have two different prefixes in the same class and the difference between these two prefixes can then be ``pumped''. \ lemma pumping_lemma_aux: fixes A :: "'a list set" defines "\ \ \w. Derivs w A" defines "n \ card (range \)" assumes "z \ A" "finite (range \)" "length z \ n" shows "\u v w. z = u @ v @ w \ length (u @ v) \ n \ v \ [] \ (\i. u @ repeat i v @ w \ A)" proof - define P where "P = set (take (Suc n) (prefixes z))" from \length z \ n\ have [simp]: "card P = Suc n" unfolding P_def by (subst distinct_card) (auto intro!: distinct_take) have length_le: "length y \ n" if "y \ P" for y using length_take_prefixes[OF that [unfolded P_def]] by simp have "card (\ ` P) \ card (range \)" by (intro card_mono assms) auto also from assms have "\ < card P" by simp finally have "\inj_on \ P" by (rule pigeonhole) then obtain a b where ab: "a \ P" "b \ P" "a \ b" "Derivs a A = Derivs b A" by (auto simp: inj_on_def \_def) from ab have prefix_ab: "prefix a z" "prefix b z" by (auto simp: P_def dest: in_set_takeD) from ab have length_ab: "length a \ n" "length b \ n" by (simp_all add: length_le) have *: ?thesis if uz': "prefix u z'" "prefix z' z" "length z' \ n" "u \ z'" "Derivs z' A = Derivs u A" for u z' proof - from \prefix u z'\ and \u \ z'\ obtain v where v [simp]: "z' = u @ v" "v \ []" by (auto simp: prefix_def) from \prefix z' z\ obtain w where [simp]: "z = u @ v @ w" by (auto simp: prefix_def) hence [simp]: "Derivs (repeat i v) (Derivs u A) = Derivs u A" for i by (induction i) (use uz' in simp_all) have "Derivs z A = Derivs (u @ repeat i v @ w) A" for i using uz' by simp with \z \ A\ and uz' have "\i. u @ repeat i v @ w \ A" by (simp add: Nil_in_Derivs_iff [of _ A, symmetric]) moreover have "z = u @ v @ w" by simp moreover from \length z' \ n\ have "length (u @ v) \ n" by simp ultimately show ?thesis using \v \ []\ by blast qed from prefix_ab have "prefix a b \ prefix b a" by (rule prefix_same_cases) with *[of a b] and *[of b a] and ab and prefix_ab and length_ab show ?thesis by blast qed theorem pumping_lemma: fixes r :: "'a :: finite rexp" obtains n where "\z. z \ lang r \ length z \ n \ \u v w. z = u @ v @ w \ length (u @ v) \ n \ v \ [] \ (\i. u @ repeat i v @ w \ lang r)" proof - let ?n = "card (range (\w. Derivs w (lang r)))" have "\u v w. z = u @ v @ w \ length (u @ v) \ ?n \ v \ [] \ (\i. u @ repeat i v @ w \ lang r)" if "z \ lang r" and "length z \ ?n" for z by (intro pumping_lemma_aux[of z] that regular_Derivs_finite) thus ?thesis by (rule that) qed corollary pumping_lemma_not_regular_lang: fixes A :: "'a :: finite list set" assumes "\n. length (z n) \ n" and "\n. z n \ A" assumes "\n u v w. z n = u @ v @ w \ length (u @ v) \ n \ v \ [] \ u @ repeat (i n u v w) v @ w \ A" shows "\regular_lang A" proof assume "regular_lang A" then obtain r where r: "lang r = A" by blast from pumping_lemma[of r] obtain n where "z n \ lang r \ n \ length (z n) \ \u v w. z n = u @ v @ w \ length (u @ v) \ n \ v \ [] \ (\i. u @ repeat i v @ w \ lang r)" by metis from this and assms[of n] obtain u v w where "z n = u @ v @ w" and "length (u @ v) \ n" and "v \ []" and "\i. u @ repeat i v @ w \ lang r" by (auto simp: r) with assms(3)[of n u v w] show False by (auto simp: r) qed subsection \Examples\ text \ The language of all words containing the same number of $a$s and $b$s is not regular. \ lemma "\regular_lang {w. length (filter id w) = length (filter Not w)}" (is "\regular_lang ?A") proof (rule not_regular_langI') show "infinite (UNIV :: nat set)" by simp next fix m n :: nat assume "m \ n" hence "replicate m True @ replicate m False \ ?A" and "replicate n True @ replicate m False \ ?A" by simp_all thus "\w. \(replicate m True @ w \ ?A \ replicate n True @ w \ ?A)" by blast qed text \ The language $\{a^i b^i\ |\ i \in \mathbb{N}\}$ is not regular. \ lemma eq_replicate_iff: "xs = replicate n x \ set xs \ {x} \ length xs = n" using replicate_length_same[of xs x] by (subst eq_commute) auto lemma replicate_eq_appendE: assumes "xs @ ys = replicate n x" obtains i j where "n = i + j" "xs = replicate i x" "ys = replicate j x" proof - have "n = length (replicate n x)" by simp also note assms [symmetric] finally have "n = length xs + length ys" by simp moreover have "xs = replicate (length xs) x" and "ys = replicate (length ys) x" using assms by (auto simp: eq_replicate_iff) ultimately show ?thesis using that[of "length xs" "length ys"] by auto qed lemma "\regular_lang (range (\i. replicate i True @ replicate i False))" (is "\regular_lang ?A") proof (rule pumping_lemma_not_regular_lang) fix n :: nat show "length (replicate n True @ replicate n False) \ n" by simp show "replicate n True @ replicate n False \ ?A" by simp next fix n :: nat and u v w :: "bool list" assume decomp: "replicate n True @ replicate n False = u @ v @ w" and length_le: "length (u @ v) \ n" and v_ne: "v \ []" define w1 w2 where "w1 = take (n - length (u@v)) w" and "w2 = drop (n - length (u@v)) w" have w_decomp: "w = w1 @ w2" by (simp add: w1_def w2_def) have "replicate n True = take n (replicate n True @ replicate n False)" by simp also note decomp also have "take n (u @ v @ w) = u @ v @ w1" using length_le by (simp add: w1_def) finally have "u @ v @ w1 = replicate n True" by simp then obtain i j k where uvw1: "n = i + j + k" "u = replicate i True" "v = replicate j True" "w1 = replicate k True" by (elim replicate_eq_appendE) auto have "replicate n False = drop n (replicate n True @ replicate n False)" by simp also note decomp finally have [simp]: "w2 = replicate n False" using length_le by (simp add: w2_def) have "u @ repeat (Suc (Suc 0)) v @ w = replicate (n + j) True @ replicate n False" by (simp add: uvw1 w_decomp replicate_add [symmetric]) also have "\ \ ?A" proof safe fix m assume *: "replicate (n + j) True @ replicate n False = replicate m True @ replicate m False" (is "?lhs = ?rhs") have "n = length (filter Not ?lhs)" by simp also note * also have "length (filter Not ?rhs) = m" by simp finally have [simp]: "m = n" by simp from * have "v = []" by (simp add: uvw1) with \v \ []\ show False by contradiction qed finally show "u @ repeat (Suc (Suc 0)) v @ w \ ?A" . qed end diff --git a/thys/Prime_Harmonic_Series/Prime_Harmonic.thy b/thys/Prime_Harmonic_Series/Prime_Harmonic.thy --- a/thys/Prime_Harmonic_Series/Prime_Harmonic.thy +++ b/thys/Prime_Harmonic_Series/Prime_Harmonic.thy @@ -1,253 +1,253 @@ (* File: Prime_Harmonic.thy - Author: Manuel Eberl + Author: Manuel Eberl A lower bound for the partial sums of the prime harmonic series, and a proof of its divergence. (#81 on the list of 100 mathematical theorems) *) section \The Prime Harmonic Series\ theory Prime_Harmonic imports "HOL-Analysis.Analysis" "HOL-Number_Theory.Number_Theory" Prime_Harmonic_Misc Squarefree_Nat begin subsection \Auxiliary equalities and inequalities\ text \ First of all, we prove the following result about rearranging a product over a set into a sum over all subsets of that set. \ lemma prime_harmonic_aux1: fixes A :: "'a :: field set" shows "finite A \ (\x\A. 1 + 1 / x) = (\x\Pow A. 1 / \x)" proof (induction rule: finite_induct) fix a :: 'a and A :: "'a set" assume a: "a \ A" and fin: "finite A" assume IH: "(\x\A. 1 + 1 / x) = (\x\Pow A. 1 / \x)" from a and fin have "(\x\insert a A. 1 + 1 / x) = (1 + 1 / a) * (\x\A. 1 + 1 / x)" by simp also from fin have "\ = (\x\Pow A. 1 / \x) + (\x\Pow A. 1 / (a * \x))" by (subst IH) (auto simp add: algebra_simps sum_divide_distrib) also from fin a have "(\x\Pow A. 1 / (a * \x)) = (\x\Pow A. 1 / \(insert a x))" by (intro sum.cong refl, subst prod.insert) (auto dest: finite_subset) also from a have "\ = (\x\insert a ` Pow A. 1 / \x)" by (subst sum.reindex) (auto simp: inj_on_def) also from fin a have "(\x\Pow A. 1 / \x) + \ = (\x\Pow A \ insert a ` Pow A. 1 / \x)" by (intro sum.union_disjoint [symmetric]) (simp, simp, blast) also have "Pow A \ insert a ` Pow A = Pow (insert a A)" by (simp only: Pow_insert) finally show " (\x\insert a A. 1 + 1 / x) = (\x\Pow (insert a A). 1 / \x)" . qed simp text \ Next, we prove a simple and reasonably accurate upper bound for the sum of the squares of any subset of the natural numbers, derived by simple telescoping. Our upper bound is approximately 1.67; the exact value is $\frac{\pi^2}{6} \approx 1.64$. (cf. Basel problem) \ lemma prime_harmonic_aux2: assumes "finite (A :: nat set)" shows "(\k\A. 1 / (real k ^ 2)) \ 5/3" proof - define n where "n = max 2 (Max A)" have n: "n \ Max A" "n \ 2" by (auto simp: n_def) with assms have "A \ {0..n}" by (auto intro: order.trans[OF Max_ge]) hence "(\k\A. 1 / (real k ^ 2)) \ (\k=0..n. 1 / (real k ^ 2))" by (intro sum_mono2) auto also from n have "\ = 1 + (\k=Suc 1..n. 1 / (real k ^ 2))" by (simp add: sum.atLeast_Suc_atMost) also have "(\k=Suc 1..n. 1 / (real k ^ 2)) \ (\k=Suc 1..n. 1 / (real k ^ 2 - 1/4))" unfolding power2_eq_square by (intro sum_mono divide_left_mono mult_pos_pos) (linarith, simp_all add: field_simps less_1_mult) also have "\ = (\k=Suc 1..n. 1 / (real k - 1/2) - 1 / (real (Suc k) - 1/2))" by (intro sum.cong refl) (simp_all add: field_simps power2_eq_square) also from n have "\ = 2 / 3 - 1 / (1 / 2 + real n)" by (subst sum_telescope') simp_all also have "1 + \ \ 5/3" by simp finally show ?thesis by - simp qed subsection \Estimating the partial sums of the Prime Harmonic Series\ text \ We are now ready to show our main result: the value of the partial prime harmonic sum over all primes no greater than $n$ is bounded from below by the $n$-th harmonic number $H_n$ minus some constant. In our case, this constant will be $\frac{5}{3}$. As mentioned before, using a proof of the Basel problem can improve this to $\frac{\pi^2}{6}$, but the improvement is very small and the proof of the Basel problem is a very complex one. The exact asymptotic behaviour of the partial sums is actually $\ln (\ln n) + M$, where $M$ is the Meissel--Mertens constant (approximately 0.261). \ theorem prime_harmonic_lower: assumes n: "n \ 2" shows "(\p\primes_upto n. 1 / real p) \ ln (harm n) - ln (5/3)" proof - \ \the set of primes that we will allow in the squarefree part\ define P where "P n = set (primes_upto n)" for n { fix n :: nat have "finite (P n)" by (simp add: P_def) } note [simp] = this \ \The function that combines the squarefree part and the square part\ define f where "f = (\(R, s :: nat). \R * s^2)" \ \@{term f} is injective if the squarefree part contains only primes and the square part is positive.\ have inj: "inj_on f (Pow (P n)\{1..n})" proof (rule inj_onI, clarify, rule conjI) fix A1 A2 :: "nat set" and s1 s2 :: nat assume A: "A1 \ P n" "A2 \ P n" "s1 \ {1..n}" "s2 \ {1..n}" "f (A1, s1) = f (A2, s2)" have fin: "finite A1" "finite A2" by (rule A(1,2)[THEN finite_subset], simp)+ show "A1 = A2" "s1 = s2" by ((rule squarefree_decomposition_unique2'[of A1 s1 A2 s2], insert A fin, auto simp: f_def P_def set_primes_upto)[])+ qed \ \@{term f} hits every number between @{term "1::nat"} and @{term "n"}. It also hits a lot of other numbers, but we do not care about those, since we only need a lower bound.\ have surj: "{1..n} \ f ` (Pow (P n)\{1..n})" proof fix x assume x: "x \ {1..n}" have "x = f (squarefree_part x, square_part x)" by (simp add: f_def squarefree_decompose) moreover have "squarefree_part x \ Pow (P n)" using squarefree_part_subset[of x] x by (auto simp: P_def set_primes_upto intro: order.trans[OF squarefree_part_le[of _ x]]) moreover have "square_part x \ {1..n}" using x by (auto simp: Suc_le_eq intro: order.trans[OF square_part_le[of x]]) ultimately show "x \ f ` (Pow (P n)\{1..n})" by simp qed \ \We now show the main result by rearranging the sum over all primes to a product over all all squarefree parts times a sum over all square parts, and then applying some simple-minded approximation\ have "harm n = (\n=1..n. 1 / real n)" by (simp add: harm_def field_simps) also from surj have "\ \ (\n\f ` (Pow (P n)\{1..n}). 1 / real n)" by (intro sum_mono2 finite_imageI finite_cartesian_product) simp_all also from inj have "\ = (\x\Pow (P n)\{1..n}. 1 / real (f x))" by (subst sum.reindex) simp_all also have "\ = (\A\Pow (P n). 1 / real (\A)) * (\k=1..n. 1 / (real k)^2)" unfolding f_def by (subst sum_product, subst sum.cartesian_product) (simp add: case_prod_beta) also have "\ \ (\A\Pow (P n). 1 / real (\A)) * (5/3)" by (intro mult_left_mono prime_harmonic_aux2 sum_nonneg) (auto simp: P_def intro!: prod_nonneg) also have "(\A\Pow (P n). 1 / real (\A)) = (\A\((`) real) ` Pow (P n). 1 / \A)" by (subst sum.reindex) (auto simp: inj_on_def inj_image_eq_iff prod.reindex) also have "((`) real) ` Pow (P n) = Pow (real ` P n)" by (intro image_Pow_surj refl) also have "(\A\Pow (real ` P n). 1 / \A) = (\x\real ` P n. 1 + 1 / x)" by (intro prime_harmonic_aux1 [symmetric] finite_imageI) simp_all also have "\ = (\i\P n. 1 + 1 / real i)" by (subst prod.reindex) (auto simp: inj_on_def) also have "\ \ (\i\P n. exp (1 / real i))" by (intro prod_mono) auto also have "\ = exp (\i\P n. 1 / real i)" by (simp add: exp_sum) finally have "ln (harm n) \ ln (\ * (5/3))" using n by (subst ln_le_cancel_iff) simp_all hence "ln (harm n) - ln (5/3) \ (\i\P n. 1 / real i)" by (subst (asm) ln_mult) (simp_all add: algebra_simps) thus ?thesis unfolding P_def by (subst (asm) sum.distinct_set_conv_list) simp_all qed text \ We can use the inequality $\ln (n + 1) \le H_n$ to estimate the asymptotic growth of the partial prime harmonic series. Note that $H_n \sim \ln n + \gamma$ where $\gamma$ is the Euler--Mascheroni constant (approximately 0.577), so we lose some accuracy here. \ corollary prime_harmonic_lower': assumes n: "n \ 2" shows "(\p\primes_upto n. 1 / real p) \ ln (ln (n + 1)) - ln (5/3)" proof - from assms ln_le_harm[of n] have "ln (ln (real n + 1)) \ ln (harm n)" by simp also from assms have "\ - ln (5/3) \ (\p\primes_upto n. 1 / real p)" by (rule prime_harmonic_lower) finally show ?thesis by - simp qed (* TODO: Not needed in Isabelle 2016 *) lemma Bseq_eventually_mono: assumes "eventually (\n. norm (f n) \ norm (g n)) sequentially" "Bseq g" shows "Bseq f" proof - from assms(1) obtain N where N: "\n. n \ N \ norm (f n) \ norm (g n)" by (auto simp: eventually_at_top_linorder) from assms(2) obtain K where K: "\n. norm (g n) \ K" by (blast elim!: BseqE) { fix n :: nat have "norm (f n) \ max K (Max {norm (f n) |n. n < N})" apply (cases "n < N") apply (rule max.coboundedI2, rule Max.coboundedI, auto) [] apply (rule max.coboundedI1, force intro: order.trans[OF N K]) done } thus ?thesis by (blast intro: BseqI') qed lemma Bseq_add: assumes "Bseq (f :: nat \ 'a :: real_normed_vector)" shows "Bseq (\x. f x + c)" proof - from assms obtain K where K: "\x. norm (f x) \ K" unfolding Bseq_def by blast { fix x :: nat have "norm (f x + c) \ norm (f x) + norm c" by (rule norm_triangle_ineq) also have "norm (f x) \ K" by (rule K) finally have "norm (f x + c) \ K + norm c" by simp } thus ?thesis by (rule BseqI') qed lemma convergent_imp_Bseq: "convergent f \ Bseq f" by (simp add: Cauchy_Bseq convergent_Cauchy) (* END TODO *) text \ We now use our last estimate to show that the prime harmonic series diverges. This is obvious, since it is bounded from below by $\ln (\ln (n + 1))$ minus some constant, which obviously tends to infinite. Directly using the divergence of the harmonic series would also be possible and shorten this proof a bit.. \ corollary prime_harmonic_series_unbounded: "\Bseq (\n. \p\primes_upto n. 1 / p)" (is "\Bseq ?f") proof assume "Bseq ?f" hence "Bseq (\n. ?f n + ln (5/3))" by (rule Bseq_add) have "Bseq (\n. ln (ln (n + 1)))" proof (rule Bseq_eventually_mono) from eventually_ge_at_top[of "2::nat"] show "eventually (\n. norm (ln (ln (n + 1))) \ norm (?f n + ln (5/3))) sequentially" proof eventually_elim fix n :: nat assume n: "n \ 2" hence "norm (ln (ln (real n + 1))) = ln (ln (real n + 1))" using ln_ln_nonneg[of "real n + 1"] by simp also have "\ \ ?f n + ln (5/3)" using prime_harmonic_lower'[OF n] by (simp add: algebra_simps) also have "?f n + ln (5/3) \ 0" by (intro add_nonneg_nonneg sum_list_nonneg) simp_all hence "?f n + ln (5/3) = norm (?f n + ln (5/3))" by simp finally show "norm (ln (ln (n + 1))) \ norm (?f n + ln (5/3))" by (simp add: add_ac) qed qed fact then obtain k where k: "k > 0" "\n. norm (ln (ln (real (n::nat) + 1))) \ k" by (auto elim!: BseqE simp: add_ac) define N where "N = nat \exp (exp k)\" have N_pos: "N > 0" unfolding N_def by simp have "real N + 1 > exp (exp k)" unfolding N_def by linarith hence "ln (real N + 1) > ln (exp (exp k))" by (subst ln_less_cancel_iff) simp_all with N_pos have "ln (ln (real N + 1)) > ln (exp k)" by (subst ln_less_cancel_iff) simp_all hence "k < ln (ln (real N + 1))" by simp also have "\ \ norm (ln (ln (real N + 1)))" by simp finally show False using k(2)[of N] by simp qed corollary prime_harmonic_series_diverges: "\convergent (\n. \p\primes_upto n. 1 / p)" using prime_harmonic_series_unbounded convergent_imp_Bseq by blast end diff --git a/thys/Prime_Harmonic_Series/Prime_Harmonic_Misc.thy b/thys/Prime_Harmonic_Series/Prime_Harmonic_Misc.thy --- a/thys/Prime_Harmonic_Series/Prime_Harmonic_Misc.thy +++ b/thys/Prime_Harmonic_Series/Prime_Harmonic_Misc.thy @@ -1,79 +1,79 @@ (* File: Prime_Harmonic_Misc.thy - Author: Manuel Eberl + Author: Manuel Eberl *) section \Auxiliary lemmas\ theory Prime_Harmonic_Misc imports Complex_Main "HOL-Number_Theory.Number_Theory" begin lemma sum_list_nonneg: "\x\set xs. x \ 0 \ sum_list xs \ (0 :: 'a :: ordered_ab_group_add)" by (induction xs) auto lemma sum_telescope': assumes "m \ n" shows "(\k = Suc m..n. f k - f (Suc k)) = f (Suc m) - (f (Suc n) :: 'a :: ab_group_add)" by (rule dec_induct[OF assms]) (simp_all add: algebra_simps) lemma dvd_prodI: assumes "finite A" "x \ A" shows "f x dvd prod f A" proof - from assms have "prod f A = f x * prod f (A - {x})" by (intro prod.remove) simp_all thus ?thesis by simp qed lemma dvd_prodD: "finite A \ prod f A dvd x \ a \ A \ f a dvd x" by (erule dvd_trans[OF dvd_prodI]) lemma multiplicity_power_nat: "prime p \ n > 0 \ multiplicity p (n ^ k :: nat) = k * multiplicity p n" by (induction k) (simp_all add: prime_elem_multiplicity_mult_distrib) lemma multiplicity_prod_prime_powers_nat': "finite S \ \p\S. prime p \ prime p \ multiplicity p (\S :: nat) = (if p \ S then 1 else 0)" using multiplicity_prod_prime_powers[of S p "\_. 1"] by simp lemma prod_prime_subset: assumes "finite A" "finite B" assumes "\x. x \ A \ prime (x::nat)" assumes "\x. x \ B \ prime x" assumes "\A dvd \B" shows "A \ B" proof fix x assume x: "x \ A" from assms(4)[of 0] have "0 \ B" by auto with assms have nonzero: "\z\B. z \ 0" by (intro ballI notI) auto from x assms have "1 = multiplicity x (\A)" by (subst multiplicity_prod_prime_powers_nat') simp_all also from assms nonzero have "\ \ multiplicity x (\B)" by (intro dvd_imp_multiplicity_le) auto finally have "multiplicity x (\B) > 0" by simp moreover from assms x have "prime x" by simp ultimately show "x \ B" using assms(2,4) by (subst (asm) multiplicity_prod_prime_powers_nat') (simp_all split: if_split_asm) qed lemma prod_prime_eq: assumes "finite A" "finite B" "\x. x \ A \ prime (x::nat)" "\x. x \ B \ prime x" "\A = \B" shows "A = B" using assms by (intro equalityI prod_prime_subset) simp_all lemma ln_ln_nonneg: assumes x: "x \ (3 :: real)" shows "ln (ln x) \ 0" proof - have "exp 1 \ (3::real)" by (rule exp_le) hence "ln (exp 1) \ ln (3 :: real)" by (subst ln_le_cancel_iff) simp_all also from x have "\ \ ln x" by (subst ln_le_cancel_iff) simp_all finally have "ln 1 \ ln (ln x)" using x by (subst ln_le_cancel_iff) simp_all thus ?thesis by simp qed end diff --git a/thys/Prime_Harmonic_Series/Squarefree_Nat.thy b/thys/Prime_Harmonic_Series/Squarefree_Nat.thy --- a/thys/Prime_Harmonic_Series/Squarefree_Nat.thy +++ b/thys/Prime_Harmonic_Series/Squarefree_Nat.thy @@ -1,235 +1,235 @@ (* File: Squarefree_Nat.thy - Author: Manuel Eberl + Author: Manuel Eberl The unique decomposition of a natural number into a squarefree part and a square. *) section \Squarefree decomposition of natural numbers\ theory Squarefree_Nat imports Main "HOL-Number_Theory.Number_Theory" Prime_Harmonic_Misc begin text \ The squarefree part of a natural number is the set of all prime factors that appear with odd multiplicity. The square part, correspondingly, is what remains after dividing by the squarefree part. \ definition squarefree_part :: "nat \ nat set" where "squarefree_part n = {p\prime_factors n. odd (multiplicity p n)}" definition square_part :: "nat \ nat" where "square_part n = (if n = 0 then 0 else (\p\prime_factors n. p ^ (multiplicity p n div 2)))" lemma squarefree_part_0 [simp]: "squarefree_part 0 = {}" by (simp add: squarefree_part_def) lemma square_part_0 [simp]: "square_part 0 = 0" by (simp add: square_part_def) lemma squarefree_decompose: "\(squarefree_part n) * square_part n ^ 2 = n" proof (cases "n = 0") case False define A s where "A = squarefree_part n" and "s = square_part n" have "(\A) = (\p\A. p ^ (multiplicity p n mod 2))" by (intro prod.cong) (auto simp: A_def squarefree_part_def elim!: oddE) also have "\ = (\p\prime_factors n. p ^ (multiplicity p n mod 2))" by (intro prod.mono_neutral_left) (auto simp: A_def squarefree_part_def) also from False have "\ * s^2 = n" by (simp add: s_def square_part_def prod.distrib [symmetric] power_add [symmetric] power_mult [symmetric] prime_factorization_nat [symmetric] algebra_simps prod_power_distrib) finally show "\A * s^2 = n" . qed simp lemma squarefree_part_pos [simp]: "\(squarefree_part n) > 0" using prime_gt_0_nat unfolding squarefree_part_def by auto lemma squarefree_part_ge_Suc_0 [simp]: "\(squarefree_part n) \ Suc 0" using squarefree_part_pos[of n] by presburger lemma squarefree_part_subset [intro]: "squarefree_part n \ prime_factors n" unfolding squarefree_part_def by auto lemma squarefree_part_finite [simp]: "finite (squarefree_part n)" by (rule finite_subset[OF squarefree_part_subset]) simp lemma squarefree_part_dvd [simp]: "\(squarefree_part n) dvd n" by (subst (2) squarefree_decompose [of n, symmetric]) simp lemma squarefree_part_dvd' [simp]: "p \ squarefree_part n \ p dvd n" by (rule dvd_prodD[OF _ squarefree_part_dvd]) simp_all lemma square_part_dvd [simp]: "square_part n ^ 2 dvd n" by (subst (2) squarefree_decompose [of n, symmetric]) simp lemma square_part_dvd' [simp]: "square_part n dvd n" by (subst (2) squarefree_decompose [of n, symmetric]) simp lemma squarefree_part_le: "p \ squarefree_part n \ p \ n" by (cases "n = 0") (simp_all add: dvd_imp_le) lemma square_part_le: "square_part n \ n" by (cases "n = 0") (simp_all add: dvd_imp_le) lemma square_part_le_sqrt: "square_part n \ nat \sqrt (real n)\" proof - have "1 * square_part n ^ 2 \ \(squarefree_part n) * square_part n ^ 2" by (intro mult_right_mono) simp_all also have "\ = n" by (rule squarefree_decompose) finally have "real (square_part n ^ 2) \ real n" by (subst of_nat_le_iff) simp hence "sqrt (real (square_part n ^ 2)) \ sqrt (real n)" by (subst real_sqrt_le_iff) simp_all also have "sqrt (real (square_part n ^ 2)) = real (square_part n)" by simp finally show ?thesis by linarith qed lemma square_part_pos [simp]: "n > 0 \ square_part n > 0" unfolding square_part_def using prime_gt_0_nat by auto lemma square_part_ge_Suc_0 [simp]: "n > 0 \ square_part n \ Suc 0" using square_part_pos[of n] by presburger lemma zero_not_in_squarefree_part [simp]: "0 \ squarefree_part n" unfolding squarefree_part_def by auto lemma multiplicity_squarefree_part: "prime p \ multiplicity p (\(squarefree_part n)) = (if p \ squarefree_part n then 1 else 0)" using squarefree_part_subset[of n] by (intro multiplicity_prod_prime_powers_nat') auto text \ The squarefree part really is square, its only square divisor is 1. \ lemma square_dvd_squarefree_part_iff: "x^2 dvd \(squarefree_part n) \ x = 1" proof (rule iffI, rule multiplicity_eq_nat) assume dvd: "x^2 dvd \(squarefree_part n)" hence "x \ 0" using squarefree_part_subset[of n] prime_gt_0_nat by (intro notI) auto thus x: "x > 0" by simp fix p :: nat assume p: "prime p" from p x have "2 * multiplicity p x = multiplicity p (x^2)" by (simp add: multiplicity_power_nat) also from dvd have "\ \ multiplicity p (\(squarefree_part n))" by (intro dvd_imp_multiplicity_le) simp_all also have "\ \ 1" using multiplicity_squarefree_part[of p n] p by simp finally show "multiplicity p x = multiplicity p 1" by simp qed simp_all lemma squarefree_decomposition_unique1: assumes "squarefree_part m = squarefree_part n" assumes "square_part m = square_part n" shows "m = n" by (subst (1 2) squarefree_decompose [symmetric]) (simp add: assms) lemma squarefree_decomposition_unique2: assumes n: "n > 0" assumes decomp: "n = (\A2 * s2^2)" assumes prime: "\x. x \ A2 \ prime x" assumes fin: "finite A2" assumes s2_nonneg: "s2 \ 0" shows "A2 = squarefree_part n" and "s2 = square_part n" proof - define A1 s1 where "A1 = squarefree_part n" and "s1 = square_part n" have "finite A1" unfolding A1_def by simp note fin = \finite A1\ \finite A2\ have "A1 \ prime_factors n" unfolding A1_def using squarefree_part_subset . note subset = this prime have "\A1 > 0" "\A2 > 0" using subset(1) prime_gt_0_nat by (auto intro!: prod_pos dest: prime) from n have "s1 > 0" unfolding s1_def by simp from assms have "s2 \ 0" by (intro notI) simp hence "s2 > 0" by simp note pos = \\A1 > 0\ \\A2 > 0\ \s1 > 0\ \s2 > 0\ have eq': "multiplicity p s1 = multiplicity p s2" "multiplicity p (\A1) = multiplicity p (\A2)" if p: "prime p" for p proof - define m where "m = multiplicity p" from decomp have "m (\A1 * s1^2) = m (\A2 * s2^2)" unfolding A1_def s1_def by (simp add: A1_def s1_def squarefree_decompose) with p pos have eq: "m (\A1) + 2 * m s1 = m (\A2) + 2 * m s2" by (simp add: m_def prime_elem_multiplicity_mult_distrib multiplicity_power_nat) moreover from fin subset p have "m (\A1) \ 1" "m (\A2) \ 1" unfolding m_def by ((subst multiplicity_prod_prime_powers_nat', auto)[])+ ultimately show "m s1 = m s2" by linarith with eq show "m (\A1) = m (\A2)" by simp qed show "s2 = square_part n" by (rule multiplicity_eq_nat) (insert pos eq'(1), auto simp: s1_def) have "\A2 = \(squarefree_part n)" by (rule multiplicity_eq_nat) (insert pos eq'(2), auto simp: A1_def) with fin subset show "A2 = squarefree_part n" unfolding A1_def by (intro prod_prime_eq) auto qed lemma squarefree_decomposition_unique2': assumes decomp: "(\A1 * s1^2) = (\A2 * s2^2 :: nat)" assumes fin: "finite A1" "finite A2" assumes subset: "\x. x \ A1 \ prime x" "\x. x \ A2 \ prime x" assumes pos: "s1 > 0" "s2 > 0" defines "n \ \A1 * s1^2" shows "A1 = A2" "s1 = s2" proof - from pos have n: "n > 0" using prime_gt_0_nat by (auto simp: n_def intro!: prod_pos dest: subset) have "A1 = squarefree_part n" "s1 = square_part n" by ((rule squarefree_decomposition_unique2[of n A1 s1], insert assms n, simp_all)[])+ moreover have "A2 = squarefree_part n" "s2 = square_part n" by ((rule squarefree_decomposition_unique2[of n A2 s2], insert assms n, simp_all)[])+ ultimately show "A1 = A2" "s1 = s2" by simp_all qed text \ The following is a nice and simple lower bound on the number of prime numbers less than a given number due to Erd\H{o}s. In particular, it implies that there are infinitely many primes. \ lemma primes_lower_bound: fixes n :: nat assumes "n > 0" defines "\ \ \n. card {p. prime p \ p \ n}" shows "real (\ n) \ ln (real n) / ln 4" proof - have "real n = real (card {1..n})" by simp also have "{1..n} = (\(A, b). \A * b^2) ` (\n. (squarefree_part n, square_part n)) ` {1..n}" unfolding image_comp o_def squarefree_decompose case_prod_unfold fst_conv snd_conv by simp also have "card \ \ card ((\n. (squarefree_part n, square_part n)) ` {1..n})" by (rule card_image_le) simp_all also have "\ \ card (squarefree_part ` {1..n} \ square_part ` {1..n})" by (rule card_mono) auto also have "real \ = real (card (squarefree_part ` {1..n})) * real (card (square_part ` {1..n}))" by simp also have "\ \ 2 ^ \ n * sqrt (real n)" proof (rule mult_mono) have "card (squarefree_part ` {1..n}) \ card (Pow {p. prime p \ p \ n})" using squarefree_part_subset squarefree_part_le by (intro card_mono) force+ also have "real \ = 2 ^ \ n" by (simp add: \_def card_Pow) finally show "real (card (squarefree_part ` {1..n})) \ 2 ^ \ n" by - simp_all next have "square_part k \ nat \sqrt n\" if "k \ n" for k by (rule order.trans[OF square_part_le_sqrt]) (insert that, auto intro!: nat_mono floor_mono) hence "card (square_part ` {1..n}) \ card {1..nat \sqrt n\}" by (intro card_mono) (auto intro: order.trans[OF square_part_le_sqrt]) also have "\ = nat \sqrt n\" by simp also have "real \ \ sqrt n" by simp finally show "real (card (square_part ` {1..n})) \ sqrt (real n)" by - simp_all qed simp_all finally have "real n \ 2 ^ \ n * sqrt (real n)" by - simp_all with \n > 0\ have "ln (real n) \ ln (2 ^ \ n * sqrt (real n))" by (subst ln_le_cancel_iff) simp_all moreover have "ln (4 :: real) = real 2 * ln 2" by (subst ln_realpow [symmetric]) simp_all ultimately show ?thesis using \n > 0\ by (simp add: ln_mult ln_realpow[of _ "\ n"] ln_sqrt field_simps) qed end diff --git a/thys/Quick_Sort_Cost/Quick_Sort_Average_Case.thy b/thys/Quick_Sort_Cost/Quick_Sort_Average_Case.thy --- a/thys/Quick_Sort_Cost/Quick_Sort_Average_Case.thy +++ b/thys/Quick_Sort_Cost/Quick_Sort_Average_Case.thy @@ -1,219 +1,219 @@ (* File: Quick_Sort_Average_Case.thy - Author: Manuel Eberl + Author: Manuel Eberl Definition and average-case analysis of the standard deterministic QuickSort algorithm *) section \Average case analysis of deterministic QuickSort\ theory Quick_Sort_Average_Case imports Randomised_Quick_Sort begin subsection \Definition of deterministic QuickSort\ text \ This is the functional description of the standard variant of deterministic QuickSort that always chooses the first list element as the pivot as given by Hoare in 1962~\cite{hoare}. For a list that is already sorted, this leads to $n(n-1)$ comparisons, but as is well known, the average case is not that bad. \ fun quicksort :: "('a \ 'a) set \ 'a list \ 'a list" where "quicksort _ [] = []" | "quicksort R (x # xs) = quicksort R (filter (\y. (y,x) \ R) xs) @ [x] @ quicksort R (filter (\y. (y,x) \ R) xs)" text \ We can easily show that this QuickSort is correct: \ theorem mset_quicksort [simp]: "mset (quicksort R xs) = mset xs" by (induction R xs rule: quicksort.induct) (simp_all) corollary set_quicksort [simp]: "set (quicksort R xs) = set xs" by (induction R xs rule: quicksort.induct) auto theorem sorted_wrt_quicksort: assumes "trans R" and "total_on (set xs) R" and "\x. x \ set xs \ (x, x) \ R" shows "sorted_wrt R (quicksort R xs)" using assms proof (induction R xs rule: quicksort.induct) case (2 R x xs) have total: "(a, b) \ R" if "(b, a) \ R" "a \ set (x#xs)" "b \ set (x#xs)" for a b using "2.prems" that unfolding total_on_def by (cases "a = b") auto have *: "sorted_wrt R (quicksort R (filter (\y. (y,x) \ R) xs))" "sorted_wrt R (quicksort R (filter (\y. (y,x) \ R) xs))" by ((rule 2 total_on_subset[OF \total_on (set (x#xs)) R\]) | force)+ show ?case by (auto intro!: sorted_wrt_append sorted_wrt.intros \trans R\ * intro: transD[OF \trans R\] dest!: total simp: total_on_def) qed auto corollary sorted_wrt_quicksort': assumes "linorder_on A R" and "set xs \ A" shows "sorted_wrt R (quicksort R xs)" by (rule sorted_wrt_quicksort) (insert assms, auto simp: linorder_on_def refl_on_def dest: total_on_subset) text \ We now define another version of QuickSort that is identical to the previous one but also counts the number of comparisons that were made. \ fun quicksort' :: "('a \ 'a) set \ 'a list \ 'a list \ nat" where "quicksort' _ [] = ([], 0)" | "quicksort' R (x # xs) = ( let (ls, rs) = partition (\y. (y,x) \ R) xs; (ls', n1) = quicksort' R ls; (rs', n2) = quicksort' R rs in (ls' @ [x] @ rs', length xs + n1 + n2))" text \ For convenience, we also define a function that computes only the number of comparisons that were made and not the result list. \ fun qs_cost :: "('a \ 'a) set \ 'a list \ nat" where "qs_cost _ [] = 0" | "qs_cost R (x # xs) = length xs + qs_cost R (filter (\y. (y,x)\R) xs) + qs_cost R (filter (\y. (y,x)\R) xs)" text \ It is obvious that the original QuickSort and the cost function are the projections of the cost-counting QuickSort. \ lemma fst_quicksort' [simp]: "fst (quicksort' R xs) = quicksort R xs" by (induction R xs rule: quicksort.induct) (simp_all add: case_prod_unfold Let_def o_def) lemma snd_quicksort' [simp]: "snd (quicksort' R xs) = qs_cost R xs" by (induction R xs rule: quicksort.induct) (simp_all add: case_prod_unfold Let_def o_def) subsection \Analysis\ text \ We will reduce the average-case analysis to showing that it is essentially equivalent to the randomised QuickSort we analysed earlier. Similar, but more direct analyses are given by Hoare~\cite{hoare} and Sedgewick~\cite{sedgewick}. The proof is relatively straightforward -- but still a bit messy. We show that the cost distribution of QuickSort run on a random permutation of a set of size $n$ is exactly the same as that of randomised QuickSort being run on any fixed list of size $n$ (which we analysed before): \ theorem qs_cost_average_conv_rqs_cost: assumes "finite A" and "linorder_on B R" and "A \ B" shows "map_pmf (qs_cost R) (pmf_of_set (permutations_of_set A)) = rqs_cost (card A)" using assms(1,3) proof (induction A rule: finite_psubset_induct) case (psubset A) show ?case proof (cases "A = {}") case True thus ?thesis by (simp add: pmf_of_set_singleton) next case False note A = \finite A\ \A \ {}\ define n where "n = card A - 1" from A have "pmf_of_set (permutations_of_set A) = do {x \ pmf_of_set A; xs \ pmf_of_set (permutations_of_set (A - {x})); return_pmf (x#xs)}" by (rule random_permutation_of_set) also have "map_pmf (qs_cost R) \ = do { x \ pmf_of_set A; xs \ pmf_of_set (permutations_of_set (A - {x})); return_pmf (length xs + qs_cost R [y\xs. (y,x)\R] + qs_cost R [y\xs. (y,x)\R]) }" by (simp add: map_bind_pmf) also have "\ = map_pmf (\m. n + m) ( do { x \ pmf_of_set A; xs \ pmf_of_set (permutations_of_set (A - {x})); return_pmf (qs_cost R [y\xs. (y,x)\R] + qs_cost R [y\xs. (y,x)\R]) })" (is "_ = map_pmf _ ?X") using A unfolding n_def map_bind_pmf by (intro bind_pmf_cong map_pmf_cong refl) (auto simp: length_finite_permutations_of_set) also have "?X = do { x \ pmf_of_set A; (ls,rs) \ map_pmf (partition (\y. (y,x)\R)) (pmf_of_set (permutations_of_set (A - {x}))); return_pmf (qs_cost R ls + qs_cost R rs) }" by (simp add: bind_map_pmf o_def) also have "\ = do { x \ pmf_of_set A; (n1, n2) \ pair_pmf (rqs_cost (linorder_rank R A x)) (rqs_cost (n - linorder_rank R A x)); return_pmf (n1 + n2)}" proof (intro bind_pmf_cong refl, goal_cases) case (1 x) have "map_pmf (partition (\y. (y,x)\R)) (pmf_of_set (permutations_of_set (A - {x}))) \ (\(ls, rs). return_pmf (qs_cost R ls + qs_cost R rs)) = map_pmf (\(n1, n2). n1 + n2) (pair_pmf (map_pmf (qs_cost R) (pmf_of_set (permutations_of_set {xa \ A - {x}. (xa, x) \ R}))) (map_pmf (qs_cost R) (pmf_of_set (permutations_of_set {xa \ A - {x}. (xa, x) \ R}))))" (is "_ = map_pmf _ (pair_pmf ?X ?Y)") by (subst partition_random_permutations) (simp_all add: map_pmf_def case_prod_unfold bind_return_pmf bind_assoc_pmf pair_pmf_def A) also { have "{xa \ A - {x}. (xa, x) \ R} \ A - {x}" by blast also have "\ \ A" using 1 A by auto finally have subset: "{xa \ A - {x}. (xa, x) \ R} \ A" . also have "\ \ B" by fact finally have "?X = rqs_cost (card {xa \ A - {x}. (xa, x) \ R})" using subset by (intro psubset.IH) auto also have "card {xa \ A - {x}. (xa, x) \ R} = linorder_rank R A x" by (simp add: linorder_rank_def) finally have "?X = rqs_cost \" . } also { have "{xa \ A - {x}. (xa, x) \ R} \ A - {x}" by blast also have "\ \ A" using 1 A by auto finally have subset: "{xa \ A - {x}. (xa, x) \ R} \ A" . also have "\ \ B" by fact finally have "?Y = rqs_cost (card {xa \ A - {x}. (xa, x) \ R})" using subset by (intro psubset.IH) auto also { have "card ({y\A-{x}. (y,x)\R} \ {y\A-{x}. (y,x)\R}) = linorder_rank R A x + card {xa \ A - {x}. (xa, x) \ R}" unfolding linorder_rank_def using A by (intro card_Un_disjoint) auto also have "{y\A-{x}. (y,x)\R} \ {y\A-{x}. (y,x)\R} = A - {x}" by blast also have "card \ = n" using A 1 by (simp add: n_def) finally have "card {xa \ A - {x}. (xa, x) \ R} = n - linorder_rank R A x" by simp } finally have "?Y = rqs_cost (n - linorder_rank R A x)" . } finally show ?case by (simp add: case_prod_unfold map_pmf_def) qed also have "\ = do { i \ map_pmf (linorder_rank R A) (pmf_of_set A); (n1, n2) \ pair_pmf (rqs_cost i) (rqs_cost (n - i)); return_pmf (n1 + n2) }" by (simp add: bind_map_pmf) also have "map_pmf (linorder_rank R A) (pmf_of_set A) = pmf_of_set {.. 0" by (intro Nat.gr0I) auto hence "{..m. n + m) ( do { i \ pmf_of_set {..n}; (n1, n2) \ pair_pmf (rqs_cost i) (rqs_cost (n - i)); return_pmf (n1 + n2) }) = rqs_cost (Suc n)" by (simp add: pair_pmf_def map_bind_pmf case_prod_unfold bind_assoc_pmf bind_return_pmf add_ac) also from A have "card A > 0" by (intro Nat.gr0I) auto hence "Suc n = card A" by (simp add: n_def) finally show ?thesis . qed qed text \ We therefore have the same expectation as well. (Note that we showed @{thm rqs_cost_exp_eq [no_vars]} and @{thm rqs_cost_exp_asymp_equiv [no_vars]} before. \ corollary expectation_qs_cost: assumes "finite A" and "linorder_on B R" and "A \ B" defines "random_list \ pmf_of_set (permutations_of_set A)" shows "measure_pmf.expectation (map_pmf (qs_cost R) random_list) real = rqs_cost_exp (card A)" unfolding random_list_def by (subst qs_cost_average_conv_rqs_cost[OF assms(1-3)]) (simp add: expectation_rqs_cost) end \ No newline at end of file diff --git a/thys/Quick_Sort_Cost/Randomised_Quick_Sort.thy b/thys/Quick_Sort_Cost/Randomised_Quick_Sort.thy --- a/thys/Quick_Sort_Cost/Randomised_Quick_Sort.thy +++ b/thys/Quick_Sort_Cost/Randomised_Quick_Sort.thy @@ -1,717 +1,717 @@ (* File: Randomised_Quick_Sort.thy - Author: Manuel Eberl + Author: Manuel Eberl Definition and cost analysis of randomised QuickSort (i.e. pivot chosen uniformly at random). *) section \Randomised QuickSort\ theory Randomised_Quick_Sort imports "HOL-Probability.Probability" "Landau_Symbols.Landau_More" Comparison_Sort_Lower_Bound.Linorder_Relations begin subsection \Deletion by index\ text \ The following function deletes the $n$-th element of a list. \ fun delete_index :: "nat \ 'a list \ 'a list" where "delete_index _ [] = []" | "delete_index 0 (x # xs) = xs" | "delete_index (Suc n) (x # xs) = x # delete_index n xs" lemma delete_index_altdef: "delete_index n xs = take n xs @ drop (Suc n) xs" by (induction n xs rule: delete_index.induct) simp_all lemma delete_index_ge_length: "n \ length xs \ delete_index n xs = xs" by (simp add: delete_index_altdef) lemma length_delete_index [simp]: "n < length xs \ length (delete_index n xs) = length xs - 1" by (simp add: delete_index_altdef) lemma delete_index_Cons: "delete_index n (x # xs) = (if n = 0 then xs else x # delete_index (n - 1) xs)" by (cases n) simp_all lemma insert_set_delete_index: "n < length xs \ insert (xs ! n) (set (delete_index n xs)) = set xs" by (induction n xs rule: delete_index.induct) auto lemma add_mset_delete_index: "i < length xs \ add_mset (xs ! i) (mset (delete_index i xs)) = mset xs" by (induction i xs rule: delete_index.induct) simp_all lemma nth_delete_index: "i < length xs \ n < length xs \ delete_index n xs ! i = (if i < n then xs ! i else xs ! Suc i)" by (auto simp: delete_index_altdef nth_append min_def) lemma set_delete_index_distinct: assumes "distinct xs" "n < length xs" shows "set (delete_index n xs) = set xs - {xs ! n}" using assms by (induction n xs rule: delete_index.induct) fastforce+ lemma distinct_delete_index [simp, intro]: assumes "distinct xs" shows "distinct (delete_index n xs)" proof (cases "n < length xs") case True with assms show ?thesis by (induction n xs rule: delete_index.induct) (auto simp: set_delete_index_distinct) qed (simp_all add: delete_index_ge_length assms) lemma mset_delete_index [simp]: "i < length xs \ mset (delete_index i xs) = mset xs - {# xs!i #}" by (induction i xs rule: delete_index.induct) simp_all subsection \Definition\ text \ The following is a functional randomised version of QuickSort that also records the number of comparisons that were made. The randomisation is in the selection of the pivot element: In each step, the next pivot is chosen uniformly at random from all remaining list elements. The function takes the ordering relation to use as a first argument in the form of a set of pairs. \ function rquicksort :: "('a \ 'a) set \ 'a list \ ('a list \ nat) pmf" where "rquicksort R xs = (if xs = [] then return_pmf ([], 0) else do { i \ pmf_of_set {..y. (y,x) \ R) (delete_index i xs) of (ls, rs) \ do { (ls, n1) \ rquicksort R ls; (rs, n2) \ rquicksort R rs; return_pmf (ls @ [x] @ rs, length xs - 1 + n1 + n2) } })" by auto termination proof (relation "Wellfounded.measure (length \ snd)", goal_cases) show "wf (Wellfounded.measure (length \ snd))" by simp qed (subst (asm) set_pmf_of_set; force intro!: le_less_trans[OF length_filter_le])+ declare rquicksort.simps [simp del] lemma rquicksort_Nil [simp]: "rquicksort R [] = return_pmf ([], 0)" by (simp add: rquicksort.simps) subsection \Correctness proof\ lemma set_pmf_of_set_lessThan_length [simp]: "xs \ [] \ set_pmf (pmf_of_set {.. We can now prove that any list that can be returned by QuickSort is sorted w.\,r.\,t.\ the given relation. (as long as that relation is reflexive, transitive, and total) \ theorem rquicksort_correct: assumes "trans R" and "total_on (set xs) R" and "\x\set xs. (x,x) \ R" assumes "(ys, n) \ set_pmf (rquicksort R xs)" shows "sorted_wrt R ys \ mset ys = mset xs" using assms(2-) proof (induction xs arbitrary: ys n rule: length_induct) case (1 xs) have IH: "sorted_wrt R zs" "mset zs = mset ys" if "(zs, n) \ set_pmf (rquicksort R ys)" "length ys < length xs" "set ys \ set xs" for zs ys n using that "1.IH" total_on_subset[OF "1.prems"(1) that(3)] "1.prems"(2) by blast+ show ?case proof (cases "xs = []") case False with "1.prems" obtain ls rs n1 n2 i where *: "i < length xs" "(ls, n1) \ set_pmf (rquicksort R [y\delete_index i xs. (y, xs ! i) \ R])" "(rs, n2) \ set_pmf (rquicksort R [y\delete_index i xs. (y, xs ! i) \ R])" "ys = ls @ [xs ! i] @ rs" by (subst (asm) rquicksort.simps[of _ xs]) (auto simp: Let_def o_def) note ys = \ys = ls @ [xs ! i] @ rs\ define ls' where "ls' = [y\delete_index i xs. (y, xs ! i) \ R]" define rs' where "rs' = [y\delete_index i xs. (y, xs ! i) \ R]" from \i < length xs\ have less: "length ls' < length xs" "length rs' < length xs" unfolding ls'_def rs'_def by (intro le_less_trans[OF length_filter_le]; force)+ have ls: "(ls, n1) \ set_pmf (rquicksort R ls')" and rs: "(rs, n2) \ set_pmf (rquicksort R rs')" using * unfolding ls'_def rs'_def by blast+ have subset: "set ls' \ set xs" "set rs' \ set xs" using insert_set_delete_index[of i xs] \i < length xs\ by (auto simp: ls'_def rs'_def) have sorted: "sorted_wrt R ls" "sorted_wrt R rs" and mset: "mset ls = mset ls'" "mset rs = mset rs'" by (rule IH[of ls n1 ls'] IH[of rs n2 rs'] less ls rs subset)+ have ls_le: "(x, xs ! i) \ R" if "x \ set ls" for x proof - from that have "x \# mset ls" by simp also note mset(1) finally show ?thesis by (simp add: ls'_def) qed have rs_ge: "(x, xs ! i) \ R" "(xs ! i, x) \ R" if "x \ set rs" for x proof - from that have "x \# mset rs" by simp also note mset(2) finally have x: "x \ set rs'" by simp thus "(x, xs ! i) \ R" by (simp_all add: rs'_def) from x and subset and \i < length xs\ have "x \ set xs" "xs ! i \ set xs" by auto with "1.prems" and \(x, xs ! i) \ R\ show "(xs ! i, x) \ R" unfolding total_on_def by (cases "xs ! i = x") auto qed have "sorted_wrt R ys" unfolding ys by (intro sorted_wrt_append \trans R\ sorted_wrt_singleton sorted) (auto intro: rs_ge ls_le transD[OF \trans R\, of _ "xs!i"]) moreover have "mset ys = mset xs" unfolding ys using \i < length xs\ by (simp add: mset ls'_def rs'_def add_mset_delete_index) ultimately show ?thesis .. qed (insert "1.prems", simp_all) qed subsection \Cost analysis\ text \ The following distribution describes the number of comparisons made by randomised QuickSort in terms of the list length. (This is only valid if all list elements are distinct) A succinct explanation of this cost analysis is given by Jacek Cicho\'{n}~\cite{cichon}. \ fun rqs_cost :: "nat \ nat pmf" where "rqs_cost 0 = return_pmf 0" | "rqs_cost (Suc n) = do {i \ pmf_of_set {..n}; a \ rqs_cost i; b \ rqs_cost (n - i); return_pmf (n + a + b)}" lemma finite_set_pmf_rqs_cost [intro!]: "finite (set_pmf (rqs_cost n))" by (induction n rule: rqs_cost.induct) simp_all text \ We connect the @{const rqs_cost} function to the @{const rquicksort} function by showing that projecting out the number of comparisons from a run of @{const rquicksort} on a list with distinct elements yields the same distribution as @{const rqs_cost} for the length of that list. \ theorem snd_rquicksort: assumes "linorder_on A R" and "set xs \ A" and "distinct xs" shows "map_pmf snd (rquicksort R xs) = rqs_cost (length xs)" using assms(2-) proof (induction xs rule: length_induct) case (1 xs) have IH: "map_pmf snd (rquicksort R ys) = rqs_cost (length ys)" if "length ys < length xs" "mset ys \# mset xs" for ys proof - from set_mset_mono[OF that(2)] have "set ys \ set xs" by simp also note \set xs \ A\ finally have "set ys \ A" . moreover from \distinct xs\ and that(2) have "distinct ys" by (rule distinct_mset_mono) ultimately show ?thesis using that and "1.IH" by blast qed define n where "n = length xs" define cnt where "cnt = (\i. length [y\delete_index i xs. (y, xs ! i) \ R])" have cnt_altdef: "cnt i = linorder_rank R (set xs) (xs ! i)" if i: "i < n" for i proof - have "cnt i = length [y\delete_index i xs. (y, xs ! i) \ R]" by (simp add: cnt_def) also have "\ = card (set [y\delete_index i xs. (y, xs ! i) \ R])" by (intro distinct_card [symmetric] distinct_filter distinct_delete_index "1.prems") also have "set [y\delete_index i xs. (y, xs ! i) \ R] = {x \ set xs-{xs!i}. (x, xs ! i) \ R}" using "1.prems" and i by (simp add: set_delete_index_distinct n_def) also have "card \ = linorder_rank R (set xs) (xs ! i)" by (simp add: linorder_rank_def) finally show ?thesis . qed from "1.prems" have "bij_betw ((!) xs) {.. (\i. xs ! i)) {..i. linorder_rank R (set xs) (xs ! i)) {.. 0" by (simp add: n_def) hence [simp]: "n \ 0" by (intro notI) auto from False have "map_pmf snd (rquicksort R xs) = pmf_of_set {.. (\i. map_pmf (\z. length xs - 1 + fst z + snd z) (pair_pmf (map_pmf snd (rquicksort R [y\delete_index i xs. (y, xs ! i) \ R])) (map_pmf snd (rquicksort R [y\delete_index i xs. (y, xs ! i) \ R]))))" by (subst rquicksort.simps) (simp add: map_bind_pmf bind_map_pmf Let_def case_prod_unfold o_def pair_pmf_def) also have "\ = pmf_of_set {.. (\i. map_pmf (\z. n - 1 + fst z + snd z) (pair_pmf (rqs_cost (cnt i)) (rqs_cost (n - 1 - cnt i))))" proof (intro bind_pmf_cong refl, goal_cases) case (1 i) with \xs \ []\ have i: "i < length xs" by auto from i have "map_pmf snd (rquicksort R [y\delete_index i xs. (y, xs ! i) \ R]) = rqs_cost (length [y\delete_index i xs. (y, xs ! i) \ R])" by (intro IH) (auto intro!: le_less_trans[OF length_filter_le] intro: subset_mset.trans multiset_filter_subset diff_subset_eq_self) also have "length [y\delete_index i xs. (y, xs ! i) \ R] = n - 1 - cnt i" unfolding n_def cnt_def using sum_length_filter_compl[of "\y. (y, xs ! i) \ R" "delete_index i xs"] i by simp finally have "map_pmf snd (rquicksort R [y\delete_index i xs. (y, xs ! i) \ R]) = rqs_cost (n - 1 - cnt i)" . moreover have "map_pmf snd (rquicksort R [y\delete_index i xs. (y, xs ! i) \ R]) = rqs_cost (cnt i)" unfolding cnt_def using i by (intro IH) (auto intro!: le_less_trans[OF length_filter_le] intro: subset_mset.trans multiset_filter_subset diff_subset_eq_self) ultimately show ?case by (simp only: n_def) qed also have "\ = map_pmf cnt (pmf_of_set {.. (\i. map_pmf (\z. n - 1 + fst z + snd z) (pair_pmf (rqs_cost i) (rqs_cost (n - 1 - i))))" (is "_ = bind_pmf _ ?f") by (simp add: bind_map_pmf n_def) also have "map_pmf cnt (pmf_of_set {..i. linorder_rank R (set xs) (xs ! i)) (pmf_of_set {..n > 0\ by (intro map_pmf_cong refl, subst (asm) set_pmf_of_set) (auto simp: cnt_altdef) also from \n > 0\ have "\ = pmf_of_set {.. ?f = rqs_cost n" by (cases n) (simp_all add: lessThan_Suc_atMost bind_map_pmf map_bind_pmf pair_pmf_def) finally show ?thesis by (simp add: n_def) qed simp_all qed subsection \Expected cost\ text \ It is relatively straightforward to see that the following recursive function (sometimes called the `QuickSort equation') describes the expectation of @{const rqs_cost}, i.e. the expected number of comparisons of QuickSort when run on a list with distinct elements. \ fun rqs_cost_exp :: "nat \ real" where "rqs_cost_exp 0 = 0" | "rqs_cost_exp (Suc n) = real n + (\i\n. rqs_cost_exp i + rqs_cost_exp (n - i)) / real (Suc n)" lemmas rqs_cost_exp_0 = rqs_cost_exp.simps(1) lemmas rqs_cost_exp_Suc [simp del] = rqs_cost_exp.simps(2) lemma rqs_cost_exp_Suc_0 [simp]: "rqs_cost_exp (Suc 0) = 0" by (simp add: rqs_cost_exp_Suc) text \ The following theorem shows that @{const rqs_cost_exp} is indeed the expectation of @{const rqs_cost}. \ theorem expectation_rqs_cost: "measure_pmf.expectation (rqs_cost n) real = rqs_cost_exp n" proof (induction n rule: rqs_cost.induct) case (2 n) note IH = "2.IH" have "measure_pmf.expectation (rqs_cost (Suc n)) real = (\a\n. inverse (real (Suc n)) * measure_pmf.expectation (rqs_cost a \ (\aa. rqs_cost (n - a) \ (\b. return_pmf (n + aa + b)))) real)" unfolding rqs_cost.simps by (subst pmf_expectation_bind_pmf_of_set) auto also have "\ = (\i\n. inverse (real (Suc n)) * (real n + rqs_cost_exp i + rqs_cost_exp (n - i)))" proof (intro sum.cong refl, goal_cases) case (1 i) have "rqs_cost i \ (\a. rqs_cost (n - i) \ (\b. return_pmf (n + a + b))) = map_pmf (\(a,b). n + a + b) (pair_pmf (rqs_cost i) (rqs_cost (n - i)))" by (simp add: pair_pmf_def map_bind_pmf) also have "measure_pmf.expectation \ real = measure_pmf.expectation (pair_pmf (rqs_cost i) (rqs_cost (n - i))) (\z. real n + (real (fst z) + real (snd z)))" by (subst integral_map_pmf) (simp add: case_prod_unfold add_ac) also have "\ = real n + measure_pmf.expectation (pair_pmf (rqs_cost i) (rqs_cost (n - i))) (\z. real (fst z) + real (snd z))" (is "_ = _ + ?A") by (subst Bochner_Integration.integral_add) (auto intro!: integrable_measure_pmf_finite) also have "?A = measure_pmf.expectation (map_pmf fst (pair_pmf (rqs_cost i) (rqs_cost (n - i)))) real + measure_pmf.expectation (map_pmf snd (pair_pmf (rqs_cost i) (rqs_cost (n - i)))) real" unfolding integral_map_pmf by (subst Bochner_Integration.integral_add) (auto intro!: integrable_measure_pmf_finite) also have "\ = measure_pmf.expectation (rqs_cost i) real + measure_pmf.expectation (rqs_cost (n - i)) real" unfolding map_fst_pair_pmf map_snd_pair_pmf .. also from 1 have "\ = rqs_cost_exp i + rqs_cost_exp (n - i)" by (simp_all add: IH) finally show ?case by simp qed also have "\ = (\i\n. inverse (real (Suc n)) * real n) + (\i\n. rqs_cost_exp i + rqs_cost_exp (n - i)) / real (Suc n)" by (simp add: sum.distrib field_simps sum_distrib_left sum_distrib_right sum_divide_distrib [symmetric] del: of_nat_Suc) also have "(\i\n. inverse (real (Suc n)) * real n) = real n" by simp also have "\ + (\i\n. rqs_cost_exp i + rqs_cost_exp (n - i)) / real (Suc n) = rqs_cost_exp (Suc n)" by (simp add: rqs_cost_exp_Suc) finally show ?case . qed simp_all text \ We will now obtain a closed-form solution for @{const rqs_cost_exp}. First of all, we can reindex the right-most sum in the recursion step and obtain: \ lemma rqs_cost_exp_Suc': "rqs_cost_exp (Suc n) = real n + 2 / real (Suc n) * (\i\n. rqs_cost_exp i)" proof - have "rqs_cost_exp (Suc n) = real n + (\i\n. rqs_cost_exp i + rqs_cost_exp (n - i)) / real (Suc n)" by (rule rqs_cost_exp_Suc) also have "(\i\n. rqs_cost_exp i + rqs_cost_exp (n - i)) = (\i\n. rqs_cost_exp i) + (\i\n. rqs_cost_exp (n - i))" by (simp add: sum.distrib) also have "(\i\n. rqs_cost_exp (n - i)) = (\i\n. rqs_cost_exp i)" by (intro sum.reindex_bij_witness[of _ "\i. n - i" "\i. n - i"]) auto also have "\ + \ = 2 * \" by simp also have "\ / real (Suc n) = 2 / real (Suc n) * (\i\n. rqs_cost_exp i)" by simp finally show ?thesis . qed text \ Next, we can apply some standard techniques to transform this equation into a simple linear recurrence, which we can then solve easily in terms of harmonic numbers: \ theorem rqs_cost_exp_eq [code]: "rqs_cost_exp n = 2 * real (n + 1) * harm n - 4 * real n" proof - define F where "F = (\n. rqs_cost_exp n / (real n + 1))" have [simp]: "F 0 = 0" "F (Suc 0) = 0" by (simp_all add: F_def) have F_Suc: "F (Suc m) = F m + real (2*m) / (real ((m+1)*(m+2)))" if "m > 0" for m proof (cases m) case (Suc n) have A: "rqs_cost_exp (Suc (Suc n)) * real (Suc (Suc n)) = real ((n+1)*(n+2)) + 2 * (\i\n. rqs_cost_exp i) + 2 * rqs_cost_exp (Suc n)" by (subst rqs_cost_exp_Suc') (simp_all add: field_simps) have B: "rqs_cost_exp (Suc n) * real (Suc n) = real (n*(n+1)) + 2 * (\i\n. rqs_cost_exp i)" by (subst rqs_cost_exp_Suc') (simp_all add: field_simps) have "rqs_cost_exp (Suc (Suc n)) * real (Suc (Suc n)) - rqs_cost_exp (Suc n) * real (Suc n) = real ((n+1)*(n+2)) - real (n*(n+1)) + 2 * rqs_cost_exp (Suc n)" by (subst A, subst B) simp_all also have "real ((n+1)*(n+2)) - real (n*(n+1)) = real (2*(n+1))" by simp finally have "rqs_cost_exp (Suc (Suc n)) * real (n+2) = rqs_cost_exp (Suc n) * real (n+3) + real (2*(n+1))" by (simp add: algebra_simps) hence "rqs_cost_exp (Suc (Suc n)) / real (n+3) = rqs_cost_exp (Suc n) / real (n+2) + real (2*(n+1)) / (real (n+2)*real (n+3))" by (simp add: divide_simps del: of_nat_Suc of_nat_add) thus ?thesis by (simp add: F_def algebra_simps Suc) qed simp_all have F_eq: "F n = 2 * (\k=1..n. real (k - 1) / real (k * (k + 1)))" for n proof (cases "n \ 1") case True thus ?thesis by (induction n rule: dec_induct) (simp_all add: F_Suc algebra_simps) qed (simp_all add: not_le) have "F n = 2 * (\k=1..n. real (k - 1) / real (k * (k + 1)))" (is "_ = 2 * ?S") by (fact F_eq) also have "?S = (\k=1..n. 2 / real (Suc k) - 1 / real k)" by (intro sum.cong) (simp_all add: field_simps of_nat_diff) also have "\ = 2 * (\k=1..n. inverse (real (Suc k))) - harm n" by (subst sum_subtractf) (simp add: harm_def sum.distrib sum_distrib_left divide_simps) also have "(\k=1..n. inverse (real (Suc k))) = (\k=Suc 1..Suc n. inverse (real k))" by (intro sum.reindex_bij_witness[of _ "\x. x - 1" Suc]) auto also have "\ = harm (Suc n) - 1" unfolding harm_def by (subst (2) sum.atLeast_Suc_atMost) simp_all finally have "F n = 2 * harm n + 4 * (1 / (n + 1) - 1)" by (simp add: harm_Suc field_simps) also have "\ * real (n + 1) = 2 * real (n + 1) * harm n - 4 * real n" by (simp add: field_simps) also have "F n * real (n + 1) = rqs_cost_exp n" by (simp add: F_def add_ac) finally show ?thesis . qed (* TODO Move *) lemma asymp_equiv_harm [asymp_equiv_intros]: "harm \[at_top] (\n. ln (real n))" proof - have "(\n. harm n - ln (real n)) \ O(\_. 1)" using euler_mascheroni_LIMSEQ by (intro bigoI_tendsto[where c = euler_mascheroni]) simp_all also have "(\_. 1) \ o(\n. ln (real n))" by auto finally have "(\n. ln (real n) + (harm n - ln (real n))) \[at_top] (\n. ln (real n))" by (subst asymp_equiv_add_right) simp_all thus ?thesis by simp qed corollary rqs_cost_exp_asymp_equiv: "rqs_cost_exp \[at_top] (\n. 2 * n * ln n)" proof - have "rqs_cost_exp = (\n. 2 * real (n + 1) * harm n - 4 * real n)" using rqs_cost_exp_eq .. also have "\ = (\n. 2 * real n * harm n + (2 * harm n - 4 * real n))" by (simp add: algebra_simps) finally have "rqs_cost_exp \[at_top] \" by simp also have "\ \[at_top] (\n. 2 * real n * harm n)" proof (subst asymp_equiv_add_right) have "(\x. 1 * harm x) \ o(\x. real x * harm x)" by (intro landau_o.small_big_mult smallo_real_nat_transfer) simp_all moreover have "harm \ \(\_. 1 :: real)" by (intro smallomegaI_filterlim_at_top_norm) (auto simp: harm_at_top) hence "(\x. real x * 1) \ o(\x. real x * harm x)" by (intro landau_o.big_small_mult) (simp_all add: smallomega_iff_smallo) ultimately show "(\n. 2 * harm n - 4 * real n) \ o(\n. 2 * real n * harm n)" by (intro sum_in_smallo) simp_all qed simp_all also have "\ \[at_top] (\n. 2 * real n * ln (real n))" by (intro asymp_equiv_intros) finally show ?thesis . qed lemma harm_mono: "m \ n \ harm m \ (harm n :: real)" unfolding harm_def by (intro sum_mono2) auto lemma harm_Suc_0 [simp]: "harm (Suc 0) = 1" by (simp add: harm_def) lemma harm_ge_1: "n > 0 \ harm n \ (1::real)" using harm_mono[of 1 n] by simp lemma mono_rqs_cost_exp: "mono rqs_cost_exp" proof (rule incseq_SucI) fix n show "rqs_cost_exp n \ rqs_cost_exp (Suc n)" proof (cases "n = 0") case False have "0 < (1 * 2 * (real n + 1) - 2 * real n) / (real n + 1)" by simp also have "\ \ (harm n * 2 * (real n + 1) - 2 * real n) / (real n + 1)" using False by (intro divide_right_mono diff_right_mono mult_right_mono) (auto simp: harm_ge_1) also have "\ = rqs_cost_exp (Suc n) - rqs_cost_exp n" by (simp add: rqs_cost_exp_eq harm_Suc field_simps) finally show ?thesis by simp qed auto qed lemma rqs_cost_exp_leI: "m \ n \ rqs_cost_exp m \ rqs_cost_exp n" using mono_rqs_cost_exp by (simp add: mono_def) subsection \Version for lists with repeated elements\ definition threeway_partition where "threeway_partition x R xs = (filter (\y. (y,x) \ R \ (x,y) \ R) xs, filter (\y. (x,y) \ R \ (y,x) \ R) xs, filter (\y. (x,y) \ R \ (y,x) \ R) xs)" text \ The following version of randomised Quicksort uses a three-way partitioning function in order to also achieve expected logarithmic running time on lists with repeated elements. \ function rquicksort' :: "('a \ 'a) set \ 'a list \ ('a list \ nat) pmf" where "rquicksort' R xs = (if xs = [] then return_pmf ([], 0) else do { i \ pmf_of_set {.. do { (ls, n1) \ rquicksort' R ls; (rs, n2) \ rquicksort' R rs; return_pmf (ls @ x # es @ rs, length xs - 1 + n1 + n2) } })" by auto termination proof (relation "Wellfounded.measure (length \ snd)", goal_cases) show "wf (Wellfounded.measure (length \ snd))" by simp qed (subst (asm) set_pmf_of_set; force intro!: le_less_trans[OF length_filter_le] simp: threeway_partition_def)+ declare rquicksort'.simps [simp del] lemma rquicksort'_Nil [simp]: "rquicksort' R [] = return_pmf ([], 0)" by (simp add: rquicksort'.simps) context begin qualified definition lesss :: "('a \ 'a) set \ 'a \ 'a list \ 'a list" where "lesss R x xs = filter (\y. (y, x) \ R \ (x, y) \ R) xs" qualified definition greaters :: "('a \ 'a) set \ 'a \ 'a list \ 'a list" where "greaters R x xs = filter (\y. (x, y) \ R \ (y, x) \ R) xs" qualified lemma lesss_Cons: "lesss R x (y # ys) = (if (y, x) \ R \ (x, y) \ R then y # lesss R x ys else lesss R x ys)" by (simp add: lesss_def) qualified lemma length_lesss_le [intro]: "length (lesss R x xs) \ length xs" by (simp add: lesss_def) qualified lemma length_lesss_less [intro]: assumes "x \ set xs" shows "length (lesss R x xs) < length xs" using assms by (induction xs) (auto simp: lesss_Cons intro: le_less_trans) qualified lemma greaters_Cons: "greaters R x (y # ys) = (if (x, y) \ R \ (y, x) \ R then y # greaters R x ys else greaters R x ys)" by (simp add: greaters_def) qualified lemma length_greaters_le [intro]: "length (greaters R x xs) \ length xs" by (simp add: greaters_def) qualified lemma length_greaters_less [intro]: assumes "x \ set xs" shows "length (greaters R x xs) < length xs" using assms by (induction xs) (auto simp: greaters_Cons intro: le_less_trans) text \ The following function counts the comparisons made by the modified randomised Quicksort. \ function rqs'_cost :: "('a \ 'a) set \ 'a list \ nat pmf" where "rqs'_cost R xs = (if xs = [] then return_pmf 0 else do { i \ pmf_of_set {..(n1,n2). length xs - 1 + n1 + n2) (pair_pmf (rqs'_cost R (lesss R x xs)) (rqs'_cost R (greaters R x xs))) })" by auto termination by (relation "Wellfounded.measure (length \ snd)") auto declare rqs'_cost.simps [simp del] lemma rqs'_cost_nonempty: "xs \ [] \ rqs'_cost R xs = do { i \ pmf_of_set {.. rqs'_cost R (lesss R x xs); n2 \ rqs'_cost R (greaters R x xs); return_pmf (length xs - 1 + n1 + n2) }" by (subst rqs'_cost.simps) (auto simp: pair_pmf_def Let_def map_bind_pmf) lemma finite_set_pmf_rqs'_cost [simp, intro]: "finite (set_pmf (rqs'_cost R xs))" by (induction R xs rule: rqs'_cost.induct) (auto simp: rqs'_cost.simps Let_def) (* TODO: Move? *) lemma expectation_pair_pmf_fst [simp]: fixes f :: "'a \ 'b::{banach, second_countable_topology}" shows "measure_pmf.expectation (pair_pmf p q) (\x. f (fst x)) = measure_pmf.expectation p f" proof - have "measure_pmf.expectation (pair_pmf p q) (\x. f (fst x)) = measure_pmf.expectation (map_pmf fst (pair_pmf p q)) f" by simp also have "map_pmf fst (pair_pmf p q) = p" by (simp add: map_fst_pair_pmf) finally show ?thesis . qed lemma expectation_pair_pmf_snd [simp]: fixes f :: "'a \ 'b::{banach, second_countable_topology}" shows "measure_pmf.expectation (pair_pmf p q) (\x. f (snd x)) = measure_pmf.expectation q f" proof - have "measure_pmf.expectation (pair_pmf p q) (\x. f (snd x)) = measure_pmf.expectation (map_pmf snd (pair_pmf p q)) f" by simp also have "map_pmf snd (pair_pmf p q) = q" by (simp add: map_snd_pair_pmf) finally show ?thesis . qed qualified lemma length_lesss_le_sorted: assumes "sorted_wrt R xs" "i < length xs" shows "length (lesss R (xs ! i) xs) \ i" using assms by (induction arbitrary: i rule: sorted_wrt.induct) (force simp: lesss_def nth_Cons le_Suc_eq split: nat.splits)+ qualified lemma length_greaters_le_sorted: assumes "sorted_wrt R xs" "i < length xs" shows "length (greaters R (xs ! i) xs) \ length xs - i - 1" using assms by (induction arbitrary: i rule: sorted_wrt.induct) (force simp: greaters_def nth_Cons le_Suc_eq split: nat.splits)+ qualified lemma length_lesss_le': assumes "i < length xs" "linorder_on A R" "set xs \ A" shows "length (lesss R (insort_wrt R xs ! i) xs) \ i" proof - define x where "x = insort_wrt R xs ! i" define less where "less = (\x y. (x,y) \ R \ (y,x) \ R)" have "length (lesss R x xs) = size {# y \# mset xs. less y x #}" by (simp add: lesss_def size_mset [symmetric] less_def mset_filter del: size_mset) also have "mset xs = mset (insort_wrt R xs)" by simp also have "size {#y \# mset (insort_wrt R xs). less y x#} = length (lesss R x (insort_wrt R xs))" by (simp only: mset_filter [symmetric] size_mset lesss_def less_def) also have "\ \ i" unfolding x_def by (rule length_lesss_le_sorted) (use assms in auto) finally show ?thesis unfolding x_def . qed qualified lemma length_greaters_le': assumes "i < length xs" "linorder_on A R" "set xs \ A" shows "length (greaters R (insort_wrt R xs ! i) xs) \ length xs - i - 1" proof - define x where "x = insort_wrt R xs ! i" define less where "less = (\x y. (x,y) \ R \ (y,x) \ R)" have "length (greaters R x xs) = size {# y \# mset xs. less x y #}" by (simp add: greaters_def size_mset [symmetric] less_def mset_filter del: size_mset) also have "mset xs = mset (insort_wrt R xs)" by simp also have "size {#y \# mset (insort_wrt R xs). less x y#} = length (greaters R x (insort_wrt R xs))" by (simp only: mset_filter [symmetric] size_mset greaters_def less_def) also have "\ \ length (insort_wrt R xs) - i - 1" unfolding x_def by (rule length_greaters_le_sorted) (use assms in auto) finally show ?thesis unfolding x_def by simp qed text \ We can show quite easily that the expected number of comparisons in this modified QuickSort is bounded above by the expected number of comparisons on a list of the same length with no repeated elements. \ theorem rqs'_cost_expectation_le: assumes "linorder_on A R" "set xs \ A" shows "measure_pmf.expectation (rqs'_cost R xs) real \ rqs_cost_exp (length xs)" using assms proof (induction R xs rule: rqs'_cost.induct) case (1 R xs) show ?case proof (cases "xs = []") case False define n where "n = length xs - 1" have length_eq: "length xs = Suc n" using False by (simp add: n_def) define E where "E = (\xs. measure_pmf.expectation (rqs'_cost R xs) real)" define f where "f = (\x. rqs_cost_exp (length (lesss R x xs)) + rqs_cost_exp (length (greaters R x xs)))" have "rqs'_cost R xs = do { i \ pmf_of_set {..(n1, y). length xs - Suc 0 + n1 + y) (pair_pmf (rqs'_cost R (lesss R (xs ! i) xs)) (rqs'_cost R (greaters R (xs ! i) xs))) }" using False by (subst rqs'_cost.simps) (simp_all add: Let_def) also have "measure_pmf.expectation \ real = real n + (\k \ real n + (\kkx\#mset xs. f x)" by (simp only: mset_map [symmetric] sum_mset_sum_list sum_list_sum_nth) (simp_all add: atLeast0LessThan) also have "mset xs = mset (insort_wrt R xs)" by simp also have "(\x\#\. f x) = (\i \ (\i {.. i" using i "1.prems" by (intro length_lesss_le'[where A = A]) auto show "length (greaters R (insort_wrt R xs ! i) xs) \ length xs - i - 1" using i "1.prems" by (intro length_greaters_le'[where A = A]) auto qed also have "\ = (\i\n. rqs_cost_exp i + rqs_cost_exp (n - i))" by (intro sum.cong) (auto simp: length_eq) also have "real n + \ / real (length xs) = rqs_cost_exp (length xs)" by (simp add: length_eq rqs_cost_exp.simps(2)) finally show ?thesis by (simp add: divide_right_mono) qed (auto simp: rqs'_cost.simps) qed end end diff --git a/thys/Random_BSTs/Random_BSTs.thy b/thys/Random_BSTs/Random_BSTs.thy --- a/thys/Random_BSTs/Random_BSTs.thy +++ b/thys/Random_BSTs/Random_BSTs.thy @@ -1,818 +1,818 @@ (* File: Random_BSTs.thy - Author: Manuel Eberl + Author: Manuel Eberl Expected shape of random Binary Search Trees *) section \Expected shape of random Binary Search Trees\ theory Random_BSTs imports Complex_Main "HOL-Probability.Random_Permutations" "HOL-Data_Structures.Tree_Set" Quick_Sort_Cost.Quick_Sort_Average_Case begin (* TODO: Hide this in the proper place *) hide_const (open) Tree_Set.insert subsection \Auxiliary lemmas\ (* TODO: Move? *) lemma linorder_on_linorder_class [intro]: "linorder_on UNIV {(x, y). x \ (y :: 'a :: linorder)}" by (auto simp: linorder_on_def refl_on_def antisym_def trans_def total_on_def) lemma Nil_in_permutations_of_set_iff [simp]: "[] \ permutations_of_set A \ A = {}" by (auto simp: permutations_of_set_def) lemma max_power_distrib_right: fixes a :: "'a :: linordered_semidom" shows "a > 1 \ max (a ^ b) (a ^ c) = a ^ max b c" by (auto simp: max_def) lemma set_tree_empty_iff [simp]: "set_tree t = {} \ t = Leaf" by (cases t) auto lemma card_set_tree_bst: "bst t \ card (set_tree t) = size t" proof (induction t) case (Node l x r) have "set_tree \l, x, r\ = insert x (set_tree l \ set_tree r)" by simp also from Node.prems have "card \ = Suc (card (set_tree l \ set_tree r))" by (intro card_insert_disjoint) auto also from Node have "card (set_tree l \ set_tree r) = size l + size r" by (subst card_Un_disjoint) force+ finally show ?case by simp qed simp_all lemma pair_pmf_cong: "p = p' \ q = q' \ pair_pmf p q = pair_pmf p' q'" by simp lemma expectation_add_pair_pmf: fixes f :: "'a \ 'c::{banach, second_countable_topology}" assumes "finite (set_pmf p)" and "finite (set_pmf q)" shows "measure_pmf.expectation (pair_pmf p q) (\(x,y). f x + g y) = measure_pmf.expectation p f + measure_pmf.expectation q g" proof - have "measure_pmf.expectation (pair_pmf p q) (\(x,y). f x + g y) = measure_pmf.expectation (pair_pmf p q) (\z. f (fst z) + g (snd z))" by (simp add: case_prod_unfold) also have "\ = measure_pmf.expectation (pair_pmf p q) (\z. f (fst z)) + measure_pmf.expectation (pair_pmf p q) (\z. g (snd z))" by (intro Bochner_Integration.integral_add integrable_measure_pmf_finite) (auto intro: assms) also have "measure_pmf.expectation (pair_pmf p q) (\z. f (fst z)) = measure_pmf.expectation (map_pmf fst (pair_pmf p q)) f" by simp also have "map_pmf fst (pair_pmf p q) = p" by (rule map_fst_pair_pmf) also have "measure_pmf.expectation (pair_pmf p q) (\z. g (snd z)) = measure_pmf.expectation (map_pmf snd (pair_pmf p q)) g" by simp also have "map_pmf snd (pair_pmf p q) = q" by (rule map_snd_pair_pmf) finally show ?thesis . qed subsection \Creating a BST from a list\ text \ The following recursive function creates a binary search tree from a given list of elements by inserting them into an initially empty BST from left to right. We will prove that this is the case later, but the recursive definition has the advantage of giving us a useful induction rule, so we chose that definition and prove the alternative definitions later. This recursion, which already almost looks like QuickSort, will be key in analysing the shape distributions of random BSTs. \ fun bst_of_list :: "'a :: linorder list \ 'a tree" where "bst_of_list [] = Leaf" | "bst_of_list (x # xs) = Node (bst_of_list [y \ xs. y < x]) x (bst_of_list [y \ xs. y > x])" lemma bst_of_list_eq_Leaf_iff [simp]: "bst_of_list xs = Leaf \ xs = []" by (induction xs) auto lemma bst_of_list_snoc [simp]: "bst_of_list (xs @ [y]) = Tree_Set.insert y (bst_of_list xs)" by (induction xs rule: bst_of_list.induct) auto lemma bst_of_list_append: "bst_of_list (xs @ ys) = fold Tree_Set.insert ys (bst_of_list xs)" proof (induction ys arbitrary: xs) case (Cons y ys) have "bst_of_list (xs @ (y # ys)) = bst_of_list ((xs @ [y]) @ ys)" by simp also have "\ = fold Tree_Set.insert ys (bst_of_list (xs @ [y]))" by (rule Cons.IH) finally show ?case by simp qed simp_all text \ The following now shows that the recursive function indeed corresponds to the notion of inserting the elements from the list from left to right. \ lemma bst_of_list_altdef: "bst_of_list xs = fold Tree_Set.insert xs Leaf" using bst_of_list_append[of "[]" xs] by simp lemma size_bst_insert: "x \ set_tree t \ size (Tree_Set.insert x t) = Suc (size t)" by (induction t) auto lemma set_bst_insert [simp]: "set_tree (Tree_Set.insert x t) = insert x (set_tree t)" by (induction t) auto lemma set_bst_of_list [simp]: "set_tree (bst_of_list xs) = set xs" by (induction xs rule: rev_induct) simp_all lemma size_bst_of_list_distinct [simp]: assumes "distinct xs" shows "size (bst_of_list xs) = length xs" using assms by (induction xs rule: rev_induct) (auto simp: size_bst_insert) lemma strict_mono_on_imp_less_iff: assumes "strict_mono_on f A" "x \ A" "y \ A" shows "f x < (f y :: 'b :: linorder) \ x < (y :: 'a :: linorder)" using assms by (cases x y rule: linorder_cases; force simp: strict_mono_on_def)+ lemma bst_of_list_map: fixes f :: "'a :: linorder \ 'b :: linorder" assumes "strict_mono_on f A" "set xs \ A" shows "bst_of_list (map f xs) = map_tree f (bst_of_list xs)" using assms proof (induction xs rule: bst_of_list.induct) case (2 x xs) have "[xa\xs . f xa < f x] = [xa\xs . xa < x]" and "[xa\xs . f xa > f x] = [xa\xs . xa > x]" using "2.prems" by (auto simp: strict_mono_on_imp_less_iff intro!: filter_cong) with 2 show ?case by (auto simp: filter_map o_def) qed auto subsection \Random BSTs\ text \ Analogously to the previous section, we can now view the concept of a random BST (i.\,e.\ a BST obtained by inserting a given set of elements in random order) in two different ways. We again start with the recursive variant: \ function random_bst :: "'a :: linorder set \ 'a tree pmf" where "random_bst A = (if \finite A \ A = {} then return_pmf Leaf else do { x \ pmf_of_set A; l \ random_bst {y \ A. y < x}; r \ random_bst {y \ A. y > x}; return_pmf (Node l x r) })" by auto termination by (relation finite_psubset) auto declare random_bst.simps [simp del] lemma random_bst_empty [simp]: "random_bst {} = return_pmf Leaf" by (simp add: random_bst.simps) lemma set_pmf_random_permutation [simp]: "finite A \ set_pmf (pmf_of_set (permutations_of_set A)) = {xs. distinct xs \ set xs = A}" by (subst set_pmf_of_set) (auto dest: permutations_of_setD) text \ The alternative characterisation is the more intuitive one where we simply pick a random permutation of the set elements uniformly at random and insert them into an empty tree from left to right: \ lemma random_bst_altdef: assumes "finite A" shows "random_bst A = map_pmf bst_of_list (pmf_of_set (permutations_of_set A))" using assms proof (induction A rule: finite_psubset_induct) case (psubset A) define L R where "L = (\x. {y\A. y < x})" and "R = (\x. {y\A. y > x})" { fix x assume x: "x \ A" hence *: "L x \ A" "R x \ A" by (auto simp: L_def R_def) note this [THEN psubset.IH] } note IH = this show ?case proof (cases "A = {}") case False note A = \finite A\ \A \ {}\ have "random_bst A = do { x \ pmf_of_set A; (l, r) \ pair_pmf (random_bst (L x)) (random_bst (R x)); return_pmf (Node l x r) }" using A unfolding pair_pmf_def L_def R_def by (subst random_bst.simps) (simp add: bind_return_pmf bind_assoc_pmf) also have "\ = do { x \ pmf_of_set A; (l, r) \ pair_pmf (map_pmf bst_of_list (pmf_of_set (permutations_of_set (L x)))) (map_pmf bst_of_list (pmf_of_set (permutations_of_set (R x)))); return_pmf (Node l x r) }" using A by (intro bind_pmf_cong refl) (simp_all add: IH) also have "\ = do { x \ pmf_of_set A; (ls, rs) \ pair_pmf (pmf_of_set (permutations_of_set (L x))) (pmf_of_set (permutations_of_set (R x))); return_pmf (Node (bst_of_list ls) x (bst_of_list rs)) }" unfolding map_pair [symmetric] by (simp add: map_pmf_def case_prod_unfold bind_return_pmf bind_assoc_pmf) also have "L = (\x. {y \ A - {x}. y \ x})" by (auto simp: L_def) also have "R = (\x. {y \ A - {x}. \y \ x})" by (auto simp: R_def) also have "do { x \ pmf_of_set A; (ls, rs) \ pair_pmf (pmf_of_set (permutations_of_set {y \ A - {x}. y \ x})) (pmf_of_set (permutations_of_set {y \ A - {x}. \y \ x})); return_pmf (Node (bst_of_list ls) x (bst_of_list rs)) } = do { x \ pmf_of_set A; (ls, rs) \ map_pmf (partition (\y. y \ x)) (pmf_of_set (permutations_of_set (A - {x}))); return_pmf (Node (bst_of_list ls) x (bst_of_list rs)) }" using \finite A\ by (intro bind_pmf_cong refl partition_random_permutations [symmetric]) auto also have "\ = do { x \ pmf_of_set A; (ls, rs) \ map_pmf (\xs. ([y\xs. y < x], [y\xs. y > x])) (pmf_of_set (permutations_of_set (A - {x}))); return_pmf (Node (bst_of_list ls) x (bst_of_list rs)) }" using A by (intro bind_pmf_cong refl map_pmf_cong) (auto intro!: filter_cong dest: permutations_of_setD simp: order.strict_iff_order) also have "\ = map_pmf bst_of_list (pmf_of_set (permutations_of_set A))" using A by (subst random_permutation_of_set[of A]) (auto simp: map_pmf_def bind_return_pmf o_def bind_assoc_pmf not_le) finally show ?thesis . qed (simp_all add: pmf_of_set_singleton) qed lemma finite_set_random_bst [simp, intro]: "finite A \ finite (set_pmf (random_bst A))" by (simp add: random_bst_altdef) lemma random_bst_code [code]: "random_bst (set xs) = map_pmf bst_of_list (pmf_of_set (permutations_of_set (set xs)))" by (rule random_bst_altdef) simp_all lemma random_bst_singleton [simp]: "random_bst {x} = return_pmf (Node Leaf x Leaf)" by (simp add: random_bst_altdef pmf_of_set_singleton) lemma size_random_bst: assumes "t \ set_pmf (random_bst A)" "finite A" shows "size t = card A" proof - from assms obtain xs where "distinct xs" "A = set xs" "t = bst_of_list xs" by (auto simp: random_bst_altdef dest: permutations_of_setD) thus ?thesis using \finite A\ by (simp add: distinct_card) qed lemma random_bst_image: assumes "finite A" "strict_mono_on f A" shows "random_bst (f ` A) = map_pmf (map_tree f) (random_bst A)" proof - from assms(2) have inj: "inj_on f A" by (rule strict_mono_on_imp_inj_on) with assms have "inj_on (map f) (permutations_of_set A)" by (intro inj_on_mapI) auto with assms inj have "random_bst (f ` A) = map_pmf (\x. bst_of_list (map f x)) (pmf_of_set (permutations_of_set A))" by (simp add: random_bst_altdef permutations_of_set_image_inj map_pmf_of_set_inj [symmetric] pmf.map_comp o_def) also have "\ = map_pmf (map_tree f) (random_bst A)" unfolding random_bst_altdef[OF \finite A\] pmf.map_comp o_def using assms by (intro map_pmf_cong refl bst_of_list_map[of f A]) (auto dest: permutations_of_setD) finally show ?thesis . qed text \ We can also re-phrase the non-recursive definition using the @{const fold_random_permutation} combinator from the HOL-Probability library, which folds over a given set in random order. \ lemma random_bst_altdef': assumes "finite A" shows "random_bst A = fold_random_permutation Tree_Set.insert Leaf A" proof - have "random_bst A = map_pmf bst_of_list (pmf_of_set (permutations_of_set A))" using assms by (simp add: random_bst_altdef) also have "\ = map_pmf (\xs. fold Tree_Set.insert xs Leaf) (pmf_of_set (permutations_of_set A))" using assms by (intro map_pmf_cong refl) (auto simp: bst_of_list_altdef) also from assms have "\ = fold_random_permutation Tree_Set.insert Leaf A" by (simp add: fold_random_permutation_fold) finally show ?thesis . qed subsection \Expected height\ text \ For the purposes of the analysis of the expected height, we define the following notion of `expected height', which is essentially two to the power of the height (as defined by Cormen \textit{et al.}) with a special treatment for the empty tree, which has exponential height 0. Note that the height defined by Cormen \textit{et al.}\ differs from the @{const height} function here in Isabelle in that for them, the height of the empty tree is undefined and the height of a singleton tree is 0 etc., whereas in Isabelle, the height of the empty tree is 0 and the height of a singleton tree is 1. \ definition eheight :: "'a tree \ nat" where "eheight t = (if t = Leaf then 0 else 2 ^ (height t - 1))" lemma eheight_Leaf [simp]: "eheight Leaf = 0" by (simp add: eheight_def) lemma eheight_Node_singleton [simp]: "eheight (Node Leaf x Leaf) = 1" by (simp add: eheight_def) lemma eheight_Node: "l \ Leaf \ r \ Leaf \ eheight (Node l x r) = 2 * max (eheight l) (eheight r)" by (cases l; cases r) (simp_all add: eheight_def max_power_distrib_right) fun eheight_rbst :: "nat \ nat pmf" where "eheight_rbst 0 = return_pmf 0" | "eheight_rbst (Suc 0) = return_pmf 1" | "eheight_rbst (Suc n) = do { k \ pmf_of_set {..n}; h1 \ eheight_rbst k; h2 \ eheight_rbst (n - k); return_pmf (2 * max h1 h2)}" definition eheight_exp :: "nat \ real" where "eheight_exp n = measure_pmf.expectation (eheight_rbst n) real" lemma eheight_rbst_reduce: assumes "n > 1" shows "eheight_rbst n = do {k \ pmf_of_set {.. eheight_rbst k; h2 \ eheight_rbst (n - k - 1); return_pmf (2 * max h1 h2)}" using assms by (cases n rule: eheight_rbst.cases) (simp_all add: lessThan_Suc_atMost) lemma Leaf_in_set_random_bst_iff: assumes "finite A" shows "Leaf \ set_pmf (random_bst A) \ A = {}" proof assume "Leaf \ set_pmf (random_bst A)" from size_random_bst[OF this] and assms show "A = {}" by auto qed auto lemma eheight_rbst: assumes "finite A" shows "eheight_rbst (card A) = map_pmf eheight (random_bst A)" using assms proof (induction A rule: finite_psubset_induct) case (psubset A) define rank where "rank = linorder_rank {(x,y). x \ y} A" from \finite A\ have "A = {} \ is_singleton A \ card A > 1" by (auto simp: not_less le_Suc_eq is_singleton_altdef) then consider "A = {}" | "is_singleton A" | "card A > 1" by blast thus ?case proof cases case 3 hence nonempty: "A \ {}" by auto from 3 have "\is_singleton A" by (auto simp: is_singleton_def) hence exists_other: "\y\A. y \ x" for x using \A \ {}\ by (force simp: is_singleton_def) hence "map_pmf eheight (random_bst A) = do { x \ pmf_of_set A; l \ random_bst {y \ A. y < x}; r \ random_bst {y \ A. y > x}; return_pmf (eheight (Node l x r)) }" using \finite A\ by (subst random_bst.simps) (auto simp: map_bind_pmf) also have "\ = do { x \ pmf_of_set A; l \ random_bst {y \ A. y < x}; r \ random_bst {y \ A. y > x}; return_pmf (2 * max (eheight l) (eheight r)) }" using 3 \finite A\ exists_other by (intro bind_pmf_cong refl, subst eheight_Node) (force simp: Leaf_in_set_random_bst_iff not_less nonempty eheight_Node)+ also have "\ = do { x \ pmf_of_set A; h1 \ map_pmf eheight (random_bst {y \ A. y < x}); h2 \ map_pmf eheight (random_bst {y \ A. y > x}); return_pmf (2 * max h1 h2) }" by (simp add: bind_map_pmf) also have "\ = do { x \ pmf_of_set A; h1 \ eheight_rbst (card {y \ A. y < x}); h2 \ eheight_rbst (card {y \ A. y > x}); return_pmf (2 * max h1 h2) }" using \A \ {}\ \finite A\ by (intro bind_pmf_cong psubset.IH [symmetric] refl) auto also have "\ = do { k \ map_pmf rank (pmf_of_set A); h1 \ eheight_rbst k; h2 \ eheight_rbst (card A - k - 1); return_pmf (2 * max h1 h2) }" unfolding bind_map_pmf proof (intro bind_pmf_cong refl, goal_cases) case (1 x) have "rank x = card {y\A-{x}. y \ x}" by (simp add: rank_def linorder_rank_def) also have "{y\A-{x}. y \ x} = {y\A. y < x}" by auto finally show ?case by simp next case (2 x) have "A - {x} = {y\A-{x}. y \ x} \ {y\A. y > x}" by auto also have "card \ = rank x + card {y\A. y > x}" using \finite A\ by (subst card_Un_disjoint) (auto simp: rank_def linorder_rank_def) finally have "card {y\A. y > x} = card A - rank x - 1" using 2 \finite A\ \A \ {}\ by simp thus ?case by simp qed also have "map_pmf rank (pmf_of_set A) = pmf_of_set {..A \ {}\ \finite A\ unfolding rank_def by (intro map_pmf_of_set_bij_betw bij_betw_linorder_rank[of UNIV]) auto also have "do { k \ pmf_of_set {.. eheight_rbst k; h2 \ eheight_rbst (card A - k - 1); return_pmf (2 * max h1 h2) } = eheight_rbst (card A)" by (rule eheight_rbst_reduce [symmetric]) fact+ finally show ?thesis .. qed (auto simp: is_singleton_def) qed lemma finite_pmf_set_eheight_rbst [simp, intro]: "finite (set_pmf (eheight_rbst n))" proof - have "eheight_rbst n = map_pmf eheight (random_bst {..)" by simp finally show ?thesis . qed lemma eheight_exp_0 [simp]: "eheight_exp 0 = 0" by (simp add: eheight_exp_def) lemma eheight_exp_1 [simp]: "eheight_exp (Suc 0) = 1" by (simp add: eheight_exp_def lessThan_Suc) lemma eheight_exp_reduce_bound: assumes "n > 1" shows "eheight_exp n \ 4 / n * (\k = 1 / real n * (\k(h1,h2). 2 * max h1 h2) (?p k)) real)" (is "_ = _ * ?S") unfolding pair_pmf_def map_bind_pmf by (subst eheight_rbst_reduce [OF assms], subst pmf_expectation_bind_pmf_of_set) (insert assms, auto simp: sum_divide_distrib divide_simps) also have "?S = (\kx. 2 * x) (map_pmf ?f (?p k))) real)" by (simp only: pmf.map_comp o_def case_prod_unfold) also have "\ = 2 * (\kk(h1,h2). max (real h1) (real h2)))" by (simp add: case_prod_unfold) also have "\ \ (\k(h1,h2). real h1 + real h2))" unfolding integral_map_pmf case_prod_unfold by (intro sum_mono Bochner_Integration.integral_mono integrable_measure_pmf_finite) auto also have "\ = (\kkkkk. n - Suc k" "\k. n - Suc k"]) auto also have "1 / real n * (2 * (\ + \)) = 4 / real n * \" by simp finally show ?thesis using assms by (simp_all add: mult_left_mono divide_right_mono) qed text \ We now define the following upper bound on the expected exponential height due to Cormen\ \textit{et\ al.}~\cite{cormen}: \ lemma eheight_exp_bound: "eheight_exp n \ real ((n + 3) choose 3) / 4" proof (induction n rule: less_induct) case (less n) consider "n = 0" | "n = 1" | "n > 1" by force thus ?case proof cases case 3 hence "eheight_exp n \ 4 / n * (\kk (\k = real (\kkk\n - 1. ((k + 3) choose 3))" using \n > 1\ by (intro sum.cong) auto also have "\ = ((n + 3) choose 4)" using choose_rising_sum(1)[of 3 "n - 1"] and \n > 1\ by (simp add: add_ac Suc3_eq_add_3) also have "4 / real n * (\ / 4) = real ((n + 3) choose 3) / 4" using \n > 1\ by (cases n) (simp_all add: binomial_fact fact_numeral divide_simps) finally show ?thesis using \n > 1\ by (simp add: mult_left_mono divide_right_mono) qed (auto simp: eval_nat_numeral) qed text \ We then show that this is indeed an upper bound on the expected exponential height by induction over the set of elements. This proof mostly follows that by Cormen\ \textit{et al.}~\cite{cormen}, and partially an answer on the Computer Science Stack Exchange~\cite{sofl}. \ text \ Since the function $\uplambda x.\ 2 ^ x$ is convex, we can then easily derive a bound on the actual height using Jensen's inequality: \ definition height_exp_approx :: "nat \ real" where "height_exp_approx n = log 2 (real ((n + 3) choose 3) / 4) + 1" theorem height_expectation_bound: assumes "finite A" "A \ {}" shows "measure_pmf.expectation (random_bst A) height \ height_exp_approx (card A)" proof - have "convex_on UNIV ((powr) 2)" by (intro convex_on_realI[where f' = "\x. ln 2 * 2 powr x"]) (auto intro!: derivative_eq_intros DERIV_powr simp: powr_def [abs_def]) hence "2 powr measure_pmf.expectation (random_bst A) (\t. real (height t - 1)) \ measure_pmf.expectation (random_bst A) (\t. 2 powr real (height t - 1))" using assms by (intro measure_pmf.jensens_inequality[where I = UNIV]) (auto intro!: integrable_measure_pmf_finite) also have "(\t. 2 powr real (height t - 1)) = (\t. 2 ^ (height t - 1))" by (simp add: powr_realpow) also have "measure_pmf.expectation (random_bst A) (\t. 2 ^ (height t - 1)) = measure_pmf.expectation (random_bst A) (\t. real (eheight t))" using assms by (intro integral_cong_AE) (auto simp: AE_measure_pmf_iff random_bst_altdef eheight_def) also have "\ = measure_pmf.expectation (map_pmf eheight (random_bst A)) real" by simp also have "map_pmf eheight (random_bst A) = eheight_rbst (card A)" by (rule eheight_rbst [symmetric]) fact+ also have "measure_pmf.expectation \ real = eheight_exp (card A)" by (simp add: eheight_exp_def) also have "\ \ real ((card A + 3) choose 3) / 4" by (rule eheight_exp_bound) also have "measure_pmf.expectation (random_bst A) (\t. real (height t - 1)) = measure_pmf.expectation (random_bst A) (\t. real (height t) - 1)" proof (intro integral_cong_AE AE_pmfI, goal_cases) case (3 t) with \A \ {}\ and assms show ?case by (subst of_nat_diff) (auto simp: Suc_le_eq random_bst_altdef) qed auto finally have "2 powr measure_pmf.expectation (random_bst A) (\t. real (height t) - 1) \ real ((card A + 3) choose 3) / 4" . hence "log 2 (2 powr measure_pmf.expectation (random_bst A) (\t. real (height t) - 1)) \ log 2 (real ((card A + 3) choose 3) / 4)" (is "?lhs \ ?rhs") by (subst log_le_cancel_iff) (auto simp: ) also have "?lhs = measure_pmf.expectation (random_bst A) (\t. real (height t) - 1)" by simp also have "\ = measure_pmf.expectation (random_bst A) (\t. real (height t)) - 1" using assms by (subst Bochner_Integration.integral_diff) (auto intro!: integrable_measure_pmf_finite) finally show ?thesis by (simp add: height_exp_approx_def) qed text \ This upper bound is asymptotically equivalent to $c \ln n$ with $c = \frac{3}{\ln 2} \approx 4.328$. This is actually a relatively tight upper bound, since the exact asymptotics of the expected height of a random BST is $c \ln n$ with $c \approx 4.311$.~\cite{reed} However, the proof of these precise asymptotics is very intricate and we will therefore be content with the upper bound. In particular, we can now show that the expected height is $O(\log n)$. \ lemma ln_sum_bigo_ln: "(\x::real. ln (x + c)) \ O(ln)" proof (rule bigoI_tendsto) from eventually_gt_at_top[of "1::real"] show "eventually (\x::real. ln x \ 0) at_top" by eventually_elim simp_all next show "((\x. ln (x + c) / ln x) \ 1) at_top" proof (rule lhospital_at_top_at_top) show "eventually (\x. ((\x. ln (x + c)) has_real_derivative inverse (x + c)) (at x)) at_top" using eventually_gt_at_top[of "-c"] by eventually_elim (auto intro!: derivative_eq_intros simp: field_simps) show "eventually (\x. ((\x. ln x) has_real_derivative inverse x) (at x)) at_top" using eventually_gt_at_top[of 0] by eventually_elim (auto intro!: derivative_eq_intros simp: field_simps) show "((\x. inverse (x + c) / inverse x) \ 1) at_top" proof (rule Lim_transform_eventually) show "eventually (\x. inverse (1 + c / x) = inverse (x + c) / inverse x) at_top" using eventually_gt_at_top[of "0::real"] eventually_gt_at_top[of "-c"] by eventually_elim (simp add: field_simps) have "((\x. inverse (1 + c / x)) \ inverse (1 + 0)) at_top" by (intro tendsto_inverse tendsto_add tendsto_const real_tendsto_divide_at_top[OF tendsto_const] filterlim_ident) simp_all thus "((\x. inverse (1 + c / x)) \ 1) at_top" by simp qed qed (auto simp: ln_at_top eventually_at_top_not_equal) qed corollary height_expectation_bigo: "height_exp_approx \ O(ln)" proof - let ?T = "\x::real. log 2 (x + 1) + log 2 (x + 2) + log 2 (x + 3) + (1 - log 2 24)" have "eventually (\n. height_exp_approx n = log 2 (real n + 1) + log 2 (real n + 2) + log 2 (real n + 3) + (1 - log 2 24)) at_top" (is "eventually (\n. _ = ?T n) at_top") using eventually_gt_at_top[of "0::nat"] proof eventually_elim case (elim n) have "height_exp_approx n = log 2 (real (n + 3 choose 3) / 4) + 1" by (simp add: height_exp_approx_def log_divide) also have "real ((n + 3) choose 3) = real (n + 3) gchoose 3" by (simp add: binomial_gbinomial) also have "\ / 4 = (real n + 1) * (real n + 2) * (real n + 3) / 24" by (simp add: gbinomial_pochhammer' numeral_3_eq_3 pochhammer_Suc add_ac) also have "log 2 \ = log 2 (real n + 1) + log 2 (real n + 2) + log 2 (real n + 3) - log 2 24" by (simp add: log_divide log_mult) finally show ?case by simp qed hence "height_exp_approx \ \(?T)" by (rule bigthetaI_cong) also have *: "(\x. ln (x + c) / ln 2) \ O(ln)" for c :: real by (subst landau_o.big.cdiv_in_iff') (auto intro!: ln_sum_bigo_ln) have "?T \ O(\n. ln (real n))" unfolding log_def by (intro bigo_real_nat_transfer sum_in_bigo ln_sum_bigo_ln *) simp_all finally show ?thesis . qed subsection \Lookup costs\ text \ The following function describes the cost incurred when looking up a specific element in a specific BST. The cost corresponds to the number of edges traversed in the lookup. \ primrec lookup_cost :: "'a :: linorder \ 'a tree \ nat" where "lookup_cost x Leaf = 0" | "lookup_cost x (Node l y r) = (if x = y then 0 else if x < y then Suc (lookup_cost x l) else Suc (lookup_cost x r))" text \ Some of the literature defines these costs as 1 in the case that the current node is the correct one, i.\,e.\ their costs are our costs plus 1. These alternative costs are exactly the number of comparisons performed in the lookup. Our cost function has the advantage of precisely summing up to the internal path length and therefore gives us slightly nicer results, and since the difference is only a ${}+1$ in the end, this variant seemed more reasonable. \ text \ It can be shown with a simple induction that The sum of all lookup costs in a tree is the internal path length of the tree. \ theorem sum_lookup_costs: fixes t :: "'a :: linorder tree" assumes "bst t" shows "(\x\set_tree t. lookup_cost x t) = ipl t" using assms proof (induction t) case (Node l x r) from Node.prems have disj: "x \ set_tree l" "x \ set_tree r" "set_tree l \ set_tree r = {}" by force+ have "set_tree (Node l x r) = insert x (set_tree l \ set_tree r)" by simp also have "(\y\\. lookup_cost y (Node l x r)) = lookup_cost x \l, x, r\ + (\y\set_tree l. lookup_cost y \l, x, r\) + (\y\set_tree r. lookup_cost y \l, x, r\)" using disj by (simp add: sum.union_disjoint) also have "(\y\set_tree l. lookup_cost y \l, x, r\) = (\y\set_tree l. 1 + lookup_cost y l)" using disj and Node by (intro sum.cong refl) auto also have "\ = size l + ipl l" using Node by (subst sum.distrib) (simp_all add: card_set_tree_bst) also have "(\y\set_tree r. lookup_cost y \l, x, r\) = (\y\set_tree r. 1 + lookup_cost y r)" using disj and Node by (intro sum.cong refl) auto also have "\ = size r + ipl r" using Node by (subst sum.distrib) (simp_all add: card_set_tree_bst) finally show ?case by simp qed simp_all text \ This allows us to easily show that the expected cost of looking up a random element in a fixed tree is the internal path length divided by the number of elements. \ theorem expected_lookup_cost: assumes "bst t" "t \ Leaf" shows "measure_pmf.expectation (pmf_of_set (set_tree t)) (\x. lookup_cost x t) = ipl t / size t" using assms by (subst integral_pmf_of_set) (simp_all add: sum_lookup_costs of_nat_sum [symmetric] card_set_tree_bst) text \ Therefore, we will now turn to analysing the internal path length of a random BST. This then clearly related to the expected lookup costs of a random element in a random BST by the above result. \ subsection \Average Path Length\ text \ The internal path length satisfies the recursive equation @{thm ipl.simps(2)[of l x r]}. This is quite similar to the number of comparisons performed by QuickSort, and indeed, we can reduce the internal path length of a random BST to the number of comparisons performed by QuickSort on a randomly-ordered list relatively easily: \ theorem map_pmf_random_bst_eq_rqs_cost: assumes "finite A" shows "map_pmf ipl (random_bst A) = rqs_cost (card A)" using assms proof (induction A rule: finite_psubset_induct) case (psubset A) show ?case proof (cases "A = {}") case False note A = \finite A\ \A \ {}\ define n where "n = card A - 1" define rank :: "'a \ nat" where "rank = linorder_rank {(x,y). x \ y} A" from A have card: "card A = Suc n" by (cases "card A") (auto simp: n_def) from A have "map_pmf ipl (random_bst A) = do { x \ pmf_of_set A; (l,r) \ pair_pmf (random_bst {y \ A. y < x}) (random_bst {y \ A. y > x}); return_pmf (ipl (Node l x r)) }" by (subst random_bst.simps) (simp_all add: pair_pmf_def card map_pmf_def bind_assoc_pmf bind_return_pmf) also have "\ = do { x \ pmf_of_set A; (l,r) \ pair_pmf (random_bst {y \ A. y < x}) (random_bst {y \ A. y > x}); return_pmf (n + ipl l + ipl r) }" proof (intro bind_pmf_cong refl, clarify, goal_cases) case (1 x l r) from 1 and A have "n = card (A - {x})" by (simp add: n_def) also have "A - {x} = {y\A. y < x} \ {y\A. y > x}" by auto also have "card \ = card {y\A. y < x} + card {y\A. y > x}" using \finite A\ by (intro card_Un_disjoint) auto also from 1 and A have "card {y\A. y < x} = size l" by (auto dest: size_random_bst) also from 1 and A have "card {y\A. y > x} = size r" by (auto dest: size_random_bst) finally show ?case by simp qed also have "\ = do { x \ pmf_of_set A; (l,r) \ pair_pmf (map_pmf ipl (random_bst {y \ A. y < x})) (map_pmf ipl (random_bst {y \ A. y > x})); return_pmf (n + l + r) }" by (simp add: map_pair [symmetric] case_prod_unfold bind_map_pmf) also have "\ = do { i \ map_pmf rank (pmf_of_set A); (l,r) \ pair_pmf (rqs_cost i) (rqs_cost (n - i)); return_pmf (n + l + r) }" (is "_ = bind_pmf _ ?f") unfolding bind_map_pmf proof (intro bind_pmf_cong refl pair_pmf_cong, goal_cases) case (1 x) have "map_pmf ipl (random_bst {y \ A. y < x}) = rqs_cost (card {y \ A. y < x})" using 1 and A by (intro psubset.IH) auto also have "{y \ A. y < x} = {y \ A - {x}. y \ x}" by auto hence "card {y \ A. y < x} = rank x" by (simp add: rank_def linorder_rank_def) finally show ?case . next case (2 x) have "map_pmf ipl (random_bst {y \ A. y > x}) = rqs_cost (card {y \ A. y > x})" using 2 and A by (intro psubset.IH) auto also have "{y \ A. y > x} = A - {x} - {y \ A - {x}. y \ x}" by auto hence "card {y \ A. y > x} = card \" by (simp only:) also from 2 and A have "\ = n - rank x" by (subst card_Diff_subset) (auto simp: rank_def linorder_rank_def n_def) finally show ?case . qed also from A have "map_pmf rank (pmf_of_set A) = pmf_of_set {.. \ ?f = rqs_cost (card A)" by (simp add: pair_pmf_def bind_assoc_pmf bind_return_pmf card) finally show ?thesis . qed simp_all qed text \ In particular, this means that the expected values are the same: \ corollary expected_ipl_random_bst_eq: assumes "finite A" shows "measure_pmf.expectation (random_bst A) ipl = rqs_cost_exp (card A)" proof - have "measure_pmf.expectation (random_bst A) ipl = measure_pmf.expectation (map_pmf ipl (random_bst A)) real" by simp also from assms have "map_pmf ipl (random_bst A) = rqs_cost (card A)" by (rule map_pmf_random_bst_eq_rqs_cost) also have "measure_pmf.expectation \ real = rqs_cost_exp (card A)" by (rule expectation_rqs_cost) finally show ?thesis . qed text \ Therefore, the results about the expected number of comparisons of QuickSort carry over to the expected internal path length: \ corollary expected_ipl_random_bst_eq': assumes "finite A" shows "measure_pmf.expectation (random_bst A) ipl = 2 * real (card A + 1) * harm (card A) - 4 * real (card A)" by (simp add: expected_ipl_random_bst_eq rqs_cost_exp_eq assms) end diff --git a/thys/Randomised_Social_Choice/Automation/SDS_Automation.thy b/thys/Randomised_Social_Choice/Automation/SDS_Automation.thy --- a/thys/Randomised_Social_Choice/Automation/SDS_Automation.thy +++ b/thys/Randomised_Social_Choice/Automation/SDS_Automation.thy @@ -1,430 +1,430 @@ (* File: SDS_Automation.thy - Author: Manuel Eberl + Author: Manuel Eberl This theory provides a number of commands to automatically derive restrictions on the results of Social Decision Schemes fulfilling properties like Anonymity, Neutrality, Ex-post- or SD-efficiency, and SD-Strategy-Proofness. *) section \Automatic Fact Gathering for Social Decision Schemes\ theory SDS_Automation imports Preference_Profile_Cmd QSOpt_Exact "../Social_Decision_Schemes" keywords "derive_orbit_equations" "derive_support_conditions" "derive_ex_post_conditions" "find_inefficient_supports" "prove_inefficient_supports" "derive_strategyproofness_conditions" :: thy_goal begin text \ We now provide the following commands to automatically derive restrictions on the results of Social Decision Schemes satisfying Anonymity, Neutrality, Efficiency, or Strategy-Proofness: \begin{description} \item[@{command derive_orbit_equations}] to derive equalities arising from automorphisms of the given profiles due to Anonymity and Neutrality \item[@{command derive_ex_post_conditions}] to find all Pareto losers and the given profiles and derive the facts that they must be assigned probability 0 by any \textit{ex-post}-efficient SDS \item[@{command find_inefficient_supports}] to use Linear Programming to find all minimal SD-inefficient (but not \textit{ex-post}-inefficient) supports in the given profiles and output a corresponding witness lottery for each of them \item[@{command prove_inefficient_supports}] to prove a specified set of support conditions arising from \textit{ex-post}- or \textit{SD}-Efficiency. For conditions arising from \textit{SD}-Efficiency, a witness lottery must be specified (e.\,g. as computed by @{command derive_orbit_equations}). \item[@{command derive_support_conditions}] to automatically find and prove all support conditions arising from \textit{ex-post-} and \textit{SD}-Efficiency \item [@{command derive_strategyproofness_conditions}] to automatically derive all conditions arising from weak Strategy-Proofness and any manipulations between the given preference profiles. An optional maximum manipulation size can be specified. \end{description} All commands except @{command find_inefficient_supports} open a proof state and leave behind proof obligations for the user to discharge. This should always be possible using the Simplifier, possibly with a few additional rules, depending on the context. \ lemma disj_False_right: "P \ False \ P" by simp lemmas multiset_add_ac = add_ac[where ?'a = "'a multiset"] lemma less_or_eq_real: "(x::real) < y \ x = y \ x \ y" "x < y \ y = x \ x \ y" by linarith+ lemma multiset_Diff_single_normalize: fixes a c assumes "a \ c" shows "({#a#} + B) - {#c#} = {#a#} + (B - {#c#})" using assms by auto lemma ex_post_efficient_aux: assumes "prefs_from_table_wf agents alts xss" "R \ prefs_from_table xss" assumes "i \ agents" "\i\agents. y \[prefs_from_table xss i] x" "\y \[prefs_from_table xss i] x" shows "ex_post_efficient_sds agents alts sds \ pmf (sds R) x = 0" proof assume ex_post: "ex_post_efficient_sds agents alts sds" from assms(1,2) have wf: "pref_profile_wf agents alts R" by (simp add: pref_profile_from_tableI') from ex_post interpret ex_post_efficient_sds agents alts sds . from assms(2-) show "pmf (sds R) x = 0" by (intro ex_post_efficient''[OF wf, of i x y]) simp_all qed lemma SD_inefficient_support_aux: assumes R: "prefs_from_table_wf agents alts xss" "R \ prefs_from_table xss" assumes as: "as \ []" "set as \ alts" "distinct as" "A = set as" assumes ys: "\x\set (map snd ys). 0 \ x" "sum_list (map snd ys) = 1" "set (map fst ys) \ alts" assumes i: "i \ agents" assumes SD1: "\i\agents. \x\alts. sum_list (map snd (filter (\y. prefs_from_table xss i x (fst y)) ys)) \ real (length (filter (prefs_from_table xss i x) as)) / real (length as)" assumes SD2: "\x\alts. sum_list (map snd (filter (\y. prefs_from_table xss i x (fst y)) ys)) > real (length (filter (prefs_from_table xss i x) as)) / real (length as)" shows "sd_efficient_sds agents alts sds \ (\x\A. pmf (sds R) x = 0)" proof assume "sd_efficient_sds agents alts sds" from R have wf: "pref_profile_wf agents alts R" by (simp add: pref_profile_from_tableI') then interpret pref_profile_wf agents alts R . interpret sd_efficient_sds agents alts sds by fact from ys have ys': "pmf_of_list_wf ys" by (intro pmf_of_list_wfI) auto { fix i x assume "x \ alts" "i \ agents" with ys' have "lottery_prob (pmf_of_list ys) (preferred_alts (R i) x) = sum_list (map snd (filter (\y. prefs_from_table xss i x (fst y)) ys))" by (subst measure_pmf_of_list) (simp_all add: preferred_alts_def R) } note A = this { fix i x assume "x \ alts" "i \ agents" with as have "lottery_prob (pmf_of_set (set as)) (preferred_alts (R i) x) = real (card (set as \ preferred_alts (R i) x)) / real (card (set as))" by (subst measure_pmf_of_set) simp_all also have "set as \ preferred_alts (R i) x = set (filter (\y. R i x y) as)" by (auto simp add: preferred_alts_def) also have "card \ = length (filter (\y. R i x y) as)" by (intro distinct_card distinct_filter assms) also have "card (set as) = length as" by (intro distinct_card assms) finally have "lottery_prob (pmf_of_set (set as)) (preferred_alts (R i) x) = real (length (filter (prefs_from_table xss i x) as)) / real (length as)" by (simp add: R) } note B = this from wf show "\x\A. pmf (sds R) x = 0" proof (rule SD_inefficient_support') from ys ys' show lottery1: "pmf_of_list ys \ lotteries" by (intro pmf_of_list_lottery) show i: "i \ agents" by fact from as have lottery2: "pmf_of_set (set as) \ lotteries" by (intro pmf_of_set_lottery) simp_all from i as SD2 lottery1 lottery2 show "\SD (R i) (pmf_of_list ys) (pmf_of_set A)" by (subst preorder_on.SD_preorder[of alts]) (auto simp: A B not_le) from as SD1 lottery1 lottery2 show "\i\agents. SD (R i) (pmf_of_set A) (pmf_of_list ys)" by safe (auto simp: preorder_on.SD_preorder[of alts] A B) qed (insert as, simp_all) qed definition pref_classes where "pref_classes alts le = preferred_alts le ` alts - {alts}" primrec pref_classes_lists where "pref_classes_lists [] = {}" | "pref_classes_lists (xs#xss) = insert (\(set (xs#xss))) (pref_classes_lists xss)" fun pref_classes_lists_aux where "pref_classes_lists_aux acc [] = {}" | "pref_classes_lists_aux acc (xs#xss) = insert acc (pref_classes_lists_aux (acc \ xs) xss)" lemma pref_classes_lists_append: "pref_classes_lists (xs @ ys) = (\) (\(set ys)) ` pref_classes_lists xs \ pref_classes_lists ys" by (induction xs) auto lemma pref_classes_lists_aux: assumes "is_weak_ranking xss" "acc \ (\(set xss)) = {}" shows "pref_classes_lists_aux acc xss = (insert acc ((\A. A \ acc) ` pref_classes_lists (rev xss)) - {acc \ \(set xss)})" using assms proof (induction acc xss rule: pref_classes_lists_aux.induct [case_names Nil Cons]) case (Cons acc xs xss) from Cons.prems have A: "acc \ (xs \ \(set xss)) = {}" "xs \ {}" by (simp_all add: is_weak_ranking_Cons) from Cons.prems have "pref_classes_lists_aux (acc \ xs) xss = insert (acc \ xs) ((\A. A \ (acc \ xs)) `pref_classes_lists (rev xss)) - {acc \ xs \ \(set xss)}" by (intro Cons.IH) (auto simp: is_weak_ranking_Cons) with Cons.prems have "pref_classes_lists_aux acc (xs # xss) = insert acc (insert (acc \ xs) ((\A. A \ (acc \ xs)) ` pref_classes_lists (rev xss)) - {acc \ (xs \ \(set xss))})" by (simp_all add: is_weak_ranking_Cons pref_classes_lists_append image_image Un_ac) also from A have "\ = insert acc (insert (acc \ xs) ((\x. x \ (acc \ xs)) ` pref_classes_lists (rev xss))) - {acc \ (xs \ \(set xss))}" by blast finally show ?case by (simp_all add: pref_classes_lists_append image_image Un_ac) qed simp_all lemma pref_classes_list_aux_hd_tl: assumes "is_weak_ranking xss" "xss \ []" shows "pref_classes_lists_aux (hd xss) (tl xss) = pref_classes_lists (rev xss) - {\(set xss)}" proof - from assms have A: "xss = hd xss # tl xss" by simp from assms have "hd xss \ \(set (tl xss)) = {} \ is_weak_ranking (tl xss)" by (subst (asm) A, subst (asm) is_weak_ranking_Cons) simp_all hence "pref_classes_lists_aux (hd xss) (tl xss) = insert (hd xss) ((\A. A \ hd xss) ` pref_classes_lists (rev (tl xss))) - {hd xss \ \(set (tl xss))}" by (intro pref_classes_lists_aux) simp_all also have "hd xss \ \(set (tl xss)) = \(set xss)" by (subst (3) A, subst set_simps) simp_all also have "insert (hd xss) ((\A. A \ hd xss) ` pref_classes_lists (rev (tl xss))) = pref_classes_lists (rev (tl xss) @ [hd xss])" by (subst pref_classes_lists_append) auto also have "rev (tl xss) @ [hd xss] = rev xss" by (subst (3) A) (simp only: rev.simps) finally show ?thesis . qed lemma pref_classes_of_weak_ranking_aux: assumes "is_weak_ranking xss" shows "of_weak_ranking_Collect_ge xss ` (\(set xss)) = pref_classes_lists xss" proof safe fix X x assume "x \ X" "X \ set xss" with assms show "of_weak_ranking_Collect_ge xss x \ pref_classes_lists xss" by (induction xss) (auto simp: is_weak_ranking_Cons of_weak_ranking_Collect_ge_Cons') next fix x assume "x \ pref_classes_lists xss" with assms show "x \ of_weak_ranking_Collect_ge xss ` \(set xss)" proof (induction xss) case (Cons xs xss) from Cons.prems consider "x = xs \ \(set xss)" | "x \ pref_classes_lists xss" by auto thus ?case proof cases assume "x = xs \ \(set xss)" with Cons.prems show ?thesis by (auto simp: is_weak_ranking_Cons of_weak_ranking_Collect_ge_Cons') next assume x: "x \ pref_classes_lists xss" from Cons.prems x have "x \ of_weak_ranking_Collect_ge xss ` \(set xss)" by (intro Cons.IH) (simp_all add: is_weak_ranking_Cons) moreover from Cons.prems have "xs \ \(set xss) = {}" by (simp add: is_weak_ranking_Cons) ultimately have "x \ of_weak_ranking_Collect_ge xss ` ((xs \ \(set xss)) \ {x. x \ xs})" by blast thus ?thesis by (simp add: of_weak_ranking_Collect_ge_Cons') qed qed simp_all qed lemma eval_pref_classes_of_weak_ranking: assumes "\(set xss) = alts" "is_weak_ranking xss" "alts \ {}" shows "pref_classes alts (of_weak_ranking xss) = pref_classes_lists_aux (hd xss) (tl xss)" proof - have "pref_classes alts (of_weak_ranking xss) = preferred_alts (of_weak_ranking xss) ` (\(set (rev xss))) - {\(set xss)}" by (simp add: pref_classes_def assms) also { have "of_weak_ranking_Collect_ge (rev xss) ` (\(set (rev xss))) = pref_classes_lists (rev xss)" using assms by (intro pref_classes_of_weak_ranking_aux) simp_all also have "of_weak_ranking_Collect_ge (rev xss) = preferred_alts (of_weak_ranking xss)" by (intro ext) (simp_all add: of_weak_ranking_Collect_ge_def preferred_alts_def) finally have "preferred_alts (of_weak_ranking xss) ` (\(set (rev xss))) = pref_classes_lists (rev xss)" . } also from assms have "pref_classes_lists (rev xss) - {\(set xss)} = pref_classes_lists_aux (hd xss) (tl xss)" by (intro pref_classes_list_aux_hd_tl [symmetric]) auto finally show ?thesis by simp qed context preorder_on begin lemma SD_iff_pref_classes: assumes "p \ lotteries_on carrier" "q \ lotteries_on carrier" shows "p \[SD(le)] q \ (\A\pref_classes carrier le. measure_pmf.prob p A \ measure_pmf.prob q A)" proof safe fix A assume "p \[SD(le)] q" "A \ pref_classes carrier le" thus "measure_pmf.prob p A \ measure_pmf.prob q A" by (auto simp: SD_preorder pref_classes_def) next assume A: "\A\pref_classes carrier le. measure_pmf.prob p A \ measure_pmf.prob q A" show "p \[SD(le)] q" proof (rule SD_preorderI) fix x assume x: "x \ carrier" show "measure_pmf.prob p (preferred_alts le x) \ measure_pmf.prob q (preferred_alts le x)" proof (cases "preferred_alts le x = carrier") case False with x have "preferred_alts le x \ pref_classes carrier le" unfolding pref_classes_def by (intro DiffI imageI) simp_all with A show ?thesis by simp next case True from assms have "measure_pmf.prob p carrier = 1" "measure_pmf.prob q carrier = 1" by (auto simp: measure_pmf.prob_eq_1 lotteries_on_def AE_measure_pmf_iff) with True show ?thesis by simp qed qed (insert assms, simp_all) qed end lemma (in strategyproof_an_sds) strategyproof': assumes wf: "is_pref_profile R" "total_preorder_on alts Ri'" and i: "i \ agents" shows "(\A\pref_classes alts (R i). lottery_prob (sds (R(i := Ri'))) A < lottery_prob (sds R) A) \ (\A\pref_classes alts (R i). lottery_prob (sds (R(i := Ri'))) A = lottery_prob (sds R) A)" proof - from wf(1) interpret R: pref_profile_wf agents alts R . from i interpret total_preorder_on alts "R i" by simp from assms have "\ manipulable_profile R i Ri'" by (intro strategyproof) moreover from wf i have "sds R \ lotteries" "sds (R(i := Ri')) \ lotteries" by (simp_all add: sds_wf) ultimately show ?thesis by (fastforce simp: manipulable_profile_def strongly_preferred_def SD_iff_pref_classes not_le not_less) qed lemma pref_classes_lists_aux_finite: "A \ pref_classes_lists_aux acc xss \ finite acc \ (\A. A \ set xss \ finite A) \ finite A" by (induction acc xss rule: pref_classes_lists_aux.induct) auto lemma strategyproof_aux: assumes wf: "prefs_from_table_wf agents alts xss1" "R1 = prefs_from_table xss1" "prefs_from_table_wf agents alts xss2" "R2 = prefs_from_table xss2" assumes sds: "strategyproof_an_sds agents alts sds" and i: "i \ agents" and j: "j \ agents" assumes eq: "R1(i := R2 j) = R2" "the (map_of xss1 i) = xs" "pref_classes_lists_aux (hd xs) (tl xs) = ps" shows "(\A\ps. (\x\A. pmf (sds R2) x) < (\x\A. pmf (sds R1) x)) \ (\A\ps. (\x\A. pmf (sds R2) x) = (\x\A. pmf (sds R1) x))" proof - from sds interpret strategyproof_an_sds agents alts sds . let ?Ri' = "R2 j" from wf j have wf': "is_pref_profile R1" "total_preorder_on alts ?Ri'" by (auto intro: pref_profile_from_tableI pref_profile_wf.prefs_wf'(1)) from wf(1) i have "i \ set (map fst xss1)" by (simp add: prefs_from_table_wf_def) with prefs_from_table_wfD(3)[OF wf(1)] eq have "xs \ set (map snd xss1)" by force note xs = prefs_from_table_wfD(2)[OF wf(1)] prefs_from_table_wfD(5,6)[OF wf(1) this] { fix p A assume A: "A \ pref_classes_lists_aux (hd xs) (tl xs)" from xs have "xs \ []" by auto with xs have "finite A" by (intro pref_classes_lists_aux_finite[OF A]) (auto simp: is_finite_weak_ranking_def list.set_sel) hence "lottery_prob p A = (\x\A. pmf p x)" by (rule measure_measure_pmf_finite) } note A = this from strategyproof'[OF wf' i] eq have "(\A\pref_classes alts (R1 i). lottery_prob (sds R2) A < lottery_prob (sds R1) A) \ (\A\pref_classes alts (R1 i). lottery_prob (sds R2) A = lottery_prob (sds R1) A)" by simp also from wf eq i have "R1 i = of_weak_ranking xs" by (simp add: prefs_from_table_map_of) also from xs have "pref_classes alts (of_weak_ranking xs) = pref_classes_lists_aux (hd xs) (tl xs)" unfolding is_finite_weak_ranking_def by (intro eval_pref_classes_of_weak_ranking) simp_all finally show ?thesis by (simp add: A eq) qed lemma strategyproof_aux': assumes wf: "prefs_from_table_wf agents alts xss1" "R1 \ prefs_from_table xss1" "prefs_from_table_wf agents alts xss2" "R2 \ prefs_from_table xss2" assumes sds: "strategyproof_an_sds agents alts sds" and i: "i \ agents" and j: "j \ agents" assumes perm: "list_permutes ys alts" defines "\ \ permutation_of_list ys" and "\' \ inverse_permutation_of_list ys" defines "xs \ the (map_of xss1 i)" defines xs': "xs' \ map ((`) \) (the (map_of xss2 j))" defines "Ri' \ of_weak_ranking xs'" assumes distinct_ps: "\A\ps. distinct A" assumes eq: "mset (map snd xss1) - {#the (map_of xss1 i)#} + {#xs'#} = mset (map (map ((`) \) \ snd) xss2)" "pref_classes_lists_aux (hd xs) (tl xs) = set ` ps" shows "list_permutes ys alts \ ((\A\ps. (\x\A. pmf (sds R2) (\' x)) < (\x\A. pmf (sds R1) x)) \ (\A\ps. (\x\A. pmf (sds R2) (\' x)) = (\x\A. pmf (sds R1) x)))" (is "_ \ ?th") proof from perm have perm': "\ permutes alts" by (simp add: \_def) from sds interpret strategyproof_an_sds agents alts sds . from wf(3) j have "j \ set (map fst xss2)" by (simp add: prefs_from_table_wf_def) with prefs_from_table_wfD(3)[OF wf(3)] have xs'_aux: "the (map_of xss2 j) \ set (map snd xss2)" by force with wf(3) have xs'_aux': "is_finite_weak_ranking (the (map_of xss2 j))" by (auto simp: prefs_from_table_wf_def) hence *: "is_weak_ranking xs'" unfolding xs' by (intro is_weak_ranking_map_inj permutes_inj_on[OF perm']) (auto simp add: is_finite_weak_ranking_def) moreover from * xs'_aux' have "is_finite_weak_ranking xs'" by (auto simp: xs' is_finite_weak_ranking_def) moreover from prefs_from_table_wfD(5)[OF wf(3) xs'_aux] have "\(set xs') = alts" unfolding xs' by (simp add: image_Union [symmetric] permutes_image[OF perm']) ultimately have wf_xs': "is_weak_ranking xs'" "is_finite_weak_ranking xs'" "\(set xs') = alts" by (simp_all add: is_finite_weak_ranking_def) from this wf j have wf': "is_pref_profile R1" "total_preorder_on alts Ri'" "is_pref_profile R2" "finite_total_preorder_on alts Ri'" unfolding Ri'_def by (auto intro: pref_profile_from_tableI pref_profile_wf.prefs_wf'(1) total_preorder_of_weak_ranking) interpret R1: pref_profile_wf agents alts R1 by fact interpret R2: pref_profile_wf agents alts R2 by fact from wf(1) i have "i \ set (map fst xss1)" by (simp add: prefs_from_table_wf_def) with prefs_from_table_wfD(3)[OF wf(1)] eq(2) have "xs \ set (map snd xss1)" unfolding xs_def by force note xs = prefs_from_table_wfD(2)[OF wf(1)] prefs_from_table_wfD(5,6)[OF wf(1) this] from wf i wf' wf_xs' xs eq have eq': "anonymous_profile (R1(i := Ri')) = image_mset (map ((`) \)) (anonymous_profile R2)" by (subst R1.anonymous_profile_update) (simp_all add: Ri'_def weak_ranking_of_weak_ranking mset_map multiset.map_comp xs_def anonymise_prefs_from_table prefs_from_table_map_of) { fix p A assume A: "A \ pref_classes_lists_aux (hd xs) (tl xs)" from xs have "xs \ []" by auto with xs have "finite A" by (intro pref_classes_lists_aux_finite[OF A]) (auto simp: is_finite_weak_ranking_def list.set_sel) hence "lottery_prob p A = (\x\A. pmf p x)" by (rule measure_measure_pmf_finite) } note A = this from strategyproof'[OF wf'(1,2) i] eq' have "(\A\pref_classes alts (R1 i). lottery_prob (sds (R1(i := Ri'))) A < lottery_prob (sds R1) A) \ (\A\pref_classes alts (R1 i). lottery_prob (sds (R1(i := Ri'))) A = lottery_prob (sds R1) A)" by simp also from eq' i have "sds (R1(i := Ri')) = map_pmf \ (sds R2)" unfolding \_def by (intro sds_anonymous_neutral permutation_of_list_permutes perm wf' pref_profile_wf.wf_update eq) also from wf eq i have "R1 i = of_weak_ranking xs" by (simp add: prefs_from_table_map_of xs_def) also from xs have "pref_classes alts (of_weak_ranking xs) = pref_classes_lists_aux (hd xs) (tl xs)" unfolding is_finite_weak_ranking_def by (intro eval_pref_classes_of_weak_ranking) simp_all finally have "(\A\ps. (\x\A. pmf (map_pmf \ (sds R2)) x) < (\x\A. pmf (sds R1) x)) \ (\A\ps. (\x\A. pmf (map_pmf \ (sds R2)) x) = (\x\A. pmf (sds R1) x))" using distinct_ps by (simp add: A eq sum.distinct_set_conv_list del: measure_map_pmf) also from perm' have "pmf (map_pmf \ (sds R2)) = (\x. pmf (sds R2) (inv \ x))" using pmf_map_inj'[of \ _ "inv \ x" for x] by (simp add: fun_eq_iff permutes_inj permutes_inverses) also from perm have "inv \ = \'" unfolding \_def \'_def by (rule inverse_permutation_of_list_correct [symmetric]) finally show ?th . qed fact+ ML_file \randomised_social_choice.ML\ ML_file \sds_automation.ML\ end diff --git a/thys/Regular-Sets/Regexp_Constructions.thy b/thys/Regular-Sets/Regexp_Constructions.thy --- a/thys/Regular-Sets/Regexp_Constructions.thy +++ b/thys/Regular-Sets/Regexp_Constructions.thy @@ -1,395 +1,395 @@ (* File: Regexp_Constructions.thy - Author: Manuel Eberl + Author: Manuel Eberl Some simple constructions on regular expressions to illustrate closure properties of regular languages: reversal, substitution, prefixes, suffixes, subwords ("fragments") *) section \Basic constructions on regular expressions\ theory Regexp_Constructions imports Main "HOL-Library.Sublist" Regular_Exp begin subsection \Reverse language\ lemma rev_conc [simp]: "rev ` (A @@ B) = rev ` B @@ rev ` A" unfolding conc_def image_def by force lemma rev_compower [simp]: "rev ` (A ^^ n) = (rev ` A) ^^ n" by (induction n) (simp_all add: conc_pow_comm) lemma rev_star [simp]: "rev ` star A = star (rev ` A)" by (simp add: star_def image_UN) subsection \Substituting characters in a language\ definition subst_word :: "('a \ 'b list) \ 'a list \ 'b list" where "subst_word f xs = concat (map f xs)" lemma subst_word_Nil [simp]: "subst_word f [] = []" by (simp add: subst_word_def) lemma subst_word_singleton [simp]: "subst_word f [x] = f x" by (simp add: subst_word_def) lemma subst_word_append [simp]: "subst_word f (xs @ ys) = subst_word f xs @ subst_word f ys" by (simp add: subst_word_def) lemma subst_word_Cons [simp]: "subst_word f (x # xs) = f x @ subst_word f xs" by (simp add: subst_word_def) lemma subst_word_conc [simp]: "subst_word f ` (A @@ B) = subst_word f ` A @@ subst_word f ` B" unfolding conc_def image_def by force lemma subst_word_compower [simp]: "subst_word f ` (A ^^ n) = (subst_word f ` A) ^^ n" by (induction n) simp_all lemma subst_word_star [simp]: "subst_word f ` (star A) = star (subst_word f ` A)" by (simp add: star_def image_UN) text \Suffix language\ definition Suffixes :: "'a list set \ 'a list set" where "Suffixes A = {w. \q. q @ w \ A}" lemma Suffixes_altdef [code]: "Suffixes A = (\w\A. set (suffixes w))" unfolding Suffixes_def set_suffixes_eq suffix_def by blast lemma Nil_in_Suffixes_iff [simp]: "[] \ Suffixes A \ A \ {}" by (auto simp: Suffixes_def) lemma Suffixes_empty [simp]: "Suffixes {} = {}" by (auto simp: Suffixes_def) lemma Suffixes_empty_iff [simp]: "Suffixes A = {} \ A = {}" by (auto simp: Suffixes_altdef) lemma Suffixes_singleton [simp]: "Suffixes {xs} = set (suffixes xs)" by (auto simp: Suffixes_altdef) lemma Suffixes_insert: "Suffixes (insert xs A) = set (suffixes xs) \ Suffixes A" by (simp add: Suffixes_altdef) lemma Suffixes_conc [simp]: "A \ {} \ Suffixes (A @@ B) = Suffixes B \ (Suffixes A @@ B)" unfolding Suffixes_altdef conc_def by (force simp: suffix_append) lemma Suffixes_union [simp]: "Suffixes (A \ B) = Suffixes A \ Suffixes B" by (auto simp: Suffixes_def) lemma Suffixes_UNION [simp]: "Suffixes (\(f ` A)) = \((\x. Suffixes (f x)) ` A)" by (auto simp: Suffixes_def) lemma Suffixes_compower: assumes "A \ {}" shows "Suffixes (A ^^ n) = insert [] (Suffixes A @@ (\kk A ^^ n))" by (simp_all add: assms conc_Un_distrib) also have "(\k A ^^ n = (\k\insert n {.. {}" shows "Suffixes (star A) = Suffixes A @@ star A" proof - have "star A = (\n. A ^^ n)" unfolding star_def .. also have "Suffixes \ = (\x. Suffixes (A ^^ x))" by simp also have "\ = (\n. insert [] (Suffixes A @@ (\k = insert [] (Suffixes A @@ (\n. (\kn. (\kn. A ^^ n)" by auto also have "\ = star A" unfolding star_def .. also have "insert [] (Suffixes A @@ star A) = Suffixes A @@ star A" using assms by auto finally show ?thesis . qed text \Prefix language\ definition Prefixes :: "'a list set \ 'a list set" where "Prefixes A = {w. \q. w @ q \ A}" lemma Prefixes_altdef [code]: "Prefixes A = (\w\A. set (prefixes w))" unfolding Prefixes_def set_prefixes_eq prefix_def by blast lemma Nil_in_Prefixes_iff [simp]: "[] \ Prefixes A \ A \ {}" by (auto simp: Prefixes_def) lemma Prefixes_empty [simp]: "Prefixes {} = {}" by (auto simp: Prefixes_def) lemma Prefixes_empty_iff [simp]: "Prefixes A = {} \ A = {}" by (auto simp: Prefixes_altdef) lemma Prefixes_singleton [simp]: "Prefixes {xs} = set (prefixes xs)" by (auto simp: Prefixes_altdef) lemma Prefixes_insert: "Prefixes (insert xs A) = set (prefixes xs) \ Prefixes A" by (simp add: Prefixes_altdef) lemma Prefixes_conc [simp]: "B \ {} \ Prefixes (A @@ B) = Prefixes A \ (A @@ Prefixes B)" unfolding Prefixes_altdef conc_def by (force simp: prefix_append) lemma Prefixes_union [simp]: "Prefixes (A \ B) = Prefixes A \ Prefixes B" by (auto simp: Prefixes_def) lemma Prefixes_UNION [simp]: "Prefixes (\(f ` A)) = \((\x. Prefixes (f x)) ` A)" by (auto simp: Prefixes_def) lemma Prefixes_rev: "Prefixes (rev ` A) = rev ` Suffixes A" by (auto simp: Prefixes_altdef prefixes_rev Suffixes_altdef) lemma Suffixes_rev: "Suffixes (rev ` A) = rev ` Prefixes A" by (auto simp: Prefixes_altdef suffixes_rev Suffixes_altdef) lemma Prefixes_compower: assumes "A \ {}" shows "Prefixes (A ^^ n) = insert [] ((\k = insert [] ((\k {}" shows "Prefixes (star A) = star A @@ Prefixes A" proof - have "star A = rev ` star (rev ` A)" by (simp add: image_image) also have "Prefixes \ = star A @@ Prefixes A" unfolding Prefixes_rev by (subst Suffixes_star) (simp_all add: assms image_image Suffixes_rev) finally show ?thesis . qed subsection \Subword language\ text \ The language of all sub-words, i.e. all words that are a contiguous sublist of a word in the original language. \ definition Sublists :: "'a list set \ 'a list set" where "Sublists A = {w. \q\A. sublist w q}" lemma Sublists_altdef [code]: "Sublists A = (\w\A. set (sublists w))" by (auto simp: Sublists_def) lemma Sublists_empty [simp]: "Sublists {} = {}" by (auto simp: Sublists_def) lemma Sublists_singleton [simp]: "Sublists {w} = set (sublists w)" by (auto simp: Sublists_altdef) lemma Sublists_insert: "Sublists (insert w A) = set (sublists w) \ Sublists A" by (auto simp: Sublists_altdef) lemma Sublists_Un [simp]: "Sublists (A \ B) = Sublists A \ Sublists B" by (auto simp: Sublists_altdef) lemma Sublists_UN [simp]: "Sublists (\(f ` A)) = \((\x. Sublists (f x)) ` A)" by (auto simp: Sublists_altdef) lemma Sublists_conv_Prefixes: "Sublists A = Prefixes (Suffixes A)" by (auto simp: Sublists_def Prefixes_def Suffixes_def sublist_def) lemma Sublists_conv_Suffixes: "Sublists A = Suffixes (Prefixes A)" by (auto simp: Sublists_def Prefixes_def Suffixes_def sublist_def) lemma Sublists_conc [simp]: assumes "A \ {}" "B \ {}" shows "Sublists (A @@ B) = Sublists A \ Sublists B \ Suffixes A @@ Prefixes B" using assms unfolding Sublists_conv_Suffixes by auto lemma star_not_empty [simp]: "star A \ {}" by auto lemma Sublists_star: "A \ {} \ Sublists (star A) = Sublists A \ Suffixes A @@ star A @@ Prefixes A" by (simp add: Sublists_conv_Prefixes) lemma Prefixes_subset_Sublists: "Prefixes A \ Sublists A" unfolding Prefixes_def Sublists_def by auto lemma Suffixes_subset_Sublists: "Suffixes A \ Sublists A" unfolding Suffixes_def Sublists_def by auto subsection \Fragment language\ text \ The following is the fragment language of a given language, i.e. the set of all words that are (not necessarily contiguous) sub-sequences of a word in the original language. \ definition Subseqs where "Subseqs A = (\w\A. set (subseqs w))" lemma Subseqs_empty [simp]: "Subseqs {} = {}" by (simp add: Subseqs_def) lemma Subseqs_insert [simp]: "Subseqs (insert xs A) = set (subseqs xs) \ Subseqs A" by (simp add: Subseqs_def) lemma Subseqs_singleton [simp]: "Subseqs {xs} = set (subseqs xs)" by simp lemma Subseqs_Un [simp]: "Subseqs (A \ B) = Subseqs A \ Subseqs B" by (simp add: Subseqs_def) lemma Subseqs_UNION [simp]: "Subseqs (\(f ` A)) = \((\x. Subseqs (f x)) ` A)" by (simp add: Subseqs_def) lemma Subseqs_conc [simp]: "Subseqs (A @@ B) = Subseqs A @@ Subseqs B" proof safe fix xs assume "xs \ Subseqs (A @@ B)" then obtain ys zs where *: "ys \ A" "zs \ B" "subseq xs (ys @ zs)" by (auto simp: Subseqs_def conc_def) from *(3) obtain xs1 xs2 where "xs = xs1 @ xs2" "subseq xs1 ys" "subseq xs2 zs" by (rule subseq_appendE) with *(1,2) show "xs \ Subseqs A @@ Subseqs B" by (auto simp: Subseqs_def set_subseqs_eq) next fix xs assume "xs \ Subseqs A @@ Subseqs B" then obtain xs1 xs2 ys zs where "xs = xs1 @ xs2" "subseq xs1 ys" "subseq xs2 zs" "ys \ A" "zs \ B" by (auto simp: conc_def Subseqs_def) thus "xs \ Subseqs (A @@ B)" by (force simp: Subseqs_def conc_def intro: list_emb_append_mono) qed lemma Subseqs_compower [simp]: "Subseqs (A ^^ n) = Subseqs A ^^ n" by (induction n) simp_all lemma Subseqs_star [simp]: "Subseqs (star A) = star (Subseqs A)" by (simp add: star_def) lemma Sublists_subset_Subseqs: "Sublists A \ Subseqs A" by (auto simp: Sublists_def Subseqs_def dest!: sublist_imp_subseq) subsection \Various regular expression constructions\ text \A construction for language reversal of a regular expression:\ primrec rexp_rev where "rexp_rev Zero = Zero" | "rexp_rev One = One" | "rexp_rev (Atom x) = Atom x" | "rexp_rev (Plus r s) = Plus (rexp_rev r) (rexp_rev s)" | "rexp_rev (Times r s) = Times (rexp_rev s) (rexp_rev r)" | "rexp_rev (Star r) = Star (rexp_rev r)" lemma lang_rexp_rev [simp]: "lang (rexp_rev r) = rev ` lang r" by (induction r) (simp_all add: image_Un) text \The obvious construction for a singleton-language regular expression:\ fun rexp_of_word where "rexp_of_word [] = One" | "rexp_of_word [x] = Atom x" | "rexp_of_word (x#xs) = Times (Atom x) (rexp_of_word xs)" lemma lang_rexp_of_word [simp]: "lang (rexp_of_word xs) = {xs}" by (induction xs rule: rexp_of_word.induct) (simp_all add: conc_def) lemma size_rexp_of_word [simp]: "size (rexp_of_word xs) = Suc (2 * (length xs - 1))" by (induction xs rule: rexp_of_word.induct) auto text \Character substitution in a regular expression:\ primrec rexp_subst where "rexp_subst f Zero = Zero" | "rexp_subst f One = One" | "rexp_subst f (Atom x) = rexp_of_word (f x)" | "rexp_subst f (Plus r s) = Plus (rexp_subst f r) (rexp_subst f s)" | "rexp_subst f (Times r s) = Times (rexp_subst f r) (rexp_subst f s)" | "rexp_subst f (Star r) = Star (rexp_subst f r)" lemma lang_rexp_subst: "lang (rexp_subst f r) = subst_word f ` lang r" by (induction r) (simp_all add: image_Un) text \Suffix language of a regular expression:\ primrec suffix_rexp :: "'a rexp \ 'a rexp" where "suffix_rexp Zero = Zero" | "suffix_rexp One = One" | "suffix_rexp (Atom a) = Plus (Atom a) One" | "suffix_rexp (Plus r s) = Plus (suffix_rexp r) (suffix_rexp s)" | "suffix_rexp (Times r s) = (if rexp_empty r then Zero else Plus (Times (suffix_rexp r) s) (suffix_rexp s))" | "suffix_rexp (Star r) = (if rexp_empty r then One else Times (suffix_rexp r) (Star r))" theorem lang_suffix_rexp [simp]: "lang (suffix_rexp r) = Suffixes (lang r)" by (induction r) (auto simp: rexp_empty_iff) text \Prefix language of a regular expression:\ primrec prefix_rexp :: "'a rexp \ 'a rexp" where "prefix_rexp Zero = Zero" | "prefix_rexp One = One" | "prefix_rexp (Atom a) = Plus (Atom a) One" | "prefix_rexp (Plus r s) = Plus (prefix_rexp r) (prefix_rexp s)" | "prefix_rexp (Times r s) = (if rexp_empty s then Zero else Plus (Times r (prefix_rexp s)) (prefix_rexp r))" | "prefix_rexp (Star r) = (if rexp_empty r then One else Times (Star r) (prefix_rexp r))" theorem lang_prefix_rexp [simp]: "lang (prefix_rexp r) = Prefixes (lang r)" by (induction r) (auto simp: rexp_empty_iff) text \Sub-word language of a regular expression\ primrec sublist_rexp :: "'a rexp \ 'a rexp" where "sublist_rexp Zero = Zero" | "sublist_rexp One = One" | "sublist_rexp (Atom a) = Plus (Atom a) One" | "sublist_rexp (Plus r s) = Plus (sublist_rexp r) (sublist_rexp s)" | "sublist_rexp (Times r s) = (if rexp_empty r \ rexp_empty s then Zero else Plus (sublist_rexp r) (Plus (sublist_rexp s) (Times (suffix_rexp r) (prefix_rexp s))))" | "sublist_rexp (Star r) = (if rexp_empty r then One else Plus (sublist_rexp r) (Times (suffix_rexp r) (Times (Star r) (prefix_rexp r))))" theorem lang_sublist_rexp [simp]: "lang (sublist_rexp r) = Sublists (lang r)" by (induction r) (auto simp: rexp_empty_iff Sublists_star) text \Fragment language of a regular expression:\ primrec subseqs_rexp :: "'a rexp \ 'a rexp" where "subseqs_rexp Zero = Zero" | "subseqs_rexp One = One" | "subseqs_rexp (Atom x) = Plus (Atom x) One" | "subseqs_rexp (Plus r s) = Plus (subseqs_rexp r) (subseqs_rexp s)" | "subseqs_rexp (Times r s) = Times (subseqs_rexp r) (subseqs_rexp s)" | "subseqs_rexp (Star r) = Star (subseqs_rexp r)" lemma lang_subseqs_rexp [simp]: "lang (subseqs_rexp r) = Subseqs (lang r)" by (induction r) auto text \Subword language of a regular expression\ end diff --git a/thys/SDS_Impossibility/SDS_Impossibility.thy b/thys/SDS_Impossibility/SDS_Impossibility.thy --- a/thys/SDS_Impossibility/SDS_Impossibility.thy +++ b/thys/SDS_Impossibility/SDS_Impossibility.thy @@ -1,816 +1,816 @@ (* File: SDS_Impossibility.thy - Author: Manuel Eberl + Author: Manuel Eberl The proof that there exists no anonymous and neutral SDS for at least four voters and alternatives that satisfies SD-Efficiency and SD-Strategy-Proofness. *) section \Incompatibility of SD-Efficiency and SD-Strategy-Proofness\ theory SDS_Impossibility imports Randomised_Social_Choice.SDS_Automation Randomised_Social_Choice.Randomised_Social_Choice begin subsection \Preliminary Definitions\ locale sds_impossibility = anonymous_sds agents alts sds + neutral_sds agents alts sds + sd_efficient_sds agents alts sds + strategyproof_sds agents alts sds for agents :: "'agent set" and alts :: "'alt set" and sds + assumes agents_ge_4: "card agents \ 4" and alts_ge_4: "card alts \ 4" locale sds_impossibility_4_4 = sds_impossibility agents alts sds for agents :: "'agent set" and alts :: "'alt set" and sds + fixes A1 A2 A3 A4 :: 'agent and a b c d :: 'alt assumes distinct_agents: "distinct [A1, A2, A3, A4]" and distinct_alts: "distinct [a, b, c, d]" and agents: "agents = {A1, A2, A3, A4}" and alts: "alts = {a, b, c, d}" begin lemma an_sds: "an_sds agents alts sds" by unfold_locales lemma ex_post_efficient_sds: "ex_post_efficient_sds agents alts sds" by unfold_locales lemma sd_efficient_sds: "sd_efficient_sds agents alts sds" by unfold_locales lemma strategyproof_an_sds: "strategyproof_an_sds agents alts sds" by unfold_locales lemma distinct_agents' [simp]: "A1 \ A2" "A1 \ A3" "A1 \ A4" "A2 \ A1" "A2 \ A3" "A2 \ A4" "A3 \ A1" "A3 \ A2" "A3 \ A4" "A4 \ A1" "A4 \ A2" "A4 \ A3" using distinct_agents by auto lemma distinct_alts' [simp]: "a \ b" "a \ c" "a \ d" "b \ a" "b \ c" "b \ d" "c \ a" "c \ b" "c \ d" "d \ a" "d \ b" "d \ c" using distinct_alts by auto lemma card_agents [simp]: "card agents = 4" and card_alts [simp]: "card alts = 4" using distinct_agents distinct_alts by (simp_all add: agents alts) lemma in_agents [simp]: "A1 \ agents" "A2 \ agents" "A3 \ agents" "A4 \ agents" by (simp_all add: agents) lemma in_alts [simp]: "a \ alts" "b \ alts" "c \ alts" "d \ alts" by (simp_all add: alts) lemma agent_iff: "x \ agents \ x \ {A1, A2, A3, A4}" "(\x\agents. P x) \ P A1 \ P A2 \ P A3 \ P A4" "(\x\agents. P x) \ P A1 \ P A2 \ P A3 \ P A4" by (auto simp add: agents) lemma alt_iff: "x \ alts \ x \ {a,b,c,d}" "(\x\alts. P x) \ P a \ P b \ P c \ P d" "(\x\alts. P x) \ P a \ P b \ P c \ P d" by (auto simp add: alts) subsection \Definition of Preference Profiles and Fact Gathering\ preference_profile agents: agents alts: alts where R1 = A1: [c, d], [a, b] A2: [b, d], a, c A3: a, b, [c, d] A4: [a, c], [b, d] and R2 = A1: [a, c], [b, d] A2: [c, d], a, b A3: [b, d], a, c A4: a, b, [c, d] and R3 = A1: [a, b], [c, d] A2: [c, d], [a, b] A3: d, [a, b], c A4: c, a, [b, d] and R4 = A1: [a, b], [c, d] A2: [a, d], [b, c] A3: c, [a, b], d A4: d, c, [a, b] and R5 = A1: [c, d], [a, b] A2: [a, b], [c, d] A3: [a, c], d, b A4: d, [a, b], c and R6 = A1: [a, b], [c, d] A2: [c, d], [a, b] A3: [a, c], [b, d] A4: d, b, a, c and R7 = A1: [a, b], [c, d] A2: [c, d], [a, b] A3: a, c, d, b A4: d, [a, b], c and R8 = A1: [a, b], [c, d] A2: [a, c], [b, d] A3: d, [a, b], c A4: d, c, [a, b] and R9 = A1: [a, b], [c, d] A2: [a, d], c, b A3: d, c, [a, b] A4: [a, b, c], d and R10 = A1: [a, b], [c, d] A2: [c, d], [a, b] A3: [a, c], d, b A4: [b, d], a, c and R11 = A1: [a, b], [c, d] A2: [c, d], [a, b] A3: d, [a, b], c A4: c, a, b, d and R12 = A1: [c, d], [a, b] A2: [a, b], [c, d] A3: [a, c], d, b A4: [a, b, d], c and R13 = A1: [a, c], [b, d] A2: [c, d], a, b A3: [b, d], a, c A4: a, b, d, c and R14 = A1: [a, b], [c, d] A2: d, c, [a, b] A3: [a, b, c], d A4: a, d, c, b and R15 = A1: [a, b], [c, d] A2: [c, d], [a, b] A3: [b, d], a, c A4: a, c, d, b and R16 = A1: [a, b], [c, d] A2: [c, d], [a, b] A3: a, c, d, b A4: [a, b, d], c and R17 = A1: [a, b], [c, d] A2: [c, d], [a, b] A3: [a, c], [b, d] A4: d, [a, b], c and R18 = A1: [a, b], [c, d] A2: [a, d], [b, c] A3: [a, b, c], d A4: d, c, [a, b] and R19 = A1: [a, b], [c, d] A2: [c, d], [a, b] A3: [b, d], a, c A4: [a, c], [b, d] and R20 = A1: [b, d], a, c A2: b, a, [c, d] A3: a, c, [b, d] A4: d, c, [a, b] and R21 = A1: [a, d], c, b A2: d, c, [a, b] A3: c, [a, b], d A4: a, b, [c, d] and R22 = A1: [a, c], d, b A2: d, c, [a, b] A3: d, [a, b], c A4: a, b, [c, d] and R23 = A1: [a, b], [c, d] A2: [c, d], [a, b] A3: [a, c], [b, d] A4: [a, b, d], c and R24 = A1: [c, d], [a, b] A2: d, b, a, c A3: c, a, [b, d] A4: b, a, [c, d] and R25 = A1: [c, d], [a, b] A2: [b, d], a, c A3: a, b, [c, d] A4: a, c, [b, d] and R26 = A1: [b, d], [a, c] A2: [c, d], [a, b] A3: a, b, [c, d] A4: a, c, [b, d] and R27 = A1: [a, b], [c, d] A2: [b, d], a, c A3: [a, c], [b, d] A4: [c, d], a, b and R28 = A1: [c, d], a, b A2: [b, d], a, c A3: a, b, [c, d] A4: a, c, [b, d] and R29 = A1: [a, c], d, b A2: [b, d], a, c A3: a, b, [c, d] A4: d, c, [a, b] and R30 = A1: [a, d], c, b A2: d, c, [a, b] A3: c, [a, b], d A4: [a, b], d, c and R31 = A1: [b, d], a, c A2: [a, c], d, b A3: c, d, [a, b] A4: [a, b], c, d and R32 = A1: [a, c], d, b A2: d, c, [a, b] A3: d, [a, b], c A4: [a, b], d, c and R33 = A1: [c, d], [a, b] A2: [a, c], d, b A3: a, b, [c, d] A4: d, [a, b], c and R34 = A1: [a, b], [c, d] A2: a, c, d, b A3: b, [a, d], c A4: c, d, [a, b] and R35 = A1: [a, d], c, b A2: a, b, [c, d] A3: [a, b, c], d A4: d, c, [a, b] and R36 = A1: [c, d], [a, b] A2: [a, c], d, b A3: [b, d], a, c A4: a, b, [c, d] and R37 = A1: [a, c], [b, d] A2: [b, d], [a, c] A3: a, b, [c, d] A4: c, d, [a, b] and R38 = A1: [c, d], a, b A2: [b, d], a, c A3: a, b, [c, d] A4: [a, c], b, d and R39 = A1: [a, c], d, b A2: [b, d], a, c A3: a, b, [c, d] A4: [c, d], a, b and R40 = A1: [a, d], c, b A2: [a, b], c, d A3: [a, b, c], d A4: d, c, [a, b] and R41 = A1: [a, d], c, b A2: [a, b], d, c A3: [a, b, c], d A4: d, c, [a, b] and R42 = A1: [c, d], [a, b] A2: [a, b], [c, d] A3: d, b, a, c A4: c, a, [b, d] and R43 = A1: [a, b], [c, d] A2: [c, d], [a, b] A3: d, [a, b], c A4: a, [c, d], b and R44 = A1: [c, d], [a, b] A2: [a, c], d, b A3: [a, b], d, c A4: [a, b, d], c and R45 = A1: [a, c], d, b A2: [b, d], a, c A3: [a, b], c, d A4: [c, d], b, a and R46 = A1: [b, d], a, c A2: d, c, [a, b] A3: [a, c], [b, d] A4: b, a, [c, d] and R47 = A1: [a, b], [c, d] A2: [a, d], c, b A3: d, c, [a, b] A4: c, [a, b], d by (simp_all add: agents alts) derive_orbit_equations (an_sds) R10 R26 R27 R28 R29 R43 R45 by simp_all prove_inefficient_supports (ex_post_efficient_sds sd_efficient_sds) R3 [b] and R4 [b] and R5 [b] and R7 [b] and R8 [b] and R9 [b] and R11 [b] and R12 [b] and R14 [b] and R16 [b] and R17 [b] and R18 [b] and R21 [b] and R22 [b] and R23 [b] and R30 [b] and R32 [b] and R33 [b] and R35 [b] and R40 [b] and R41 [b] and R43 [b] and R44 [b] and R47 [b] and R10 [c, b] witness: [a: 1 / 2, b: 0, c: 0, d: 1 / 2] and R15 [c, b] witness: [a: 1 / 2, b: 0, c: 0, d: 1 / 2] and R19 [c, b] witness: [a: 1 / 2, b: 0, c: 0, d: 1 / 2] and R25 [b, c] witness: [c: 0, d: 1 / 2, a: 1 / 2, b: 0] and R26 [c, b] witness: [b: 0, d: 1 / 2, a: 1 / 2, c: 0] and R27 [c, b] witness: [a: 1 / 2, b: 0, c: 0, d: 1 / 2] and R28 [b, c] witness: [c: 0, d: 1 / 2, a: 1 / 2, b: 0] and R29 [b, c] witness: [a: 1 / 2, c: 0, d: 1 / 2, b: 0] and R39 [b, c] witness: [a: 1 / 2, c: 0, d: 1 / 2, b: 0] by (simp_all add: agent_iff alt_iff) derive_strategyproofness_conditions (strategyproof_an_sds) distance: 2 R1 R2 R3 R4 R5 R6 R7 R8 R9 R10 R11 R12 R13 R14 R15 R16 R17 R18 R19 R20 R21 R22 R23 R24 R25 R26 R27 R28 R29 R30 R31 R32 R33 R34 R35 R36 R37 R38 R39 R40 R41 R42 R43 R44 R45 R46 R47 by (simp_all add: agent_iff alt_iff) lemma lottery_conditions: assumes "is_pref_profile R" shows "pmf (sds R) a \ 0" "pmf (sds R) b \ 0" "pmf (sds R) c \ 0" "pmf (sds R) d \ 0" "pmf (sds R) a + pmf (sds R) b + pmf (sds R) c + pmf (sds R) d = 1" using lottery_prob_alts[OF sds_wf[OF assms]] by (simp_all add: alts pmf_nonneg measure_measure_pmf_finite) subsection \Main Proof\ lemma R45 [simp]: "pmf (sds R45) a = 1/4" "pmf (sds R45) b = 1/4" "pmf (sds R45) c = 1/4" "pmf (sds R45) d = 1/4" using R45.orbits lottery_conditions[OF R45.wf] by simp_all lemma R10_bc [simp]: "pmf (sds R10) b = 0" "pmf (sds R10) c = 0" using R10.support R10.orbits by auto lemma R10_ad [simp]: "pmf (sds R10) a = 1/2" "pmf (sds R10) d = 1/2" using lottery_conditions[OF R10.wf] R10_bc R10.orbits by simp_all lemma R26_bc [simp]: "pmf (sds R26) b = 0" "pmf (sds R26) c = 0" using R26.support R26.orbits by auto lemma R26_d [simp]: "pmf (sds R26) d = 1 - pmf (sds R26) a" using lottery_conditions[OF R26.wf] R26_bc by simp lemma R27_bc [simp]: "pmf (sds R27) b = 0" "pmf (sds R27) c = 0" using R27.support R27.orbits by auto lemma R27_d [simp]: "pmf (sds R27) d = 1 - pmf (sds R27) a" using lottery_conditions[OF R27.wf] R27_bc by simp lemma R28_bc [simp]: "pmf (sds R28) b = 0" "pmf (sds R28) c = 0" using R28.support R28.orbits by auto lemma R28_d [simp]: "pmf (sds R28) d = 1 - pmf (sds R28) a" using lottery_conditions[OF R28.wf] R28_bc by simp lemma R29_bc [simp]: "pmf (sds R29) b = 0" "pmf (sds R29) c = 0" using R29.support R29.orbits by auto lemma R29_ac [simp]: "pmf (sds R29) a = 1/2" "pmf (sds R29) d = 1/2" using lottery_conditions[OF R29.wf] R29_bc R29.orbits by simp_all lemmas R43_bc [simp] = R43.support lemma R43_ad [simp]: "pmf (sds R43) a = 1/2" "pmf (sds R43) d = 1/2" using lottery_conditions[OF R43.wf] R43_bc R43.orbits by simp_all lemma R39_b [simp]: "pmf (sds R39) b = 0" proof - { assume [simp]: "pmf (sds R39) c = 0" with R29_R39.strategyproofness(1) have "pmf (sds R39) d \ 1/2" by auto with R39_R29.strategyproofness(1) lottery_conditions[OF R39.wf] have "pmf (sds R39) b = 0" by auto } with R39.support show ?thesis by blast qed lemma R36_a [simp]: "pmf (sds R36) a = 1/2" and R36_b [simp]: "pmf (sds R36) b = 0" proof - from R10_R36.strategyproofness(1) lottery_conditions[OF R36.wf] have "pmf (sds R36) a + pmf (sds R36) b \ 1/2" by auto with R36_R10.strategyproofness(1) lottery_conditions[OF R36.wf] show "pmf (sds R36) a = 1/2" "pmf (sds R36) b = 0" by auto qed lemma R36_d [simp]: "pmf (sds R36) d = 1/2 - pmf (sds R36) c" using lottery_conditions[OF R36.wf] by simp lemma R39_a [simp]: "pmf (sds R39) a = 1/2" proof - from R36_R39.strategyproofness(1) lottery_conditions[OF R39.wf] have "pmf (sds R39) a \ 1/2" by auto with R39_R36.strategyproofness(1) lottery_conditions[OF R39.wf] show ?thesis by auto qed lemma R39_d [simp]: "pmf (sds R39) d = 1/2 - pmf (sds R39) c" using lottery_conditions[OF R39.wf] by simp lemmas R12_b [simp] = R12.support lemma R12_c [simp]: "pmf (sds R12) c = 0" using R12_R10.strategyproofness(1) lottery_conditions[OF R12.wf] by (auto simp del: pmf_nonneg) lemma R12_d [simp]: "pmf (sds R12) d = 1 - pmf (sds R12) a" using lottery_conditions[OF R12.wf] by simp lemma R12_a_ge_one_half: "pmf (sds R12) a \ 1/2" using R10_R12.strategyproofness(1) lottery_conditions[OF R12.wf] by auto lemma R44 [simp]: "pmf (sds R44) a = pmf (sds R12) a" "pmf (sds R44) d = 1 - pmf (sds R12) a" "pmf (sds R44) b = 0" "pmf (sds R44) c = 0" proof - from R12_R44.strategyproofness(1) R44.support have "pmf (sds R44) a \ pmf (sds R12) a" by simp with R44_R12.strategyproofness(1) R44.support lottery_conditions[OF R44.wf] show "pmf (sds R44) a = pmf (sds R12) a" "pmf (sds R44) c = 0" "pmf (sds R44) d = 1 - pmf (sds R12) a" by (auto simp del: pmf_nonneg) qed (insert R44.support, simp_all) lemma R9_a [simp]: "pmf (sds R9) a = pmf (sds R35) a" proof - from R9_R35.strategyproofness(1) R35.support R9.support have "pmf (sds R35) a \ pmf (sds R9) a" by simp with R35_R9.strategyproofness(1) R9.support R35.support show ?thesis by simp qed lemma R18_c [simp]: "pmf (sds R18) c = pmf (sds R9) c" proof - from R18_R9.strategyproofness(1) R18.support R9.support have "pmf (sds R18) d + pmf (sds R18) a \ pmf (sds R9) d + pmf (sds R9) a" by auto with R9_R18.strategyproofness(1) R18.support R9.support lottery_conditions[OF R9.wf] lottery_conditions[OF R18.wf] show ?thesis by auto qed lemma R5_d_ge_one_half: "pmf (sds R5) d \ 1/2" using R5_R10.strategyproofness(1) R5.support lottery_conditions[OF R5.wf] by auto lemma R7 [simp]: "pmf (sds R7) a = 1/2" "pmf (sds R7) b = 0" "pmf (sds R7) c = 0" "pmf (sds R7) d = 1/2" proof - from R5_d_ge_one_half have "1/2 \ pmf (sds R5) d" by simp also from R5_R17.strategyproofness(1) R17.support lottery_conditions[OF R5.wf] lottery_conditions[OF R17.wf] have "\ \ pmf (sds R17) d" by (auto simp del: pmf_nonneg) also from R17_R7.strategyproofness(1) lottery_conditions[OF R7.wf] lottery_conditions[OF R17.wf] R7.support have "pmf (sds R17) d \ pmf (sds R7) d" by (auto simp del: pmf_nonneg) finally have "pmf (sds R7) d \ 1/2" . with R7_R43.strategyproofness(1) lottery_conditions[OF R7.wf] R7.support show "pmf (sds R7) a = 1/2" "pmf (sds R7) b = 0" "pmf (sds R7) c = 0" "pmf (sds R7) d = 1/2" by auto qed lemma R5 [simp]: "pmf (sds R5) a = 1/2" "pmf (sds R5) b = 0" "pmf (sds R5) c = 0" "pmf (sds R5) d = 1/2" proof - from R5_R7.strategyproofness(1) lottery_conditions[OF R5.wf] R5.support have "pmf (sds R5) d \ 1/2" by auto with R5_d_ge_one_half show d: "pmf (sds R5) d = 1 / 2" by simp with R5_R10.strategyproofness(1) lottery_conditions[OF R5.wf] R5.support show "pmf (sds R5) c = 0" "pmf (sds R5) a = 1/2" by simp_all qed (simp_all add: R5.support) lemma R15 [simp]: "pmf (sds R15) a = 1/2" "pmf (sds R15) b = 0" "pmf (sds R15) c = 0" "pmf (sds R15) d = 1/2" proof - { assume "pmf (sds R15) b = 0" with R10_R15.strategyproofness(1) lottery_conditions[OF R15.wf] have "pmf (sds R15) a + pmf (sds R15) c \ 1/2" by auto with R15_R10.strategyproofness(1) lottery_conditions[OF R15.wf] have "pmf (sds R15) c = 0" by auto } with R15.support show [simp]: "pmf (sds R15) c = 0" by blast with R15_R5.strategyproofness(1) lottery_conditions[OF R15.wf] have "pmf (sds R15) a \ 1/2" by auto moreover from R15_R7.strategyproofness(1) lottery_conditions[OF R15.wf] have "pmf (sds R15) b + pmf (sds R15) d \ 1/2" by auto ultimately show "pmf (sds R15) a = 1/2" using lottery_conditions[OF R15.wf] by auto with R15_R5.strategyproofness(1) lottery_conditions[OF R15.wf] show "pmf (sds R15) d = 1/2" "pmf (sds R15) b = 0" by auto qed lemma R13_aux: "pmf (sds R13) b = 0" "pmf (sds R13) c = 0" "pmf (sds R13) d = 1 - pmf (sds R13) a" and R27_R13 [simp]: "pmf (sds R27) a = pmf (sds R13) a" using R27_R13.strategyproofness(1) R13_R27.strategyproofness(1) lottery_conditions[OF R13.wf] by auto lemma R13 [simp]: "pmf (sds R13) a = 1/2" "pmf (sds R13) b = 0" "pmf (sds R13) c = 0" "pmf (sds R13) d = 1/2" using R15_R13.strategyproofness(1) R13_R15.strategyproofness(1) R13_aux by simp_all lemma R27 [simp]: "pmf (sds R27) a = 1/2" "pmf (sds R27) b = 0" "pmf (sds R27) c = 0" "pmf (sds R27) d = 1/2" by simp_all lemma R19 [simp]: "pmf (sds R19) a = 1/2" "pmf (sds R19) b = 0" "pmf (sds R19) c = 0" "pmf (sds R19) d = 1/2" proof - have "pmf (sds R19) a = 1/2 \ pmf (sds R19) b = 0 \ pmf (sds R19) c = 0 \ pmf (sds R19) d = 1/2" proof (rule disjE[OF R19.support]; safe) assume [simp]: "pmf (sds R19) b = 0" from R10_R19.strategyproofness(1) lottery_conditions[OF R19.wf] have "pmf (sds R19) a + pmf (sds R19) c \ 1/2" by auto moreover from R19_R10.strategyproofness(1) have "pmf (sds R19) a + pmf (sds R19) c \ 1/2" by simp ultimately show "pmf (sds R19) d = 1/2" using lottery_conditions[OF R19.wf] by simp with R27_R19.strategyproofness(1) lottery_conditions[OF R19.wf] show "pmf (sds R19) a = 1/2" "pmf (sds R19) c = 0" by auto next assume [simp]: "pmf (sds R19) c = 0" from R19_R10.strategyproofness(1) have "pmf (sds R19) a \ 1/2" by auto moreover from R19_R27.strategyproofness(1) have "pmf (sds R19) d \ 1/2" by auto ultimately show "pmf (sds R19) a = 1/2" "pmf (sds R19) d = 1/2" "pmf (sds R19) b = 0" using lottery_conditions[OF R19.wf] by (auto simp del: pmf_nonneg) qed thus "pmf (sds R19) a = 1/2" "pmf (sds R19) b = 0" "pmf (sds R19) c = 0" "pmf (sds R19) d = 1/2" by blast+ qed lemma R1 [simp]: "pmf (sds R1) a = 1/2" "pmf (sds R1) b = 0" proof - from R19_R1.strategyproofness(1) lottery_conditions[OF R1.wf] have "pmf (sds R1) a + pmf (sds R1) b \ 1/2" by simp with R1_R19.strategyproofness(1) lottery_conditions[OF R1.wf] show "pmf (sds R1) a = 1/2" "pmf (sds R1) b = 0" by auto qed lemma R22 [simp]: "pmf (sds R22) a = 1/2" "pmf (sds R22) b = 0" "pmf (sds R22) c = 0" "pmf (sds R22) d = 1/2" proof - from R33_R5.strategyproofness(1) R33.support have "1/2 \ pmf (sds R33) a" by auto also from R33_R22.strategyproofness(1) R22.support R33.support lottery_conditions[OF R22.wf] lottery_conditions[OF R33.wf] have "\ \ pmf (sds R22) a" by simp finally show "pmf (sds R22) a = 1/2" "pmf (sds R22) b = 0" "pmf (sds R22) c = 0" "pmf (sds R22) d = 1/2" using R22_R29.strategyproofness(1) lottery_conditions[OF R22.wf] by (auto simp del: pmf_nonneg) qed lemma R28 [simp]: "pmf (sds R28) a = 1/2" "pmf (sds R28) b = 0" "pmf (sds R28) c = 0" "pmf (sds R28) d = 1/2" proof - have "pmf (sds R28) a \ pmf (sds R32) d" using R32_R28.strategyproofness(1) lottery_conditions[OF R32.wf] by auto hence R32_d: "pmf (sds R32) d = pmf (sds R28) a" using R28_R32.strategyproofness(1) lottery_conditions[OF R32.wf] by auto from R22_R32.strategyproofness(1) lottery_conditions[OF R32.wf] R32.support have "pmf (sds R32) a \ 1/2" by auto with R32_R22.strategyproofness(1) lottery_conditions[OF R32.wf] R32.support show "pmf (sds R28) a = 1/2" "pmf (sds R28) b = 0" "pmf (sds R28) c = 0" "pmf (sds R28) d = 1/2" by (auto simp: R32_d simp del: pmf_nonneg) qed lemma R39 [simp]: "pmf (sds R39) a = 1/2" "pmf (sds R39) b = 0" "pmf (sds R39) c = 0" "pmf (sds R39) d = 1/2" proof - from R28_R39.strategyproofness(1) show "pmf (sds R39) c = 0" by simp thus "pmf (sds R39) a = 1/2" "pmf (sds R39) b = 0" "pmf (sds R39) d = 1/2" by simp_all qed lemma R2 [simp]: "pmf (sds R2) a = 1/2" "pmf (sds R2) b = 0" "pmf (sds R2) c = 0" "pmf (sds R2) d = 1/2" proof - from R1_R2.strategyproofness(1) R2_R1.strategyproofness(1) lottery_conditions[OF R2.wf] lottery_conditions[OF R1.wf] have "pmf (sds R2) a = 1/2" "pmf (sds R2) c + pmf (sds R2) d = 1/2" by (auto simp: algebra_simps simp del: pmf_nonneg) with R39_R2.strategyproofness(1) lottery_conditions[OF R2.wf] show "pmf (sds R2) a = 1/2" "pmf (sds R2) b = 0" "pmf (sds R2) c = 0" "pmf (sds R2) d = 1/2" by auto qed lemma R42 [simp]: "pmf (sds R42) a = 0" "pmf (sds R42) b = 0" "pmf (sds R42) c = 1/2" "pmf (sds R42) d = 1/2" proof - from R17_R5.strategyproofness(1) lottery_conditions[OF R17.wf] R17.support have "pmf (sds R17) d \ 1/2" by auto moreover from R5_R17.strategyproofness(1) R17.support lottery_conditions[OF R17.wf] have "pmf (sds R17) d \ 1/2" by auto ultimately have R17_d: "pmf (sds R17) d = 1/2" by simp from R6_R42.strategyproofness(1) have "pmf (sds R42) a + pmf (sds R42) c \ pmf (sds R6) a + pmf (sds R6) c" by simp also from R6_R19.strategyproofness(1) lottery_conditions[OF R6.wf] have "pmf (sds R6) a + pmf (sds R6) c \ 1/2" by (auto simp del: pmf_nonneg) finally have "pmf (sds R42) a + pmf (sds R42) c \ 1 / 2" . moreover from R17_R11.strategyproofness(1) R11.support R17.support lottery_conditions[OF R11.wf] lottery_conditions[OF R17.wf] have "pmf (sds R11) d \ 1/2" by (auto simp: R17_d) ultimately have "pmf (sds R42) a + pmf (sds R42) c \ pmf (sds R11) d" by simp with R42_R11.strategyproofness(1) R11.support have E: "pmf (sds R11) d \ pmf (sds R42) c" by auto with \pmf (sds R11) d \ 1/2\ have "pmf (sds R42) c \ 1/2" by simp moreover from R17_R3.strategyproofness(1) R3.support R17.support lottery_conditions[OF R17.wf] lottery_conditions[OF R3.wf] have "pmf (sds R3) d \ 1/2" by (auto simp: R17_d) ultimately show "pmf (sds R42) a = 0" "pmf (sds R42) b = 0" "pmf (sds R42) c = 1/2" "pmf (sds R42) d = 1/2" using R42_R3.strategyproofness(1) lottery_conditions[OF R3.wf] lottery_conditions[OF R42.wf] by linarith+ qed lemma R37 [simp]: "pmf (sds R37) a = 1/2" "pmf (sds R37) b = 0" "pmf (sds R37) c = 1/2" "pmf (sds R37) d = 0" proof - from R37_R42.strategyproofness(1) lottery_conditions[OF R37.wf] have "pmf (sds R37) a = 1/2 \ pmf (sds R37) a + pmf (sds R37) b > 1/2" by (auto simp del: pmf_nonneg) moreover from R37_R42.strategyproofness(2) lottery_conditions[OF R37.wf] have "pmf (sds R37) c = 1/2 \ pmf (sds R37) c + pmf (sds R37) d > 1/2" by (auto simp del: pmf_nonneg) ultimately show "pmf (sds R37) a = 1/2" "pmf (sds R37) b = 0" "pmf (sds R37) c = 1/2" "pmf (sds R37) d = 0" using lottery_conditions[OF R37.wf] by (auto simp del: pmf_nonneg) qed lemma R24 [simp]: "pmf (sds R24) a = 0" "pmf (sds R24) b = 0" "pmf (sds R24) d = 1 - pmf (sds R24) c" using R42_R24.strategyproofness(1) lottery_conditions[OF R24.wf] by (auto simp del: pmf_nonneg) lemma R34 [simp]: "pmf (sds R34) a = 1 - pmf (sds R24) c" "pmf (sds R34) b = pmf (sds R24) c" "pmf (sds R34) c = 0" "pmf (sds R34) d = 0" proof - from R24_R34.strategyproofness(1) lottery_conditions[OF R34.wf] have "pmf (sds R34) b \ pmf (sds R24) c" by (auto simp del: pmf_nonneg) moreover from R34_R24.strategyproofness(1) lottery_conditions[OF R34.wf] have "pmf (sds R34) b \ pmf (sds R24) c" by auto ultimately show bc: "pmf (sds R34) b = pmf (sds R24) c" by simp from R34_R24.strategyproofness(1) bc lottery_conditions[OF R34.wf] show "pmf (sds R34) c = 0" by auto moreover from R24_R34.strategyproofness(1) bc show "pmf (sds R34) d = 0" by simp ultimately show "pmf (sds R34) a = 1 - pmf (sds R24) c" using bc lottery_conditions[OF R34.wf] by auto qed lemma R14 [simp]: "pmf (sds R14) b = 0" "pmf (sds R14) d = 0" "pmf (sds R14) c = 1 - pmf (sds R14) a" using R14_R34.strategyproofness(1) R14.support lottery_conditions[OF R14.wf] by (auto simp del: pmf_nonneg) lemma R46 [simp]: "pmf (sds R46) a = 0" "pmf (sds R46) c = 0" "pmf (sds R46) d = 1 - pmf (sds R46) b" using R46_R37.strategyproofness(1) lottery_conditions[OF R46.wf] by auto lemma R20 [simp]: "pmf (sds R20) a = 0" "pmf (sds R20) c = 0" "pmf (sds R20) d = 1 - pmf (sds R20) b" using R46_R20.strategyproofness(1) lottery_conditions[OF R20.wf] by (auto simp del: pmf_nonneg) lemma R21 [simp]: "pmf (sds R21) d = 1 - pmf (sds R21) a" "pmf (sds R21) b = 0" "pmf (sds R21) c = 0" using R20_R21.strategyproofness(1) lottery_conditions[OF R21.wf] by auto lemma R16_R12: "pmf (sds R16) c + pmf (sds R16) a \ pmf (sds R12) a" using R12_R16.strategyproofness(1) R16.support lottery_conditions[OF R16.wf] by auto lemma R16 [simp]: "pmf (sds R16) b = 0" "pmf (sds R16) c = 0" "pmf (sds R16) d = 1 - pmf (sds R16) a" proof - from R16_R12 have "pmf (sds R16) c + pmf (sds R16) a \ pmf (sds R12) a" by simp also from R44_R40.strategyproofness(1) lottery_conditions[OF R40.wf] R40.support have "pmf (sds R12) a \ pmf (sds R40) a" by auto also from R9_R40.strategyproofness(1) R9.support R40.support have "pmf (sds R40) a \ pmf (sds R9) a" by auto finally have "pmf (sds R16) c + pmf (sds R16) a \ pmf (sds R9) a" by simp moreover from R14_R16.strategyproofness(1) R16.support lottery_conditions[OF R16.wf] have "pmf (sds R16) a \ pmf (sds R14) a" by auto ultimately have "pmf (sds R16) c \ pmf (sds R9) a - pmf (sds R14) a" by simp also from R14_R9.strategyproofness(1) R9.support lottery_conditions[OF R9.wf] have "pmf (sds R9) a - pmf (sds R14) a \ 0" by (auto simp del: pmf_nonneg) finally show "pmf (sds R16) b = 0" "pmf (sds R16) c = 0" "pmf (sds R16) d = 1 - pmf (sds R16) a" using lottery_conditions[OF R16.wf] R16.support by auto qed lemma R12_R14: "pmf (sds R14) a \ pmf (sds R12) a" using R14_R16.strategyproofness(1) R16_R12 by auto lemma R12_a [simp]: "pmf (sds R12) a = pmf (sds R9) a" proof - from R44_R40.strategyproofness(1) R40.support lottery_conditions[OF R40.wf] have "pmf (sds R12) a \ pmf (sds R40) a" by auto also from R9_R40.strategyproofness(1) R9.support R40.support have "pmf (sds R40) a \ pmf (sds R9) a" by auto finally have B: "pmf (sds R12) a \ pmf (sds R9) a" by simp moreover from R14_R9.strategyproofness(1) lottery_conditions[OF R9.wf] R9.support have "pmf (sds R9) a \ pmf (sds R14) a" by (auto simp del: pmf_nonneg) with R12_R14 have "pmf (sds R9) a \ pmf (sds R12) a" by simp ultimately show "pmf (sds R12) a = pmf (sds R9) a" by simp qed lemma R9 [simp]: "pmf (sds R9) b = 0" "pmf (sds R9) d = 0" "pmf (sds R14) a = pmf (sds R35) a" "pmf (sds R9) c = 1 - pmf (sds R35) a" using R12_R14 R14_R9.strategyproofness(1) lottery_conditions[OF R9.wf] R9.support by auto lemma R23 [simp]: "pmf (sds R23) b = 0" "pmf (sds R23) c = 0" "pmf (sds R23) d = 1 - pmf (sds R23) a" using R23_R19.strategyproofness(1) lottery_conditions[OF R23.wf] R23.support by (auto simp del: pmf_nonneg) lemma R35 [simp]: "pmf (sds R35) a = pmf (sds R21) a" "pmf (sds R35) b = 0" "pmf (sds R35) c = 0" "pmf (sds R35) d = 1 - pmf (sds R21) a" proof - from R35_R21.strategyproofness(1) R35.support have "pmf (sds R21) a \ pmf (sds R35) a + pmf (sds R35) c" by auto with R21_R35.strategyproofness(1) R35.support lottery_conditions[OF R35.wf] show "pmf (sds R35) a = pmf (sds R21) a" "pmf (sds R35) b = 0" "pmf (sds R35) c = 0" "pmf (sds R35) d = 1 - pmf (sds R21) a" by simp_all qed lemma R18 [simp]: "pmf (sds R18) a = pmf (sds R14) a" "pmf (sds R18) b = 0" "pmf (sds R18) d = 0" "pmf (sds R18) c = 1 - pmf (sds R14) a" proof - from R23_R12.strategyproofness(1) have R21_R23: "pmf (sds R21) a \ pmf (sds R23) a" by simp from R23_R18.strategyproofness(1) have "pmf (sds R18) d \ pmf (sds R21) a - pmf (sds R23) a" by simp also from R21_R23 have "\ \ 0" by simp finally show "pmf (sds R18) d = 0" by simp with lottery_conditions[OF R18.wf] R18.support show "pmf (sds R18) a = pmf (sds R14) a" "pmf (sds R18) c = 1 - pmf (sds R14) a" by auto qed (insert R18.support, simp_all) lemma R4 [simp]: "pmf (sds R4) a = pmf (sds R21) a" "pmf (sds R4) b = 0" "pmf (sds R4) c = 1 - pmf (sds R4) a" "pmf (sds R4) d = 0" proof - from R30_R21.strategyproofness(1) R30.support lottery_conditions[OF R30.wf] have "pmf (sds R4) c + pmf (sds R21) a \ pmf (sds R4) c + pmf (sds R30) a" by auto also { have "pmf (sds R30) a \ pmf (sds R47) a" using R47_R30.strategyproofness(1) R30.support R47.support lottery_conditions[OF R4.wf] lottery_conditions[OF R47.wf] by auto moreover from R4_R47.strategyproofness(1) R4.support R47.support lottery_conditions[OF R4.wf] lottery_conditions[OF R47.wf] have "pmf (sds R4) c \ pmf (sds R47) c" by simp ultimately have "pmf (sds R4) c + pmf (sds R30) a \ 1 - pmf (sds R47) d" using lottery_conditions[OF R47.wf] R47.support by simp } finally have "pmf (sds R4) c + pmf (sds R14) a \ 1" using lottery_conditions[OF R47.wf] by (auto simp del: pmf_nonneg) with R4_R18.strategyproofness(1) lottery_conditions[OF R4.wf] R4.support show "pmf (sds R4) a = pmf (sds R21) a" "pmf (sds R4) b = 0" "pmf (sds R4) c = 1 - pmf (sds R4) a" "pmf (sds R4) d = 0" by auto qed lemma R8_d [simp]: "pmf (sds R8) d = 1 - pmf (sds R8) a" and R8_c [simp]: "pmf (sds R8) c = 0" and R26_a [simp]: "pmf (sds R26) a = 1 - pmf (sds R8) a" proof - from R8_R26.strategyproofness(2) R8.support lottery_conditions[OF R8.wf] have "pmf (sds R26) a \ pmf (sds R8) d" by auto with R26_R8.strategyproofness(2) R8.support lottery_conditions[OF R8.wf] have "pmf (sds R26) a = pmf (sds R8) d" by auto with R8_R26.strategyproofness(2) R8.support lottery_conditions[OF R8.wf] show "pmf (sds R8) c = 0" "pmf (sds R8) d = 1 - pmf (sds R8) a" "pmf (sds R26) a = 1 - pmf (sds R8) a" by (auto simp del: pmf_nonneg) qed lemma R21_R47: "pmf (sds R21) d \ pmf (sds R47) c" using R4_R47.strategyproofness(1) R4.support R47.support lottery_conditions[OF R4.wf] lottery_conditions[OF R47.wf] by auto lemma R30 [simp]: "pmf (sds R30) a = pmf (sds R47) a" "pmf (sds R30) b = 0" "pmf (sds R30) c = 0" "pmf (sds R30) d = 1 - pmf (sds R47) a" proof - have A: "pmf (sds R30) a \ pmf (sds R47) a" using R47_R30.strategyproofness(1) R30.support R47.support lottery_conditions[OF R4.wf] lottery_conditions[OF R47.wf] by auto with R21_R47 R30_R21.strategyproofness(1) lottery_conditions[OF R30.wf] lottery_conditions[OF R47.wf] show "pmf (sds R30) a = pmf (sds R47) a" "pmf (sds R30) b = 0" "pmf (sds R30) c = 0" "pmf (sds R30) d = 1 - pmf (sds R47) a" by (auto simp: R30.support R47.support simp del: pmf_nonneg) (* tricky step! *) qed lemma R31_c_ge_one_half: "pmf (sds R31) c \ 1/2" proof - from R25.support have "pmf (sds R25) a \ 1/2" proof assume "pmf (sds R25) c = 0" with R25_R36.strategyproofness(1) lottery_conditions[OF R36.wf] show "pmf (sds R25) a \ 1/2" by (auto simp del: pmf_nonneg) next assume [simp]: "pmf (sds R25) b = 0" from R36_R25.strategyproofness(1) lottery_conditions[OF R25.wf] have "pmf (sds R25) c + pmf (sds R25) a \ pmf (sds R36) c + 1 / 2" by auto with R25_R36.strategyproofness(1) show "pmf (sds R25) a \ 1/2" by auto qed hence "pmf (sds R26) a \ 1/2" using R25_R26.strategyproofness(1) lottery_conditions[OF R25.wf] by (auto simp del: pmf_nonneg) with lottery_conditions[OF R47.wf] have "1/2 \ pmf (sds R26) a + pmf (sds R47) d" by (simp del: pmf_nonneg) also have "\ = 1 - pmf (sds R8) a + pmf (sds R47) d" by simp also from R4_R8.strategyproofness(1) have "1 - pmf (sds R8) a \ pmf (sds R21) d" by auto also note R21_R47 also from R30_R41.strategyproofness(1) R41.support lottery_conditions[OF R41.wf] lottery_conditions[OF R47.wf] have "pmf (sds R47) c + pmf (sds R47) d \ pmf (sds R41) d" by (auto simp del: pmf_nonneg) also from R41_R31.strategyproofness(1) R41.support lottery_conditions[OF R31.wf] lottery_conditions[OF R41.wf] have "pmf (sds R41) d \ pmf (sds R31) c" by auto finally show "pmf (sds R31) c \ 1/2" by simp qed lemma R31: "pmf (sds R31) a = 0" "pmf (sds R31) c = 1/2" "pmf (sds R31) b + pmf (sds R31) d = 1/2" proof - from R2_R38.strategyproofness(1) lottery_conditions[OF R38.wf] have A: "pmf (sds R38) b + pmf (sds R38) d \ 1/2" by auto with R31_c_ge_one_half R31_R38.strategyproofness(1) lottery_conditions[OF R31.wf] lottery_conditions[OF R38.wf] have "pmf (sds R38) b + pmf (sds R38) d = pmf (sds R31) d + pmf (sds R31) b" by auto with R31_c_ge_one_half A lottery_conditions[OF R31.wf] lottery_conditions[OF R38.wf] show "pmf (sds R31) a = 0" "pmf (sds R31) c = 1/2" "pmf (sds R31) b + pmf (sds R31) d = 1/2" by linarith+ qed lemma absurd: False using R31 R45_R31.strategyproofness(2) by simp (* TODO (Re-)move *) (* This is just to output a list of all the Strategy-Proofness conditions used in the proof *) (* ML_val \ let val thms = @{thms R1_R2.strategyproofness(1) R1_R19.strategyproofness(1) R2_R1.strategyproofness(1) R2_R38.strategyproofness(1) R4_R8.strategyproofness(1) R4_R18.strategyproofness(1) R4_R47.strategyproofness(1) R5_R7.strategyproofness(1) R5_R10.strategyproofness(1) R5_R17.strategyproofness(1) R6_R19.strategyproofness(1) R6_R42.strategyproofness(1) R7_R43.strategyproofness(1) R8_R26.strategyproofness(2) R9_R18.strategyproofness(1) R9_R35.strategyproofness(1) R9_R40.strategyproofness(1) R10_R12.strategyproofness(1) R10_R15.strategyproofness(1) R10_R19.strategyproofness(1) R10_R36.strategyproofness(1) R12_R10.strategyproofness(1) R12_R16.strategyproofness(1) R12_R44.strategyproofness(1) R13_R15.strategyproofness(1) R13_R27.strategyproofness(1) R14_R9.strategyproofness(1) R14_R16.strategyproofness(1) R14_R34.strategyproofness(1) R15_R5.strategyproofness(1) R15_R7.strategyproofness(1) R15_R10.strategyproofness(1) R15_R13.strategyproofness(1) R17_R3.strategyproofness(1) R17_R5.strategyproofness(1) R17_R7.strategyproofness(1) R17_R11.strategyproofness(1) R18_R9.strategyproofness(1) R19_R1.strategyproofness(1) R19_R10.strategyproofness(1) R19_R27.strategyproofness(1) R20_R21.strategyproofness(1) R21_R35.strategyproofness(1) R22_R29.strategyproofness(1) R22_R32.strategyproofness(1) R23_R12.strategyproofness(1) R23_R18.strategyproofness(1) R23_R19.strategyproofness(1) R24_R34.strategyproofness(1) R25_R26.strategyproofness(1) R25_R36.strategyproofness(1) R26_R8.strategyproofness(2) R27_R13.strategyproofness(1) R27_R19.strategyproofness(1) R28_R32.strategyproofness(1) R28_R39.strategyproofness(1) R29_R39.strategyproofness(1) R30_R21.strategyproofness(1) R30_R41.strategyproofness(1) R31_R38.strategyproofness(1) R32_R22.strategyproofness(1) R32_R28.strategyproofness(1) R33_R5.strategyproofness(1) R33_R22.strategyproofness(1) R34_R24.strategyproofness(1) R35_R9.strategyproofness(1) R35_R21.strategyproofness(1) R36_R10.strategyproofness(1) R36_R25.strategyproofness(1) R36_R39.strategyproofness(1) R37_R42.strategyproofness(1) R37_R42.strategyproofness(2) R39_R2.strategyproofness(1) R39_R29.strategyproofness(1) R39_R36.strategyproofness(1) R41_R31.strategyproofness(1) R42_R3.strategyproofness(1) R42_R11.strategyproofness(1) R42_R24.strategyproofness(1) R44_R12.strategyproofness(1) R44_R40.strategyproofness(1) R45_R31.strategyproofness(2) R46_R20.strategyproofness(1) R46_R37.strategyproofness(1) R47_R30.strategyproofness(1) }; in thms |> map (Pretty.quote o Pretty.str o Pretty.unformatted_string_of o Syntax.pretty_term @{context} o Thm.prop_of) |> Pretty.list "[" "]" |> (fn x => Pretty.block [Pretty.str "thms = ", x]) |> Pretty.string_of |> writeln end \*) end subsection \Lifting to more than 4 agents and alternatives\ (* TODO: Move? *) lemma finite_list': assumes "finite A" obtains xs where "A = set xs" "distinct xs" "length xs = card A" proof - from assms obtain xs where "set xs = A" using finite_list by blast thus ?thesis using distinct_card[of "remdups xs"] by (intro that[of "remdups xs"]) simp_all qed lemma finite_list_subset: assumes "finite A" "card A \ n" obtains xs where "set xs \ A" "distinct xs" "length xs = n" proof - obtain xs where "A = set xs" "distinct xs" "length xs = card A" using finite_list'[OF assms(1)] by blast with assms show ?thesis by (intro that[of "take n xs"]) (simp_all add: set_take_subset) qed lemma card_ge_4E: assumes "finite A" "card A \ 4" obtains a b c d where "distinct [a,b,c,d]" "{a,b,c,d} \ A" proof - from assms obtain xs where xs: "set xs \ A" "distinct xs" "length xs = 4" by (rule finite_list_subset) then obtain a b c d where "xs = [a, b, c, d]" by (auto simp: eval_nat_numeral length_Suc_conv) with xs show ?thesis by (intro that[of a b c d]) simp_all qed context sds_impossibility begin lemma absurd: False proof - from card_ge_4E[OF finite_agents agents_ge_4] obtain A1 A2 A3 A4 where agents: "distinct [A1, A2, A3, A4]" "{A1, A2, A3, A4} \ agents" . from card_ge_4E[OF finite_alts alts_ge_4] obtain a b c d where alts: "distinct [a, b, c, d]" "{a, b, c, d} \ alts" . define agents' alts' where "agents' = {A1,A2,A3,A4}" and "alts' = {a,b,c,d}" from agents alts interpret sds_lowering_anonymous_neutral_sdeff_stratproof agents alts sds agents' alts' unfolding agents'_def alts'_def by unfold_locales simp_all from agents alts interpret sds_impossibility_4_4 agents' alts' lowered A1 A2 A3 A4 a b c d by unfold_locales (simp_all add: agents'_def alts'_def) from absurd show False . qed end end diff --git a/thys/Sturm_Sequences/Examples/Sturm_Ex.thy b/thys/Sturm_Sequences/Examples/Sturm_Ex.thy --- a/thys/Sturm_Sequences/Examples/Sturm_Ex.thy +++ b/thys/Sturm_Sequences/Examples/Sturm_Ex.thy @@ -1,57 +1,57 @@ section \Example usage of the ``sturm'' method\ -(* Author: Manuel Eberl *) +(* Author: Manuel Eberl *) theory Sturm_Ex imports "../Sturm" begin text \ In this section, we give a variety of statements about real polynomials that can b proven by the \emph{sturm} method. \ lemma "\x::real. x^2 + 1 \ 0" by sturm lemma fixes x :: real shows "x^2 + 1 \ 0" by sturm lemma "(x::real) > 1 \ x^3 > 1" by sturm lemma "\x::real. x*x \ -1" by sturm schematic_goal A: "card {x::real. -0.010831 < x \ x < 0.010831 \ 1/120*x^5 + 1/24*x^4 +1/6*x^3 - 49/16777216*x^2 - 17/2097152*x = 0} = ?n" by sturm lemma "card {x::real. x^3 + x = 2*x^2 \ x^3 - 6*x^2 + 11*x = 6} = 1" by sturm schematic_goal "card {x::real. x^3 + x = 2*x^2 \ x^3 - 6*x^2 + 11*x = 6} = ?n" by sturm lemma "card {x::real. -0.010831 < x \ x < 0.010831 \ poly [:0, -17/2097152, -49/16777216, 1/6, 1/24, 1/120:] x = 0} = 3" by sturm lemma "\x::real. x*x \ 0 \ x*x - 1 \ 2*x" by sturm lemma "(x::real)*x+1 \ 0 \ (x^2+1)*(x^2+2) \ 0" by sturm text\3 examples related to continued fraction approximants to exp: LCP\ lemma fixes x::real shows "-7.29347719 \ x \ 0 < x^5 + 30*x^4 + 420*x^3 + 3360*x^2 + 15120*x + 30240" by sturm lemma fixes x::real shows "0 < x^6 + 42*x^5 + 840*x^4 + 10080*x^3 + 75600*x\<^sup>2 + 332640*x + 665280" by sturm schematic_goal "card {x::real. x^7 + 56*x^6 + 1512*x^5 + 25200*x^4 + 277200*x^3 + 1995840*x^2 + 8648640*x = -17297280} = ?n" by sturm end diff --git a/thys/Sturm_Sequences/Lib/Misc_Polynomial.thy b/thys/Sturm_Sequences/Lib/Misc_Polynomial.thy --- a/thys/Sturm_Sequences/Lib/Misc_Polynomial.thy +++ b/thys/Sturm_Sequences/Lib/Misc_Polynomial.thy @@ -1,961 +1,961 @@ -(* Author: Manuel Eberl *) +(* Author: Manuel Eberl *) theory Misc_Polynomial imports "HOL-Computational_Algebra.Polynomial" "HOL-Computational_Algebra.Polynomial_Factorial" "Pure-ex.Guess" begin subsection \Analysis\ lemma fun_eq_in_ivl: assumes "a \ b" "\x::real. a \ x \ x \ b \ eventually (\\. f \ = f x) (at x)" shows "f a = f b" proof (rule connected_local_const) show "connected {a..b}" "a \ {a..b}" "b \ {a..b}" using \a \ b\ by (auto intro: connected_Icc) show "\aa\{a..b}. eventually (\b. f aa = f b) (at aa within {a..b})" proof fix x assume "x \ {a..b}" with assms(2)[rule_format, of x] show "eventually (\b. f x = f b) (at x within {a..b})" by (auto simp: eventually_at_filter elim: eventually_mono) qed qed subsection \Polynomials\ subsubsection \General simplification lemmas\ lemma pderiv_div: assumes [simp]: "q dvd p" "q \ 0" shows "pderiv (p div q) = (q * pderiv p - p * pderiv q) div (q * q)" "q*q dvd (q * pderiv p - p * pderiv q)" proof- from assms obtain r where "p = q * r" unfolding dvd_def by blast hence "q * pderiv p - p * pderiv q = (q * q) * pderiv r" by (simp add: algebra_simps pderiv_mult) thus "q*q dvd (q * pderiv p - p * pderiv q)" by simp note 0 = pderiv_mult[of q "p div q"] have 1: "q * (p div q) = p" by (metis assms(1) assms(2) dvd_def nonzero_mult_div_cancel_left) have f1: "pderiv (p div q) * (q * q) div (q * q) = pderiv (p div q)" by simp have f2: "pderiv p = q * pderiv (p div q) + p div q * pderiv q" by (metis 0 1) have "p * pderiv q = pderiv q * (q * (p div q))" by (metis 1 mult.commute) then have "p * pderiv q = q * (p div q * pderiv q)" by fastforce then have "q * pderiv p - p * pderiv q = q * (q * pderiv (p div q))" using f2 by (metis add_diff_cancel_right' distrib_left) then show "pderiv (p div q) = (q * pderiv p - p * pderiv q) div (q * q)" using f1 by (metis mult.commute mult.left_commute) qed subsubsection \Divisibility of polynomials\ text \ Two polynomials that are coprime have no common roots. \ lemma coprime_imp_no_common_roots: "\ (poly p x = 0 \ poly q x = 0)" if "coprime p q" for x :: "'a :: field" proof clarify assume "poly p x = 0" "poly q x = 0" then have "[:-x, 1:] dvd p" "[:-x, 1:] dvd q" by (simp_all add: poly_eq_0_iff_dvd) with that have "is_unit [:-x, 1:]" by (rule coprime_common_divisor) then show False by (auto simp add: is_unit_pCons_iff) qed lemma poly_div: assumes "poly q x \ 0" and "(q::'a :: field poly) dvd p" shows "poly (p div q) x = poly p x / poly q x" proof- from assms have [simp]: "q \ 0" by force have "poly q x * poly (p div q) x = poly (q * (p div q)) x" by simp also have "q * (p div q) = p" using assms by (simp add: div_mult_swap) finally show "poly (p div q) x = poly p x / poly q x" using assms by (simp add: field_simps) qed (* TODO: make this less ugly *) lemma poly_div_gcd_squarefree_aux: assumes "pderiv (p::('a::{field_char_0,field_gcd}) poly) \ 0" defines "d \ gcd p (pderiv p)" shows "coprime (p div d) (pderiv (p div d))" and "\x. poly (p div d) x = 0 \ poly p x = 0" proof - obtain r s where "bezout_coefficients p (pderiv p) = (r, s)" by (auto simp add: prod_eq_iff) then have "r * p + s * pderiv p = gcd p (pderiv p)" by (rule bezout_coefficients) then have rs: "d = r * p + s * pderiv p" by (simp add: d_def) define t where "t = p div d" define p' where [simp]: "p' = pderiv p" define d' where [simp]: "d' = pderiv d" define u where "u = p' div d" have A: "p = t * d" and B: "p' = u * d" by (simp_all add: t_def u_def d_def algebra_simps) from poly_squarefree_decomp[OF assms(1) A B[unfolded p'_def] rs] show "\x. poly (p div d) x = 0 \ poly p x = 0" by (auto simp: t_def) from rs have C: "s*t*d' = d * (1 - r*t - s*pderiv t)" by (simp add: A B algebra_simps pderiv_mult) from assms have [simp]: "p \ 0" "d \ 0" "t \ 0" by (force, force, subst (asm) A, force) have "\x. \x dvd t; x dvd (pderiv t)\ \ x dvd 1" proof - fix x assume "x dvd t" "x dvd (pderiv t)" then obtain v w where vw: "t = x*v" "pderiv t = x*w" unfolding dvd_def by blast define x' v' where [simp]: "x' = pderiv x" and [simp]: "v' = pderiv v" from vw have "x*v' + v*x' = x*w" by (simp add: pderiv_mult) hence "v*x' = x*(w - v')" by (simp add: algebra_simps) hence "x dvd v*pderiv x" by simp then obtain y where y: "v*x' = x*y" unfolding dvd_def by force from \t \ 0\ and vw have "x \ 0" by simp have x_pow_n_dvd_d: "\n. x^n dvd d" proof- fix n show "x ^ n dvd d" proof (induction n, simp, rename_tac n, case_tac n) fix n assume "n = (0::nat)" from vw and C have "d = x*(d*r*v + d*s*w + s*v*d')" by (simp add: algebra_simps) with \n = 0\ show "x^Suc n dvd d" by (force intro: dvdI) next fix n n' assume IH: "x^n dvd d" and "n = Suc n'" hence [simp]: "Suc n' = n" "x * x^n' = x^n" by simp_all define c :: "'a poly" where "c = [:of_nat n:]" from pderiv_power_Suc[of x n'] have [simp]: "pderiv (x^n) = c*x^n' * x'" unfolding c_def by simp from IH obtain z where d: "d = x^n * z" unfolding dvd_def by blast define z' where [simp]: "z' = pderiv z" from d \d \ 0\ have "x^n \ 0" "z \ 0" by force+ from C d have "x^n*z = z*r*v*x^Suc n + z*s*c*x^n*(v*x') + s*v*z'*x^Suc n + s*z*(v*x')*x^n + s*z*v'*x^Suc n" by (simp add: algebra_simps vw pderiv_mult) also have "... = x^n*x * (z*r*v + z*s*c*y + s*v*z' + s*z*y + s*z*v')" by (simp only: y, simp add: algebra_simps) finally have "z = x*(z*r*v+z*s*c*y+s*v*z'+s*z*y+s*z*v')" using \x^n \ 0\ by force hence "x dvd z" by (metis dvd_triv_left) with d show "x^Suc n dvd d" by simp qed qed have "degree x = 0" proof (cases "degree x", simp) case (Suc n) hence "x \ 0" by auto with Suc have "degree (x ^ (Suc (degree d))) > degree d" by (subst degree_power_eq, simp_all) moreover from x_pow_n_dvd_d[of "Suc (degree d)"] and \d \ 0\ have "degree (x^Suc (degree d)) \ degree d" by (simp add: dvd_imp_degree_le) ultimately show ?thesis by simp qed then obtain c where [simp]: "x = [:c:]" by (cases x, simp split: if_split_asm) moreover from \x \ 0\ have "c \ 0" by simp ultimately show "x dvd 1" using dvdI[of 1 x "[:inverse c:]"] by simp qed then show "coprime t (pderiv t)" by (rule coprimeI) qed lemma normalize_field: "normalize (x :: 'a :: {field,normalization_semidom}) = (if x = 0 then 0 else 1)" by (auto simp: is_unit_normalize dvd_field_iff) lemma normalize_field_eq_1 [simp]: "x \ 0 \ normalize (x :: 'a :: {field,normalization_semidom}) = 1" by (simp add: normalize_field) lemma unit_factor_field [simp]: "unit_factor (x :: 'a :: {field,normalization_semidom}) = x" by (cases "x = 0") (auto simp: is_unit_unit_factor dvd_field_iff) text \ Dividing a polynomial by its gcd with its derivative yields a squarefree polynomial with the same roots. \ lemma poly_div_gcd_squarefree: assumes "(p :: ('a::{field_char_0,field_gcd}) poly) \ 0" defines "d \ gcd p (pderiv p)" shows "coprime (p div d) (pderiv (p div d))" (is ?A) and "\x. poly (p div d) x = 0 \ poly p x = 0" (is "\x. ?B x") proof- have "?A \ (\x. ?B x)" proof (cases "pderiv p = 0") case False from poly_div_gcd_squarefree_aux[OF this] show ?thesis unfolding d_def by auto next case True then obtain c where [simp]: "p = [:c:]" using pderiv_iszero by blast from assms(1) have "c \ 0" by simp from True have "d = smult (inverse c) p" by (simp add: d_def normalize_poly_def map_poly_pCons field_simps) with \p \ 0\ \c \ 0\ have "p div d = [:c:]" by (simp add: pCons_one) with \c \ 0\ show ?thesis by (simp add: normalize_const_poly is_unit_triv) qed thus ?A and "\x. ?B x" by simp_all qed subsubsection \Sign changes of a polynomial\ text \ If a polynomial has different signs at two points, it has a root inbetween. \ lemma poly_different_sign_imp_root: assumes "a < b" and "sgn (poly p a) \ sgn (poly p (b::real))" shows "\x. a \ x \ x \ b \ poly p x = 0" proof (cases "poly p a = 0 \ poly p b = 0") case True thus ?thesis using assms(1) by (elim disjE, rule_tac exI[of _ a], simp, rule_tac exI[of _ b], simp) next case False hence [simp]: "poly p a \ 0" "poly p b \ 0" by simp_all show ?thesis proof (cases "poly p a < 0") case True hence "sgn (poly p a) = -1" by simp with assms True have "poly p b > 0" by (auto simp: sgn_real_def split: if_split_asm) from poly_IVT_pos[OF \a < b\ True this] guess x .. thus ?thesis by (intro exI[of _ x], simp) next case False hence "poly p a > 0" by (simp add: not_less less_eq_real_def) hence "sgn (poly p a) = 1" by simp with assms False have "poly p b < 0" by (auto simp: sgn_real_def not_less less_eq_real_def split: if_split_asm) from poly_IVT_neg[OF \a < b\ \poly p a > 0\ this] guess x .. thus ?thesis by (intro exI[of _ x], simp) qed qed lemma poly_different_sign_imp_root': assumes "sgn (poly p a) \ sgn (poly p (b::real))" shows "\x. poly p x = 0" using assms by (cases "a < b", auto dest!: poly_different_sign_imp_root simp: less_eq_real_def not_less) lemma no_roots_inbetween_imp_same_sign: assumes "a < b" "\x. a \ x \ x \ b \ poly p x \ (0::real)" shows "sgn (poly p a) = sgn (poly p b)" using poly_different_sign_imp_root assms by auto subsubsection \Limits of polynomials\ lemma poly_neighbourhood_without_roots: assumes "(p :: real poly) \ 0" shows "eventually (\x. poly p x \ 0) (at x\<^sub>0)" proof- { fix \ :: real assume "\ > 0" have fin: "finite {x. \x-x\<^sub>0\ < \ \ x \ x\<^sub>0 \ poly p x = 0}" using poly_roots_finite[OF assms] by simp with \\ > 0\have "\\>0. \\\ \ (\x. \x-x\<^sub>0\ < \ \ x \ x\<^sub>0 \ poly p x \ 0)" proof (induction "card {x. \x-x\<^sub>0\ < \ \ x \ x\<^sub>0 \ poly p x = 0}" arbitrary: \ rule: less_induct) case (less \) let ?A = "{x. \x - x\<^sub>0\ < \ \ x \ x\<^sub>0 \ poly p x = 0}" show ?case proof (cases "card ?A") case 0 hence "?A = {}" using less by auto thus ?thesis using less(2) by (rule_tac exI[of _ \], auto) next case (Suc _) with less(3) have "{x. \x - x\<^sub>0\ < \ \ x \ x\<^sub>0 \ poly p x = 0} \ {}" by force then obtain x where x_props: "\x - x\<^sub>0\ < \" "x \ x\<^sub>0" "poly p x = 0" by blast define \' where "\' = \x - x\<^sub>0\ / 2" have "\' > 0" "\' < \" unfolding \'_def using x_props by simp_all from x_props(1,2) and \\ > 0\ have "x \ {x'. \x' - x\<^sub>0\ < \' \ x' \ x\<^sub>0 \ poly p x' = 0}" (is "_ \ ?B") by (auto simp: \'_def) moreover from x_props have "x \ {x. \x - x\<^sub>0\ < \ \ x \ x\<^sub>0 \ poly p x = 0}" by blast ultimately have "?B \ ?A" by auto hence "card ?B < card ?A" "finite ?B" by (rule psubset_card_mono[OF less(3)], blast intro: finite_subset[OF _ less(3)]) from less(1)[OF this(1) \\' > 0\ this(2)] show ?thesis using \\' < \\ by force qed qed } from this[of "1"] show ?thesis by (auto simp: eventually_at dist_real_def) qed lemma poly_neighbourhood_same_sign: assumes "poly p (x\<^sub>0 :: real) \ 0" shows "eventually (\x. sgn (poly p x) = sgn (poly p x\<^sub>0)) (at x\<^sub>0)" proof - have cont: "isCont (\x. sgn (poly p x)) x\<^sub>0" by (rule isCont_sgn, rule poly_isCont, rule assms) then have "eventually (\x. \sgn (poly p x) - sgn (poly p x\<^sub>0)\ < 1) (at x\<^sub>0)" by (auto simp: isCont_def tendsto_iff dist_real_def) then show ?thesis by (rule eventually_mono) (simp add: sgn_real_def split: if_split_asm) qed lemma poly_lhopital: assumes "poly p (x::real) = 0" "poly q x = 0" "q \ 0" assumes "(\x. poly (pderiv p) x / poly (pderiv q) x) \x\ y" shows "(\x. poly p x / poly q x) \x\ y" using assms proof (rule_tac lhopital) have "isCont (poly p) x" "isCont (poly q) x" by simp_all with assms(1,2) show "poly p \x\ 0" "poly q \x\ 0" by (simp_all add: isCont_def) from \q \ 0\ and \poly q x = 0\ have "pderiv q \ 0" by (auto dest: pderiv_iszero) from poly_neighbourhood_without_roots[OF this] show "eventually (\x. poly (pderiv q) x \ 0) (at x)" . qed (auto intro: poly_DERIV poly_neighbourhood_without_roots) lemma poly_roots_bounds: assumes "p \ 0" obtains l u where "l \ (u :: real)" and "poly p l \ 0" and "poly p u \ 0" and "{x. x > l \ x \ u \ poly p x = 0 } = {x. poly p x = 0}" and "\x. x \ l \ sgn (poly p x) = sgn (poly p l)" and "\x. x \ u \ sgn (poly p x) = sgn (poly p u)" proof from assms have "finite {x. poly p x = 0}" (is "finite ?roots") using poly_roots_finite by fast let ?roots' = "insert 0 ?roots" define l where "l = Min ?roots' - 1" define u where "u = Max ?roots' + 1" from \finite ?roots\ have A: "finite ?roots'" by auto from Min_le[OF this, of 0] and Max_ge[OF this, of 0] show "l \ u" by (simp add: l_def u_def) from Min_le[OF A] have l_props: "\x. x\l \ poly p x \ 0" by (fastforce simp: l_def) from Max_ge[OF A] have u_props: "\x. x\u \ poly p x \ 0" by (fastforce simp: u_def) from l_props u_props show [simp]: "poly p l \ 0" "poly p u \ 0" by auto from l_props have "\x. poly p x = 0 \ x > l" by (metis not_le) moreover from u_props have "\x. poly p x = 0 \ x \ u" by (metis linear) ultimately show "{x. x > l \ x \ u \ poly p x = 0} = ?roots" by auto { fix x assume A: "x < l" "sgn (poly p x) \ sgn (poly p l)" with poly_IVT_pos[OF A(1), of p] poly_IVT_neg[OF A(1), of p] A(2) have False by (auto split: if_split_asm simp: sgn_real_def l_props not_less less_eq_real_def) } thus "\x. x \ l \ sgn (poly p x) = sgn (poly p l)" by (case_tac "x = l", auto simp: less_eq_real_def) { fix x assume A: "x > u" "sgn (poly p x) \ sgn (poly p u)" with u_props poly_IVT_neg[OF A(1), of p] poly_IVT_pos[OF A(1), of p] A(2) have False by (auto split: if_split_asm simp: sgn_real_def l_props not_less less_eq_real_def) } thus "\x. x \ u \ sgn (poly p x) = sgn (poly p u)" by (case_tac "x = u", auto simp: less_eq_real_def) qed definition poly_inf :: "('a::real_normed_vector) poly \ 'a" where "poly_inf p \ sgn (coeff p (degree p))" definition poly_neg_inf :: "('a::real_normed_vector) poly \ 'a" where "poly_neg_inf p \ if even (degree p) then sgn (coeff p (degree p)) else -sgn (coeff p (degree p))" lemma poly_inf_0_iff[simp]: "poly_inf p = 0 \ p = 0" "poly_neg_inf p = 0 \ p = 0" by (auto simp: poly_inf_def poly_neg_inf_def sgn_zero_iff) lemma poly_inf_mult[simp]: fixes p :: "('a::real_normed_field) poly" shows "poly_inf (p*q) = poly_inf p * poly_inf q" "poly_neg_inf (p*q) = poly_neg_inf p * poly_neg_inf q" unfolding poly_inf_def poly_neg_inf_def by ((cases "p = 0 \ q = 0",auto simp: sgn_zero_iff degree_mult_eq[of p q] coeff_mult_degree_sum Real_Vector_Spaces.sgn_mult)[])+ lemma poly_neq_0_at_infinity: assumes "(p :: real poly) \ 0" shows "eventually (\x. poly p x \ 0) at_infinity" proof- from poly_roots_bounds[OF assms] guess l u . note lu_props = this define b where "b = max (-l) u" show ?thesis proof (subst eventually_at_infinity, rule exI[of _ b], clarsimp) fix x assume A: "\x\ \ b" and B: "poly p x = 0" show False proof (cases "x \ 0") case True with A have "x \ u" unfolding b_def by simp with lu_props(3, 6) show False by (metis sgn_zero_iff B) next case False with A have "x \ l" unfolding b_def by simp with lu_props(2, 5) show False by (metis sgn_zero_iff B) qed qed qed lemma poly_limit_aux: fixes p :: "real poly" defines "n \ degree p" shows "((\x. poly p x / x ^ n) \ coeff p n) at_infinity" proof (subst filterlim_cong, rule refl, rule refl) show "eventually (\x. poly p x / x^n = (\i\n. coeff p i / x^(n-i))) at_infinity" proof (rule eventually_mono) show "eventually (\x::real. x \ 0) at_infinity" by (simp add: eventually_at_infinity, rule exI[of _ 1], auto) fix x :: real assume [simp]: "x \ 0" show "poly p x / x ^ n = (\i\n. coeff p i / x ^ (n - i))" by (simp add: n_def sum_divide_distrib power_diff poly_altdef) qed let ?a = "\i. if i = n then coeff p n else 0" have "\i\{..n}. ((\x. coeff p i / x ^ (n - i)) \ ?a i) at_infinity" proof fix i assume "i \ {..n}" hence "i \ n" by simp show "((\x. coeff p i / x ^ (n - i)) \ ?a i) at_infinity" proof (cases "i = n") case True thus ?thesis by (intro tendstoI, subst eventually_at_infinity, intro exI[of _ 1], simp add: dist_real_def) next case False hence "n - i > 0" using \i \ n\ by simp from tendsto_inverse_0 and divide_real_def[of 1] have "((\x. 1 / x :: real) \ 0) at_infinity" by simp from tendsto_power[OF this, of "n - i"] have "((\x::real. 1 / x ^ (n - i)) \ 0) at_infinity" using \n - i > 0\ by (simp add: power_0_left power_one_over) from tendsto_mult_right_zero[OF this, of "coeff p i"] have "((\x. coeff p i / x ^ (n - i)) \ 0) at_infinity" by (simp add: field_simps) thus ?thesis using False by simp qed qed hence "((\x. \i\n. coeff p i / x^(n-i)) \ (\i\n. ?a i)) at_infinity" by (force intro!: tendsto_sum) also have "(\i\n. ?a i) = coeff p n" by (subst sum.delta, simp_all) finally show "((\x. \i\n. coeff p i / x^(n-i)) \ coeff p n) at_infinity" . qed lemma poly_at_top_at_top: fixes p :: "real poly" assumes "degree p \ 1" "coeff p (degree p) > 0" shows "LIM x at_top. poly p x :> at_top" proof- let ?n = "degree p" define f g where "f x = poly p x / x^?n" and "g x = x ^ ?n" for x :: real from poly_limit_aux have "(f \ coeff p (degree p)) at_top" using tendsto_mono at_top_le_at_infinity unfolding f_def by blast moreover from assms have "LIM x at_top. g x :> at_top" by (auto simp add: g_def intro!: filterlim_pow_at_top filterlim_ident) ultimately have "LIM x at_top. f x * g x :> at_top" using filterlim_tendsto_pos_mult_at_top assms by simp also have "eventually (\x. f x * g x = poly p x) at_top" unfolding f_def g_def by (subst eventually_at_top_linorder, rule exI[of _ 1], simp add: poly_altdef field_simps sum_distrib_left power_diff) note filterlim_cong[OF refl refl this] finally show ?thesis . qed lemma poly_at_bot_at_top: fixes p :: "real poly" assumes "degree p \ 1" "coeff p (degree p) < 0" shows "LIM x at_top. poly p x :> at_bot" proof- from poly_at_top_at_top[of "-p"] and assms have "LIM x at_top. -poly p x :> at_top" by simp thus ?thesis by (simp add: filterlim_uminus_at_bot) qed lemma poly_lim_inf: "eventually (\x::real. sgn (poly p x) = poly_inf p) at_top" proof (cases "degree p \ 1") case False hence "degree p = 0" by simp then obtain c where "p = [:c:]" by (cases p, auto split: if_split_asm) thus ?thesis by (simp add: eventually_at_top_linorder poly_inf_def) next case True note deg = this let ?lc = "coeff p (degree p)" from True have "?lc \ 0" by force show ?thesis proof (cases "?lc > 0") case True from poly_at_top_at_top[OF deg this] obtain x\<^sub>0 where "\x. x \ x\<^sub>0 \ poly p x \ 1" by (fastforce simp: filterlim_at_top eventually_at_top_linorder less_eq_real_def) hence "\x. x \ x\<^sub>0 \ sgn (poly p x) = 1" by force thus ?thesis by (simp only: eventually_at_top_linorder poly_inf_def, intro exI[of _ x\<^sub>0], simp add: True) next case False hence "?lc < 0" using \?lc \ 0\ by linarith from poly_at_bot_at_top[OF deg this] obtain x\<^sub>0 where "\x. x \ x\<^sub>0 \ poly p x \ -1" by (fastforce simp: filterlim_at_bot eventually_at_top_linorder less_eq_real_def) hence "\x. x \ x\<^sub>0 \ sgn (poly p x) = -1" by force thus ?thesis by (simp only: eventually_at_top_linorder poly_inf_def, intro exI[of _ x\<^sub>0], simp add: \?lc < 0\) qed qed lemma poly_at_top_or_bot_at_bot: fixes p :: "real poly" assumes "degree p \ 1" "coeff p (degree p) > 0" shows "LIM x at_bot. poly p x :> (if even (degree p) then at_top else at_bot)" proof- let ?n = "degree p" define f g where "f x = poly p x / x ^ ?n" and "g x = x ^ ?n" for x :: real from poly_limit_aux have "(f \ coeff p (degree p)) at_bot" using tendsto_mono at_bot_le_at_infinity by (force simp: f_def [abs_def]) moreover from assms have "LIM x at_bot. g x :> (if even (degree p) then at_top else at_bot)" by (auto simp add: g_def split: if_split_asm intro: filterlim_pow_at_bot_even filterlim_pow_at_bot_odd filterlim_ident) ultimately have "LIM x at_bot. f x * g x :> (if even ?n then at_top else at_bot)" by (auto simp: assms intro: filterlim_tendsto_pos_mult_at_top filterlim_tendsto_pos_mult_at_bot) also have "eventually (\x. f x * g x = poly p x) at_bot" unfolding f_def g_def by (subst eventually_at_bot_linorder, rule exI[of _ "-1"], simp add: poly_altdef field_simps sum_distrib_left power_diff) note filterlim_cong[OF refl refl this] finally show ?thesis . qed lemma poly_at_bot_or_top_at_bot: fixes p :: "real poly" assumes "degree p \ 1" "coeff p (degree p) < 0" shows "LIM x at_bot. poly p x :> (if even (degree p) then at_bot else at_top)" proof- from poly_at_top_or_bot_at_bot[of "-p"] and assms have "LIM x at_bot. -poly p x :> (if even (degree p) then at_top else at_bot)" by simp thus ?thesis by (auto simp: filterlim_uminus_at_bot) qed lemma poly_lim_neg_inf: "eventually (\x::real. sgn (poly p x) = poly_neg_inf p) at_bot" proof (cases "degree p \ 1") case False hence "degree p = 0" by simp then obtain c where "p = [:c:]" by (cases p, auto split: if_split_asm) thus ?thesis by (simp add: eventually_at_bot_linorder poly_neg_inf_def) next case True note deg = this let ?lc = "coeff p (degree p)" from True have "?lc \ 0" by force show ?thesis proof (cases "?lc > 0") case True note lc_pos = this show ?thesis proof (cases "even (degree p)") case True from poly_at_top_or_bot_at_bot[OF deg lc_pos] and True obtain x\<^sub>0 where "\x. x \ x\<^sub>0 \ poly p x \ 1" by (fastforce simp add: filterlim_at_top filterlim_at_bot eventually_at_bot_linorder less_eq_real_def) hence "\x. x \ x\<^sub>0 \ sgn (poly p x) = 1" by force thus ?thesis by (simp add: True eventually_at_bot_linorder poly_neg_inf_def, intro exI[of _ x\<^sub>0], simp add: lc_pos) next case False from poly_at_top_or_bot_at_bot[OF deg lc_pos] and False obtain x\<^sub>0 where "\x. x \ x\<^sub>0 \ poly p x \ -1" by (fastforce simp add: filterlim_at_bot eventually_at_bot_linorder less_eq_real_def) hence "\x. x \ x\<^sub>0 \ sgn (poly p x) = -1" by force thus ?thesis by (simp add: False eventually_at_bot_linorder poly_neg_inf_def, intro exI[of _ x\<^sub>0], simp add: lc_pos) qed next case False hence lc_neg: "?lc < 0" using \?lc \ 0\ by linarith show ?thesis proof (cases "even (degree p)") case True with poly_at_bot_or_top_at_bot[OF deg lc_neg] obtain x\<^sub>0 where "\x. x \ x\<^sub>0 \ poly p x \ -1" by (fastforce simp: filterlim_at_bot eventually_at_bot_linorder less_eq_real_def) hence "\x. x \ x\<^sub>0 \ sgn (poly p x) = -1" by force thus ?thesis by (simp only: True eventually_at_bot_linorder poly_neg_inf_def, intro exI[of _ x\<^sub>0], simp add: lc_neg) next case False with poly_at_bot_or_top_at_bot[OF deg lc_neg] obtain x\<^sub>0 where "\x. x \ x\<^sub>0 \ poly p x \ 1" by (fastforce simp: filterlim_at_top eventually_at_bot_linorder less_eq_real_def) hence "\x. x \ x\<^sub>0 \ sgn (poly p x) = 1" by force thus ?thesis by (simp only: False eventually_at_bot_linorder poly_neg_inf_def, intro exI[of _ x\<^sub>0], simp add: lc_neg) qed qed qed subsubsection \Signs of polynomials for sufficiently large values\ lemma polys_inf_sign_thresholds: assumes "finite (ps :: real poly set)" obtains l u where "l \ u" and "\p. \p \ ps; p \ 0\ \ {x. l < x \ x \ u \ poly p x = 0} = {x. poly p x = 0}" and "\p x. \p \ ps; x \ u\ \ sgn (poly p x) = poly_inf p" and "\p x. \p \ ps; x \ l\ \ sgn (poly p x) = poly_neg_inf p" proof goal_cases case prems: 1 have "\l u. l \ u \ (\p x. p \ ps \ x \ u \ sgn (poly p x) = poly_inf p) \ (\p x. p \ ps \ x \ l \ sgn (poly p x) = poly_neg_inf p)" (is "\l u. ?P ps l u") proof (induction rule: finite_subset_induct[OF assms(1), where A = UNIV]) case 1 show ?case by simp next case 2 show ?case by (intro exI[of _ 42], simp) next case prems: (3 p ps) from prems(4) obtain l u where lu_props: "?P ps l u" by blast from poly_lim_inf obtain u' where u'_props: "\x\u'. sgn (poly p x) = poly_inf p" by (force simp add: eventually_at_top_linorder) from poly_lim_neg_inf obtain l' where l'_props: "\x\l'. sgn (poly p x) = poly_neg_inf p" by (force simp add: eventually_at_bot_linorder) show ?case by (rule exI[of _ "min l l'"], rule exI[of _ "max u u'"], insert lu_props l'_props u'_props, auto) qed then obtain l u where lu_props: "l \ u" "\p x. p \ ps \ u \ x \ sgn (poly p x) = poly_inf p" "\p x. p \ ps \ x \ l \ sgn (poly p x) = poly_neg_inf p" by blast moreover { fix p x assume A: "p \ ps" "p \ 0" "poly p x = 0" from A have "l < x" "x < u" by (auto simp: not_le[symmetric] dest: lu_props(2,3)) } note A = this have "\p. p \ ps \ p \ 0 \ {x. l < x \ x \ u \ poly p x = 0} = {x. poly p x = 0}" by (auto dest: A) from prems[OF lu_props(1) this lu_props(2,3)] show thesis . qed subsubsection \Positivity of polynomials\ lemma poly_pos: "(\x::real. poly p x > 0) \ poly_inf p = 1 \ (\x. poly p x \ 0)" proof (intro iffI conjI) assume A: "\x::real. poly p x > 0" have "\x. poly p (x::real) > 0 \ poly p x \ 0" by simp with A show "\x::real. poly p x \ 0" by simp from poly_lim_inf obtain x where "sgn (poly p x) = poly_inf p" by (auto simp: eventually_at_top_linorder) with A show "poly_inf p = 1" by (simp add: sgn_real_def split: if_split_asm) next assume "poly_inf p = 1 \ (\x. poly p x \ 0)" hence A: "poly_inf p = 1" and B: "(\x. poly p x \ 0)" by simp_all from poly_lim_inf obtain x where C: "sgn (poly p x) = poly_inf p" by (auto simp: eventually_at_top_linorder) show "\x. poly p x > 0" proof (rule ccontr) assume "\(\x. poly p x > 0)" then obtain x' where "poly p x' \ 0" by (auto simp: not_less) with A and C have "sgn (poly p x') \ sgn (poly p x)" by (auto simp: sgn_real_def split: if_split_asm) from poly_different_sign_imp_root'[OF this] and B show False by blast qed qed lemma poly_pos_greater: "(\x::real. x > a \ poly p x > 0) \ poly_inf p = 1 \ (\x. x > a \ poly p x \ 0)" proof (intro iffI conjI) assume A: "\x::real. x > a \ poly p x > 0" have "\x. poly p (x::real) > 0 \ poly p x \ 0" by simp with A show "\x::real. x > a \ poly p x \ 0" by auto from poly_lim_inf obtain x\<^sub>0 where "\x\x\<^sub>0. sgn (poly p x) = poly_inf p" by (auto simp: eventually_at_top_linorder) hence "poly_inf p = sgn (poly p (max x\<^sub>0 (a + 1)))" by simp also from A have "... = 1" by force finally show "poly_inf p = 1" . next assume "poly_inf p = 1 \ (\x. x > a \ poly p x \ 0)" hence A: "poly_inf p = 1" and B: "(\x. x > a \ poly p x \ 0)" by simp_all from poly_lim_inf obtain x\<^sub>0 where C: "\x\x\<^sub>0. sgn (poly p x) = poly_inf p" by (auto simp: eventually_at_top_linorder) hence "sgn (poly p (max x\<^sub>0 (a+1))) = poly_inf p" by simp with A have D: "sgn (poly p (max x\<^sub>0 (a+1))) = 1" by simp show "\x. x > a \ poly p x > 0" proof (rule ccontr) assume "\(\x. x > a \ poly p x > 0)" then obtain x' where "x' > a" "poly p x' \ 0" by (auto simp: not_less) with A and D have E: "sgn (poly p x') \ sgn (poly p (max x\<^sub>0(a+1)))" by (auto simp: sgn_real_def split: if_split_asm) show False apply (cases x' "max x\<^sub>0 (a+1)" rule: linorder_cases) using B E \x' > a\ apply (force dest!: poly_different_sign_imp_root[of _ _ p])+ done qed qed lemma poly_pos_geq: "(\x::real. x \ a \ poly p x > 0) \ poly_inf p = 1 \ (\x. x \ a \ poly p x \ 0)" proof (intro iffI conjI) assume A: "\x::real. x \ a \ poly p x > 0" hence "\x::real. x > a \ poly p x > 0" by simp also note poly_pos_greater finally have "poly_inf p = 1" "(\x>a. poly p x \ 0)" by simp_all moreover from A have "poly p a > 0" by simp ultimately show "poly_inf p = 1" "\x\a. poly p x \ 0" by (auto simp: less_eq_real_def) next assume "poly_inf p = 1 \ (\x. x \ a \ poly p x \ 0)" hence A: "poly_inf p = 1" and B: "poly p a \ 0" and C: "\x>a. poly p x \ 0" by simp_all from A and C and poly_pos_greater have "\x>a. poly p x > 0" by simp moreover with B C poly_IVT_pos[of a "a+1" p] have "poly p a > 0" by force ultimately show "\x\a. poly p x > 0" by (auto simp: less_eq_real_def) qed lemma poly_pos_less: "(\x::real. x < a \ poly p x > 0) \ poly_neg_inf p = 1 \ (\x. x < a \ poly p x \ 0)" proof (intro iffI conjI) assume A: "\x::real. x < a \ poly p x > 0" have "\x. poly p (x::real) > 0 \ poly p x \ 0" by simp with A show "\x::real. x < a \ poly p x \ 0" by auto from poly_lim_neg_inf obtain x\<^sub>0 where "\x\x\<^sub>0. sgn (poly p x) = poly_neg_inf p" by (auto simp: eventually_at_bot_linorder) hence "poly_neg_inf p = sgn (poly p (min x\<^sub>0 (a - 1)))" by simp also from A have "... = 1" by force finally show "poly_neg_inf p = 1" . next assume "poly_neg_inf p = 1 \ (\x. x < a \ poly p x \ 0)" hence A: "poly_neg_inf p = 1" and B: "(\x. x < a \ poly p x \ 0)" by simp_all from poly_lim_neg_inf obtain x\<^sub>0 where C: "\x\x\<^sub>0. sgn (poly p x) = poly_neg_inf p" by (auto simp: eventually_at_bot_linorder) hence "sgn (poly p (min x\<^sub>0 (a - 1))) = poly_neg_inf p" by simp with A have D: "sgn (poly p (min x\<^sub>0 (a - 1))) = 1" by simp show "\x. x < a \ poly p x > 0" proof (rule ccontr) assume "\(\x. x < a \ poly p x > 0)" then obtain x' where "x' < a" "poly p x' \ 0" by (auto simp: not_less) with A and D have E: "sgn (poly p x') \ sgn (poly p (min x\<^sub>0 (a - 1)))" by (auto simp: sgn_real_def split: if_split_asm) show False apply (cases x' "min x\<^sub>0 (a - 1)" rule: linorder_cases) using B E \x' < a\ apply (auto dest!: poly_different_sign_imp_root[of _ _ p])+ done qed qed lemma poly_pos_leq: "(\x::real. x \ a \ poly p x > 0) \ poly_neg_inf p = 1 \ (\x. x \ a \ poly p x \ 0)" proof (intro iffI conjI) assume A: "\x::real. x \ a \ poly p x > 0" hence "\x::real. x < a \ poly p x > 0" by simp also note poly_pos_less finally have "poly_neg_inf p = 1" "(\x 0)" by simp_all moreover from A have "poly p a > 0" by simp ultimately show "poly_neg_inf p = 1" "\x\a. poly p x \ 0" by (auto simp: less_eq_real_def) next assume "poly_neg_inf p = 1 \ (\x. x \ a \ poly p x \ 0)" hence A: "poly_neg_inf p = 1" and B: "poly p a \ 0" and C: "\x 0" by simp_all from A and C and poly_pos_less have "\x 0" by simp moreover with B C poly_IVT_neg[of "a - 1" a p] have "poly p a > 0" by force ultimately show "\x\a. poly p x > 0" by (auto simp: less_eq_real_def) qed lemma poly_pos_between_less_less: "(\x::real. a < x \ x < b \ poly p x > 0) \ (a \ b \ poly p ((a+b)/2) > 0) \ (\x. a < x \ x < b \ poly p x \ 0)" proof (intro iffI conjI) assume A: "\x. a < x \ x < b \ poly p x > 0" have "\x. poly p (x::real) > 0 \ poly p x \ 0" by simp with A show "\x::real. a < x \ x < b \ poly p x \ 0" by auto from A show "a \ b \ poly p ((a+b)/2) > 0" by (cases "a < b", auto) next assume "(b \ a \ 0 < poly p ((a+b)/2)) \ (\x. a x poly p x \ 0)" hence A: "b \ a \ 0 < poly p ((a+b)/2)" and B: "\x. a x poly p x \ 0" by simp_all show "\x. a < x \ x < b \ poly p x > 0" proof (cases "a \ b", simp, clarify, rule_tac ccontr, simp only: not_le not_less) fix x assume "a < b" "a < x" "x < b" "poly p x \ 0" with B have "poly p x < 0" by (simp add: less_eq_real_def) moreover from A and \a < b\ have "poly p ((a+b)/2) > 0" by simp ultimately have "sgn (poly p x) \ sgn (poly p ((a+b)/2))" by simp thus False using B apply (cases x "(a+b)/2" rule: linorder_cases) apply (drule poly_different_sign_imp_root[of _ _ p], assumption, insert \a < b\ \a < x\ \x < b\ , force) [] apply simp apply (drule poly_different_sign_imp_root[of _ _ p], simp, insert \a < b\ \a < x\ \x < b\ , force) done qed qed lemma poly_pos_between_less_leq: "(\x::real. a < x \ x \ b \ poly p x > 0) \ (a \ b \ poly p b > 0) \ (\x. a < x \ x \ b \ poly p x \ 0)" proof (intro iffI conjI) assume A: "\x. a < x \ x \ b \ poly p x > 0" have "\x. poly p (x::real) > 0 \ poly p x \ 0" by simp with A show "\x::real. a < x \ x \ b \ poly p x \ 0" by auto from A show "a \ b \ poly p b > 0" by (cases "a < b", auto) next assume "(b \ a \ 0 < poly p b) \ (\x. a x\b \ poly p x \ 0)" hence A: "b \ a \ 0 < poly p b" and B: "\x. a x\b \ poly p x \ 0" by simp_all show "\x. a < x \ x \ b \ poly p x > 0" proof (cases "a \ b", simp, clarify, rule_tac ccontr, simp only: not_le not_less) fix x assume "a < b" "a < x" "x \ b" "poly p x \ 0" with B have "poly p x < 0" by (simp add: less_eq_real_def) moreover from A and \a < b\ have "poly p b > 0" by simp ultimately have "x < b" using \x \ b\ by (auto simp: less_eq_real_def) from \poly p x < 0\ and \poly p b > 0\ have "sgn (poly p x) \ sgn (poly p b)" by simp from poly_different_sign_imp_root[OF \x < b\ this] and B and \x > a\ show False by auto qed qed lemma poly_pos_between_leq_less: "(\x::real. a \ x \ x < b \ poly p x > 0) \ (a \ b \ poly p a > 0) \ (\x. a \ x \ x < b \ poly p x \ 0)" proof (intro iffI conjI) assume A: "\x. a \ x \ x < b \ poly p x > 0" have "\x. poly p (x::real) > 0 \ poly p x \ 0" by simp with A show "\x::real. a \ x \ x < b \ poly p x \ 0" by auto from A show "a \ b \ poly p a > 0" by (cases "a < b", auto) next assume "(b \ a \ 0 < poly p a) \ (\x. a\x \ x poly p x \ 0)" hence A: "b \ a \ 0 < poly p a" and B: "\x. a\x \ x poly p x \ 0" by simp_all show "\x. a \ x \ x < b \ poly p x > 0" proof (cases "a \ b", simp, clarify, rule_tac ccontr, simp only: not_le not_less) fix x assume "a < b" "a \ x" "x < b" "poly p x \ 0" with B have "poly p x < 0" by (simp add: less_eq_real_def) moreover from A and \a < b\ have "poly p a > 0" by simp ultimately have "x > a" using \x \ a\ by (auto simp: less_eq_real_def) from \poly p x < 0\ and \poly p a > 0\ have "sgn (poly p a) \ sgn (poly p x)" by simp from poly_different_sign_imp_root[OF \x > a\ this] and B and \x < b\ show False by auto qed qed lemma poly_pos_between_leq_leq: "(\x::real. a \ x \ x \ b \ poly p x > 0) \ (a > b \ poly p a > 0) \ (\x. a \ x \ x \ b \ poly p x \ 0)" proof (intro iffI conjI) assume A: "\x. a \ x \ x \ b \ poly p x > 0" have "\x. poly p (x::real) > 0 \ poly p x \ 0" by simp with A show "\x::real. a \ x \ x \ b \ poly p x \ 0" by auto from A show "a > b \ poly p a > 0" by (cases "a \ b", auto) next assume "(b < a \ 0 < poly p a) \ (\x. a\x \ x\b \ poly p x \ 0)" hence A: "b < a \ 0 < poly p a" and B: "\x. a\x \ x\b \ poly p x \ 0" by simp_all show "\x. a \ x \ x \ b \ poly p x > 0" proof (cases "a > b", simp, clarify, rule_tac ccontr, simp only: not_le not_less) fix x assume "a \ b" "a \ x" "x \ b" "poly p x \ 0" with B have "poly p x < 0" by (simp add: less_eq_real_def) moreover from A and \a \ b\ have "poly p a > 0" by simp ultimately have "x > a" using \x \ a\ by (auto simp: less_eq_real_def) from \poly p x < 0\ and \poly p a > 0\ have "sgn (poly p a) \ sgn (poly p x)" by simp from poly_different_sign_imp_root[OF \x > a\ this] and B and \x \ b\ show False by auto qed qed end diff --git a/thys/Sturm_Sequences/Sturm.thy b/thys/Sturm_Sequences/Sturm.thy --- a/thys/Sturm_Sequences/Sturm.thy +++ b/thys/Sturm_Sequences/Sturm.thy @@ -1,10 +1,10 @@ (* Title: A Formalisation of Sturm's Theorem - Author: Manuel Eberl - Maintainer: Manuel Eberl + Author: Manuel Eberl + Maintainer: Manuel Eberl *) theory Sturm imports Sturm_Method begin end diff --git a/thys/Sturm_Sequences/Sturm_Method.thy b/thys/Sturm_Sequences/Sturm_Method.thy --- a/thys/Sturm_Sequences/Sturm_Method.thy +++ b/thys/Sturm_Sequences/Sturm_Method.thy @@ -1,583 +1,583 @@ section \The ``sturm'' proof method\ -(* Author: Manuel Eberl *) +(* Author: Manuel Eberl *) theory Sturm_Method imports Sturm_Theorem begin subsection \Preliminary lemmas\ text \ In this subsection, we prove lemmas that reduce root counting and related statements to simple, computable expressions using the @{term "count_roots"} function family. \ lemma poly_card_roots_less_leq: "card {x. a < x \ x \ b \ poly p x = 0} = count_roots_between p a b" by (simp add: count_roots_between_correct) lemma poly_card_roots_leq_leq: "card {x. a \ x \ x \ b \ poly p x = 0} = ( count_roots_between p a b + (if (a \ b \ poly p a = 0 \ p \ 0) \ (a = b \ p = 0) then 1 else 0))" proof (cases "(a \ b \ poly p a = 0 \ p \ 0) \ (a = b \ p = 0)") case False note False' = this thus ?thesis proof (cases "p = 0") case False with False' have "poly p a \ 0 \ a > b" by auto hence "{x. a \ x \ x \ b \ poly p x = 0} = {x. a < x \ x \ b \ poly p x = 0}" by (auto simp: less_eq_real_def) thus ?thesis using poly_card_roots_less_leq False' by (auto split: if_split_asm) next case True have "{x. a \ x \ x \ b} = {a..b}" "{x. a < x \ x \ b} = {a<..b}" by auto with True False have "card {x. a < x \ x \ b} = 0" "card {x. a \ x \ x \ b} = 0" by (auto simp add: card_eq_0_iff infinite_Ioc infinite_Icc) with True False show ?thesis using count_roots_between_correct by (simp add: ) qed next case True note True' = this have fin: "finite {x. a \ x \ x \ b \ poly p x = 0}" proof (cases "p = 0") case True with True' have "a = b" by simp hence "{x. a \ x \ x \ b \ poly p x = 0} = {b}" using True by auto thus ?thesis by simp next case False from poly_roots_finite[OF this] show ?thesis by fast qed with True have "{x. a \ x \ x \ b \ poly p x = 0} = insert a {x. a < x \ x \ b \ poly p x = 0}" by auto hence "card {x. a \ x \ x \ b \ poly p x = 0} = Suc (card {x. a < x \ x \ b \ poly p x = 0})" using fin by force thus ?thesis using True count_roots_between_correct by simp qed lemma poly_card_roots_less_less: "card {x. a < x \ x < b \ poly p x = 0} = ( count_roots_between p a b - (if poly p b = 0 \ a < b \ p \ 0 then 1 else 0))" proof (cases "poly p b = 0 \ a < b \ p \ 0") case False note False' = this show ?thesis proof (cases "p = 0") case True have [simp]: "{x. a < x \ x < b} = {a<.. x \ b} = {a<..b}" by auto with True False have "card {x. a < x \ x \ b} = 0" "card {x. a < x \ x < b} = 0" by (auto simp add: card_eq_0_iff infinite_Ioo infinite_Ioc) with True False' show ?thesis by (auto simp: count_roots_between_correct) next case False with False' have "{x. a < x \ x < b \ poly p x = 0} = {x. a < x \ x \ b \ poly p x = 0}" by (auto simp: less_eq_real_def) thus ?thesis using poly_card_roots_less_leq False by auto qed next case True with poly_roots_finite have fin: "finite {x. a < x \ x < b \ poly p x = 0}" by fast from True have "{x. a < x \ x \ b \ poly p x = 0} = insert b {x. a < x \ x < b \ poly p x = 0}" by auto hence "Suc (card {x. a < x \ x < b \ poly p x = 0}) = card {x. a < x \ x \ b \ poly p x = 0}" using fin by force also note count_roots_between_correct[symmetric] finally show ?thesis using True by simp qed lemma poly_card_roots_leq_less: "card {x::real. a \ x \ x < b \ poly p x = 0} = ( count_roots_between p a b + (if p \ 0 \ a < b \ poly p a = 0 then 1 else 0) - (if p \ 0 \ a < b \ poly p b = 0 then 1 else 0))" proof (cases "p = 0 \ a \ b") case True note True' = this show ?thesis proof (cases "a \ b") case False hence "{x. a < x \ x \ b} = {a<..b}" "{x. a \ x \ x < b} = {a.. x \ b} = 0" "card {x. a \ x \ x < b} = 0" by (auto simp add: card_eq_0_iff infinite_Ico infinite_Ioc) with False True' show ?thesis by (simp add: count_roots_between_correct) next case True with True' have "{x. a \ x \ x < b \ poly p x = 0} = {x. a < x \ x \ b \ poly p x = 0}" by (auto simp: less_eq_real_def) thus ?thesis using poly_card_roots_less_leq True by simp qed next case False let ?A = "{x. a \ x \ x < b \ poly p x = 0}" let ?B = "{x. a < x \ x \ b \ poly p x = 0}" let ?C = "{x. x = b \ poly p x = 0}" let ?D = "{x. x = a \ poly p a = 0}" have CD_if: "?C = (if poly p b = 0 then {b} else {})" "?D = (if poly p a = 0 then {a} else {})" by auto from False poly_roots_finite have [simp]: "finite ?A" "finite ?B" "finite ?C" "finite ?D" by (fast, fast, simp_all) from False have "?A = (?B \ ?D) - ?C" by (auto simp: less_eq_real_def) with False have "card ?A = card ?B + (if poly p a = 0 then 1 else 0) - (if poly p b = 0 then 1 else 0)" by (auto simp: CD_if) also note count_roots_between_correct[symmetric] finally show ?thesis using False by simp qed lemma poly_card_roots: "card {x::real. poly p x = 0} = count_roots p" using count_roots_correct by simp lemma poly_no_roots: "(\x. poly p x \ 0) \ ( p \ 0 \ count_roots p = 0)" by (auto simp: count_roots_correct dest: poly_roots_finite) lemma poly_pos: "(\x. poly p x > 0) \ ( p \ 0 \ poly_inf p = 1 \ count_roots p = 0)" by (simp only: Let_def poly_pos poly_no_roots, blast) lemma poly_card_roots_greater: "card {x::real. x > a \ poly p x = 0} = count_roots_above p a" using count_roots_above_correct by simp lemma poly_card_roots_leq: "card {x::real. x \ a \ poly p x = 0} = count_roots_below p a" using count_roots_below_correct by simp lemma poly_card_roots_geq: "card {x::real. x \ a \ poly p x = 0} = ( count_roots_above p a + (if poly p a = 0 \ p \ 0 then 1 else 0))" proof (cases "poly p a = 0 \ p \ 0") case False hence "card {x. x \ a \ poly p x = 0} = card {x. x > a \ poly p x = 0}" proof (cases rule: disjE) assume "p = 0" have "\finite {a<.. {x. x \ a \ poly p x = 0}" "{a<.. {x. x > a \ poly p x = 0}" using \p = 0\ by auto ultimately have "\finite {x. x \ a \ poly p x = 0}" "\finite {x. x > a \ poly p x = 0}" by (auto dest!: finite_subset[of "{a<.. 0" hence "{x. x \ a \ poly p x = 0} = {x. x > a \ poly p x = 0}" by (auto simp: less_eq_real_def) thus ?thesis by simp qed auto thus ?thesis using False by (auto intro: poly_card_roots_greater) next case True hence "finite {x. x > a \ poly p x = 0}" using poly_roots_finite by force moreover have "{x. x \ a \ poly p x = 0} = insert a {x. x > a \ poly p x = 0}" using True by auto ultimately have "card {x. x \ a \ poly p x = 0} = Suc (card {x. x > a \ poly p x = 0})" using card_insert_disjoint by auto thus ?thesis using True by (auto intro: poly_card_roots_greater) qed lemma poly_card_roots_less: "card {x::real. x < a \ poly p x = 0} = (count_roots_below p a - (if poly p a = 0 \ p \ 0 then 1 else 0))" proof (cases "poly p a = 0 \ p \ 0") case False hence "card {x. x < a \ poly p x = 0} = card {x. x \ a \ poly p x = 0}" proof (cases rule: disjE) assume "p = 0" have "\finite {a - 1<.. {x. x \ a \ poly p x = 0}" "{a - 1<.. {x. x < a \ poly p x = 0}" using \p = 0\ by auto ultimately have "\finite {x. x \ a \ poly p x = 0}" "\finite {x. x < a \ poly p x = 0}" by (auto dest: finite_subset[of "{a - 1<.. 0" hence "{x. x < a \ poly p x = 0} = {x. x \ a \ poly p x = 0}" by (auto simp: less_eq_real_def) thus ?thesis by simp qed auto thus ?thesis using False by (auto intro: poly_card_roots_leq) next case True hence "finite {x. x < a \ poly p x = 0}" using poly_roots_finite by force moreover have "{x. x \ a \ poly p x = 0} = insert a {x. x < a \ poly p x = 0}" using True by auto ultimately have "Suc (card {x. x < a \ poly p x = 0}) = (card {x. x \ a \ poly p x = 0})" using card_insert_disjoint by auto also note count_roots_below_correct[symmetric] finally show ?thesis using True by simp qed lemma poly_no_roots_less_leq: "(\x. a < x \ x \ b \ poly p x \ 0) \ ((a \ b \ (p \ 0 \ count_roots_between p a b = 0)))" by (auto simp: count_roots_between_correct card_eq_0_iff not_le dest: poly_roots_finite) lemma poly_pos_between_less_leq: "(\x. a < x \ x \ b \ poly p x > 0) \ ((a \ b \ (p \ 0 \ poly p b > 0 \ count_roots_between p a b = 0)))" by (simp only: poly_pos_between_less_leq Let_def poly_no_roots_less_leq, blast) lemma poly_no_roots_leq_leq: "(\x. a \ x \ x \ b \ poly p x \ 0) \ ((a > b \ (p \ 0 \ poly p a \ 0 \ count_roots_between p a b = 0)))" apply (intro iffI) apply (force simp add: count_roots_between_correct card_eq_0_iff) apply (elim conjE disjE, simp, intro allI) apply (rename_tac x, case_tac "x = a") apply (auto simp add: count_roots_between_correct card_eq_0_iff dest: poly_roots_finite) done lemma poly_pos_between_leq_leq: "(\x. a \ x \ x \ b \ poly p x > 0) \ ((a > b \ (p \ 0 \ poly p a > 0 \ count_roots_between p a b = 0)))" by (simp only: poly_pos_between_leq_leq Let_def poly_no_roots_leq_leq, force) lemma poly_no_roots_less_less: "(\x. a < x \ x < b \ poly p x \ 0) \ ((a \ b \ p \ 0 \ count_roots_between p a b = (if poly p b = 0 then 1 else 0)))" proof (standard, goal_cases) case A: 1 show ?case proof (cases "a \ b") case True with A show ?thesis by simp next case False with A have [simp]: "p \ 0" using dense[of a b] by auto have B: "{x. a < x \ x \ b \ poly p x = 0} = {x. a < x \ x < b \ poly p x = 0} \ (if poly p b = 0 then {b} else {})" using A False by auto have "count_roots_between p a b = card {x. a < x \ x < b \ poly p x = 0} + (if poly p b = 0 then 1 else 0)" by (subst count_roots_between_correct, subst B, subst card_Un_disjoint, rule finite_subset[OF _ poly_roots_finite], blast, simp_all) also from A have "{x. a < x \ x < b \ poly p x = 0} = {}" by simp finally show ?thesis by auto qed next case prems: 2 hence "card {x. a < x \ x < b \ poly p x = 0} = 0" by (subst poly_card_roots_less_less, auto simp: count_roots_between_def) thus ?case using prems by (cases "p = 0", simp, subst (asm) card_eq_0_iff, auto dest: poly_roots_finite) qed lemma poly_pos_between_less_less: "(\x. a < x \ x < b \ poly p x > 0) \ ((a \ b \ (p \ 0 \ poly p ((a+b)/2) > 0 \ count_roots_between p a b = (if poly p b = 0 then 1 else 0))))" by (simp only: poly_pos_between_less_less Let_def poly_no_roots_less_less, blast) lemma poly_no_roots_leq_less: "(\x. a \ x \ x < b \ poly p x \ 0) \ ((a \ b \ p \ 0 \ poly p a \ 0 \ count_roots_between p a b = (if a < b \ poly p b = 0 then 1 else 0)))" proof (standard, goal_cases) case prems: 1 hence "\x. a < x \ x < b \ poly p x \ 0" by simp thus ?case using prems by (subst (asm) poly_no_roots_less_less, auto) next case prems: 2 hence "(b \ a \ p \ 0 \ count_roots_between p a b = (if poly p b = 0 then 1 else 0))" by auto thus ?case using prems unfolding Let_def by (subst (asm) poly_no_roots_less_less[symmetric, unfolded Let_def], auto split: if_split_asm simp: less_eq_real_def) qed lemma poly_pos_between_leq_less: "(\x. a \ x \ x < b \ poly p x > 0) \ ((a \ b \ (p \ 0 \ poly p a > 0 \ count_roots_between p a b = (if a < b \ poly p b = 0 then 1 else 0))))" by (simp only: poly_pos_between_leq_less Let_def poly_no_roots_leq_less, force) lemma poly_no_roots_greater: "(\x. x > a \ poly p x \ 0) \ ((p \ 0 \ count_roots_above p a = 0))" proof- have "\x. \ a < x \ False" by (metis gt_ex) thus ?thesis by (auto simp: count_roots_above_correct card_eq_0_iff intro: poly_roots_finite ) qed lemma poly_pos_greater: "(\x. x > a \ poly p x > 0) \ ( p \ 0 \ poly_inf p = 1 \ count_roots_above p a = 0)" unfolding Let_def by (subst poly_pos_greater, subst poly_no_roots_greater, force) lemma poly_no_roots_leq: "(\x. x \ a \ poly p x \ 0) \ ( (p \ 0 \ count_roots_below p a = 0))" by (auto simp: Let_def count_roots_below_correct card_eq_0_iff intro: poly_roots_finite) lemma poly_pos_leq: "(\x. x \ a \ poly p x > 0) \ ( p \ 0 \ poly_neg_inf p = 1 \ count_roots_below p a = 0)" by (simp only: poly_pos_leq Let_def poly_no_roots_leq, blast) lemma poly_no_roots_geq: "(\x. x \ a \ poly p x \ 0) \ ( (p \ 0 \ poly p a \ 0 \ count_roots_above p a = 0))" proof (standard, goal_cases) case prems: 1 hence "\x>a. poly p x \ 0" by simp thus ?case using prems by (subst (asm) poly_no_roots_greater, auto) next case prems: 2 hence "(p \ 0 \ count_roots_above p a = 0)" by simp thus ?case using prems by (subst (asm) poly_no_roots_greater[symmetric, unfolded Let_def], auto simp: less_eq_real_def) qed lemma poly_pos_geq: "(\x. x \ a \ poly p x > 0) \ (p \ 0 \ poly_inf p = 1 \ poly p a \ 0 \ count_roots_above p a = 0)" by (simp only: poly_pos_geq Let_def poly_no_roots_geq, blast) lemma poly_no_roots_less: "(\x. x < a \ poly p x \ 0) \ ((p \ 0 \ count_roots_below p a = (if poly p a = 0 then 1 else 0)))" proof (standard, goal_cases) case prems: 1 hence "{x. x \ a \ poly p x = 0} = (if poly p a = 0 then {a} else {})" by (auto simp: less_eq_real_def) moreover have "\x. \ x < a \ False" by (metis lt_ex) ultimately show ?case using prems by (auto simp: count_roots_below_correct) next case prems: 2 have A: "{x. x \ a \ poly p x = 0} = {x. x < a \ poly p x = 0} \ (if poly p a = 0 then {a} else {})" by (auto simp: less_eq_real_def) have "count_roots_below p a = card {x. x < a \ poly p x = 0} + (if poly p a = 0 then 1 else 0)" using prems by (subst count_roots_below_correct, subst A, subst card_Un_disjoint, auto intro: poly_roots_finite) with prems have "card {x. x < a \ poly p x = 0} = 0" by simp thus ?case using prems by (subst (asm) card_eq_0_iff, auto intro: poly_roots_finite) qed lemma poly_pos_less: "(\x. x < a \ poly p x > 0) \ (p \ 0 \ poly_neg_inf p = 1 \ count_roots_below p a = (if poly p a = 0 then 1 else 0))" by (simp only: poly_pos_less Let_def poly_no_roots_less, blast) lemmas sturm_card_substs = poly_card_roots poly_card_roots_less_leq poly_card_roots_leq_less poly_card_roots_less_less poly_card_roots_leq_leq poly_card_roots_less poly_card_roots_leq poly_card_roots_greater poly_card_roots_geq lemmas sturm_prop_substs = poly_no_roots poly_no_roots_less_leq poly_no_roots_leq_leq poly_no_roots_less_less poly_no_roots_leq_less poly_no_roots_leq poly_no_roots_less poly_no_roots_geq poly_no_roots_greater poly_pos poly_pos_greater poly_pos_geq poly_pos_less poly_pos_leq poly_pos_between_leq_less poly_pos_between_less_leq poly_pos_between_leq_leq poly_pos_between_less_less subsection \Reification\ text \ This subsection defines a number of equations to automatically convert statements about roots of polynomials into a canonical form so that they can be proven using the above substitutions. \ definition "PR_TAG x \ x" lemma sturm_id_PR_prio0: "{x::real. P x} = {x::real. (PR_TAG P) x}" "(\x::real. f x < g x) = (\x::real. PR_TAG (\x. f x < g x) x)" "(\x::real. P x) = (\x::real. \(PR_TAG (\x. \P x)) x)" by (simp_all add: PR_TAG_def) lemma sturm_id_PR_prio1: "{x::real. x < a \ P x} = {x::real. x < a \ (PR_TAG P) x}" "{x::real. x \ a \ P x} = {x::real. x \ a \ (PR_TAG P) x}" "{x::real. x \ b \ P x} = {x::real. x \ b \ (PR_TAG P) x}" "{x::real. x > b \ P x} = {x::real. x > b \ (PR_TAG P) x}" "(\x::real < a. f x < g x) = (\x::real < a. PR_TAG (\x. f x < g x) x)" "(\x::real \ a. f x < g x) = (\x::real \ a. PR_TAG (\x. f x < g x) x)" "(\x::real > a. f x < g x) = (\x::real > a. PR_TAG (\x. f x < g x) x)" "(\x::real \ a. f x < g x) = (\x::real \ a. PR_TAG (\x. f x < g x) x)" "(\x::real < a. P x) = (\x::real < a. \(PR_TAG (\x. \P x)) x)" "(\x::real > a. P x) = (\x::real > a. \(PR_TAG (\x. \P x)) x)" "(\x::real \ a. P x) = (\x::real \ a. \(PR_TAG (\x. \P x)) x)" "(\x::real \ a. P x) = (\x::real \ a. \(PR_TAG (\x. \P x)) x)" by (simp_all add: PR_TAG_def) lemma sturm_id_PR_prio2: "{x::real. x > a \ x \ b \ P x} = {x::real. x > a \ x \ b \ PR_TAG P x}" "{x::real. x \ a \ x \ b \ P x} = {x::real. x \ a \ x \ b \ PR_TAG P x}" "{x::real. x \ a \ x < b \ P x} = {x::real. x \ a \ x < b \ PR_TAG P x}" "{x::real. x > a \ x < b \ P x} = {x::real. x > a \ x < b \ PR_TAG P x}" "(\x::real. a < x \ x \ b \ f x < g x) = (\x::real. a < x \ x \ b \ PR_TAG (\x. f x < g x) x)" "(\x::real. a \ x \ x \ b \ f x < g x) = (\x::real. a \ x \ x \ b \ PR_TAG (\x. f x < g x) x)" "(\x::real. a < x \ x < b \ f x < g x) = (\x::real. a < x \ x < b \ PR_TAG (\x. f x < g x) x)" "(\x::real. a \ x \ x < b \ f x < g x) = (\x::real. a \ x \ x < b \ PR_TAG (\x. f x < g x) x)" "(\x::real. a < x \ x \ b \ P x) = (\x::real. a < x \ x \ b \ \(PR_TAG (\x. \P x)) x)" "(\x::real. a \ x \ x \ b \ P x) = (\x::real. a \ x \ x \ b \ \(PR_TAG (\x. \P x)) x)" "(\x::real. a \ x \ x < b \ P x) = (\x::real. a \ x \ x < b \ \(PR_TAG (\x. \P x)) x)" "(\x::real. a < x \ x < b \ P x) = (\x::real. a < x \ x < b \ \(PR_TAG (\x. \P x)) x)" by (simp_all add: PR_TAG_def) lemma PR_TAG_intro_prio0: fixes P :: "real \ bool" and f :: "real \ real" shows "PR_TAG P = P' \ PR_TAG (\x. \(\P x)) = P'" "\PR_TAG P = (\x. poly p x = 0); PR_TAG Q = (\x. poly q x = 0)\ \ PR_TAG (\x. P x \ Q x) = (\x. poly (gcd p q) x = 0)" and " \PR_TAG P = (\x. poly p x = 0); PR_TAG Q = (\x. poly q x = 0)\ \ PR_TAG (\x. P x \ Q x) = (\x. poly (p*q) x = 0)" and "\PR_TAG f = (\x. poly p x); PR_TAG g = (\x. poly q x)\ \ PR_TAG (\x. f x = g x) = (\x. poly (p-q) x = 0)" "\PR_TAG f = (\x. poly p x); PR_TAG g = (\x. poly q x)\ \ PR_TAG (\x. f x \ g x) = (\x. poly (p-q) x \ 0)" "\PR_TAG f = (\x. poly p x); PR_TAG g = (\x. poly q x)\ \ PR_TAG (\x. f x < g x) = (\x. poly (q-p) x > 0)" "\PR_TAG f = (\x. poly p x); PR_TAG g = (\x. poly q x)\ \ PR_TAG (\x. f x \ g x) = (\x. poly (q-p) x \ 0)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. -f x) = (\x. poly (-p) x)" "\PR_TAG f = (\x. poly p x); PR_TAG g = (\x. poly q x)\ \ PR_TAG (\x. f x + g x) = (\x. poly (p+q) x)" "\PR_TAG f = (\x. poly p x); PR_TAG g = (\x. poly q x)\ \ PR_TAG (\x. f x - g x) = (\x. poly (p-q) x)" "\PR_TAG f = (\x. poly p x); PR_TAG g = (\x. poly q x)\ \ PR_TAG (\x. f x * g x) = (\x. poly (p*q) x)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. (f x)^n) = (\x. poly (p^n) x)" "PR_TAG (\x. poly p x :: real) = (\x. poly p x)" "PR_TAG (\x. x::real) = (\x. poly [:0,1:] x)" "PR_TAG (\x. a::real) = (\x. poly [:a:] x)" by (simp_all add: PR_TAG_def poly_eq_0_iff_dvd field_simps) lemma PR_TAG_intro_prio1: fixes f :: "real \ real" shows "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. f x = 0) = (\x. poly p x = 0)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. f x \ 0) = (\x. poly p x \ 0)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. 0 = f x) = (\x. poly p x = 0)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. 0 \ f x) = (\x. poly p x \ 0)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. f x \ 0) = (\x. poly p x \ 0)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. f x > 0) = (\x. poly p x > 0)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. f x \ 0) = (\x. poly (-p) x \ 0)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. f x < 0) = (\x. poly (-p) x > 0)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. 0 \ f x) = (\x. poly (-p) x \ 0)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. 0 < f x) = (\x. poly (-p) x < 0)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. a * f x) = (\x. poly (smult a p) x)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. f x * a) = (\x. poly (smult a p) x)" "PR_TAG f = (\x. poly p x) \ PR_TAG (\x. f x / a) = (\x. poly (smult (inverse a) p) x)" "PR_TAG (\x. x^n :: real) = (\x. poly (monom 1 n) x)" by (simp_all add: PR_TAG_def field_simps poly_monom) lemma PR_TAG_intro_prio2: "PR_TAG (\x. 1 / b) = (\x. inverse b)" "PR_TAG (\x. a / b) = (\x. a / b)" "PR_TAG (\x. a / b * x^n :: real) = (\x. poly (monom (a/b) n) x)" "PR_TAG (\x. x^n * a / b :: real) = (\x. poly (monom (a/b) n) x)" "PR_TAG (\x. a * x^n :: real) = (\x. poly (monom a n) x)" "PR_TAG (\x. x^n * a :: real) = (\x. poly (monom a n) x)" "PR_TAG (\x. x^n / a :: real) = (\x. poly (monom (inverse a) n) x)" (* TODO: can this be done more efficiently? I should think so. *) "PR_TAG (\x. f x^(Suc (Suc 0)) :: real) = (\x. poly p x) \ PR_TAG (\x. f x * f x :: real) = (\x. poly p x)" "PR_TAG (\x. (f x)^Suc n :: real) = (\x. poly p x) \ PR_TAG (\x. (f x)^n * f x :: real) = (\x. poly p x)" "PR_TAG (\x. (f x)^Suc n :: real) = (\x. poly p x) \ PR_TAG (\x. f x * (f x)^n :: real) = (\x. poly p x)" "PR_TAG (\x. (f x)^(m+n) :: real) = (\x. poly p x) \ PR_TAG (\x. (f x)^m * (f x)^n :: real) = (\x. poly p x)" by (simp_all add: PR_TAG_def field_simps poly_monom power_add) lemma sturm_meta_spec: "(\x::real. P x) \ P x" by simp lemma sturm_imp_conv: "(a < x \ x < b \ c) \ (a < x \ x < b \ c)" "(a \ x \ x < b \ c) \ (a \ x \ x < b \ c)" "(a < x \ x \ b \ c) \ (a < x \ x \ b \ c)" "(a \ x \ x \ b \ c) \ (a \ x \ x \ b \ c)" "(x < b \ a < x \ c) \ (a < x \ x < b \ c)" "(x < b \ a \ x \ c) \ (a \ x \ x < b \ c)" "(x \ b \ a < x \ c) \ (a < x \ x \ b \ c)" "(x \ b \ a \ x \ c) \ (a \ x \ x \ b \ c)" by auto subsection \Setup for the ``sturm'' method\ ML_file \sturm.ML\ method_setup sturm = \ Scan.succeed (fn ctxt => SIMPLE_METHOD' (Sturm.sturm_tac ctxt true)) \ end diff --git a/thys/Sturm_Sequences/Sturm_Theorem.thy b/thys/Sturm_Sequences/Sturm_Theorem.thy --- a/thys/Sturm_Sequences/Sturm_Theorem.thy +++ b/thys/Sturm_Sequences/Sturm_Theorem.thy @@ -1,1785 +1,1785 @@ section \Proof of Sturm's Theorem\ -(* Author: Manuel Eberl *) +(* Author: Manuel Eberl *) theory Sturm_Theorem imports "HOL-Computational_Algebra.Polynomial" "Lib/Sturm_Library" "HOL-Computational_Algebra.Field_as_Ring" begin subsection \Sign changes of polynomial sequences\ text \ For a given sequence of polynomials, this function computes the number of sign changes of the sequence of polynomials evaluated at a given position $x$. A sign change is a change from a negative value to a positive one or vice versa; zeros in the sequence are ignored. \ definition sign_changes where "sign_changes ps (x::real) = length (remdups_adj (filter (\x. x \ 0) (map (\p. sgn (poly p x)) ps))) - 1" text \ The number of sign changes of a sequence distributes over a list in the sense that the number of sign changes of a sequence $p_1, \ldots, p_i, \ldots, p_n$ at $x$ is the same as the sum of the sign changes of the sequence $p_1, \ldots, p_i$ and $p_i, \ldots, p_n$ as long as $p_i(x)\neq 0$. \ lemma sign_changes_distrib: "poly p x \ 0 \ sign_changes (ps\<^sub>1 @ [p] @ ps\<^sub>2) x = sign_changes (ps\<^sub>1 @ [p]) x + sign_changes ([p] @ ps\<^sub>2) x" by (simp add: sign_changes_def sgn_zero_iff, subst remdups_adj_append, simp) text \ The following two congruences state that the number of sign changes is the same if all the involved signs are the same. \ lemma sign_changes_cong: assumes "length ps = length ps'" assumes "\i < length ps. sgn (poly (ps!i) x) = sgn (poly (ps'!i) y)" shows "sign_changes ps x = sign_changes ps' y" proof- from assms(2) have A: "map (\p. sgn (poly p x)) ps = map (\p. sgn (poly p y)) ps'" proof (induction rule: list_induct2[OF assms(1)]) case 1 then show ?case by simp next case (2 p ps p' ps') from 2(3) have "\ip \ set ps. sgn (poly p x) = sgn (poly p y)" shows "sign_changes ps x = sign_changes ps y" using assms by (intro sign_changes_cong, simp_all) text \ For a sequence of polynomials of length 3, if the first and the third polynomial have opposite and nonzero sign at some $x$, the number of sign changes is always 1, irrespective of the sign of the second polynomial. \ lemma sign_changes_sturm_triple: assumes "poly p x \ 0" and "sgn (poly r x) = - sgn (poly p x)" shows "sign_changes [p,q,r] x = 1" unfolding sign_changes_def by (insert assms, auto simp: sgn_real_def) text \ Finally, we define two additional functions that count the sign changes ``at infinity''. \ definition sign_changes_inf where "sign_changes_inf ps = length (remdups_adj (filter (\x. x \ 0) (map poly_inf ps))) - 1" definition sign_changes_neg_inf where "sign_changes_neg_inf ps = length (remdups_adj (filter (\x. x \ 0) (map poly_neg_inf ps))) - 1" subsection \Definition of Sturm sequences locale\ text \ We first define the notion of a ``Quasi-Sturm sequence'', which is a weakening of a Sturm sequence that captures the properties that are fulfilled by a nonempty suffix of a Sturm sequence: \begin{itemize} \item The sequence is nonempty. \item The last polynomial does not change its sign. \item If the middle one of three adjacent polynomials has a root at $x$, the other two have opposite and nonzero signs at $x$. \end{itemize} \ locale quasi_sturm_seq = fixes ps :: "(real poly) list" assumes last_ps_sgn_const[simp]: "\x y. sgn (poly (last ps) x) = sgn (poly (last ps) y)" assumes ps_not_Nil[simp]: "ps \ []" assumes signs: "\i x. \i < length ps - 2; poly (ps ! (i+1)) x = 0\ \ (poly (ps ! (i+2)) x) * (poly (ps ! i) x) < 0" text \ Now we define a Sturm sequence $p_1,\ldots,p_n$ of a polynomial $p$ in the following way: \begin{itemize} \item The sequence contains at least two elements. \item $p$ is the first polynomial, i.\,e. $p_1 = p$. \item At any root $x$ of $p$, $p_2$ and $p$ have opposite sign left of $x$ and the same sign right of $x$ in some neighbourhood around $x$. \item The first two polynomials in the sequence have no common roots. \item If the middle one of three adjacent polynomials has a root at $x$, the other two have opposite and nonzero signs at $x$. \end{itemize} \ locale sturm_seq = quasi_sturm_seq + fixes p :: "real poly" assumes hd_ps_p[simp]: "hd ps = p" assumes length_ps_ge_2[simp]: "length ps \ 2" assumes deriv: "\x\<^sub>0. poly p x\<^sub>0 = 0 \ eventually (\x. sgn (poly (p * ps!1) x) = (if x > x\<^sub>0 then 1 else -1)) (at x\<^sub>0)" assumes p_squarefree: "\x. \(poly p x = 0 \ poly (ps!1) x = 0)" begin text \ Any Sturm sequence is obviously a Quasi-Sturm sequence. \ lemma quasi_sturm_seq: "quasi_sturm_seq ps" .. (*<*) lemma ps_first_two: obtains q ps' where "ps = p # q # ps'" using hd_ps_p length_ps_ge_2 by (cases ps, simp, clarsimp, rename_tac ps', case_tac ps', auto) lemma ps_first: "ps ! 0 = p" by (rule ps_first_two, simp) lemma [simp]: "p \ set ps" using hd_in_set[OF ps_not_Nil] by simp (*>*) end (*<*) lemma [simp]: "\quasi_sturm_seq []" by (simp add: quasi_sturm_seq_def) (*>*) text \ Any suffix of a Quasi-Sturm sequence is again a Quasi-Sturm sequence. \ lemma quasi_sturm_seq_Cons: assumes "quasi_sturm_seq (p#ps)" and "ps \ []" shows "quasi_sturm_seq ps" proof (unfold_locales) show "ps \ []" by fact next from assms(1) interpret quasi_sturm_seq "p#ps" . fix x y from last_ps_sgn_const and \ps \ []\ show "sgn (poly (last ps) x) = sgn (poly (last ps) y)" by simp_all next from assms(1) interpret quasi_sturm_seq "p#ps" . fix i x assume "i < length ps - 2" and "poly (ps ! (i+1)) x = 0" with signs[of "i+1"] show "poly (ps ! (i+2)) x * poly (ps ! i) x < 0" by simp qed subsection \Auxiliary lemmas about roots and sign changes\ lemma sturm_adjacent_root_aux: assumes "i < length (ps :: real poly list) - 1" assumes "poly (ps ! i) x = 0" and "poly (ps ! (i + 1)) x = 0" assumes "\i x. \i < length ps - 2; poly (ps ! (i+1)) x = 0\ \ sgn (poly (ps ! (i+2)) x) = - sgn (poly (ps ! i) x)" shows "\j\i+1. poly (ps ! j) x = 0" using assms proof (induction i) case 0 thus ?case by (clarsimp, rename_tac j, case_tac j, simp_all) next case (Suc i) from Suc.prems(1,2) have "sgn (poly (ps ! (i + 2)) x) = - sgn (poly (ps ! i) x)" by (intro assms(4)) simp_all with Suc.prems(3) have "poly (ps ! i) x = 0" by (simp add: sgn_zero_iff) with Suc.prems have "\j\i+1. poly (ps ! j) x = 0" by (intro Suc.IH, simp_all) with Suc.prems(3) show ?case by (clarsimp, rename_tac j, case_tac "j = Suc (Suc i)", simp_all) qed text \ This function splits the sign list of a Sturm sequence at a position @{term x} that is not a root of @{term p} into a list of sublists such that the number of sign changes within every sublist is constant in the neighbourhood of @{term x}, thus proving that the total number is also constant. \ fun split_sign_changes where "split_sign_changes [p] (x :: real) = [[p]]" | "split_sign_changes [p,q] x = [[p,q]]" | "split_sign_changes (p#q#r#ps) x = (if poly p x \ 0 \ poly q x = 0 then [p,q,r] # split_sign_changes (r#ps) x else [p,q] # split_sign_changes (q#r#ps) x)" lemma (in quasi_sturm_seq) split_sign_changes_subset[dest]: "ps' \ set (split_sign_changes ps x) \ set ps' \ set ps" apply (insert ps_not_Nil) apply (induction ps x rule: split_sign_changes.induct) apply (simp, simp, rename_tac p q r ps x, case_tac "poly p x \ 0 \ poly q x = 0", auto) done text \ A custom induction rule for @{term split_sign_changes} that uses the fact that all the intermediate parameters in calls of @{term split_sign_changes} are quasi-Sturm sequences. \ lemma (in quasi_sturm_seq) split_sign_changes_induct: "\\p x. P [p] x; \p q x. quasi_sturm_seq [p,q] \ P [p,q] x; \p q r ps x. quasi_sturm_seq (p#q#r#ps) \ \poly p x \ 0 \ poly q x = 0 \ P (r#ps) x; poly q x \ 0 \ P (q#r#ps) x; poly p x = 0 \ P (q#r#ps) x\ \ P (p#q#r#ps) x\ \ P ps x" proof goal_cases case prems: 1 have "quasi_sturm_seq ps" .. with prems show ?thesis proof (induction ps x rule: split_sign_changes.induct) case (3 p q r ps x) show ?case proof (rule 3(5)[OF 3(6)]) assume A: "poly p x \ 0" "poly q x = 0" from 3(6) have "quasi_sturm_seq (r#ps)" by (force dest: quasi_sturm_seq_Cons) with 3 A show "P (r # ps) x" by blast next assume A: "poly q x \ 0" from 3(6) have "quasi_sturm_seq (q#r#ps)" by (force dest: quasi_sturm_seq_Cons) with 3 A show "P (q # r # ps) x" by blast next assume A: "poly p x = 0" from 3(6) have "quasi_sturm_seq (q#r#ps)" by (force dest: quasi_sturm_seq_Cons) with 3 A show "P (q # r # ps) x" by blast qed qed simp_all qed text \ The total number of sign changes in the split list is the same as the number of sign changes in the original list. \ lemma (in quasi_sturm_seq) split_sign_changes_correct: assumes "poly (hd ps) x\<^sub>0 \ 0" defines "sign_changes' \ \ps x. \ps'\split_sign_changes ps x. sign_changes ps' x" shows "sign_changes' ps x\<^sub>0 = sign_changes ps x\<^sub>0" using assms(1) proof (induction x\<^sub>0 rule: split_sign_changes_induct) case (3 p q r ps x\<^sub>0) hence "poly p x\<^sub>0 \ 0" by simp note IH = 3(2,3,4) show ?case proof (cases "poly q x\<^sub>0 = 0") case True from 3 interpret quasi_sturm_seq "p#q#r#ps" by simp from signs[of 0] and True have sgn_r_x0: "poly r x\<^sub>0 * poly p x\<^sub>0 < 0" by simp with 3 have "poly r x\<^sub>0 \ 0" by force from sign_changes_distrib[OF this, of "[p,q]" ps] have "sign_changes (p#q#r#ps) x\<^sub>0 = sign_changes ([p, q, r]) x\<^sub>0 + sign_changes (r # ps) x\<^sub>0" by simp also have "sign_changes (r#ps) x\<^sub>0 = sign_changes' (r#ps) x\<^sub>0" using \poly q x\<^sub>0 = 0\ \poly p x\<^sub>0 \ 0\ 3(5)\poly r x\<^sub>0 \ 0\ by (intro IH(1)[symmetric], simp_all) finally show ?thesis unfolding sign_changes'_def using True \poly p x\<^sub>0 \ 0\ by simp next case False from sign_changes_distrib[OF this, of "[p]" "r#ps"] have "sign_changes (p#q#r#ps) x\<^sub>0 = sign_changes ([p,q]) x\<^sub>0 + sign_changes (q#r#ps) x\<^sub>0" by simp also have "sign_changes (q#r#ps) x\<^sub>0 = sign_changes' (q#r#ps) x\<^sub>0" using \poly q x\<^sub>0 \ 0\ \poly p x\<^sub>0 \ 0\ 3(5) by (intro IH(2)[symmetric], simp_all) finally show ?thesis unfolding sign_changes'_def using False by simp qed qed (simp_all add: sign_changes_def sign_changes'_def) text \ We now prove that if $p(x)\neq 0$, the number of sign changes of a Sturm sequence of $p$ at $x$ is constant in a neighbourhood of $x$. \ lemma (in quasi_sturm_seq) split_sign_changes_correct_nbh: assumes "poly (hd ps) x\<^sub>0 \ 0" defines "sign_changes' \ \x\<^sub>0 ps x. \ps'\split_sign_changes ps x\<^sub>0. sign_changes ps' x" shows "eventually (\x. sign_changes' x\<^sub>0 ps x = sign_changes ps x) (at x\<^sub>0)" proof (rule eventually_mono) show "eventually (\x. \p\{p \ set ps. poly p x\<^sub>0 \ 0}. sgn (poly p x) = sgn (poly p x\<^sub>0)) (at x\<^sub>0)" by (rule eventually_ball_finite, auto intro: poly_neighbourhood_same_sign) next fix x show "(\p\{p \ set ps. poly p x\<^sub>0 \ 0}. sgn (poly p x) = sgn (poly p x\<^sub>0)) \ sign_changes' x\<^sub>0 ps x = sign_changes ps x" proof - fix x assume nbh: "\p\{p \ set ps. poly p x\<^sub>0 \ 0}. sgn (poly p x) = sgn (poly p x\<^sub>0)" thus "sign_changes' x\<^sub>0 ps x = sign_changes ps x" using assms(1) proof (induction x\<^sub>0 rule: split_sign_changes_induct) case (3 p q r ps x\<^sub>0) hence "poly p x\<^sub>0 \ 0" by simp note IH = 3(2,3,4) show ?case proof (cases "poly q x\<^sub>0 = 0") case True from 3 interpret quasi_sturm_seq "p#q#r#ps" by simp from signs[of 0] and True have sgn_r_x0: "poly r x\<^sub>0 * poly p x\<^sub>0 < 0" by simp with 3 have "poly r x\<^sub>0 \ 0" by force with nbh 3(5) have "poly r x \ 0" by (auto simp: sgn_zero_iff) from sign_changes_distrib[OF this, of "[p,q]" ps] have "sign_changes (p#q#r#ps) x = sign_changes ([p, q, r]) x + sign_changes (r # ps) x" by simp also have "sign_changes (r#ps) x = sign_changes' x\<^sub>0 (r#ps) x" using \poly q x\<^sub>0 = 0\ nbh \poly p x\<^sub>0 \ 0\ 3(5)\poly r x\<^sub>0 \ 0\ by (intro IH(1)[symmetric], simp_all) finally show ?thesis unfolding sign_changes'_def using True \poly p x\<^sub>0 \ 0\by simp next case False with nbh 3(5) have "poly q x \ 0" by (auto simp: sgn_zero_iff) from sign_changes_distrib[OF this, of "[p]" "r#ps"] have "sign_changes (p#q#r#ps) x = sign_changes ([p,q]) x + sign_changes (q#r#ps) x" by simp also have "sign_changes (q#r#ps) x = sign_changes' x\<^sub>0 (q#r#ps) x" using \poly q x\<^sub>0 \ 0\ nbh \poly p x\<^sub>0 \ 0\ 3(5) by (intro IH(2)[symmetric], simp_all) finally show ?thesis unfolding sign_changes'_def using False by simp qed qed (simp_all add: sign_changes_def sign_changes'_def) qed qed lemma (in quasi_sturm_seq) hd_nonzero_imp_sign_changes_const_aux: assumes "poly (hd ps) x\<^sub>0 \ 0" and "ps' \ set (split_sign_changes ps x\<^sub>0)" shows "eventually (\x. sign_changes ps' x = sign_changes ps' x\<^sub>0) (at x\<^sub>0)" using assms proof (induction x\<^sub>0 rule: split_sign_changes_induct) case (1 p x) thus ?case by (simp add: sign_changes_def) next case (2 p q x\<^sub>0) hence [simp]: "ps' = [p,q]" by simp from 2 have "poly p x\<^sub>0 \ 0" by simp from 2(1) interpret quasi_sturm_seq "[p,q]" . from poly_neighbourhood_same_sign[OF \poly p x\<^sub>0 \ 0\] have "eventually (\x. sgn (poly p x) = sgn (poly p x\<^sub>0)) (at x\<^sub>0)" . moreover from last_ps_sgn_const have sgn_q: "\x. sgn (poly q x) = sgn (poly q x\<^sub>0)" by simp ultimately have A: "eventually (\x. \p\set[p,q]. sgn (poly p x) = sgn (poly p x\<^sub>0)) (at x\<^sub>0)" by simp thus ?case by (force intro: eventually_mono[OF A] sign_changes_cong') next case (3 p q r ps'' x\<^sub>0) hence p_not_0: "poly p x\<^sub>0 \ 0" by simp note sturm = 3(1) note IH = 3(2,3) note ps''_props = 3(6) show ?case proof (cases "poly q x\<^sub>0 = 0") case True note q_0 = this from sturm interpret quasi_sturm_seq "p#q#r#ps''" . from signs[of 0] and q_0 have signs': "poly r x\<^sub>0 * poly p x\<^sub>0 < 0" by simp with p_not_0 have r_not_0: "poly r x\<^sub>0 \ 0" by force show ?thesis proof (cases "ps' \ set (split_sign_changes (r # ps'') x\<^sub>0)") case True show ?thesis by (rule IH(1), fact, fact, simp add: r_not_0, fact) next case False with ps''_props p_not_0 q_0 have ps'_props: "ps' = [p,q,r]" by simp from signs[of 0] and q_0 have sgn_r: "poly r x\<^sub>0 * poly p x\<^sub>0 < 0" by simp from p_not_0 sgn_r have A: "eventually (\x. sgn (poly p x) = sgn (poly p x\<^sub>0) \ sgn (poly r x) = sgn (poly r x\<^sub>0)) (at x\<^sub>0)" by (intro eventually_conj poly_neighbourhood_same_sign, simp_all add: r_not_0) show ?thesis proof (rule eventually_mono[OF A], clarify, subst ps'_props, subst sign_changes_sturm_triple) fix x assume A: "sgn (poly p x) = sgn (poly p x\<^sub>0)" and B: "sgn (poly r x) = sgn (poly r x\<^sub>0)" have prod_neg: "\a (b::real). \a>0; b>0; a*b<0\ \ False" "\a (b::real). \a<0; b<0; a*b<0\ \ False" by (drule mult_pos_pos, simp, simp, drule mult_neg_neg, simp, simp) from A and \poly p x\<^sub>0 \ 0\ show "poly p x \ 0" by (force simp: sgn_zero_iff) with sgn_r p_not_0 r_not_0 A B have "poly r x * poly p x < 0" "poly r x \ 0" by (metis sgn_less sgn_mult, metis sgn_0_0) with sgn_r show sgn_r': "sgn (poly r x) = - sgn (poly p x)" apply (simp add: sgn_real_def not_le not_less split: if_split_asm, intro conjI impI) using prod_neg[of "poly r x" "poly p x"] apply force+ done show "1 = sign_changes ps' x\<^sub>0" by (subst ps'_props, subst sign_changes_sturm_triple, fact, metis A B sgn_r', simp) qed qed next case False note q_not_0 = this show ?thesis proof (cases "ps' \ set (split_sign_changes (q # r # ps'') x\<^sub>0)") case True show ?thesis by (rule IH(2), fact, simp add: q_not_0, fact) next case False with ps''_props and q_not_0 have "ps' = [p, q]" by simp hence [simp]: "\p\set ps'. poly p x\<^sub>0 \ 0" using q_not_0 p_not_0 by simp show ?thesis proof (rule eventually_mono) fix x assume "\p\set ps'. sgn (poly p x) = sgn (poly p x\<^sub>0)" thus "sign_changes ps' x = sign_changes ps' x\<^sub>0" by (rule sign_changes_cong') next show "eventually (\x. \p\set ps'. sgn (poly p x) = sgn (poly p x\<^sub>0)) (at x\<^sub>0)" by (force intro: eventually_ball_finite poly_neighbourhood_same_sign) qed qed qed qed lemma (in quasi_sturm_seq) hd_nonzero_imp_sign_changes_const: assumes "poly (hd ps) x\<^sub>0 \ 0" shows "eventually (\x. sign_changes ps x = sign_changes ps x\<^sub>0) (at x\<^sub>0)" proof- let ?pss = "split_sign_changes ps x\<^sub>0" let ?f = "\pss x. \ps'\pss. sign_changes ps' x" { fix pss assume "\ps'. ps'\set pss \ eventually (\x. sign_changes ps' x = sign_changes ps' x\<^sub>0) (at x\<^sub>0)" hence "eventually (\x. ?f pss x = ?f pss x\<^sub>0) (at x\<^sub>0)" proof (induction pss) case (Cons ps' pss) then show ?case apply (rule eventually_mono[OF eventually_conj]) apply (auto simp add: Cons.prems) done qed simp } note A = this[of ?pss] have B: "eventually (\x. ?f ?pss x = ?f ?pss x\<^sub>0) (at x\<^sub>0)" by (rule A, rule hd_nonzero_imp_sign_changes_const_aux[OF assms], simp) note C = split_sign_changes_correct_nbh[OF assms] note D = split_sign_changes_correct[OF assms] note E = eventually_conj[OF B C] show ?thesis by (rule eventually_mono[OF E], auto simp: D) qed (*<*) hide_fact quasi_sturm_seq.split_sign_changes_correct_nbh hide_fact quasi_sturm_seq.hd_nonzero_imp_sign_changes_const_aux (*>*) lemma (in sturm_seq) p_nonzero_imp_sign_changes_const: "poly p x\<^sub>0 \ 0 \ eventually (\x. sign_changes ps x = sign_changes ps x\<^sub>0) (at x\<^sub>0)" using hd_nonzero_imp_sign_changes_const by simp text \ If $x$ is a root of $p$ and $p$ is not the zero polynomial, the number of sign changes of a Sturm chain of $p$ decreases by 1 at $x$. \ lemma (in sturm_seq) p_zero: assumes "poly p x\<^sub>0 = 0" "p \ 0" shows "eventually (\x. sign_changes ps x = sign_changes ps x\<^sub>0 + (if x0 then 1 else 0)) (at x\<^sub>0)" proof- from ps_first_two obtain q ps' where [simp]: "ps = p#q#ps'" . hence "ps!1 = q" by simp have "eventually (\x. x \ x\<^sub>0) (at x\<^sub>0)" by (simp add: eventually_at, rule exI[of _ 1], simp) moreover from p_squarefree and assms(1) have "poly q x\<^sub>0 \ 0" by simp { have A: "quasi_sturm_seq ps" .. with quasi_sturm_seq_Cons[of p "q#ps'"] interpret quasi_sturm_seq "q#ps'" by simp from \poly q x\<^sub>0 \ 0\ have "eventually (\x. sign_changes (q#ps') x = sign_changes (q#ps') x\<^sub>0) (at x\<^sub>0)" using hd_nonzero_imp_sign_changes_const[where x\<^sub>0=x\<^sub>0] by simp } moreover note poly_neighbourhood_without_roots[OF assms(2)] deriv[OF assms(1)] ultimately have A: "eventually (\x. x \ x\<^sub>0 \ poly p x \ 0 \ sgn (poly (p*ps!1) x) = (if x > x\<^sub>0 then 1 else -1) \ sign_changes (q#ps') x = sign_changes (q#ps') x\<^sub>0) (at x\<^sub>0)" by (simp only: \ps!1 = q\, intro eventually_conj) show ?thesis proof (rule eventually_mono[OF A], clarify, goal_cases) case prems: (1 x) from zero_less_mult_pos have zero_less_mult_pos': "\a b. \(0::real) < a*b; 0 < b\ \ 0 < a" by (subgoal_tac "a*b = b*a", auto) from prems have "poly q x \ 0" and q_sgn: "sgn (poly q x) = (if x < x\<^sub>0 then -sgn (poly p x) else sgn (poly p x))" by (auto simp add: sgn_real_def elim: linorder_neqE_linordered_idom dest: mult_neg_neg zero_less_mult_pos zero_less_mult_pos' split: if_split_asm) from sign_changes_distrib[OF \poly q x \ 0\, of "[p]" ps'] have "sign_changes ps x = sign_changes [p,q] x + sign_changes (q#ps') x" by simp also from q_sgn and \poly p x \ 0\ have "sign_changes [p,q] x = (if x0 then 1 else 0)" by (simp add: sign_changes_def sgn_zero_iff split: if_split_asm) also note prems(4) also from assms(1) have "sign_changes (q#ps') x\<^sub>0 = sign_changes ps x\<^sub>0" by (simp add: sign_changes_def) finally show ?case by simp qed qed text \ With these two results, we can now show that if $p$ is nonzero, the number of roots in an interval of the form $(a;b]$ is the difference of the sign changes of a Sturm sequence of $p$ at $a$ and $b$.\\ First, however, we prove the following auxiliary lemma that shows that if a function $f: \RR\to\NN$ is locally constant at any $x\in(a;b]$, it is constant across the entire interval $(a;b]$: \ lemma count_roots_between_aux: assumes "a \ b" assumes "\x::real. a < x \ x \ b \ eventually (\\. f \ = (f x::nat)) (at x)" shows "\x. a < x \ x \ b \ f x = f b" proof (clarify) fix x assume "x > a" "x \ b" with assms have "\x'. x \ x' \ x' \ b \ eventually (\\. f \ = f x') (at x')" by auto from fun_eq_in_ivl[OF \x \ b\ this] show "f x = f b" . qed text \ Now we can prove the actual root-counting theorem: \ theorem (in sturm_seq) count_roots_between: assumes [simp]: "p \ 0" "a \ b" shows "sign_changes ps a - sign_changes ps b = card {x. x > a \ x \ b \ poly p x = 0}" proof- have "sign_changes ps a - int (sign_changes ps b) = card {x. x > a \ x \ b \ poly p x = 0}" using \a \ b\ proof (induction "card {x. x > a \ x \ b \ poly p x = 0}" arbitrary: a b rule: less_induct) case (less a b) show ?case proof (cases "\x. a < x \ x \ b \ poly p x = 0") case False hence no_roots: "{x. a < x \ x \ b \ poly p x = 0} = {}" (is "?roots=_") by auto hence card_roots: "card ?roots = (0::int)" by (subst no_roots, simp) show ?thesis proof (simp only: card_roots eq_iff_diff_eq_0[symmetric] of_nat_eq_iff, cases "poly p a = 0") case False with no_roots show "sign_changes ps a = sign_changes ps b" by (force intro: fun_eq_in_ivl \a \ b\ p_nonzero_imp_sign_changes_const) next case True have A: "\x. a < x \ x \ b \ sign_changes ps x = sign_changes ps b" apply (rule count_roots_between_aux, fact, clarify) apply (rule p_nonzero_imp_sign_changes_const) apply (insert False, simp) done have "eventually (\x. x > a \ sign_changes ps x = sign_changes ps a) (at a)" apply (rule eventually_mono [OF p_zero[OF \poly p a = 0\ \p \ 0\]]) apply force done then obtain \ where \_props: "\ > 0" "\x. x > a \ x < a+\ \ sign_changes ps x = sign_changes ps a" by (auto simp: eventually_at dist_real_def) show "sign_changes ps a = sign_changes ps b" proof (cases "a = b") case False define x where "x = min (a+\/2) b" with False have "a < x" "x < a+\" "x \ b" using \\ > 0\ \a \ b\ by simp_all from \_props \a < x\ \x < a+\\ have "sign_changes ps a = sign_changes ps x" by simp also from A \a < x\ \x \ b\ have "... = sign_changes ps b" by blast finally show ?thesis . qed simp qed next case True from poly_roots_finite[OF assms(1)] have fin: "finite {x. x > a \ x \ b \ poly p x = 0}" by (force intro: finite_subset) from True have "{x. x > a \ x \ b \ poly p x = 0} \ {}" by blast with fin have card_greater_0: "card {x. x > a \ x \ b \ poly p x = 0} > 0" by fastforce define x\<^sub>2 where "x\<^sub>2 = Min {x. x > a \ x \ b \ poly p x = 0}" from Min_in[OF fin] and True have x\<^sub>2_props: "x\<^sub>2 > a" "x\<^sub>2 \ b" "poly p x\<^sub>2 = 0" unfolding x\<^sub>2_def by blast+ from Min_le[OF fin] x\<^sub>2_props have x\<^sub>2_le: "\x'. \x' > a; x' \ b; poly p x' = 0\ \ x\<^sub>2 \ x'" unfolding x\<^sub>2_def by simp have left: "{x. a < x \ x \ x\<^sub>2 \ poly p x = 0} = {x\<^sub>2}" using x\<^sub>2_props x\<^sub>2_le by force hence [simp]: "card {x. a < x \ x \ x\<^sub>2 \ poly p x = 0} = 1" by simp from p_zero[OF \poly p x\<^sub>2 = 0\ \p \ 0\, unfolded eventually_at dist_real_def] guess \ .. hence \_props: "\ > 0" "\x. x \ x\<^sub>2 \ \x - x\<^sub>2\ < \ \ sign_changes ps x = sign_changes ps x\<^sub>2 + (if x < x\<^sub>2 then 1 else 0)" by auto define x\<^sub>1 where "x\<^sub>1 = max (x\<^sub>2 - \ / 2) a" have "\x\<^sub>1 - x\<^sub>2\ < \" using \\ > 0\ x\<^sub>2_props by (simp add: x\<^sub>1_def) hence "sign_changes ps x\<^sub>1 = (if x\<^sub>1 < x\<^sub>2 then sign_changes ps x\<^sub>2 + 1 else sign_changes ps x\<^sub>2)" using \_props(2) by (cases "x\<^sub>1 = x\<^sub>2", auto) hence "sign_changes ps x\<^sub>1 - sign_changes ps x\<^sub>2 = 1" unfolding x\<^sub>1_def using x\<^sub>2_props \\ > 0\ by simp also have "x\<^sub>2 \ {x. a < x \ x \ x\<^sub>1 \ poly p x = 0}" unfolding x\<^sub>1_def using \\ > 0\ by force with left have "{x. a < x \ x \ x\<^sub>1 \ poly p x = 0} = {}" by force with less(1)[of a x\<^sub>1] have "sign_changes ps x\<^sub>1 = sign_changes ps a" unfolding x\<^sub>1_def \\ > 0\ by (force simp: card_greater_0) finally have signs_left: "sign_changes ps a - int (sign_changes ps x\<^sub>2) = 1" by simp have "{x. x > a \ x \ b \ poly p x = 0} = {x. a < x \ x \ x\<^sub>2 \ poly p x = 0} \ {x. x\<^sub>2 < x \ x \ b \ poly p x = 0}" using x\<^sub>2_props by auto also note left finally have A: "card {x. x\<^sub>2 < x \ x \ b \ poly p x = 0} + 1 = card {x. a < x \ x \ b \ poly p x = 0}" using fin by simp hence "card {x. x\<^sub>2 < x \ x \ b \ poly p x = 0} < card {x. a < x \ x \ b \ poly p x = 0}" by simp from less(1)[OF this x\<^sub>2_props(2)] and A have signs_right: "sign_changes ps x\<^sub>2 - int (sign_changes ps b) + 1 = card {x. a < x \ x \ b \ poly p x = 0}" by simp from signs_left and signs_right show ?thesis by simp qed qed thus ?thesis by simp qed text \ By applying this result to a sufficiently large upper bound, we can effectively count the number of roots ``between $a$ and infinity'', i.\,e. the roots greater than $a$: \ lemma (in sturm_seq) count_roots_above: assumes "p \ 0" shows "sign_changes ps a - sign_changes_inf ps = card {x. x > a \ poly p x = 0}" proof- have "p \ set ps" using hd_in_set[OF ps_not_Nil] by simp have "finite (set ps)" by simp from polys_inf_sign_thresholds[OF this] guess l u . note lu_props = this let ?u = "max a u" {fix x assume "poly p x = 0" hence "x \ ?u" using lu_props(3)[OF \p \ set ps\, of x] \p \ 0\ by (cases "u \ x", auto simp: sgn_zero_iff) } note [simp] = this from lu_props have "map (\p. sgn (poly p ?u)) ps = map poly_inf ps" by simp hence "sign_changes ps a - sign_changes_inf ps = sign_changes ps a - sign_changes ps ?u" by (simp_all only: sign_changes_def sign_changes_inf_def) also from count_roots_between[OF assms] lu_props have "... = card {x. a < x \ x \ ?u \ poly p x = 0}" by simp also have "{x. a < x \ x \ ?u \ poly p x = 0} = {x. a < x \ poly p x = 0}" using lu_props by auto finally show ?thesis . qed text \ The same works analogously for the number of roots below $a$ and the total number of roots. \ lemma (in sturm_seq) count_roots_below: assumes "p \ 0" shows "sign_changes_neg_inf ps - sign_changes ps a = card {x. x \ a \ poly p x = 0}" proof- have "p \ set ps" using hd_in_set[OF ps_not_Nil] by simp have "finite (set ps)" by simp from polys_inf_sign_thresholds[OF this] guess l u . note lu_props = this let ?l = "min a l" {fix x assume "poly p x = 0" hence "x > ?l" using lu_props(4)[OF \p \ set ps\, of x] \p \ 0\ by (cases "l < x", auto simp: sgn_zero_iff) } note [simp] = this from lu_props have "map (\p. sgn (poly p ?l)) ps = map poly_neg_inf ps" by simp hence "sign_changes_neg_inf ps - sign_changes ps a = sign_changes ps ?l - sign_changes ps a" by (simp_all only: sign_changes_def sign_changes_neg_inf_def) also from count_roots_between[OF assms] lu_props have "... = card {x. ?l < x \ x \ a \ poly p x = 0}" by simp also have "{x. ?l < x \ x \ a \ poly p x = 0} = {x. a \ x \ poly p x = 0}" using lu_props by auto finally show ?thesis . qed lemma (in sturm_seq) count_roots: assumes "p \ 0" shows "sign_changes_neg_inf ps - sign_changes_inf ps = card {x. poly p x = 0}" proof- have "finite (set ps)" by simp from polys_inf_sign_thresholds[OF this] guess l u . note lu_props = this from lu_props have "map (\p. sgn (poly p l)) ps = map poly_neg_inf ps" "map (\p. sgn (poly p u)) ps = map poly_inf ps" by simp_all hence "sign_changes_neg_inf ps - sign_changes_inf ps = sign_changes ps l - sign_changes ps u" by (simp_all only: sign_changes_def sign_changes_inf_def sign_changes_neg_inf_def) also from count_roots_between[OF assms] lu_props have "... = card {x. l < x \ x \ u \ poly p x = 0}" by simp also have "{x. l < x \ x \ u \ poly p x = 0} = {x. poly p x = 0}" using lu_props assms by simp finally show ?thesis . qed subsection \Constructing Sturm sequences\ subsection \The canonical Sturm sequence\ text \ In this subsection, we will present the canonical Sturm sequence construction for a polynomial $p$ without multiple roots that is very similar to the Euclidean algorithm: $$p_i = \begin{cases} p & \text{for}\ i = 1\\ p' & \text{for}\ i = 2\\ -p_{i-2}\ \text{mod}\ p_{i-1} & \text{otherwise} \end{cases}$$ We break off the sequence at the first constant polynomial. \ (*<*) lemma degree_mod_less': "degree q \ 0 \ degree (p mod q) < degree q" by (metis degree_0 degree_mod_less not_gr0) (*>*) function sturm_aux where "sturm_aux (p :: real poly) q = (if degree q = 0 then [p,q] else p # sturm_aux q (-(p mod q)))" by (pat_completeness, simp_all) termination by (relation "measure (degree \ snd)", simp_all add: o_def degree_mod_less') (*<*) declare sturm_aux.simps[simp del] (*>*) definition sturm where "sturm p = sturm_aux p (pderiv p)" text \Next, we show some simple facts about this construction:\ lemma sturm_0[simp]: "sturm 0 = [0,0]" by (unfold sturm_def, subst sturm_aux.simps, simp) lemma [simp]: "sturm_aux p q = [] \ False" by (induction p q rule: sturm_aux.induct, subst sturm_aux.simps, auto) lemma sturm_neq_Nil[simp]: "sturm p \ []" unfolding sturm_def by simp lemma [simp]: "hd (sturm p) = p" unfolding sturm_def by (subst sturm_aux.simps, simp) lemma [simp]: "p \ set (sturm p)" using hd_in_set[OF sturm_neq_Nil] by simp lemma [simp]: "length (sturm p) \ 2" proof- {fix q have "length (sturm_aux p q) \ 2" by (induction p q rule: sturm_aux.induct, subst sturm_aux.simps, auto) } thus ?thesis unfolding sturm_def . qed lemma [simp]: "degree (last (sturm p)) = 0" proof- {fix q have "degree (last (sturm_aux p q)) = 0" by (induction p q rule: sturm_aux.induct, subst sturm_aux.simps, simp) } thus ?thesis unfolding sturm_def . qed lemma [simp]: "sturm_aux p q ! 0 = p" by (subst sturm_aux.simps, simp) lemma [simp]: "sturm_aux p q ! Suc 0 = q" by (subst sturm_aux.simps, simp) lemma [simp]: "sturm p ! 0 = p" unfolding sturm_def by simp lemma [simp]: "sturm p ! Suc 0 = pderiv p" unfolding sturm_def by simp lemma sturm_indices: assumes "i < length (sturm p) - 2" shows "sturm p!(i+2) = -(sturm p!i mod sturm p!(i+1))" proof- {fix ps q have "\ps = sturm_aux p q; i < length ps - 2\ \ ps!(i+2) = -(ps!i mod ps!(i+1))" proof (induction p q arbitrary: ps i rule: sturm_aux.induct) case (1 p q) show ?case proof (cases "i = 0") case False then obtain i' where [simp]: "i = Suc i'" by (cases i, simp_all) hence "length ps \ 4" using 1 by simp with 1(2) have deg: "degree q \ 0" by (subst (asm) sturm_aux.simps, simp split: if_split_asm) with 1(2) obtain ps' where [simp]: "ps = p # ps'" by (subst (asm) sturm_aux.simps, simp) with 1(2) deg have ps': "ps' = sturm_aux q (-(p mod q))" by (subst (asm) sturm_aux.simps, simp) from \length ps \ 4\ and \ps = p # ps'\ 1(3) False have "i - 1 < length ps' - 2" by simp from 1(1)[OF deg ps' this] show ?thesis by simp next case True with 1(3) have "length ps \ 3" by simp with 1(2) have "degree q \ 0" by (subst (asm) sturm_aux.simps, simp split: if_split_asm) with 1(2) have [simp]: "sturm_aux p q ! Suc (Suc 0) = -(p mod q)" by (subst sturm_aux.simps, simp) from True have "ps!i = p" "ps!(i+1) = q" "ps!(i+2) = -(p mod q)" by (simp_all add: 1(2)) thus ?thesis by simp qed qed} from this[OF sturm_def assms] show ?thesis . qed text \ If the Sturm sequence construction is applied to polynomials $p$ and $q$, the greatest common divisor of $p$ and $q$ a divisor of every element in the sequence. This is obvious from the similarity to Euclid's algorithm for computing the GCD. \ lemma sturm_aux_gcd: "r \ set (sturm_aux p q) \ gcd p q dvd r" proof (induction p q rule: sturm_aux.induct) case (1 p q) show ?case proof (cases "r = p") case False with 1(2) have r: "r \ set (sturm_aux q (-(p mod q)))" by (subst (asm) sturm_aux.simps, simp split: if_split_asm, subst sturm_aux.simps, simp) show ?thesis proof (cases "degree q = 0") case False hence "q \ 0" by force with 1(1) [OF False r] show ?thesis by (simp add: gcd_mod_right ac_simps) next case True with 1(2) and \r \ p\ have "r = q" by (subst (asm) sturm_aux.simps, simp) thus ?thesis by simp qed qed simp qed lemma sturm_gcd: "r \ set (sturm p) \ gcd p (pderiv p) dvd r" unfolding sturm_def by (rule sturm_aux_gcd) text \ If two adjacent polynomials in the result of the canonical Sturm chain construction both have a root at some $x$, this $x$ is a root of all polynomials in the sequence. \ lemma sturm_adjacent_root_propagate_left: assumes "i < length (sturm (p :: real poly)) - 1" assumes "poly (sturm p ! i) x = 0" and "poly (sturm p ! (i + 1)) x = 0" shows "\j\i+1. poly (sturm p ! j) x = 0" using assms(2) proof (intro sturm_adjacent_root_aux[OF assms(1,2,3)], goal_cases) case prems: (1 i x) let ?p = "sturm p ! i" let ?q = "sturm p ! (i + 1)" let ?r = "sturm p ! (i + 2)" from sturm_indices[OF prems(2)] have "?p = ?p div ?q * ?q - ?r" by (simp add: div_mult_mod_eq) hence "poly ?p x = poly (?p div ?q * ?q - ?r) x" by simp hence "poly ?p x = -poly ?r x" using prems(3) by simp thus ?case by (simp add: sgn_minus) qed text \ Consequently, if this is the case in the canonical Sturm chain of $p$, $p$ must have multiple roots. \ lemma sturm_adjacent_root_not_squarefree: assumes "i < length (sturm (p :: real poly)) - 1" "poly (sturm p ! i) x = 0" "poly (sturm p ! (i + 1)) x = 0" shows "\rsquarefree p" proof- from sturm_adjacent_root_propagate_left[OF assms] have "poly p x = 0" "poly (pderiv p) x = 0" by auto thus ?thesis by (auto simp: rsquarefree_roots) qed text \ Since the second element of the sequence is chosen to be the derivative of $p$, $p_1$ and $p_2$ fulfil the property demanded by the definition of a Sturm sequence that they locally have opposite sign left of a root $x$ of $p$ and the same sign to the right of $x$. \ lemma sturm_firsttwo_signs_aux: assumes "(p :: real poly) \ 0" "q \ 0" assumes q_pderiv: "eventually (\x. sgn (poly q x) = sgn (poly (pderiv p) x)) (at x\<^sub>0)" assumes p_0: "poly p (x\<^sub>0::real) = 0" shows "eventually (\x. sgn (poly (p*q) x) = (if x > x\<^sub>0 then 1 else -1)) (at x\<^sub>0)" proof- have A: "eventually (\x. poly p x \ 0 \ poly q x \ 0 \ sgn (poly q x) = sgn (poly (pderiv p) x)) (at x\<^sub>0)" using \p \ 0\ \q \ 0\ by (intro poly_neighbourhood_same_sign q_pderiv poly_neighbourhood_without_roots eventually_conj) then obtain \ where \_props: "\ > 0" "\x. x \ x\<^sub>0 \ \x - x\<^sub>0\ < \ \ poly p x \ 0 \ poly q x \ 0 \ sgn (poly (pderiv p) x) = sgn (poly q x)" by (auto simp: eventually_at dist_real_def) have sqr_pos: "\x::real. x \ 0 \ sgn x * sgn x = 1" by (auto simp: sgn_real_def) show ?thesis proof (simp only: eventually_at dist_real_def, rule exI[of _ \], intro conjI, fact \\ > 0\, clarify) fix x assume "x \ x\<^sub>0" "\x - x\<^sub>0\ < \" with \_props have [simp]: "poly p x \ 0" "poly q x \ 0" "sgn (poly (pderiv p) x) = sgn (poly q x)" by auto show "sgn (poly (p*q) x) = (if x > x\<^sub>0 then 1 else -1)" proof (cases "x \ x\<^sub>0") case True with \x \ x\<^sub>0\ have "x > x\<^sub>0" by simp from poly_MVT[OF this, of p] guess \ .. note \_props = this with \\x - x\<^sub>0\ < \\ \poly p x\<^sub>0 = 0\ \x > x\<^sub>0\ \_props have "\\ - x\<^sub>0\ < \" "sgn (poly p x) = sgn (x - x\<^sub>0) * sgn (poly q \)" by (auto simp add: q_pderiv sgn_mult) moreover from \_props \_props \\x - x\<^sub>0\ < \\ have "\t. \ \ t \ t \ x \ poly q t \ 0" by auto hence "sgn (poly q \) = sgn (poly q x)" using \_props \_props by (intro no_roots_inbetween_imp_same_sign, simp_all) ultimately show ?thesis using True \x \ x\<^sub>0\ \_props \_props by (auto simp: sgn_mult sqr_pos) next case False hence "x < x\<^sub>0" by simp hence sgn: "sgn (x - x\<^sub>0) = -1" by simp from poly_MVT[OF \x < x\<^sub>0\, of p] guess \ .. note \_props = this with \\x - x\<^sub>0\ < \\ \poly p x\<^sub>0 = 0\ \x < x\<^sub>0\ \_props have "\\ - x\<^sub>0\ < \" "poly p x = (x - x\<^sub>0) * poly (pderiv p) \" "poly p \ \ 0" by (auto simp: field_simps) hence "sgn (poly p x) = sgn (x - x\<^sub>0) * sgn (poly q \)" using \_props \_props by (auto simp: q_pderiv sgn_mult) moreover from \_props \_props \\x - x\<^sub>0\ < \\ have "\t. x \ t \ t \ \ \ poly q t \ 0" by auto hence "sgn (poly q \) = sgn (poly q x)" using \_props \_props by (rule_tac sym, intro no_roots_inbetween_imp_same_sign, simp_all) ultimately show ?thesis using False \x \ x\<^sub>0\ by (auto simp: sgn_mult sqr_pos) qed qed qed lemma sturm_firsttwo_signs: fixes ps :: "real poly list" assumes squarefree: "rsquarefree p" assumes p_0: "poly p (x\<^sub>0::real) = 0" shows "eventually (\x. sgn (poly (p * sturm p ! 1) x) = (if x > x\<^sub>0 then 1 else -1)) (at x\<^sub>0)" proof- from assms have [simp]: "p \ 0" by (auto simp add: rsquarefree_roots) with squarefree p_0 have [simp]: "pderiv p \ 0" by (auto simp add:rsquarefree_roots) from assms show ?thesis by (intro sturm_firsttwo_signs_aux, simp_all add: rsquarefree_roots) qed text \ The construction also obviously fulfils the property about three adjacent polynomials in the sequence. \ lemma sturm_signs: assumes squarefree: "rsquarefree p" assumes i_in_range: "i < length (sturm (p :: real poly)) - 2" assumes q_0: "poly (sturm p ! (i+1)) x = 0" (is "poly ?q x = 0") shows "poly (sturm p ! (i+2)) x * poly (sturm p ! i) x < 0" (is "poly ?p x * poly ?r x < 0") proof- from sturm_indices[OF i_in_range] have "sturm p ! (i+2) = - (sturm p ! i mod sturm p ! (i+1))" (is "?r = - (?p mod ?q)") . hence "-?r = ?p mod ?q" by simp with div_mult_mod_eq[of ?p ?q] have "?p div ?q * ?q - ?r = ?p" by simp hence "poly (?p div ?q) x * poly ?q x - poly ?r x = poly ?p x" by (metis poly_diff poly_mult) with q_0 have r_x: "poly ?r x = -poly ?p x" by simp moreover have sqr_pos: "\x::real. x \ 0 \ x * x > 0" apply (case_tac "x \ 0") by (simp_all add: mult_neg_neg) from sturm_adjacent_root_not_squarefree[of i p] assms r_x have "poly ?p x * poly ?p x > 0" by (force intro: sqr_pos) ultimately show "poly ?r x * poly ?p x < 0" by simp qed text \ Finally, if $p$ contains no multiple roots, @{term "sturm p"}, i.e. the canonical Sturm sequence for $p$, is a Sturm sequence and can be used to determine the number of roots of $p$. \ lemma sturm_seq_sturm[simp]: assumes "rsquarefree p" shows "sturm_seq (sturm p) p" proof show "sturm p \ []" by simp show "hd (sturm p) = p" by simp show "length (sturm p) \ 2" by simp from assms show "\x. \(poly p x = 0 \ poly (sturm p ! 1) x = 0)" by (simp add: rsquarefree_roots) next fix x :: real and y :: real have "degree (last (sturm p)) = 0" by simp then obtain c where "last (sturm p) = [:c:]" by (cases "last (sturm p)", simp split: if_split_asm) thus "\x y. sgn (poly (last (sturm p)) x) = sgn (poly (last (sturm p)) y)" by simp next from sturm_firsttwo_signs[OF assms] show "\x\<^sub>0. poly p x\<^sub>0 = 0 \ eventually (\x. sgn (poly (p*sturm p ! 1) x) = (if x > x\<^sub>0 then 1 else -1)) (at x\<^sub>0)" by simp next from sturm_signs[OF assms] show "\i x. \i < length (sturm p) - 2; poly (sturm p ! (i + 1)) x = 0\ \ poly (sturm p ! (i + 2)) x * poly (sturm p ! i) x < 0" by simp qed subsubsection \Canonical squarefree Sturm sequence\ text \ The previous construction does not work for polynomials with multiple roots, but we can simply ``divide away'' multiple roots by dividing $p$ by the GCD of $p$ and $p'$. The resulting polynomial has the same roots as $p$, but with multiplicity 1, allowing us to again use the canonical construction. \ definition sturm_squarefree where "sturm_squarefree p = sturm (p div (gcd p (pderiv p)))" lemma sturm_squarefree_not_Nil[simp]: "sturm_squarefree p \ []" by (simp add: sturm_squarefree_def) lemma sturm_seq_sturm_squarefree: assumes [simp]: "p \ 0" defines [simp]: "p' \ p div gcd p (pderiv p)" shows "sturm_seq (sturm_squarefree p) p'" proof have "rsquarefree p'" proof (subst rsquarefree_roots, clarify) fix x assume "poly p' x = 0" "poly (pderiv p') x = 0" hence "[:-x,1:] dvd gcd p' (pderiv p')" by (simp add: poly_eq_0_iff_dvd) also from poly_div_gcd_squarefree(1)[OF assms(1)] have "gcd p' (pderiv p') = 1" by simp finally show False by (simp add: poly_eq_0_iff_dvd[symmetric]) qed from sturm_seq_sturm[OF \rsquarefree p'\] interpret sturm_seq: sturm_seq "sturm_squarefree p" p' by (simp add: sturm_squarefree_def) show "\x y. sgn (poly (last (sturm_squarefree p)) x) = sgn (poly (last (sturm_squarefree p)) y)" by simp show "sturm_squarefree p \ []" by simp show "hd (sturm_squarefree p) = p'" by (simp add: sturm_squarefree_def) show "length (sturm_squarefree p) \ 2" by simp have [simp]: "sturm_squarefree p ! 0 = p'" "sturm_squarefree p ! Suc 0 = pderiv p'" by (simp_all add: sturm_squarefree_def) from \rsquarefree p'\ show "\x. \ (poly p' x = 0 \ poly (sturm_squarefree p ! 1) x = 0)" by (simp add: rsquarefree_roots) from sturm_seq.signs show "\i x. \i < length (sturm_squarefree p) - 2; poly (sturm_squarefree p ! (i + 1)) x = 0\ \ poly (sturm_squarefree p ! (i + 2)) x * poly (sturm_squarefree p ! i) x < 0" . from sturm_seq.deriv show "\x\<^sub>0. poly p' x\<^sub>0 = 0 \ eventually (\x. sgn (poly (p' * sturm_squarefree p ! 1) x) = (if x > x\<^sub>0 then 1 else -1)) (at x\<^sub>0)" . qed subsubsection \Optimisation for multiple roots\ text \ We can also define the following non-canonical Sturm sequence that is obtained by taking the canonical Sturm sequence of $p$ (possibly with multiple roots) and then dividing the entire sequence by the GCD of $p$ and its derivative. \ definition sturm_squarefree' where "sturm_squarefree' p = (let d = gcd p (pderiv p) in map (\p'. p' div d) (sturm p))" text \ This construction also has all the desired properties: \ lemma sturm_squarefree'_adjacent_root_propagate_left: assumes "p \ 0" assumes "i < length (sturm_squarefree' (p :: real poly)) - 1" assumes "poly (sturm_squarefree' p ! i) x = 0" and "poly (sturm_squarefree' p ! (i + 1)) x = 0" shows "\j\i+1. poly (sturm_squarefree' p ! j) x = 0" proof (intro sturm_adjacent_root_aux[OF assms(2,3,4)], goal_cases) case prems: (1 i x) define q where "q = sturm p ! i" define r where "r = sturm p ! (Suc i)" define s where "s = sturm p ! (Suc (Suc i))" define d where "d = gcd p (pderiv p)" define q' r' s' where "q' = q div d" and "r' = r div d" and "s' = s div d" from \p \ 0\ have "d \ 0" unfolding d_def by simp from prems(1) have i_in_range: "i < length (sturm p) - 2" unfolding sturm_squarefree'_def Let_def by simp have [simp]: "d dvd q" "d dvd r" "d dvd s" unfolding q_def r_def s_def d_def using i_in_range by (auto intro: sturm_gcd) hence qrs_simps: "q = q' * d" "r = r' * d" "s = s' * d" unfolding q'_def r'_def s'_def by (simp_all) with prems(2) i_in_range have r'_0: "poly r' x = 0" unfolding r'_def r_def d_def sturm_squarefree'_def Let_def by simp hence r_0: "poly r x = 0" by (simp add: \r = r' * d\) from sturm_indices[OF i_in_range] have "q = q div r * r - s" unfolding q_def r_def s_def by (simp add: div_mult_mod_eq) hence "q' = (q div r * r - s) div d" by (simp add: q'_def) also have "... = (q div r * r) div d - s'" by (simp add: s'_def poly_div_diff_left) also have "... = q div r * r' - s'" using dvd_div_mult[OF \d dvd r\, of "q div r"] by (simp add: algebra_simps r'_def) also have "q div r = q' div r'" by (simp add: qrs_simps \d \ 0\) finally have "poly q' x = poly (q' div r' * r' - s') x" by simp also from r'_0 have "... = -poly s' x" by simp finally have "poly s' x = -poly q' x" by simp thus ?case using i_in_range unfolding q'_def s'_def q_def s_def sturm_squarefree'_def Let_def by (simp add: d_def sgn_minus) qed lemma sturm_squarefree'_adjacent_roots: assumes "p \ 0" "i < length (sturm_squarefree' (p :: real poly)) - 1" "poly (sturm_squarefree' p ! i) x = 0" "poly (sturm_squarefree' p ! (i + 1)) x = 0" shows False proof- define d where "d = gcd p (pderiv p)" from sturm_squarefree'_adjacent_root_propagate_left[OF assms] have "poly (sturm_squarefree' p ! 0) x = 0" "poly (sturm_squarefree' p ! 1) x = 0" by auto hence "poly (p div d) x = 0" "poly (pderiv p div d) x = 0" using assms(2) unfolding sturm_squarefree'_def Let_def d_def by auto moreover from div_gcd_coprime assms(1) have "coprime (p div d) (pderiv p div d)" unfolding d_def by auto ultimately show False using coprime_imp_no_common_roots by auto qed lemma sturm_squarefree'_signs: assumes "p \ 0" assumes i_in_range: "i < length (sturm_squarefree' (p :: real poly)) - 2" assumes q_0: "poly (sturm_squarefree' p ! (i+1)) x = 0" (is "poly ?q x = 0") shows "poly (sturm_squarefree' p ! (i+2)) x * poly (sturm_squarefree' p ! i) x < 0" (is "poly ?r x * poly ?p x < 0") proof- define d where "d = gcd p (pderiv p)" with \p \ 0\ have [simp]: "d \ 0" by simp from poly_div_gcd_squarefree(1)[OF \p \ 0\] coprime_imp_no_common_roots have rsquarefree: "rsquarefree (p div d)" by (auto simp: rsquarefree_roots d_def) from i_in_range have i_in_range': "i < length (sturm p) - 2" unfolding sturm_squarefree'_def by simp hence "d dvd (sturm p ! i)" (is "d dvd ?p'") "d dvd (sturm p ! (Suc i))" (is "d dvd ?q'") "d dvd (sturm p ! (Suc (Suc i)))" (is "d dvd ?r'") unfolding d_def by (auto intro: sturm_gcd) hence pqr_simps: "?p' = ?p * d" "?q' = ?q * d" "?r' = ?r * d" unfolding sturm_squarefree'_def Let_def d_def using i_in_range' by (auto simp: dvd_div_mult_self) with q_0 have q'_0: "poly ?q' x = 0" by simp from sturm_indices[OF i_in_range'] have "sturm p ! (i+2) = - (sturm p ! i mod sturm p ! (i+1))" . hence "-?r' = ?p' mod ?q'" by simp with div_mult_mod_eq[of ?p' ?q'] have "?p' div ?q' * ?q' - ?r' = ?p'" by simp hence "d*(?p div ?q * ?q - ?r) = d* ?p" by (simp add: pqr_simps algebra_simps) hence "?p div ?q * ?q - ?r = ?p" by simp hence "poly (?p div ?q) x * poly ?q x - poly ?r x = poly ?p x" by (metis poly_diff poly_mult) with q_0 have r_x: "poly ?r x = -poly ?p x" by simp from sturm_squarefree'_adjacent_roots[OF \p \ 0\] i_in_range q_0 have "poly ?p x \ 0" by force moreover have sqr_pos: "\x::real. x \ 0 \ x * x > 0" apply (case_tac "x \ 0") by (simp_all add: mult_neg_neg) ultimately show ?thesis using r_x by simp qed text \ This approach indeed also yields a valid squarefree Sturm sequence for the polynomial $p/\text{gcd}(p,p')$. \ lemma sturm_seq_sturm_squarefree': assumes "(p :: real poly) \ 0" defines "d \ gcd p (pderiv p)" shows "sturm_seq (sturm_squarefree' p) (p div d)" (is "sturm_seq ?ps' ?p'") proof show "?ps' \ []" "hd ?ps' = ?p'" "2 \ length ?ps'" by (simp_all add: sturm_squarefree'_def d_def hd_map) from assms have "d \ 0" by simp { have "d dvd last (sturm p)" unfolding d_def by (rule sturm_gcd, simp) hence *: "last (sturm p) = last ?ps' * d" by (simp add: sturm_squarefree'_def last_map d_def dvd_div_mult_self) then have "last ?ps' dvd last (sturm p)" by simp with * dvd_imp_degree_le[OF this] have "degree (last ?ps') \ degree (last (sturm p))" using \d \ 0\ by (cases "last ?ps' = 0") auto hence "degree (last ?ps') = 0" by simp then obtain c where "last ?ps' = [:c:]" by (cases "last ?ps'", simp split: if_split_asm) thus "\x y. sgn (poly (last ?ps') x) = sgn (poly (last ?ps') y)" by simp } have squarefree: "rsquarefree ?p'" using \p \ 0\ by (subst rsquarefree_roots, unfold d_def, intro allI coprime_imp_no_common_roots poly_div_gcd_squarefree) have [simp]: "sturm_squarefree' p ! Suc 0 = pderiv p div d" unfolding sturm_squarefree'_def Let_def sturm_def d_def by (subst sturm_aux.simps, simp) have coprime: "coprime ?p' (pderiv p div d)" unfolding d_def using div_gcd_coprime \p \ 0\ by blast thus squarefree': "\x. \ (poly (p div d) x = 0 \ poly (sturm_squarefree' p ! 1) x = 0)" using coprime_imp_no_common_roots by simp from sturm_squarefree'_signs[OF \p \ 0\] show "\i x. \i < length ?ps' - 2; poly (?ps' ! (i + 1)) x = 0\ \ poly (?ps' ! (i + 2)) x * poly (?ps' ! i) x < 0" . have [simp]: "?p' \ 0" using squarefree by (simp add: rsquarefree_def) have A: "?p' = ?ps' ! 0" "pderiv p div d = ?ps' ! 1" by (simp_all add: sturm_squarefree'_def Let_def d_def sturm_def, subst sturm_aux.simps, simp) have [simp]: "?ps' ! 0 \ 0" using squarefree by (auto simp: A rsquarefree_def) fix x\<^sub>0 :: real assume "poly ?p' x\<^sub>0 = 0" hence "poly p x\<^sub>0 = 0" using poly_div_gcd_squarefree(2)[OF \p \ 0\] unfolding d_def by simp hence "pderiv p \ 0" using \p \ 0\ by (auto dest: pderiv_iszero) with \p \ 0\ \poly p x\<^sub>0 = 0\ have A: "eventually (\x. sgn (poly (p * pderiv p) x) = (if x\<^sub>0 < x then 1 else -1)) (at x\<^sub>0)" by (intro sturm_firsttwo_signs_aux, simp_all) note ev = eventually_conj[OF A poly_neighbourhood_without_roots[OF \d \ 0\]] show "eventually (\x. sgn (poly (p div d * sturm_squarefree' p ! 1) x) = (if x\<^sub>0 < x then 1 else -1)) (at x\<^sub>0)" proof (rule eventually_mono[OF ev], goal_cases) have [intro]: "\a (b::real). b \ 0 \ a < 0 \ a / (b * b) < 0" "\a (b::real). b \ 0 \ a > 0 \ a / (b * b) > 0" by ((case_tac "b > 0", auto simp: mult_neg_neg field_simps) [])+ case prems: (1 x) hence [simp]: "poly d x * poly d x > 0" by (cases "poly d x > 0", auto simp: mult_neg_neg) from poly_div_gcd_squarefree_aux(2)[OF \pderiv p \ 0\] have "poly (p div d) x = 0 \ poly p x = 0" by (simp add: d_def) moreover have "d dvd p" "d dvd pderiv p" unfolding d_def by simp_all ultimately show ?case using prems by (auto simp: sgn_real_def poly_div not_less[symmetric] zero_less_divide_iff split: if_split_asm) qed qed text \ This construction is obviously more expensive to compute than the one that \emph{first} divides $p$ by $\text{gcd}(p,p')$ and \emph{then} applies the canonical construction. In this construction, we \emph{first} compute the canonical Sturm sequence of $p$ as if it had no multiple roots and \emph{then} divide by the GCD. However, it can be seen quite easily that unless $x$ is a multiple root of $p$, i.\,e. as long as $\text{gcd}(P,P')\neq 0$, the number of sign changes in a sequence of polynomials does not actually change when we divide the polynomials by $\text{gcd}(p,p')$.\\ There\-fore we can use the ca\-no\-ni\-cal Sturm se\-quence even in the non-square\-free case as long as the borders of the interval we are interested in are not multiple roots of the polynomial. \ lemma sign_changes_mult_aux: assumes "d \ (0::real)" shows "length (remdups_adj (filter (\x. x \ 0) (map ((*) d \ f) xs))) = length (remdups_adj (filter (\x. x \ 0) (map f xs)))" proof- from assms have inj: "inj ((*) d)" by (auto intro: injI) from assms have [simp]: "filter (\x. ((*) d \ f) x \ 0) = filter (\x. f x \ 0)" "filter ((\x. x \ 0) \ f) = filter (\x. f x \ 0)" by (simp_all add: o_def) have "filter (\x. x \ 0) (map ((*) d \ f) xs) = map ((*) d \ f) (filter (\x. ((*) d \ f) x \ 0) xs)" by (simp add: filter_map o_def) thus ?thesis using remdups_adj_map_injective[OF inj] assms by (simp add: filter_map map_map[symmetric] del: map_map) qed lemma sturm_sturm_squarefree'_same_sign_changes: fixes p :: "real poly" defines "ps \ sturm p" and "ps' \ sturm_squarefree' p" shows "poly p x \ 0 \ poly (pderiv p) x \ 0 \ sign_changes ps' x = sign_changes ps x" "p \ 0 \ sign_changes_inf ps' = sign_changes_inf ps" "p \ 0 \ sign_changes_neg_inf ps' = sign_changes_neg_inf ps" proof- define d where "d = gcd p (pderiv p)" define p' where "p' = p div d" define s' where "s' = poly_inf d" define s'' where "s'' = poly_neg_inf d" { fix x :: real and q :: "real poly" assume "q \ set ps" hence "d dvd q" unfolding d_def ps_def using sturm_gcd by simp hence q_prod: "q = (q div d) * d" unfolding p'_def d_def by (simp add: algebra_simps dvd_mult_div_cancel) have "poly q x = poly d x * poly (q div d) x" by (subst q_prod, simp) hence s1: "sgn (poly q x) = sgn (poly d x) * sgn (poly (q div d) x)" by (subst q_prod, simp add: sgn_mult) from poly_inf_mult have s2: "poly_inf q = s' * poly_inf (q div d)" unfolding s'_def by (subst q_prod, simp) from poly_inf_mult have s3: "poly_neg_inf q = s'' * poly_neg_inf (q div d)" unfolding s''_def by (subst q_prod, simp) note s1 s2 s3 } note signs = this { fix f :: "real poly \ real" and s :: real assume f: "\q. q \ set ps \ f q = s * f (q div d)" and s: "s \ 0" hence "inverse s \ 0" by simp {fix q assume "q \ set ps" hence "f (q div d) = inverse s * f q" by (subst f[of q], simp_all add: s) } note f' = this have "length (remdups_adj [x\map f (map (\q. q div d) ps). x \ 0]) - 1 = length (remdups_adj [x\map (\q. f (q div d)) ps . x \ 0]) - 1" by (simp only: sign_changes_def o_def map_map) also have "map (\q. q div d) ps = ps'" by (simp add: ps_def ps'_def sturm_squarefree'_def Let_def d_def) also from f' have "map (\q. f (q div d)) ps = map (\x. ((*)(inverse s) \ f) x) ps" by (simp add: o_def) also note sign_changes_mult_aux[OF \inverse s \ 0\, of f ps] finally have "length (remdups_adj [x\map f ps' . x \ 0]) - 1 = length (remdups_adj [x\map f ps . x \ 0]) - 1" by simp } note length_remdups_adj = this { fix x assume A: "poly p x \ 0 \ poly (pderiv p) x \ 0" have "d dvd p" "d dvd pderiv p" unfolding d_def by simp_all with A have "sgn (poly d x) \ 0" by (auto simp add: sgn_zero_iff elim: dvdE) thus "sign_changes ps' x = sign_changes ps x" using signs(1) unfolding sign_changes_def by (intro length_remdups_adj[of "\q. sgn (poly q x)"], simp_all) } assume "p \ 0" hence "d \ 0" unfolding d_def by simp hence "s' \ 0" "s'' \ 0" unfolding s'_def s''_def by simp_all from length_remdups_adj[of poly_inf s', OF signs(2) \s' \ 0\] show "sign_changes_inf ps' = sign_changes_inf ps" unfolding sign_changes_inf_def . from length_remdups_adj[of poly_neg_inf s'', OF signs(3) \s'' \ 0\] show "sign_changes_neg_inf ps' = sign_changes_neg_inf ps" unfolding sign_changes_neg_inf_def . qed subsection \Root-counting functions\ text \ With all these results, we can now define functions that count roots in bounded and unbounded intervals: \ definition count_roots_between where "count_roots_between p a b = (if a \ b \ p \ 0 then (let ps = sturm_squarefree p in sign_changes ps a - sign_changes ps b) else 0)" definition count_roots where "count_roots p = (if (p::real poly) = 0 then 0 else (let ps = sturm_squarefree p in sign_changes_neg_inf ps - sign_changes_inf ps))" definition count_roots_above where "count_roots_above p a = (if (p::real poly) = 0 then 0 else (let ps = sturm_squarefree p in sign_changes ps a - sign_changes_inf ps))" definition count_roots_below where "count_roots_below p a = (if (p::real poly) = 0 then 0 else (let ps = sturm_squarefree p in sign_changes_neg_inf ps - sign_changes ps a))" lemma count_roots_between_correct: "count_roots_between p a b = card {x. a < x \ x \ b \ poly p x = 0}" proof (cases "p \ 0 \ a \ b") case False note False' = this hence "card {x. a < x \ x \ b \ poly p x = 0} = 0" proof (cases "a < b") case True with False have [simp]: "p = 0" by simp have subset: "{a<.. {x. a < x \ x \ b \ poly p x = 0}" by auto from infinite_Ioo[OF True] have "\finite {a<..finite {x. a < x \ x \ b \ poly p x = 0}" using finite_subset[OF subset] by blast thus ?thesis by simp next case False with False' show ?thesis by (auto simp: not_less card_eq_0_iff) qed thus ?thesis unfolding count_roots_between_def Let_def using False by auto next case True hence "p \ 0" "a \ b" by simp_all define p' where "p' = p div (gcd p (pderiv p))" from poly_div_gcd_squarefree(1)[OF \p \ 0\] have "p' \ 0" unfolding p'_def by clarsimp from sturm_seq_sturm_squarefree[OF \p \ 0\] interpret sturm_seq "sturm_squarefree p" p' unfolding p'_def . from poly_roots_finite[OF \p' \ 0\] have "finite {x. a < x \ x \ b \ poly p' x = 0}" by fast have "count_roots_between p a b = card {x. a < x \ x \ b \ poly p' x = 0}" unfolding count_roots_between_def Let_def using True count_roots_between[OF \p' \ 0\ \a \ b\] by simp also from poly_div_gcd_squarefree(2)[OF \p \ 0\] have "{x. a < x \ x \ b \ poly p' x = 0} = {x. a < x \ x \ b \ poly p x = 0}" unfolding p'_def by blast finally show ?thesis . qed lemma count_roots_correct: fixes p :: "real poly" shows "count_roots p = card {x. poly p x = 0}" (is "_ = card ?S") proof (cases "p = 0") case True with finite_subset[of "{0<..<1}" ?S] have "\finite {x. poly p x = 0}" by (auto simp: infinite_Ioo) thus ?thesis by (simp add: count_roots_def True) next case False define p' where "p' = p div (gcd p (pderiv p))" from poly_div_gcd_squarefree(1)[OF \p \ 0\] have "p' \ 0" unfolding p'_def by clarsimp from sturm_seq_sturm_squarefree[OF \p \ 0\] interpret sturm_seq "sturm_squarefree p" p' unfolding p'_def . from count_roots[OF \p' \ 0\] have "count_roots p = card {x. poly p' x = 0}" unfolding count_roots_def Let_def by (simp add: \p \ 0\) also from poly_div_gcd_squarefree(2)[OF \p \ 0\] have "{x. poly p' x = 0} = {x. poly p x = 0}" unfolding p'_def by blast finally show ?thesis . qed lemma count_roots_above_correct: fixes p :: "real poly" shows "count_roots_above p a = card {x. x > a \ poly p x = 0}" (is "_ = card ?S") proof (cases "p = 0") case True with finite_subset[of "{a<..finite {x. x > a \ poly p x = 0}" by (auto simp: infinite_Ioo subset_eq) thus ?thesis by (simp add: count_roots_above_def True) next case False define p' where "p' = p div (gcd p (pderiv p))" from poly_div_gcd_squarefree(1)[OF \p \ 0\] have "p' \ 0" unfolding p'_def by clarsimp from sturm_seq_sturm_squarefree[OF \p \ 0\] interpret sturm_seq "sturm_squarefree p" p' unfolding p'_def . from count_roots_above[OF \p' \ 0\] have "count_roots_above p a = card {x. x > a \ poly p' x = 0}" unfolding count_roots_above_def Let_def by (simp add: \p \ 0\) also from poly_div_gcd_squarefree(2)[OF \p \ 0\] have "{x. x > a \ poly p' x = 0} = {x. x > a \ poly p x = 0}" unfolding p'_def by blast finally show ?thesis . qed lemma count_roots_below_correct: fixes p :: "real poly" shows "count_roots_below p a = card {x. x \ a \ poly p x = 0}" (is "_ = card ?S") proof (cases "p = 0") case True with finite_subset[of "{a - 1<..finite {x. x \ a \ poly p x = 0}" by (auto simp: infinite_Ioo subset_eq) thus ?thesis by (simp add: count_roots_below_def True) next case False define p' where "p' = p div (gcd p (pderiv p))" from poly_div_gcd_squarefree(1)[OF \p \ 0\] have "p' \ 0" unfolding p'_def by clarsimp from sturm_seq_sturm_squarefree[OF \p \ 0\] interpret sturm_seq "sturm_squarefree p" p' unfolding p'_def . from count_roots_below[OF \p' \ 0\] have "count_roots_below p a = card {x. x \ a \ poly p' x = 0}" unfolding count_roots_below_def Let_def by (simp add: \p \ 0\) also from poly_div_gcd_squarefree(2)[OF \p \ 0\] have "{x. x \ a \ poly p' x = 0} = {x. x \ a \ poly p x = 0}" unfolding p'_def by blast finally show ?thesis . qed text \ The optimisation explained above can be used to prove more efficient code equations that use the more efficient construction in the case that the interval borders are not multiple roots: \ lemma count_roots_between[code]: "count_roots_between p a b = (let q = pderiv p in if a > b \ p = 0 then 0 else if (poly p a \ 0 \ poly q a \ 0) \ (poly p b \ 0 \ poly q b \ 0) then (let ps = sturm p in sign_changes ps a - sign_changes ps b) else (let ps = sturm_squarefree p in sign_changes ps a - sign_changes ps b))" proof (cases "a > b \ p = 0") case True thus ?thesis by (auto simp add: count_roots_between_def Let_def) next case False note False1 = this hence "a \ b" "p \ 0" by simp_all thus ?thesis proof (cases "(poly p a \ 0 \ poly (pderiv p) a \ 0) \ (poly p b \ 0 \ poly (pderiv p) b \ 0)") case False thus ?thesis using False1 by (auto simp add: Let_def count_roots_between_def) next case True hence A: "poly p a \ 0 \ poly (pderiv p) a \ 0" and B: "poly p b \ 0 \ poly (pderiv p) b \ 0" by auto define d where "d = gcd p (pderiv p)" from \p \ 0\ have [simp]: "p div d \ 0" using poly_div_gcd_squarefree(1)[OF \p \ 0\] by (auto simp add: d_def) from sturm_seq_sturm_squarefree'[OF \p \ 0\] interpret sturm_seq "sturm_squarefree' p" "p div d" unfolding sturm_squarefree'_def Let_def d_def . note count_roots_between_correct also have "{x. a < x \ x \ b \ poly p x = 0} = {x. a < x \ x \ b \ poly (p div d) x = 0}" unfolding d_def using poly_div_gcd_squarefree(2)[OF \p \ 0\] by simp also note count_roots_between[OF \p div d \ 0\ \a \ b\, symmetric] also note sturm_sturm_squarefree'_same_sign_changes(1)[OF A] also note sturm_sturm_squarefree'_same_sign_changes(1)[OF B] finally show ?thesis using True False by (simp add: Let_def) qed qed lemma count_roots_code[code]: "count_roots (p::real poly) = (if p = 0 then 0 else let ps = sturm p in sign_changes_neg_inf ps - sign_changes_inf ps)" proof (cases "p = 0", simp add: count_roots_def) case False define d where "d = gcd p (pderiv p)" from \p \ 0\ have [simp]: "p div d \ 0" using poly_div_gcd_squarefree(1)[OF \p \ 0\] by (auto simp add: d_def) from sturm_seq_sturm_squarefree'[OF \p \ 0\] interpret sturm_seq "sturm_squarefree' p" "p div d" unfolding sturm_squarefree'_def Let_def d_def . note count_roots_correct also have "{x. poly p x = 0} = {x. poly (p div d) x = 0}" unfolding d_def using poly_div_gcd_squarefree(2)[OF \p \ 0\] by simp also note count_roots[OF \p div d \ 0\, symmetric] also note sturm_sturm_squarefree'_same_sign_changes(2)[OF \p \ 0\] also note sturm_sturm_squarefree'_same_sign_changes(3)[OF \p \ 0\] finally show ?thesis using False unfolding Let_def by simp qed lemma count_roots_above_code[code]: "count_roots_above p a = (let q = pderiv p in if p = 0 then 0 else if poly p a \ 0 \ poly q a \ 0 then (let ps = sturm p in sign_changes ps a - sign_changes_inf ps) else (let ps = sturm_squarefree p in sign_changes ps a - sign_changes_inf ps))" proof (cases "p = 0") case True thus ?thesis by (auto simp add: count_roots_above_def Let_def) next case False note False1 = this hence "p \ 0" by simp_all thus ?thesis proof (cases "(poly p a \ 0 \ poly (pderiv p) a \ 0)") case False thus ?thesis using False1 by (auto simp add: Let_def count_roots_above_def) next case True hence A: "poly p a \ 0 \ poly (pderiv p) a \ 0" by simp define d where "d = gcd p (pderiv p)" from \p \ 0\ have [simp]: "p div d \ 0" using poly_div_gcd_squarefree(1)[OF \p \ 0\] by (auto simp add: d_def) from sturm_seq_sturm_squarefree'[OF \p \ 0\] interpret sturm_seq "sturm_squarefree' p" "p div d" unfolding sturm_squarefree'_def Let_def d_def . note count_roots_above_correct also have "{x. a < x \ poly p x = 0} = {x. a < x \ poly (p div d) x = 0}" unfolding d_def using poly_div_gcd_squarefree(2)[OF \p \ 0\] by simp also note count_roots_above[OF \p div d \ 0\, symmetric] also note sturm_sturm_squarefree'_same_sign_changes(1)[OF A] also note sturm_sturm_squarefree'_same_sign_changes(2)[OF \p \ 0\] finally show ?thesis using True False by (simp add: Let_def) qed qed lemma count_roots_below_code[code]: "count_roots_below p a = (let q = pderiv p in if p = 0 then 0 else if poly p a \ 0 \ poly q a \ 0 then (let ps = sturm p in sign_changes_neg_inf ps - sign_changes ps a) else (let ps = sturm_squarefree p in sign_changes_neg_inf ps - sign_changes ps a))" proof (cases "p = 0") case True thus ?thesis by (auto simp add: count_roots_below_def Let_def) next case False note False1 = this hence "p \ 0" by simp_all thus ?thesis proof (cases "(poly p a \ 0 \ poly (pderiv p) a \ 0)") case False thus ?thesis using False1 by (auto simp add: Let_def count_roots_below_def) next case True hence A: "poly p a \ 0 \ poly (pderiv p) a \ 0" by simp define d where "d = gcd p (pderiv p)" from \p \ 0\ have [simp]: "p div d \ 0" using poly_div_gcd_squarefree(1)[OF \p \ 0\] by (auto simp add: d_def) from sturm_seq_sturm_squarefree'[OF \p \ 0\] interpret sturm_seq "sturm_squarefree' p" "p div d" unfolding sturm_squarefree'_def Let_def d_def . note count_roots_below_correct also have "{x. x \ a \ poly p x = 0} = {x. x \ a \ poly (p div d) x = 0}" unfolding d_def using poly_div_gcd_squarefree(2)[OF \p \ 0\] by simp also note count_roots_below[OF \p div d \ 0\, symmetric] also note sturm_sturm_squarefree'_same_sign_changes(1)[OF A] also note sturm_sturm_squarefree'_same_sign_changes(3)[OF \p \ 0\] finally show ?thesis using True False by (simp add: Let_def) qed qed end diff --git a/thys/Sturm_Sequences/document/root_userguide.tex b/thys/Sturm_Sequences/document/root_userguide.tex --- a/thys/Sturm_Sequences/document/root_userguide.tex +++ b/thys/Sturm_Sequences/document/root_userguide.tex @@ -1,143 +1,143 @@ \documentclass[11pt,a4paper,oneside]{article} \usepackage[T1]{fontenc} \usepackage[english]{babel} \usepackage{geometry} \usepackage{color} \usepackage{graphicx} \usepackage{pifont} \usepackage[babel]{csquotes} \usepackage{textcomp} \usepackage{upgreek} \usepackage{amsmath} \usepackage{textcomp} \usepackage{amssymb} \usepackage{latexsym} \usepackage{pgf} \usepackage{nicefrac} \usepackage{enumerate} \usepackage{stmaryrd} \usepackage{tgpagella} \DeclareFontFamily{OT1}{pzc}{} \DeclareFontShape{OT1}{pzc}{m}{it}{<-> s * [1.10] pzcmi7t}{} \DeclareMathAlphabet{\mathpzc}{OT1}{pzc}{m}{it} \newcommand{\ie}{i.\,e.} \newcommand{\wuppdi}[0]{\hfill\ensuremath{\square}} \newcommand{\qed}[0]{\vspace{-3mm}\begin{flushright}\textit{q.e.d.}\end{flushright}\vspace{3mm}} \newcommand{\bred}{\ensuremath{\longrightarrow_\beta}} \newcommand{\acos}{\textrm{arccos}} \newcommand{\determ}[1]{\textrm{det}(#1)} \newcommand{\RR}{\mathbb{R}} \newcommand{\BB}{\mathbb{B}} \newcommand{\NN}{\mathbb{N}} \newcommand{\QQ}{\mathbb{Q}} \newcommand{\ZZ}{\mathbb{Z}} \newcommand{\CC}{\mathbb{C}} \newcommand{\II}{\mathbb{I}} \newcommand{\kernel}[1]{\textrm{ker}(#1)} \renewcommand{\epsilon}{\varepsilon} \renewcommand{\phi}{\varphi} \renewcommand{\theta}{\vartheta} \newcommand{\atan}{\mathrm{arctan}} \newcommand{\rot}{\mathrm{rot}} \newcommand{\vdiv}{\mathrm{div}} \newcommand{\shouldbe}{\stackrel{!}{=}} \newcommand{\sturm}{\texttt{sturm}} \newcommand{\lemma}{\textbf{lemma}} \newcommand{\card}{\textrm{card}} \newcommand{\real}{\textrm{real}} \newcommand{\isabellehol}{\mbox{Isabelle}\slash HOL} \geometry{a4paper,left=30mm,right=30mm, top=25mm, bottom=30mm} \title{\LARGE User's Guide for the \texttt{sturm} Method\\[4mm]} -\author{\Large Manuel Eberl \\[1mm]\large Institut für Informatik, Technische Universität München\\[4mm]} +\author{\Large Manuel Eberl \\[1mm]\large Institut für Informatik, Technische Universität München\\[4mm]} \begin{document} \begin{center} \vspace*{20mm} \includegraphics[width=4cm]{isabelle_logo} \end{center} \vspace*{-5mm} {\let\newpage\relax\maketitle} \vspace*{10mm} \tableofcontents \newpage \section{Introduction} The \sturm\ method uses Sturm's theorem to determine the number of distinct real roots of a polynomial (with rational coefficients) within a certain interval. It also provides some preprocessing to decide a number of statements that can be reduced to real roots of polynomials, such as simple polynomial inequalities and logical combinations of polynomial equations. \vspace*{10mm} \section{Usage} \subsection{Examples} The following examples should give a good overview of what the \sturm\ method can do: \begin{align*} &\lemma\ "\card\ \{x::\real.\ (x - 1)^2 * (x + 1) = 0\}\ =\ 2"\ \textrm{\textbf{by}\ sturm}\\ &\lemma\ "\mathrm{card}\ \{x::\mathrm{real}.\ -0.010831 < x\ \wedge\ x < 0.010831\ \wedge\\ &\hskip20mm \mathrm{poly}\ [:0, -17/2097152, -49/16777216, 1/6, 1/24, 1/120:]\ \ x\ =\ 0\}\ =\ 3"\ \textrm{\textbf{by}\ sturm}\\ &\lemma\ "\card\ \{x::\real.\ x^3 + x = 2*x^2\ \wedge\ x^3-6*x^2+11*x=6\}\ =\ 1"\ \textrm{\textbf{by}\ sturm}\\ &\lemma\ "\card\ \{x::\real.\ x^3 + x = 2*x^2\ \vee\ x^3-6*x^2+11*x=6\}\ =\ 4"\ \textrm{\textbf{by}\ sturm}\\ &\lemma\ "(x::\real)^2+1 > 0"\ \textrm{\textbf{by}\ sturm}\\ &\lemma\ "(x::\real) > 0\ \Longrightarrow\ x^2+1 > 0"\ \textrm{\textbf{by}\ sturm}\\ &\lemma\ "\llbracket (x::\real) > 0; x \leq 2/3\rrbracket\ \Longrightarrow\ x*x \neq\ x"\ \textrm{\textbf{by}\ sturm}\\ &\lemma\ "(x::\real) > 1\ \Longrightarrow\ x*x > x"\ \textrm{\textbf{by}\ sturm}\\ \end{align*} \subsection{Determining the number of real roots} The \enquote{classical} application of Sturm's theorem is to count the number of real roots of a polynomial in a certain interval. The \sturm\ method supports this for any polynomial with rational coefficients and any real interval, \ie $[a;b]$, $(a;b]$, $[a;b)$, and $(a;b)$ where $a\in\QQ\cup\{-\infty\}$ and $b\in\QQ\cup\{\infty\}$.\footnote{The restriction to rational numbers for the coefficients and interval bounds is to the fact that the code generator is used internally, which, of course, does not support computations on irrational real numbers.} The general form of the theorems the method expects is: $$\card\ \{x::\real.\ a < x \wedge x < b \wedge p\ x = 0\}\ =\ ?n$$ $?n$ should be replaced by the actual number of such roots and $p$ may be any polynomial real function in $x$ with rational coefficients. The bounds $a < x$ and $x < b$ can be omitted for the \enquote{$\infty$} case.\\ Furthermore, the \sturm\ method can instantiate the number $?n$ on the right-hand side automatically if it is left unspecified (as a schematic variable in a schematic lemma). However, due to technical restrictions this also takes twice as long as simply proving that the specified number is correct. \newpage \subsection{Inequalities} A simple special case of root counting is the statement that a polynomial $p\in\RR[X]$ has no roots in a certain interval, which can be written as: $$\forall x::\real.\ x > a \wedge x < b \longrightarrow p\ x \neq 0$$ The \sturm\ method can be directly applied to statements such as this and prove them. \subsection{More complex expressions} By using some simple preprocessing, the \sturm\ method can also decide more complex statements: $$\card\ \{x::\real.\ x > a\ \wedge\ x < b\ \wedge\ P\ x\}\ =\ n$$ where $P\ x$ is a \enquote{polynomial expression}, which is defined as: \begin{enumerate} \item $p\ x= q\ x$, where $p$ and $q$ are polynomial functions, such as $\lambda x.\ a$, $\lambda x.\ x$, $\lambda x.\ x^2$, $\mathrm{poly}\ p$, and so on \item $P\ x\ \wedge\ Q\ x$ or $P\ x\ \vee\ Q\ x$, where $P\ x$ and $Q\ x$ are polynomial expressions \end{enumerate} Of course, by reduction to the case of zero roots, the following kind of statement is also provable by \sturm\ : $$\forall x::\real.\ x > a\ \wedge\ x < b\ \longrightarrow\ P\ x$$ where $P\ x$ is a \enquote{negated polynomial expression}, which is defined as: \begin{enumerate} \item $p\ x\neq q\ x$, where $p$ and $q$ are polynomial functions \item $P\ x\ \wedge\ Q\ x$ or $P\ x\ \vee\ Q\ x$, where $P\ x$ and $Q\ x$ are negated polynomial expressions \end{enumerate} \subsection{Simple ordered inequalities} For any polynomial $p\in\RR[X]$, the question whether $p(x) > 0$ for all $x\in I$ for a non-empty real interval $I$ can obviously be reduced to the question of whether $p(x) \neq 0$ for all $x\in I$, \ie $p$ has no roots in $I$, and $p(x) > 0$ for some arbitrary fixed $x\in I$, the first of which can be decided using Sturm's theorem and the second by choosing an arbitrary $x\in I$ and evaluating $p(x)$.\\ Using this reduction, the \sturm\ method can also decide single \enquote{less than}/\enquote{greater than} inequalities of the form $$\forall x::\real.\ x > a\ \wedge\ x < b\ \longrightarrow\ p\ x < q\ x$$ \subsection{A note on meta logic versus object logic} While statements like $\forall x::\real.\ x^2+1>0$ were expressed in their HOL notation in this guide, the \sturm\ method can also prove the meta logic equivalents $\bigwedge x::\real.\ x^2+1>0$ and $(x::\real)^2+1>0$ directly. \section{Troubleshooting} Should you find that the \sturm\ method fails to prove a statement that it should, according to the above text, be able to prove, please go through the following steps: \begin{enumerate} \item ensure that your function is indeed a \emph{real} polynomial. Add an appropriate type annotation if necessary. \item use a computer algebra system to ensure that the property is indeed correct -\item if this did not help, send the statement in question to \texttt{eberlm@in.tum.de}; it may be a bug in the preprocessing of the proof method. +\item if this did not help, send the statement in question to \texttt{manuel@pruvisto.org}; it may be a bug in the preprocessing of the proof method. \end{enumerate} \end{document} diff --git a/thys/Triangle/Angles.thy b/thys/Triangle/Angles.thy --- a/thys/Triangle/Angles.thy +++ b/thys/Triangle/Angles.thy @@ -1,253 +1,253 @@ (* File: Angles.thy - Author: Manuel Eberl + Author: Manuel Eberl Definition of angles between vectors and between three points. *) section \Definition of angles\ theory Angles imports "HOL-Analysis.Multivariate_Analysis" begin lemma collinear_translate_iff: "collinear (((+) a) ` A) \ collinear A" by (auto simp: collinear_def) definition vangle where "vangle u v = (if u = 0 \ v = 0 then pi / 2 else arccos (u \ v / (norm u * norm v)))" definition angle where "angle a b c = vangle (a - b) (c - b)" lemma angle_altdef: "angle a b c = arccos ((a - b) \ (c - b) / (dist a b * dist c b))" by (simp add: angle_def vangle_def dist_norm) lemma vangle_0_left [simp]: "vangle 0 v = pi / 2" and vangle_0_right [simp]: "vangle u 0 = pi / 2" by (simp_all add: vangle_def) lemma vangle_refl [simp]: "u \ 0 \ vangle u u = 0" by (simp add: vangle_def dot_square_norm power2_eq_square) lemma angle_refl [simp]: "angle a a b = pi / 2" "angle a b b = pi / 2" by (simp_all add: angle_def) lemma angle_refl_mid [simp]: "a \ b \ angle a b a = 0" by (simp add: angle_def) lemma cos_vangle: "cos (vangle u v) = u \ v / (norm u * norm v)" unfolding vangle_def using Cauchy_Schwarz_ineq2[of u v] by (auto simp: field_simps) lemma cos_angle: "cos (angle a b c) = (a - b) \ (c - b) / (dist a b * dist c b)" by (simp add: angle_def cos_vangle dist_norm) lemma inner_conv_angle: "(a - b) \ (c - b) = dist a b * dist c b * cos (angle a b c)" by (simp add: cos_angle) lemma vangle_commute: "vangle u v = vangle v u" by (simp add: vangle_def inner_commute mult.commute) lemma angle_commute: "angle a b c = angle c b a" by (simp add: angle_def vangle_commute) lemma vangle_nonneg: "vangle u v \ 0" and vangle_le_pi: "vangle u v \ pi" using Cauchy_Schwarz_ineq2[of u v] by (auto simp: vangle_def field_simps intro!: arccos_lbound arccos_ubound) lemmas vangle_bounds = vangle_nonneg vangle_le_pi lemma angle_nonneg: "angle a b c \ 0" and angle_le_pi: "angle a b c \ pi" using vangle_bounds unfolding angle_def by blast+ lemmas angle_bounds = angle_nonneg angle_le_pi lemma sin_vangle_nonneg: "sin (vangle u v) \ 0" using vangle_bounds by (rule sin_ge_zero) lemma sin_angle_nonneg: "sin (angle a b c) \ 0" using angle_bounds by (rule sin_ge_zero) lemma vangle_eq_0D: assumes "vangle u v = 0" shows "norm u *\<^sub>R v = norm v *\<^sub>R u" proof - from assms have "u \ v = norm u * norm v" using arccos_eq_iff[of "(u \ v) / (norm u * norm v)" 1] Cauchy_Schwarz_ineq2[of u v] by (fastforce simp: vangle_def split: if_split_asm) thus ?thesis by (subst (asm) norm_cauchy_schwarz_eq) simp_all qed lemma vangle_eq_piD: assumes "vangle u v = pi" shows "norm u *\<^sub>R v + norm v *\<^sub>R u = 0" proof - from assms have "(-u) \ v = norm (-u) * norm v" using arccos_eq_iff[of "(u \ v) / (norm u * norm v)" "-1"] Cauchy_Schwarz_ineq2[of u v] by (simp add: field_simps vangle_def split: if_split_asm) thus ?thesis by (subst (asm) norm_cauchy_schwarz_eq) simp_all qed lemma dist_triangle_eq: fixes a b c :: "'a :: real_inner" shows "(dist a c = dist a b + dist b c) \ dist a b *\<^sub>R (c - b) + dist b c *\<^sub>R (a - b) = 0" using norm_triangle_eq[of "b - a" "c - b"] by (simp add: dist_norm norm_minus_commute algebra_simps) lemma angle_eq_pi_imp_dist_additive: assumes "angle a b c = pi" shows "dist a c = dist a b + dist b c" using vangle_eq_piD[OF assms[unfolded angle_def]] by (subst dist_triangle_eq) (simp add: dist_norm norm_minus_commute) lemma orthogonal_iff_vangle: "orthogonal u v \ vangle u v = pi / 2" using arccos_eq_iff[of "u \ v / (norm u * norm v)" 0] Cauchy_Schwarz_ineq2[of u v] by (auto simp: vangle_def orthogonal_def) lemma cos_minus1_imp_pi: assumes "cos x = -1" "x \ 0" "x < 3 * pi" shows "x = pi" proof - have "cos (x - pi) = 1" by (simp add: assms) then obtain n :: int where n: "of_int n = (x / pi - 1) / 2" by (subst (asm) cos_one_2pi_int) (auto simp: field_simps) also from assms have "\ \ {-1<..<1}" by (auto simp: field_simps) finally have "n = 0" by simp with n show ?thesis by simp qed lemma vangle_eqI: assumes "u \ 0" "v \ 0" "w \ 0" "x \ 0" assumes "(u \ v) * norm w * norm x = (w \ x) * norm u * norm v" shows "vangle u v = vangle w x" using assms Cauchy_Schwarz_ineq2[of u v] Cauchy_Schwarz_ineq2[of w x] unfolding vangle_def by (auto simp: arccos_eq_iff field_simps) lemma angle_eqI: assumes "a \ b" "a \ c" "d \ e" "d \ f" assumes "((b-a) \ (c-a)) * dist d e * dist d f = ((e-d) \ (f-d)) * dist a b * dist a c" shows "angle b a c = angle e d f" using assms unfolding angle_def by (intro vangle_eqI) (simp_all add: dist_norm norm_minus_commute) lemma cos_vangle_eqD: "cos (vangle u v) = cos (vangle w x) \ vangle u v = vangle w x" by (rule cos_inj_pi) (simp_all add: vangle_bounds) lemma cos_angle_eqD: "cos (angle a b c) = cos (angle d e f) \ angle a b c = angle d e f" unfolding angle_def by (rule cos_vangle_eqD) lemma sin_vangle_zero_iff: "sin (vangle u v) = 0 \ vangle u v \ {0, pi}" proof assume "sin (vangle u v) = 0" then obtain n :: int where n: "of_int n = vangle u v / pi" by (subst (asm) sin_zero_iff_int2) auto also have "\ \ {0..1}" using vangle_bounds by (auto simp: field_simps) finally have "n \ {0,1}" by auto thus "vangle u v \ {0,pi}" using n by (auto simp: field_simps) qed auto lemma sin_angle_zero_iff: "sin (angle a b c) = 0 \ angle a b c \ {0, pi}" unfolding angle_def by (simp only: sin_vangle_zero_iff) lemma vangle_collinear: "vangle u v \ {0, pi} \ collinear {0, u, v}" apply (subst norm_cauchy_schwarz_equal [symmetric]) apply (subst norm_cauchy_schwarz_abs_eq) apply (auto dest!: vangle_eq_0D vangle_eq_piD simp: eq_neg_iff_add_eq_0) done lemma angle_collinear: "angle a b c \ {0, pi} \ collinear {a, b, c}" apply (unfold angle_def, drule vangle_collinear) apply (subst collinear_translate_iff[symmetric, of _ "-b"]) apply (auto simp: insert_commute) done lemma not_collinear_vangle: "\collinear {0,u,v} \ vangle u v \ {0<.. vangle u v = pi") auto lemma not_collinear_angle: "\collinear {a,b,c} \ angle a b c \ {0<.. angle a b c = pi") auto subsection\Contributions from Lukas Bulwahn\ lemma vangle_scales: assumes "0 < c" shows "vangle (c *\<^sub>R v\<^sub>1) v\<^sub>2 = vangle v\<^sub>1 v\<^sub>2" using assms unfolding vangle_def by auto lemma vangle_inverse: "vangle (- v\<^sub>1) v\<^sub>2 = pi - vangle v\<^sub>1 v\<^sub>2" proof - have "\v\<^sub>1 \ v\<^sub>2 / (norm v\<^sub>1 * norm v\<^sub>2)\ \ 1" proof cases assume "v\<^sub>1 \ 0 \ v\<^sub>2 \ 0" from this show ?thesis by (simp add: Cauchy_Schwarz_ineq2) next assume "\ (v\<^sub>1 \ 0 \ v\<^sub>2 \ 0)" from this show ?thesis by auto qed from this show ?thesis unfolding vangle_def by (simp add: arccos_minus_abs) qed lemma orthogonal_iff_angle: shows "orthogonal (A - B) (C - B) \ angle A B C = pi / 2" unfolding angle_def by (auto simp only: orthogonal_iff_vangle) lemma angle_inverse: assumes "between (A, C) B" assumes "A \ B" "B \ C" shows "angle A B D = pi - angle C B D" proof - from \between (A, C) B\ obtain u where u: "u \ 0" "u \ 1" and X: "B = u *\<^sub>R A + (1 - u) *\<^sub>R C" by (metis add.commute betweenE between_commute) from \A \ B\ \B \ C\ X have "u \ 0" "u \ 1" by auto have "0 < ((1 - u) / u)" using \u \ 0\ \u \ 1\ \u \ 0\ \u \ 1\ by simp from X have "A - B = - (1 - u) *\<^sub>R (C - A)" by (simp add: real_vector.scale_right_diff_distrib real_vector.scale_left_diff_distrib) moreover from X have "C - B = u *\<^sub>R (C - A)" by (simp add: scaleR_diff_left real_vector.scale_right_diff_distrib) ultimately have "A - B = - (((1 - u) / u) *\<^sub>R (C - B))" using \u \ 0\ by simp (metis minus_diff_eq real_vector.scale_minus_left) from this have "vangle (A - B) (D - B) = pi - vangle (C - B) (D - B)" using \0 < (1 - u) / u\ by (simp add: vangle_inverse vangle_scales) from this show ?thesis unfolding angle_def by simp qed lemma strictly_between_implies_angle_eq_pi: assumes "between (A, C) B" assumes "A \ B" "B \ C" shows "angle A B C = pi" proof - from \between (A, C) B\ obtain u where u: "u \ 0" "u \ 1" and X: "B = u *\<^sub>R A + (1 - u) *\<^sub>R C" by (metis add.commute betweenE between_commute) from \A \ B\ \B \ C\ X have "u \ 0" "u \ 1" by auto from \A \ B\ \B \ C\ \between (A, C) B\ have "A \ C" by auto from X have "A - B = - (1 - u) *\<^sub>R (C - A)" by (simp add: real_vector.scale_right_diff_distrib real_vector.scale_left_diff_distrib) moreover from this have "dist A B = norm ((1 - u) *\<^sub>R (C - A))" using \u \ 0\ \u \ 1\ by (simp add: dist_norm) moreover from X have "C - B = u *\<^sub>R (C - A)" by (simp add: scaleR_diff_left real_vector.scale_right_diff_distrib) moreover from this have "dist C B = norm (u *\<^sub>R (C - A))" by (simp add: dist_norm) ultimately have "(A - B) \ (C - B) / (dist A B * dist C B) = u * (u - 1) / (\1 - u\ * \u\)" using \A \ C\ by (simp add: dot_square_norm power2_eq_square) also have "\ = - 1" using \u \ 0\ \u \ 1\ \u \ 0\ \u \ 1\ by (simp add: divide_eq_minus_1_iff) finally show ?thesis unfolding angle_altdef by simp qed end diff --git a/thys/Triangle/Triangle.thy b/thys/Triangle/Triangle.thy --- a/thys/Triangle/Triangle.thy +++ b/thys/Triangle/Triangle.thy @@ -1,352 +1,352 @@ (* File: Triangle.thy - Author: Manuel Eberl + Author: Manuel Eberl Sine and cosine laws, angle sum in a triangle, congruence theorems, Isosceles Triangle Theorem *) section \Basic Properties of Triangles\ theory Triangle imports Angles begin text \ We prove a number of basic geometric properties of triangles. All theorems hold in any real inner product space. \ subsection \Thales' theorem\ theorem thales: fixes A B C :: "'a :: real_inner" assumes "dist B (midpoint A C) = dist A C / 2" shows "orthogonal (A - B) (C - B)" proof - have "dist A C ^ 2 = dist B (midpoint A C) ^ 2 * 4" by (subst assms) (simp add: field_simps power2_eq_square) thus ?thesis by (auto simp: orthogonal_def dist_norm power2_norm_eq_inner midpoint_def algebra_simps inner_commute) qed subsection \Sine and cosine laws\ text \ The proof of the Law of Cosines follows trivially from the definition of the angle, the definition of the norm in vector spaces with an inner product and the bilinearity of the inner product. \ lemma cosine_law_vector: "norm (u - v) ^ 2 = norm u ^ 2 + norm v ^ 2 - 2 * norm u * norm v * cos (vangle u v)" by (simp add: power2_norm_eq_inner cos_vangle algebra_simps inner_commute) lemma cosine_law_triangle: "dist b c ^ 2 = dist a b ^ 2 + dist a c ^ 2 - 2 * dist a b * dist a c * cos (angle b a c)" using cosine_law_vector[of "b - a" "c - a"] by (simp add: dist_norm angle_def vangle_commute norm_minus_commute) text \ According to our definition, angles are always between $0$ and $\pi$ and therefore, the sign of an angle is always non-negative. We can therefore look at $\sin(\alpha)^2$, which we can express in terms of $\cos(\alpha)$ using the identity $\sin(\alpha)^2 + \cos(\alpha)^2 = 1$. The remaining proof is then a trivial consequence of the definitions. \ lemma sine_law_triangle: "sin (angle a b c) * dist b c = sin (angle b a c) * dist a c" (is "?A = ?B") proof (cases "a = b") assume neq: "a \ b" show ?thesis proof (rule power2_eq_imp_eq) from neq have "(sin (angle a b c) * dist b c) ^ 2 * dist a b ^ 2 = dist a b ^ 2 * dist b c ^ 2 - ((a - b) \ (c - b)) ^ 2" by (simp add: sin_squared_eq cos_angle dist_commute field_simps) also have "\ = dist a b ^ 2 * dist a c ^ 2 - ((b - a) \ (c - a)) ^ 2" by (simp only: dist_norm power2_norm_eq_inner) (simp add: power2_eq_square algebra_simps inner_commute) also from neq have "\ = (sin (angle b a c) * dist a c) ^ 2 * dist a b ^ 2" by (simp add: sin_squared_eq cos_angle dist_commute field_simps) finally show "?A^2 = ?B^2" using neq by (subst (asm) mult_cancel_right) simp_all qed (auto intro!: mult_nonneg_nonneg sin_angle_nonneg) qed simp_all text \ The following forms of the Law of Sines/Cosines are more convenient for eliminating sines/cosines from a goal completely. \ lemma cosine_law_triangle': "2 * dist a b * dist a c * cos (angle b a c) = (dist a b ^ 2 + dist a c ^ 2 - dist b c ^ 2)" using cosine_law_triangle[of b c a] by simp lemma cosine_law_triangle'': "cos (angle b a c) = (dist a b ^ 2 + dist a c ^ 2 - dist b c ^ 2) / (2 * dist a b * dist a c)" using cosine_law_triangle[of b c a] by simp lemma sine_law_triangle': "b \ c \ sin (angle a b c) = sin (angle b a c) * dist a c / dist b c" using sine_law_triangle[of a b c] by (simp add: divide_simps) lemma sine_law_triangle'': "b \ c \ sin (angle c b a) = sin (angle b a c) * dist a c / dist b c" using sine_law_triangle[of a b c] by (simp add: divide_simps angle_commute) subsection \Sum of angles\ context begin private lemma gather_squares: "a * (a * b) = a^2 * (b :: real)" by (simp_all add: power2_eq_square) private lemma eval_power: "x ^ numeral n = x * x ^ pred_numeral n" by (subst numeral_eq_Suc, subst power_Suc) simp text \ The proof that the sum of the angles in a triangle is $\pi$ is somewhat more involved. Following the HOL Light proof by John Harrison, we first prove that $\cos(\alpha + \beta + \gamma) = -1$ and $\alpha + \beta + \gamma \in [0;3\pi)$, which then implies the theorem. The main work is proving $\cos(\alpha + \beta + \gamma)$. This is done using the addition theorems for the sine and cosine, then using the Laws of Sines to eliminate all $\sin$ terms save $\sin(\gamma)^2$, which only appears squared in the remaining goal. We then use $\sin(\gamma)^2 = 1 - \cos(\gamma)^2$ to eliminate this term and apply the law of cosines to eliminate this term as well. The remaining goal is a non-linear equation containing only the length of the sides of the triangle. It can be shown by simple algebraic rewriting. \ lemma angle_sum_triangle: assumes "a \ b \ b \ c \ a \ c" shows "angle c a b + angle a b c + angle b c a = pi" proof (rule cos_minus1_imp_pi) show "cos (angle c a b + angle a b c + angle b c a) = - 1" proof (cases "a \ b") case True thus "cos (angle c a b + angle a b c + angle b c a) = -1" apply (simp add: cos_add sin_add cosine_law_triangle'' field_simps sine_law_triangle''[of a b c] sine_law_triangle''[of b a c] angle_commute dist_commute gather_squares sin_squared_eq) apply (simp add: eval_power algebra_simps dist_commute) done qed (insert assms, auto) show "angle c a b + angle a b c + angle b c a < 3 * pi" proof (rule ccontr) assume "\(angle c a b + angle a b c + angle b c a < 3 * pi)" with angle_le_pi[of c a b] angle_le_pi[of a b c] angle_le_pi[of b c a] have A: "angle c a b = pi" "angle a b c = pi" by simp_all thus False using angle_eq_pi_imp_dist_additive[of c a b] angle_eq_pi_imp_dist_additive[of a b c] by (simp add: dist_commute) qed qed (auto intro!: add_nonneg_nonneg angle_nonneg) end subsection \Congruence Theorems\ text \ If two triangles agree on two angles at a non-degenerate side, the third angle must also be equal. \ lemma similar_triangle_aa: assumes "b1 \ c1" "b2 \ c2" assumes "angle a1 b1 c1 = angle a2 b2 c2" assumes "angle b1 c1 a1 = angle b2 c2 a2" shows "angle b1 a1 c1 = angle b2 a2 c2" proof - from assms angle_sum_triangle[of a1 b1 c1] angle_sum_triangle[of a2 b2 c2, symmetric] show ?thesis by (auto simp: algebra_simps angle_commute) qed text \ A triangle is defined by its three angles and the lengths of three sides up to congruence. Two triangles are congruent if they have their angles are the same and their sides have the same length. \ locale congruent_triangle = fixes a1 b1 c1 :: "'a :: real_inner" and a2 b2 c2 :: "'b :: real_inner" assumes sides': "dist a1 b1 = dist a2 b2" "dist a1 c1 = dist a2 c2" "dist b1 c1 = dist b2 c2" and angles': "angle b1 a1 c1 = angle b2 a2 c2" "angle a1 b1 c1 = angle a2 b2 c2" "angle a1 c1 b1 = angle a2 c2 b2" begin lemma sides: "dist a1 b1 = dist a2 b2" "dist a1 c1 = dist a2 c2" "dist b1 c1 = dist b2 c2" "dist b1 a1 = dist a2 b2" "dist c1 a1 = dist a2 c2" "dist c1 b1 = dist b2 c2" "dist a1 b1 = dist b2 a2" "dist a1 c1 = dist c2 a2" "dist b1 c1 = dist c2 b2" "dist b1 a1 = dist b2 a2" "dist c1 a1 = dist c2 a2" "dist c1 b1 = dist c2 b2" using sides' by (simp_all add: dist_commute) lemma angles: "angle b1 a1 c1 = angle b2 a2 c2" "angle a1 b1 c1 = angle a2 b2 c2" "angle a1 c1 b1 = angle a2 c2 b2" "angle c1 a1 b1 = angle b2 a2 c2" "angle c1 b1 a1 = angle a2 b2 c2" "angle b1 c1 a1 = angle a2 c2 b2" "angle b1 a1 c1 = angle c2 a2 b2" "angle a1 b1 c1 = angle c2 b2 a2" "angle a1 c1 b1 = angle b2 c2 a2" "angle c1 a1 b1 = angle c2 a2 b2" "angle c1 b1 a1 = angle c2 b2 a2" "angle b1 c1 a1 = angle b2 c2 a2" using angles' by (simp_all add: angle_commute) end lemmas congruent_triangleD = congruent_triangle.sides congruent_triangle.angles text \ Given two triangles that agree on a subset of its side lengths and angles that are sufficient to define a triangle uniquely up to congruence, one can conclude that they must also agree on all remaining quantities, i.e. that they are congruent. The following four congruence theorems state what constitutes such a uniquely-defining subset of quantities. Each theorem states in its name which quantities are required and in which order (clockwise or counter-clockwise): an ``s'' stands for a side, an ``a'' stands for an angle. The lemma ``congruent-triangleI-sas, for example, requires that two adjacent sides and the angle inbetween are the same in both triangles. \ lemma congruent_triangleI_sss: fixes a1 b1 c1 :: "'a :: real_inner" and a2 b2 c2 :: "'b :: real_inner" assumes "dist a1 b1 = dist a2 b2" assumes "dist b1 c1 = dist b2 c2" assumes "dist a1 c1 = dist a2 c2" shows "congruent_triangle a1 b1 c1 a2 b2 c2" proof - have A: "angle a1 b1 c1 = angle a2 b2 c2" if "dist a1 b1 = dist a2 b2" "dist b1 c1 = dist b2 c2" "dist a1 c1 = dist a2 c2" for a1 b1 c1 :: 'a and a2 b2 c2 :: 'b proof - from that cosine_law_triangle''[of a1 b1 c1] cosine_law_triangle''[of a2 b2 c2] show ?thesis by (intro cos_angle_eqD) (simp add: dist_commute) qed from assms show ?thesis by unfold_locales (auto intro!: A simp: dist_commute) qed lemmas congruent_triangle_sss = congruent_triangleD[OF congruent_triangleI_sss] lemma congruent_triangleI_sas: assumes "dist a1 b1 = dist a2 b2" assumes "dist b1 c1 = dist b2 c2" assumes "angle a1 b1 c1 = angle a2 b2 c2" shows "congruent_triangle a1 b1 c1 a2 b2 c2" proof (rule congruent_triangleI_sss) show "dist a1 c1 = dist a2 c2" proof (rule power2_eq_imp_eq) from cosine_law_triangle[of a1 c1 b1] cosine_law_triangle[of a2 c2 b2] assms show "(dist a1 c1)\<^sup>2 = (dist a2 c2)\<^sup>2" by (simp add: dist_commute) qed simp_all qed fact+ lemmas congruent_triangle_sas = congruent_triangleD[OF congruent_triangleI_sas] lemma congruent_triangleI_aas: assumes "angle a1 b1 c1 = angle a2 b2 c2" assumes "angle b1 c1 a1 = angle b2 c2 a2" assumes "dist a1 b1 = dist a2 b2" assumes "\collinear {a1,b1,c1}" shows "congruent_triangle a1 b1 c1 a2 b2 c2" proof (rule congruent_triangleI_sas) from \\collinear {a1,b1,c1}\ have neq: "a1 \ b1" by auto with assms(3) have neq': "a2 \ b2" by auto have A: "angle c1 a1 b1 = angle c2 a2 b2" using neq neq' assms using angle_sum_triangle[of a1 b1 c1] angle_sum_triangle[of a2 b2 c2] by simp from assms have B: "angle b1 a1 c1 \ {0<..collinear {a1, b1, c1}" shows "congruent_triangle a1 b1 c1 a2 b2 c2" proof (rule congruent_triangleI_aas) from assms have neq: "a1 \ b1" "a2 \ b2" by auto show "angle b1 c1 a1 = angle b2 c2 a2" by (rule similar_triangle_aa) (insert assms neq, simp_all add: angle_commute) qed fact+ lemmas congruent_triangle_asa = congruent_triangleD[OF congruent_triangleI_asa] subsection \Isosceles Triangle Theorem\ text \ We now prove the Isosceles Triangle Theorem: in a triangle where two sides have the same length, the two angles that are adjacent to only one of the two sides must be equal. \ lemma isosceles_triangle: assumes "dist a c = dist b c" shows "angle b a c = angle a b c" by (rule congruent_triangle_sss) (insert assms, simp_all add: dist_commute) text \ For the non-degenerate case (i.e. the three points are not collinear), We also prove the converse. \ lemma isosceles_triangle_converse: assumes "angle a b c = angle b a c" "\collinear {a,b,c}" shows "dist a c = dist b c" by (rule congruent_triangle_asa[OF assms(1) _ _ assms(2)]) (simp_all add: dist_commute angle_commute assms) subsection\Contributions by Lukas Bulwahn\ lemma Pythagoras: fixes A B C :: "'a :: real_inner" assumes "orthogonal (A - C) (B - C)" shows "(dist B C) ^ 2 + (dist C A) ^ 2 = (dist A B) ^ 2" proof - from assms have "cos (angle A C B) = 0" by (metis orthogonal_iff_angle cos_pi_half) from this show ?thesis by (simp add: cosine_law_triangle[of A B C] dist_commute) qed lemma isosceles_triangle_orthogonal_on_midpoint: fixes A B C :: "'a :: euclidean_space" assumes "dist C A = dist C B" shows "orthogonal (C - midpoint A B) (A - midpoint A B)" proof (cases "A = B") assume "A \ B" let ?M = "midpoint A B" from \A \ B\ have "angle A ?M C = pi - angle B ?M C" by (intro angle_inverse between_midpoint) (auto simp: between_midpoint eq_commute[of _ "midpoint A B" for A B]) moreover have "angle A ?M C = angle C ?M B" proof - have congruence: "congruent_triangle C A ?M C B ?M" proof (rule congruent_triangleI_sss) show "dist C A = dist C B" using assms . show "dist A ?M = dist B ?M" by (simp add: dist_midpoint) show "dist C (midpoint A B) = dist C (midpoint A B)" .. qed from this show ?thesis by (simp add: congruent_triangle.angles(6)) qed ultimately have "angle A ?M C = pi / 2" by (simp add: angle_commute) from this show ?thesis by (simp add: orthogonal_iff_angle orthogonal_commute) next assume "A = B" from this show ?thesis by (simp add: orthogonal_clauses(1)) qed end