diff --git a/metadata/metadata b/metadata/metadata --- a/metadata/metadata +++ b/metadata/metadata @@ -1,10311 +1,10401 @@ [Arith_Prog_Rel_Primes] title = Arithmetic progressions and relative primes author = José Manuel Rodríguez Caballero topic = Mathematics/Number theory date = 2020-02-01 notify = jose.manuel.rodriguez.caballero@ut.ee abstract = This article provides a formalization of the solution obtained by the author of the Problem “ARITHMETIC PROGRESSIONS” from the Putnam exam problems of 2002. The statement of the problem is as follows: For which integers n > 1 does the set of positive integers less than and relatively prime to n constitute an arithmetic progression? [Banach_Steinhaus] title = Banach-Steinhaus Theorem author = Dominique Unruh , Jose Manuel Rodriguez Caballero topic = Mathematics/Analysis date = 2020-05-02 notify = jose.manuel.rodriguez.caballero@ut.ee, unruh@ut.ee abstract = We formalize in Isabelle/HOL a result due to S. Banach and H. Steinhaus known as the Banach-Steinhaus theorem or Uniform boundedness principle: a pointwise-bounded family of continuous linear operators from a Banach space to a normed space is uniformly bounded. Our approach is an adaptation to Isabelle/HOL of a proof due to A. Sokal. [Complex_Geometry] title = Complex Geometry author = Filip Marić , Danijela Simić topic = Mathematics/Geometry date = 2019-12-16 notify = danijela@matf.bg.ac.rs, filip@matf.bg.ac.rs, boutry@unistra.fr abstract = A formalization of geometry of complex numbers is presented. Fundamental objects that are investigated are the complex plane extended by a single infinite point, its objects (points, lines and circles), and groups of transformations that act on them (e.g., inversions and Möbius transformations). Most objects are defined algebraically, but correspondence with classical geometric definitions is shown. [Poincare_Disc] title = Poincaré Disc Model author = Danijela Simić , Filip Marić , Pierre Boutry topic = Mathematics/Geometry date = 2019-12-16 notify = danijela@matf.bg.ac.rs, filip@matf.bg.ac.rs, boutry@unistra.fr abstract = We describe formalization of the Poincaré disc model of hyperbolic geometry within the Isabelle/HOL proof assistant. The model is defined within the extended complex plane (one dimensional complex projectives space ℂP1), formalized in the AFP entry “Complex Geometry”. Points, lines, congruence of pairs of points, betweenness of triples of points, circles, and isometries are defined within the model. It is shown that the model satisfies all Tarski's axioms except the Euclid's axiom. It is shown that it satisfies its negation and the limiting parallels axiom (which proves it to be a model of hyperbolic geometry). [Fourier] title = Fourier Series author = Lawrence C Paulson topic = Mathematics/Analysis date = 2019-09-06 notify = lp15@cam.ac.uk abstract = This development formalises the square integrable functions over the reals and the basics of Fourier series. It culminates with a proof that every well-behaved periodic function can be approximated by a Fourier series. The material is ported from HOL Light: https://github.com/jrh13/hol-light/blob/master/100/fourier.ml [Generic_Deriving] title = Deriving generic class instances for datatypes author = Jonas Rädle , Lars Hupel topic = Computer science/Data structures date = 2018-11-06 notify = jonas.raedle@gmail.com abstract =

We provide a framework for automatically deriving instances for generic type classes. Our approach is inspired by Haskell's generic-deriving package and Scala's shapeless library. In addition to generating the code for type class functions, we also attempt to automatically prove type class laws for these instances. As of now, however, some manual proofs are still required for recursive datatypes.

Note: There are already articles in the AFP that provide automatic instantiation for a number of classes. Concretely, Deriving allows the automatic instantiation of comparators, linear orders, equality, and hashing. Show instantiates a Haskell-style show class.

Our approach works for arbitrary classes (with some Isabelle/HOL overhead for each class), but a smaller set of datatypes.

[Partial_Order_Reduction] title = Partial Order Reduction author = Julian Brunner topic = Computer science/Automata and formal languages date = 2018-06-05 notify = brunnerj@in.tum.de abstract = This entry provides a formalization of the abstract theory of ample set partial order reduction. The formalization includes transition systems with actions, trace theory, as well as basics on finite, infinite, and lazy sequences. We also provide a basic framework for static analysis on concurrent systems with respect to the ample set condition. [CakeML] title = CakeML author = Lars Hupel , Yu Zhang <> contributors = Johannes Åman Pohjola <> topic = Computer science/Programming languages/Language definitions date = 2018-03-12 notify = hupel@in.tum.de abstract = CakeML is a functional programming language with a proven-correct compiler and runtime system. This entry contains an unofficial version of the CakeML semantics that has been exported from the Lem specifications to Isabelle. Additionally, there are some hand-written theory files that adapt the exported code to Isabelle and port proofs from the HOL4 formalization, e.g. termination and equivalence proofs. [CakeML_Codegen] title = A Verified Code Generator from Isabelle/HOL to CakeML author = Lars Hupel topic = Computer science/Programming languages/Compiling, Logic/Rewriting date = 2019-07-08 notify = lars@hupel.info abstract = This entry contains the formalization that accompanies my PhD thesis (see https://lars.hupel.info/research/codegen/). I develop a verified compilation toolchain from executable specifications in Isabelle/HOL to CakeML abstract syntax trees. This improves over the state-of-the-art in Isabelle by providing a trustworthy procedure for code generation. [DiscretePricing] title = Pricing in discrete financial models author = Mnacho Echenim topic = Mathematics/Probability theory, Mathematics/Games and economics date = 2018-07-16 notify = mnacho.echenim@univ-grenoble-alpes.fr abstract = We have formalized the computation of fair prices for derivative products in discrete financial models. As an application, we derive a way to compute fair prices of derivative products in the Cox-Ross-Rubinstein model of a financial market, thus completing the work that was presented in this paper. extra-history = Change history: [2019-05-12]: Renamed discr_mkt predicate to stk_strict_subs and got rid of predicate A for a more natural definition of the type discrete_market; renamed basic quantity processes for coherent notation; renamed value_process into val_process and closing_value_process to cls_val_process; relaxed hypothesis of lemma CRR_market_fair_price. Added functions to price some basic options. (revision 0b813a1a833f)
[Pell] title = Pell's Equation author = Manuel Eberl topic = Mathematics/Number theory date = 2018-06-23 notify = eberlm@in.tum.de abstract =

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

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

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

The entry contains a proof of both theorems.

[Name_Carrying_Type_Inference] title = Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus author = Michael Rawson topic = Computer science/Programming languages/Type systems date = 2017-07-09 notify = mr644@cam.ac.uk, michaelrawson76@gmail.com abstract = I formalise a Church-style simply-typed \(\lambda\)-calculus, extended with pairs, a unit value, and projection functions, and show some metatheory of the calculus, such as the subject reduction property. Particular attention is paid to the treatment of names in the calculus. A nominal style of binding is used, but I use a manual approach over Nominal Isabelle in order to extract an executable type inference algorithm. More information can be found in my undergraduate dissertation. [Propositional_Proof_Systems] title = Propositional Proof Systems author = Julius Michaelis , Tobias Nipkow topic = Logic/Proof theory date = 2017-06-21 notify = maintainafpppt@liftm.de abstract = We formalize a range of proof systems for classical propositional logic (sequent calculus, natural deduction, Hilbert systems, resolution) and prove the most important meta-theoretic results about semantics and proofs: compactness, soundness, completeness, translations between proof systems, cut-elimination, interpolation and model existence. [Optics] title = Optics author = Simon Foster , Frank Zeyda topic = Computer science/Functional programming, Mathematics/Algebra date = 2017-05-25 notify = simon.foster@york.ac.uk abstract = Lenses provide an abstract interface for manipulating data types through spatially-separated views. They are defined abstractly in terms of two functions, get, the return a value from the source type, and put that updates the value. We mechanise the underlying theory of lenses, in terms of an algebraic hierarchy of lenses, including well-behaved and very well-behaved lenses, each lens class being characterised by a set of lens laws. We also mechanise a lens algebra in Isabelle that enables their composition and comparison, so as to allow construction of complex lenses. This is accompanied by a large library of algebraic laws. Moreover we also show how the lens classes can be applied by instantiating them with a number of Isabelle data types. extra-history = Change history: [2020-03-02]: Added partial bijective and symmetric lenses. Improved alphabet command generating additional lenses and results. Several additional lens relations, including observational equivalence. Additional theorems throughout. Adaptations for Isabelle 2020. (revision 44e2e5c) [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 topic = Tools, Computer science/Functional programming, Logic/Rewriting date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = The usual monad laws can directly be used as rewrite rules for Isabelle’s simplifier to normalise monadic HOL terms and decide equivalences. In a commutative monad, however, the commutativity law is a higher-order permutative rewrite rule that makes the simplifier loop. This AFP entry implements a simproc that normalises monadic expressions in commutative monads using ordered rewriting. The simproc can also permute computations across control operators like if and case. [Monomorphic_Monad] title = Effect polymorphism in higher-order logic author = Andreas Lochbihler topic = Computer science/Functional programming date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = The notion of a monad cannot be expressed within higher-order logic (HOL) due to type system restrictions. We show that if a monad is used with values of only one type, this notion can be formalised in HOL. Based on this idea, we develop a library of effect specifications and implementations of monads and monad transformers. Hence, we can abstract over the concrete monad in HOL definitions and thus use the same definition for different (combinations of) effects. We illustrate the usefulness of effect polymorphism with a monadic interpreter for a simple language. extra-history = Change history: [2018-02-15]: added further specifications and implementations of non-determinism; more examples (revision bc5399eea78e)
[Constructor_Funs] title = Constructor Functions author = Lars Hupel topic = Tools date = 2017-04-19 notify = hupel@in.tum.de abstract = Isabelle's code generator performs various adaptations for target languages. Among others, constructor applications have to be fully saturated. That means that for constructor calls occuring as arguments to higher-order functions, synthetic lambdas have to be inserted. This entry provides tooling to avoid this construction altogether by introducing constructor functions. [Lazy_Case] title = Lazifying case constants author = Lars Hupel topic = Tools date = 2017-04-18 notify = hupel@in.tum.de abstract = Isabelle's code generator performs various adaptations for target languages. Among others, case statements are printed as match expressions. Internally, this is a sophisticated procedure, because in HOL, case statements are represented as nested calls to the case combinators as generated by the datatype package. Furthermore, the procedure relies on laziness of match expressions in the target language, i.e., that branches guarded by patterns that fail to match are not evaluated. Similarly, if-then-else is printed to the corresponding construct in the target language. This entry provides tooling to replace these special cases in the code generator by ignoring these target language features, instead printing case expressions and if-then-else as functions. [Dict_Construction] title = Dictionary Construction author = Lars Hupel topic = Tools date = 2017-05-24 notify = hupel@in.tum.de abstract = Isabelle's code generator natively supports type classes. For targets that do not have language support for classes and instances, it performs the well-known dictionary translation, as described by Haftmann and Nipkow. This translation happens outside the logic, i.e., there is no guarantee that it is correct, besides the pen-and-paper proof. This work implements a certified dictionary translation that produces new class-free constants and derives equality theorems. [Higher_Order_Terms] title = An Algebra for Higher-Order Terms author = Lars Hupel contributors = Yu Zhang <> topic = Computer science/Programming languages/Lambda calculi date = 2019-01-15 notify = lars@hupel.info abstract = In this formalization, I introduce a higher-order term algebra, generalizing the notions of free variables, matching, and substitution. The need arose from the work on a verified compiler from Isabelle to CakeML. Terms can be thought of as consisting of a generic (free variables, constants, application) and a specific part. As example applications, this entry provides instantiations for de-Bruijn terms, terms with named variables, and Blanchette’s λ-free higher-order terms. Furthermore, I implement translation functions between de-Bruijn terms and named terms and prove their correctness. [Subresultants] title = Subresultants author = Sebastiaan Joosten , René Thiemann , Akihisa Yamada topic = Mathematics/Algebra date = 2017-04-06 notify = rene.thiemann@uibk.ac.at abstract = We formalize the theory of subresultants and the subresultant polynomial remainder sequence as described by Brown and Traub. As a result, we obtain efficient certified algorithms for computing the resultant and the greatest common divisor of polynomials. [Comparison_Sort_Lower_Bound] title = Lower bound on comparison-based sorting algorithms author = Manuel Eberl topic = Computer science/Algorithms date = 2017-03-15 notify = eberlm@in.tum.de abstract =

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

+[Hermite_Lindemann] +title = The Hermite–Lindemann–Weierstraß Transcendence Theorem +author = Manuel Eberl +topic = Mathematics/Number theory +date = 2021-03-03 +notify = eberlm@in.tum.de +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 operations 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)
[Liouville_Numbers] title = Liouville numbers author = Manuel Eberl date = 2015-12-28 topic = Mathematics/Analysis, Mathematics/Number theory abstract =

Liouville numbers are a class of transcendental numbers that can be approximated particularly well with rational numbers. Historically, they were the first numbers whose transcendence was proven.

In this entry, we define the concept of Liouville numbers as well as the standard construction to obtain Liouville numbers (including Liouville's constant) and we prove their most important properties: irrationality and transcendence.

The proof is very elementary and requires only standard arithmetic, the Mean Value Theorem for polynomials, and the boundedness of polynomials on compact intervals.

notify = eberlm@in.tum.de [Triangle] title = Basic Geometric Properties of Triangles author = Manuel Eberl date = 2015-12-28 topic = Mathematics/Geometry abstract =

This entry contains a definition of angles between vectors and between three points. Building on this, we prove basic geometric properties of triangles, such as the Isosceles Triangle Theorem, the Law of Sines and the Law of Cosines, that the sum of the angles of a triangle is π, and the congruence theorems for triangles.

The definitions and proofs were developed following those by John Harrison in HOL Light. However, due to Isabelle's type class system, all definitions and theorems in the Isabelle formalisation hold for all real inner product spaces.

notify = eberlm@in.tum.de [Prime_Harmonic_Series] title = The Divergence of the Prime Harmonic Series author = Manuel Eberl date = 2015-12-28 topic = Mathematics/Number theory abstract =

In this work, we prove the lower bound ln(H_n) - ln(5/3) for the partial sum of the Prime Harmonic series and, based on this, the divergence of the Prime Harmonic Series ∑[p prime] · 1/p.

The proof relies on the unique squarefree decomposition of natural numbers. This is similar to Euler's original proof (which was highly informal and morally questionable). Its advantage over proofs by contradiction, like the famous one by Paul Erdős, is that it provides a relatively good lower bound for the partial sums.

notify = eberlm@in.tum.de [Descartes_Sign_Rule] title = Descartes' Rule of Signs author = Manuel Eberl date = 2015-12-28 topic = Mathematics/Analysis abstract =

Descartes' Rule of Signs relates the number of positive real roots of a polynomial with the number of sign changes in its coefficient sequence.

Our proof follows the simple inductive proof given by Rob Arthan, which was also used by John Harrison in his HOL Light formalisation. We proved most of the lemmas for arbitrary linearly-ordered integrity domains (e.g. integers, rationals, reals); the main result, however, requires the intermediate value theorem and was therefore only proven for real polynomials.

notify = eberlm@in.tum.de [Euler_MacLaurin] title = The Euler–MacLaurin Formula author = Manuel Eberl topic = Mathematics/Analysis date = 2017-03-10 notify = eberlm@in.tum.de abstract =

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

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

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

[Card_Partitions] title = Cardinality of Set Partitions author = Lukas Bulwahn date = 2015-12-12 topic = Mathematics/Combinatorics abstract = The theory's main theorem states that the cardinality of set partitions of size k on a carrier set of size n is expressed by Stirling numbers of the second kind. In Isabelle, Stirling numbers of the second kind are defined in the AFP entry `Discrete Summation` through their well-known recurrence relation. The main theorem relates them to the alternative definition as cardinality of set partitions. The proof follows the simple and short explanation in Richard P. Stanley's `Enumerative Combinatorics: Volume 1` and Wikipedia, and unravels the full details and implicit reasoning steps of these explanations. notify = lukas.bulwahn@gmail.com [Card_Number_Partitions] title = Cardinality of Number Partitions author = Lukas Bulwahn date = 2016-01-14 topic = Mathematics/Combinatorics abstract = This entry provides a basic library for number partitions, defines the two-argument partition function through its recurrence relation and relates this partition function to the cardinality of number partitions. The main proof shows that the recursively-defined partition function with arguments n and k equals the cardinality of number partitions of n with exactly k parts. The combinatorial proof follows the proof sketch of Theorem 2.4.1 in Mazur's textbook `Combinatorics: A Guided Tour`. This entry can serve as starting point for various more intrinsic properties about number partitions, the partition function and related recurrence relations. notify = lukas.bulwahn@gmail.com [Multirelations] title = Binary Multirelations author = Hitoshi Furusawa , Georg Struth date = 2015-06-11 topic = Mathematics/Algebra abstract = Binary multirelations associate elements of a set with its subsets; hence they are binary relations from a set to its power set. Applications include alternating automata, models and logics for games, program semantics with dual demonic and angelic nondeterministic choices and concurrent dynamic logics. This proof document supports an arXiv article that formalises the basic algebra of multirelations and proposes axiom systems for them, ranging from weak bi-monoids to weak bi-quantales. notify = [Noninterference_Generic_Unwinding] title = The Generic Unwinding Theorem for CSP Noninterference Security author = Pasquale Noce date = 2015-06-11 topic = Computer science/Security, Computer science/Concurrency/Process calculi abstract =

The classical definition of noninterference security for a deterministic state machine with outputs requires to consider the outputs produced by machine actions after any trace, i.e. any indefinitely long sequence of actions, of the machine. In order to render the verification of the security of such a machine more straightforward, there is a need of some sufficient condition for security such that just individual actions, rather than unbounded sequences of actions, have to be considered.

By extending previous results applying to transitive noninterference policies, Rushby has proven an unwinding theorem that provides a sufficient condition of this kind in the general case of a possibly intransitive policy. This condition has to be satisfied by a generic function mapping security domains into equivalence relations over machine states.

An analogous problem arises for CSP noninterference security, whose definition requires to consider any possible future, i.e. any indefinitely long sequence of subsequent events and any indefinitely large set of refused events associated to that sequence, for each process trace.

This paper provides a sufficient condition for CSP noninterference security, which indeed requires to just consider individual accepted and refused events and applies to the general case of a possibly intransitive policy. This condition follows Rushby's one for classical noninterference security, and has to be satisfied by a generic function mapping security domains into equivalence relations over process traces; hence its name, Generic Unwinding Theorem. Variants of this theorem applying to deterministic processes and trace set processes are also proven. Finally, the sufficient condition for security expressed by the theorem is shown not to be a necessary condition as well, viz. there exists a secure process such that no domain-relation map satisfying the condition exists.

notify = [Noninterference_Ipurge_Unwinding] title = The Ipurge Unwinding Theorem for CSP Noninterference Security author = Pasquale Noce date = 2015-06-11 topic = Computer science/Security abstract =

The definition of noninterference security for Communicating Sequential Processes requires to consider any possible future, i.e. any indefinitely long sequence of subsequent events and any indefinitely large set of refused events associated to that sequence, for each process trace. In order to render the verification of the security of a process more straightforward, there is a need of some sufficient condition for security such that just individual accepted and refused events, rather than unbounded sequences and sets of events, have to be considered.

Of course, if such a sufficient condition were necessary as well, it would be even more valuable, since it would permit to prove not only that a process is secure by verifying that the condition holds, but also that a process is not secure by verifying that the condition fails to hold.

This paper provides a necessary and sufficient condition for CSP noninterference security, which indeed requires to just consider individual accepted and refused events and applies to the general case of a possibly intransitive policy. This condition follows Rushby's output consistency for deterministic state machines with outputs, and has to be satisfied by a specific function mapping security domains into equivalence relations over process traces. The definition of this function makes use of an intransitive purge function following Rushby's one; hence the name given to the condition, Ipurge Unwinding Theorem.

Furthermore, in accordance with Hoare's formal definition of deterministic processes, it is shown that a process is deterministic just in case it is a trace set process, i.e. it may be identified by means of a trace set alone, matching the set of its traces, in place of a failures-divergences pair. Then, variants of the Ipurge Unwinding Theorem are proven for deterministic processes and trace set processes.

notify = [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 topic = Computer science/Automata and formal languages date = 2010-05-12 abstract = This is a library of constructions on regular expressions and languages. It provides the operations of concatenation, Kleene star and derivative on languages. Regular expressions and their meaning are defined. An executable equivalence checker for regular expressions is verified; it does not need automata but works directly on regular expressions. By mapping regular expressions to binary relations, an automatic and complete proof method for (in)equalities of binary relations over union, concatenation and (reflexive) transitive closure is obtained.

Extended regular expressions with complement and intersection are also defined and an equivalence checker is provided. extra-history = Change history: [2011-08-26]: Christian Urban added a theory about derivatives and partial derivatives of regular expressions
[2012-05-10]: Tobias Nipkow added extended regular expressions
[2012-05-10]: Tobias Nipkow added equivalence checking with partial derivatives notify = nipkow@in.tum.de, krauss@in.tum.de, christian.urban@kcl.ac.uk [Regex_Equivalence] title = Unified Decision Procedures for Regular Expression Equivalence author = Tobias Nipkow , Dmitriy Traytel topic = Computer science/Automata and formal languages date = 2014-01-30 abstract = We formalize a unified framework for verified decision procedures for regular expression equivalence. Five recently published formalizations of such decision procedures (three based on derivatives, two on marked regular expressions) can be obtained as instances of the framework. We discover that the two approaches based on marked regular expressions, which were previously thought to be the same, are different, and one seems to produce uniformly smaller automata. The common framework makes it possible to compare the performance of the different decision procedures in a meaningful way. The formalization is described in a paper of the same name presented at Interactive Theorem Proving 2014. notify = nipkow@in.tum.de, traytel@in.tum.de [MSO_Regex_Equivalence] title = Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions author = Dmitriy Traytel , Tobias Nipkow topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories date = 2014-06-12 abstract = Monadic second-order logic on finite words (MSO) is a decidable yet expressive logic into which many decision problems can be encoded. Since MSO formulas correspond to regular languages, equivalence of MSO formulas can be reduced to the equivalence of some regular structures (e.g. automata). We verify an executable decision procedure for MSO formulas that is not based on automata but on regular expressions.

Decision procedures for regular expression equivalence have been formalized before, usually based on Brzozowski derivatives. Yet, for a straightforward embedding of MSO formulas into regular expressions an extension of regular expressions with a projection operation is required. We prove total correctness and completeness of an equivalence checker for regular expressions extended in that way. We also define a language-preserving translation of formulas into regular expressions with respect to two different semantics of MSO.

The formalization is described in this ICFP 2013 functional pearl. notify = traytel@in.tum.de, nipkow@in.tum.de [Formula_Derivatives] title = Derivatives of Logical Formulas author = Dmitriy Traytel topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories date = 2015-05-28 abstract = We formalize new decision procedures for WS1S, M2L(Str), and Presburger Arithmetics. Formulas of these logics denote regular languages. Unlike traditional decision procedures, we do not translate formulas into automata (nor into regular expressions), at least not explicitly. Instead we devise notions of derivatives (inspired by Brzozowski derivatives for regular expressions) that operate on formulas directly and compute a syntactic bisimulation using these derivatives. The treatment of Boolean connectives and quantifiers is uniform for all mentioned logics and is abstracted into a locale. This locale is then instantiated by different atomic formulas and their derivatives (which may differ even for the same logic under different encodings of interpretations as formal words).

The WS1S instance is described in the draft paper A Coalgebraic Decision Procedure for WS1S by the author. notify = traytel@in.tum.de [Myhill-Nerode] title = The Myhill-Nerode Theorem Based on Regular Expressions author = Chunhan Wu <>, Xingyuan Zhang <>, Christian Urban contributors = Manuel Eberl topic = Computer science/Automata and formal languages date = 2011-08-26 abstract = There are many proofs of the Myhill-Nerode theorem using automata. In this library we give a proof entirely based on regular expressions, since regularity of languages can be conveniently defined using regular expressions (it is more painful in HOL to define regularity in terms of automata). We prove the first direction of the Myhill-Nerode theorem by solving equational systems that involve regular expressions. For the second direction we give two proofs: one using tagging-functions and another using partial derivatives. We also establish various closure properties of regular languages. Most details of the theories are described in our ITP 2011 paper. notify = christian.urban@kcl.ac.uk [Universal_Turing_Machine] title = Universal Turing Machine author = Jian Xu<>, Xingyuan Zhang<>, Christian Urban , Sebastiaan J. C. Joosten topic = Logic/Computability, Computer science/Automata and formal languages date = 2019-02-08 notify = sjcjoosten@gmail.com, christian.urban@kcl.ac.uk abstract = We formalise results from computability theory: recursive functions, undecidability of the halting problem, and the existence of a universal Turing machine. This formalisation is the AFP entry corresponding to the paper Mechanising Turing Machines and Computability Theory in Isabelle/HOL, ITP 2013. [CYK] title = A formalisation of the Cocke-Younger-Kasami algorithm author = Maksym Bortin date = 2016-04-27 topic = Computer science/Algorithms, Computer science/Automata and formal languages abstract = The theory provides a formalisation of the Cocke-Younger-Kasami algorithm (CYK for short), an approach to solving the word problem for context-free languages. CYK decides if a word is in the languages generated by a context-free grammar in Chomsky normal form. The formalized algorithm is executable. notify = maksym.bortin@nicta.com.au [Boolean_Expression_Checkers] title = Boolean Expression Checkers author = Tobias Nipkow date = 2014-06-08 topic = Computer science/Algorithms, Logic/General logic/Mechanization of proofs abstract = This entry provides executable checkers for the following properties of boolean expressions: satisfiability, tautology and equivalence. Internally, the checkers operate on binary decision trees and are reasonably efficient (for purely functional algorithms). extra-history = Change history: [2015-09-23]: Salomon Sickert added an interface that does not require the usage of the Boolean formula datatype. Furthermore the general Mapping type is used instead of an association list. notify = nipkow@in.tum.de [Presburger-Automata] title = Formalizing the Logic-Automaton Connection author = Stefan Berghofer , Markus Reiter <> date = 2009-12-03 topic = Computer science/Automata and formal languages, Logic/General logic/Decidability of theories abstract = This work presents a formalization of a library for automata on bit strings. It forms the basis of a reflection-based decision procedure for Presburger arithmetic, which is efficiently executable thanks to Isabelle's code generator. With this work, we therefore provide a mechanized proof of a well-known connection between logic and automata theory. The formalization is also described in a publication [TPHOLs 2009]. notify = berghofe@in.tum.de [Functional-Automata] title = Functional Automata author = Tobias Nipkow date = 2004-03-30 topic = Computer science/Automata and formal languages abstract = This theory defines deterministic and nondeterministic automata in a functional representation: the transition function/relation and the finality predicate are just functions. Hence the state space may be infinite. It is shown how to convert regular expressions into such automata. A scanner (generator) is implemented with the help of functional automata: the scanner chops the input up into longest recognized substrings. Finally we also show how to convert a certain subclass of functional automata (essentially the finite deterministic ones) into regular sets. notify = nipkow@in.tum.de [Statecharts] title = Formalizing Statecharts using Hierarchical Automata author = Steffen Helke , Florian Kammüller topic = Computer science/Automata and formal languages date = 2010-08-08 abstract = We formalize in Isabelle/HOL the abtract syntax and a synchronous step semantics for the specification language Statecharts. The formalization is based on Hierarchical Automata which allow a structural decomposition of Statecharts into Sequential Automata. To support the composition of Statecharts, we introduce calculating operators to construct a Hierarchical Automaton in a stepwise manner. Furthermore, we present a complete semantics of Statecharts including a theory of data spaces, which enables the modelling of racing effects. We also adapt CTL for Statecharts to build a bridge for future combinations with model checking. However the main motivation of this work is to provide a sound and complete basis for reasoning on Statecharts. As a central meta theorem we prove that the well-formedness of a Statechart is preserved by the semantics. notify = nipkow@in.tum.de [Stuttering_Equivalence] title = Stuttering Equivalence author = Stephan Merz topic = Computer science/Automata and formal languages date = 2012-05-07 abstract =

Two omega-sequences are stuttering equivalent if they differ only by finite repetitions of elements. Stuttering equivalence is a fundamental concept in the theory of concurrent and distributed systems. Notably, Lamport argues that refinement notions for such systems should be insensitive to finite stuttering. Peled and Wilke showed that all PLTL (propositional linear-time temporal logic) properties that are insensitive to stuttering equivalence can be expressed without the next-time operator. Stuttering equivalence is also important for certain verification techniques such as partial-order reduction for model checking.

We formalize stuttering equivalence in Isabelle/HOL. Our development relies on the notion of stuttering sampling functions that may skip blocks of identical sequence elements. We also encode PLTL and prove the theorem due to Peled and Wilke.

extra-history = Change history: [2013-01-31]: Added encoding of PLTL and proved Peled and Wilke's theorem. Adjusted abstract accordingly. notify = Stephan.Merz@loria.fr [Coinductive_Languages] title = A Codatatype of Formal Languages author = Dmitriy Traytel topic = Computer science/Automata and formal languages date = 2013-11-15 abstract =

We define formal languages as a codataype of infinite trees branching over the alphabet. Each node in such a tree indicates whether the path to this node constitutes a word inside or outside of the language. This codatatype is isormorphic to the set of lists representation of languages, but caters for definitions by corecursion and proofs by coinduction.

Regular operations on languages are then defined by primitive corecursion. A difficulty arises here, since the standard definitions of concatenation and iteration from the coalgebraic literature are not primitively corecursive-they require guardedness up-to union/concatenation. Without support for up-to corecursion, these operation must be defined as a composition of primitive ones (and proved being equal to the standard definitions). As an exercise in coinduction we also prove the axioms of Kleene algebra for the defined regular operations.

Furthermore, a language for context-free grammars given by productions in Greibach normal form and an initial nonterminal is constructed by primitive corecursion, yielding an executable decision procedure for the word problem without further ado.

notify = traytel@in.tum.de [Tree-Automata] title = Tree Automata author = Peter Lammich date = 2009-11-25 topic = Computer science/Automata and formal languages abstract = This work presents a machine-checked tree automata library for Standard-ML, OCaml and Haskell. The algorithms are efficient by using appropriate data structures like RB-trees. The available algorithms for non-deterministic automata include membership query, reduction, intersection, union, and emptiness check with computation of a witness for non-emptiness. The executable algorithms are derived from less-concrete, non-executable algorithms using data-refinement techniques. The concrete data structures are from the Isabelle Collections Framework. Moreover, this work contains a formalization of the class of tree-regular languages and its closure properties under set operations. notify = peter.lammich@uni-muenster.de, nipkow@in.tum.de [Depth-First-Search] title = Depth First Search author = Toshiaki Nishihara <>, Yasuhiko Minamide <> date = 2004-06-24 topic = Computer science/Algorithms/Graph abstract = Depth-first search of a graph is formalized with recdef. It is shown that it visits all of the reachable nodes from a given list of nodes. Executable ML code of depth-first search is obtained using the code generation feature of Isabelle/HOL. notify = lp15@cam.ac.uk, krauss@in.tum.de [FFT] title = Fast Fourier Transform author = Clemens Ballarin date = 2005-10-12 topic = Computer science/Algorithms/Mathematical abstract = We formalise a functional implementation of the FFT algorithm over the complex numbers, and its inverse. Both are shown equivalent to the usual definitions of these operations through Vandermonde matrices. They are also shown to be inverse to each other, more precisely, that composition of the inverse and the transformation yield the identity up to a scalar. notify = ballarin@in.tum.de [Gauss-Jordan-Elim-Fun] title = Gauss-Jordan Elimination for Matrices Represented as Functions author = Tobias Nipkow date = 2011-08-19 topic = Computer science/Algorithms/Mathematical, Mathematics/Algebra abstract = This theory provides a compact formulation of Gauss-Jordan elimination for matrices represented as functions. Its distinctive feature is succinctness. It is not meant for large computations. notify = nipkow@in.tum.de [UpDown_Scheme] title = Verification of the UpDown Scheme author = Johannes Hölzl date = 2015-01-28 topic = Computer science/Algorithms/Mathematical abstract = The UpDown scheme is a recursive scheme used to compute the stiffness matrix on a special form of sparse grids. Usually, when discretizing a Euclidean space of dimension d we need O(n^d) points, for n points along each dimension. Sparse grids are a hierarchical representation where the number of points is reduced to O(n * log(n)^d). One disadvantage of such sparse grids is that the algorithm now operate recursively in the dimensions and levels of the sparse grid.

The UpDown scheme allows us to compute the stiffness matrix on such a sparse grid. The stiffness matrix represents the influence of each representation function on the L^2 scalar product. For a detailed description see Dirk Pflüger's PhD thesis. This formalization was developed as an interdisciplinary project (IDP) at the Technische Universität München. notify = hoelzl@in.tum.de [GraphMarkingIBP] title = Verification of the Deutsch-Schorr-Waite Graph Marking Algorithm using Data Refinement author = Viorel Preoteasa , Ralph-Johan Back date = 2010-05-28 topic = Computer science/Algorithms/Graph abstract = The verification of the Deutsch-Schorr-Waite graph marking algorithm is used as a benchmark in many formalizations of pointer programs. The main purpose of this mechanization is to show how data refinement of invariant based programs can be used in verifying practical algorithms. The verification starts with an abstract algorithm working on a graph given by a relation next on nodes. Gradually the abstract program is refined into Deutsch-Schorr-Waite graph marking algorithm where only one bit per graph node of additional memory is used for marking. extra-history = Change history: [2012-01-05]: Updated for the new definition of data refinement and the new syntax for demonic and angelic update statements notify = viorel.preoteasa@aalto.fi [Efficient-Mergesort] title = Efficient Mergesort topic = Computer science/Algorithms date = 2011-11-09 author = Christian Sternagel abstract = We provide a formalization of the mergesort algorithm as used in GHC's Data.List module, proving correctness and stability. Furthermore, experimental data suggests that generated (Haskell-)code for this algorithm is much faster than for previous algorithms available in the Isabelle distribution. extra-history = Change history: [2012-10-24]: Added reference to journal article.
[2018-09-17]: Added theory Efficient_Mergesort that works exclusively with the mutual induction schemas generated by the function package.
[2018-09-19]: Added theory Mergesort_Complexity that proves an upper bound on the number of comparisons that are required by mergesort.
[2018-09-19]: Theory Efficient_Mergesort replaces theory Efficient_Sort but keeping the old name Efficient_Sort. [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 author = Asta Halkjær From topic = Logic/General logic/Logics of knowledge and belief date = 2018-10-29 notify = ahfrom@dtu.dk abstract = This work is a formalization of epistemic logic with countably many agents. It includes proofs of soundness and completeness for the axiom system K. The completeness proof is based on the textbook "Reasoning About Knowledge" by Fagin, Halpern, Moses and Vardi (MIT Press 1995). [SequentInvertibility] title = Invertibility in Sequent Calculi author = Peter Chapman <> date = 2009-08-28 topic = Logic/Proof theory license = LGPL abstract = The invertibility of the rules of a sequent calculus is important for guiding proof search and can be used in some formalised proofs of Cut admissibility. We present sufficient conditions for when a rule is invertible with respect to a calculus. We illustrate the conditions with examples. It must be noted we give purely syntactic criteria; no guarantees are given as to the suitability of the rules. notify = pc@cs.st-andrews.ac.uk, nipkow@in.tum.de [LinearQuantifierElim] title = Quantifier Elimination for Linear Arithmetic author = Tobias Nipkow date = 2008-01-11 topic = Logic/General logic/Decidability of theories abstract = This article formalizes quantifier elimination procedures for dense linear orders, linear real arithmetic and Presburger arithmetic. In each case both a DNF-based non-elementary algorithm and one or more (doubly) exponential NNF-based algorithms are formalized, including the well-known algorithms by Ferrante and Rackoff and by Cooper. The NNF-based algorithms for dense linear orders are new but based on Ferrante and Rackoff and on an algorithm by Loos and Weisspfenning which simulates infenitesimals. All algorithms are directly executable. In particular, they yield reflective quantifier elimination procedures for HOL itself. The formalization makes heavy use of locales and is therefore highly modular. notify = nipkow@in.tum.de [Nat-Interval-Logic] title = Interval Temporal Logic on Natural Numbers author = David Trachtenherz <> date = 2011-02-23 topic = Logic/General logic/Temporal logic abstract = We introduce a theory of temporal logic operators using sets of natural numbers as time domain, formalized in a shallow embedding manner. The theory comprises special natural intervals (theory IL_Interval: open and closed intervals, continuous and modulo intervals, interval traversing results), operators for shifting intervals to left/right on the number axis as well as expanding/contracting intervals by constant factors (theory IL_IntervalOperators.thy), and ultimately definitions and results for unary and binary temporal operators on arbitrary natural sets (theory IL_TemporalOperators). notify = nipkow@in.tum.de [Recursion-Theory-I] title = Recursion Theory I author = Michael Nedzelsky <> date = 2008-04-05 topic = Logic/Computability abstract = This document presents the formalization of introductory material from recursion theory --- definitions and basic properties of primitive recursive functions, Cantor pairing function and computably enumerable sets (including a proof of existence of a one-complete computably enumerable set and a proof of the Rice's theorem). notify = MichaelNedzelsky@yandex.ru [Free-Boolean-Algebra] topic = Logic/General logic/Classical propositional logic title = Free Boolean Algebra author = Brian Huffman date = 2010-03-29 abstract = This theory defines a type constructor representing the free Boolean algebra over a set of generators. Values of type (α)formula represent propositional formulas with uninterpreted variables from type α, ordered by implication. In addition to all the standard Boolean algebra operations, the library also provides a function for building homomorphisms to any other Boolean algebra type. notify = brianh@cs.pdx.edu [Sort_Encodings] title = Sound and Complete Sort Encodings for First-Order Logic author = Jasmin Christian Blanchette , Andrei Popescu date = 2013-06-27 topic = Logic/General logic/Mechanization of proofs abstract = This is a formalization of the soundness and completeness properties for various efficient encodings of sorts in unsorted first-order logic used by Isabelle's Sledgehammer tool.

Essentially, the encodings proceed as follows: a many-sorted problem is decorated with (as few as possible) tags or guards that make the problem monotonic; then sorts can be soundly erased.

The development employs a formalization of many-sorted first-order logic in clausal form (clauses, structures and the basic properties of the satisfaction relation), which could be of interest as the starting point for other formalizations of first-order logic metatheory. notify = uuomul@yahoo.com [Lambda_Free_RPOs] title = Formalization of Recursive Path Orders for Lambda-Free Higher-Order Terms author = Jasmin Christian Blanchette , Uwe Waldmann , Daniel Wand date = 2016-09-23 topic = Logic/Rewriting abstract = This Isabelle/HOL formalization defines recursive path orders (RPOs) for higher-order terms without lambda-abstraction and proves many useful properties about them. The main order fully coincides with the standard RPO on first-order terms also in the presence of currying, distinguishing it from previous work. An optimized variant is formalized as well. It appears promising as the basis of a higher-order superposition calculus. notify = jasmin.blanchette@gmail.com [Lambda_Free_KBOs] title = Formalization of Knuth–Bendix Orders for Lambda-Free Higher-Order Terms author = Heiko Becker , Jasmin Christian Blanchette , Uwe Waldmann , Daniel Wand date = 2016-11-12 topic = Logic/Rewriting abstract = This Isabelle/HOL formalization defines Knuth–Bendix orders for higher-order terms without lambda-abstraction and proves many useful properties about them. The main order fully coincides with the standard transfinite KBO with subterm coefficients on first-order terms. It appears promising as the basis of a higher-order superposition calculus. notify = jasmin.blanchette@gmail.com [Lambda_Free_EPO] title = Formalization of the Embedding Path Order for Lambda-Free Higher-Order Terms author = Alexander Bentkamp topic = Logic/Rewriting date = 2018-10-19 notify = a.bentkamp@vu.nl abstract = This Isabelle/HOL formalization defines the Embedding Path Order (EPO) for higher-order terms without lambda-abstraction and proves many useful properties about it. In contrast to the lambda-free recursive path orders, it does not fully coincide with RPO on first-order terms, but it is compatible with arbitrary higher-order contexts. [Nested_Multisets_Ordinals] title = Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals author = Jasmin Christian Blanchette , Mathias Fleury , Dmitriy Traytel date = 2016-11-12 topic = Logic/Rewriting abstract = This Isabelle/HOL formalization introduces a nested multiset datatype and defines Dershowitz and Manna's nested multiset order. The order is proved well founded and linear. By removing one constructor, we transform the nested multisets into hereditary multisets. These are isomorphic to the syntactic ordinals—the ordinals can be recursively expressed in Cantor normal form. Addition, subtraction, multiplication, and linear orders are provided on this type. notify = jasmin.blanchette@gmail.com [Abstract-Rewriting] title = Abstract Rewriting topic = Logic/Rewriting date = 2010-06-14 author = Christian Sternagel , René Thiemann license = LGPL abstract = We present an Isabelle formalization of abstract rewriting (see, e.g., the book by Baader and Nipkow). First, we define standard relations like joinability, meetability, conversion, etc. Then, we formalize important properties of abstract rewrite systems, e.g., confluence and strong normalization. Our main concern is on strong normalization, since this formalization is the basis of CeTA (which is mainly about strong normalization of term rewrite systems). Hence lemmas involving strong normalization constitute by far the biggest part of this theory. One of those is Newman's lemma. extra-history = Change history: [2010-09-17]: Added theories defining several (ordered) semirings related to strong normalization and giving some standard instances.
[2013-10-16]: Generalized delta-orders from rationals to Archimedean fields. notify = christian.sternagel@uibk.ac.at, rene.thiemann@uibk.ac.at [First_Order_Terms] title = First-Order Terms author = Christian Sternagel , René Thiemann topic = Logic/Rewriting, Computer science/Algorithms license = LGPL date = 2018-02-06 notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at abstract = We formalize basic results on first-order terms, including matching and a first-order unification algorithm, as well as well-foundedness of the subsumption order. This entry is part of the Isabelle Formalization of Rewriting IsaFoR, where first-order terms are omni-present: the unification algorithm is used to certify several confluence and termination techniques, like critical-pair computation and dependency graph approximations; and the subsumption order is a crucial ingredient for completion. [Free-Groups] title = Free Groups author = Joachim Breitner date = 2010-06-24 topic = Mathematics/Algebra abstract = Free Groups are, in a sense, the most generic kind of group. They are defined over a set of generators with no additional relations in between them. They play an important role in the definition of group presentations and in other fields. This theory provides the definition of Free Group as the set of fully canceled words in the generators. The universal property is proven, as well as some isomorphisms results about Free Groups. extra-history = Change history: [2011-12-11]: Added the Ping Pong Lemma. notify = [CofGroups] title = An Example of a Cofinitary Group in Isabelle/HOL author = Bart Kastermans date = 2009-08-04 topic = Mathematics/Algebra abstract = We formalize the usual proof that the group generated by the function k -> k + 1 on the integers gives rise to a cofinitary group. notify = nipkow@in.tum.de [Group-Ring-Module] title = Groups, Rings and Modules author = Hidetsune Kobayashi <>, L. Chen <>, H. Murao <> date = 2004-05-18 topic = Mathematics/Algebra abstract = The theory of groups, rings and modules is developed to a great depth. Group theory results include Zassenhaus's theorem and the Jordan-Hoelder theorem. The ring theory development includes ideals, quotient rings and the Chinese remainder theorem. The module development includes the Nakayama lemma, exact sequences and Tensor products. notify = lp15@cam.ac.uk [Robbins-Conjecture] title = A Complete Proof of the Robbins Conjecture author = Matthew Wampler-Doty <> date = 2010-05-22 topic = Mathematics/Algebra abstract = This document gives a formalization of the proof of the Robbins conjecture, following A. Mann, A Complete Proof of the Robbins Conjecture, 2003. notify = nipkow@in.tum.de [Valuation] title = Fundamental Properties of Valuation Theory and Hensel's Lemma author = Hidetsune Kobayashi <> date = 2007-08-08 topic = Mathematics/Algebra abstract = Convergence with respect to a valuation is discussed as convergence of a Cauchy sequence. Cauchy sequences of polynomials are defined. They are used to formalize Hensel's lemma. notify = lp15@cam.ac.uk [Rank_Nullity_Theorem] title = Rank-Nullity Theorem in Linear Algebra author = Jose Divasón , Jesús Aransay topic = Mathematics/Algebra date = 2013-01-16 abstract = In this contribution, we present some formalizations based on the HOL-Multivariate-Analysis session of Isabelle. Firstly, a generalization of several theorems of such library are presented. Secondly, some definitions and proofs involving Linear Algebra and the four fundamental subspaces of a matrix are shown. Finally, we present a proof of the result known in Linear Algebra as the ``Rank-Nullity Theorem'', which states that, given any linear map f from a finite dimensional vector space V to a vector space W, then the dimension of V is equal to the dimension of the kernel of f (which is a subspace of V) and the dimension of the range of f (which is a subspace of W). The proof presented here is based on the one given by Sheldon Axler in his book Linear Algebra Done Right. As a corollary of the previous theorem, and taking advantage of the relationship between linear maps and matrices, we prove that, for every matrix A (which has associated a linear map between finite dimensional vector spaces), the sum of its null space and its column space (which is equal to the range of the linear map) is equal to the number of columns of A. extra-history = Change history: [2014-07-14]: Added some generalizations that allow us to formalize the Rank-Nullity Theorem over finite dimensional vector spaces, instead of over the more particular euclidean spaces. Updated abstract. notify = jose.divasonm@unirioja.es, jesus-maria.aransay@unirioja.es [Affine_Arithmetic] title = Affine Arithmetic author = Fabian Immler date = 2014-02-07 topic = Mathematics/Analysis abstract = We give a formalization of affine forms as abstract representations of zonotopes. We provide affine operations as well as overapproximations of some non-affine operations like multiplication and division. Expressions involving those operations can automatically be turned into (executable) functions approximating the original expression in affine arithmetic. extra-history = Change history: [2015-01-31]: added algorithm for zonotope/hyperplane intersection
[2017-09-20]: linear approximations for all symbols from the floatarith data type notify = immler@in.tum.de [Laplace_Transform] title = Laplace Transform author = Fabian Immler topic = Mathematics/Analysis date = 2019-08-14 notify = fimmler@cs.cmu.edu abstract = This entry formalizes the Laplace transform and concrete Laplace transforms for arithmetic functions, frequency shift, integration and (higher) differentiation in the time domain. It proves Lerch's lemma and uniqueness of the Laplace transform for continuous functions. In order to formalize the foundational assumptions, this entry contains a formalization of piecewise continuous functions and functions of exponential order. [Cauchy] title = Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality author = Benjamin Porter <> date = 2006-03-14 topic = Mathematics/Analysis abstract = This document presents the mechanised proofs of two popular theorems attributed to Augustin Louis Cauchy - Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality. notify = kleing@cse.unsw.edu.au [Integration] title = Integration theory and random variables author = Stefan Richter date = 2004-11-19 topic = Mathematics/Analysis abstract = Lebesgue-style integration plays a major role in advanced probability. We formalize concepts of elementary measure theory, real-valued random variables as Borel-measurable functions, and a stepwise inductive definition of the integral itself. All proofs are carried out in human readable style using the Isar language. extra-note = Note: This article is of historical interest only. Lebesgue-style integration and probability theory are now available as part of the Isabelle/HOL distribution (directory Probability). notify = richter@informatik.rwth-aachen.de, nipkow@in.tum.de, hoelzl@in.tum.de [Ordinary_Differential_Equations] title = Ordinary Differential Equations author = Fabian Immler , Johannes Hölzl topic = Mathematics/Analysis date = 2012-04-26 abstract =

Session Ordinary-Differential-Equations formalizes ordinary differential equations (ODEs) and initial value problems. This work comprises proofs for local and global existence of unique solutions (Picard-Lindelöf theorem). Moreover, it contains a formalization of the (continuous or even differentiable) dependency of the flow on initial conditions as the flow of ODEs.

Not in the generated document are the following sessions:

  • HOL-ODE-Numerics: Rigorous numerical algorithms for computing enclosures of solutions based on Runge-Kutta methods and affine arithmetic. Reachability analysis with splitting and reduction at hyperplanes.
  • HOL-ODE-Examples: Applications of the numerical algorithms to concrete systems of ODEs.
  • Lorenz_C0, Lorenz_C1: Verified algorithms for checking C1-information according to Tucker's proof, computation of C0-information.

extra-history = Change history: [2014-02-13]: added an implementation of the Euler method based on affine arithmetic
[2016-04-14]: added flow and variational equation
[2016-08-03]: numerical algorithms for reachability analysis (using second-order Runge-Kutta methods, splitting, and reduction) implemented using Lammich's framework for automatic refinement
[2017-09-20]: added Poincare map and propagation of variational equation in reachability analysis, verified algorithms for C1-information and computations for C0-information of the Lorenz attractor. notify = immler@in.tum.de, hoelzl@in.tum.de [Polynomials] title = Executable Multivariate Polynomials author = Christian Sternagel , René Thiemann , Alexander Maletzky , Fabian Immler , Florian Haftmann , Andreas Lochbihler , Alexander Bentkamp date = 2010-08-10 topic = Mathematics/Analysis, Mathematics/Algebra, Computer science/Algorithms/Mathematical license = LGPL abstract = We define multivariate polynomials over arbitrary (ordered) semirings in combination with (executable) operations like addition, multiplication, and substitution. We also define (weak) monotonicity of polynomials and comparison of polynomials where we provide standard estimations like absolute positiveness or the more recent approach of Neurauter, Zankl, and Middeldorp. Moreover, it is proven that strongly normalizing (monotone) orders can be lifted to strongly normalizing (monotone) orders over polynomials. Our formalization was performed as part of the IsaFoR/CeTA-system which contains several termination techniques. The provided theories have been essential to formalize polynomial interpretations.

This formalization also contains an abstract representation as coefficient functions with finite support and a type of power-products. If this type is ordered by a linear (term) ordering, various additional notions, such as leading power-product, leading coefficient etc., are introduced as well. Furthermore, a lot of generic properties of, and functions on, multivariate polynomials are formalized, including the substitution and evaluation homomorphisms, embeddings of polynomial rings into larger rings (i.e. with one additional indeterminate), homogenization and dehomogenization of polynomials, and the canonical isomorphism between R[X,Y] and R[X][Y]. extra-history = Change history: [2010-09-17]: Moved theories on arbitrary (ordered) semirings to Abstract Rewriting.
[2016-10-28]: Added abstract representation of polynomials and authors Maletzky/Immler.
[2018-01-23]: Added authors Haftmann, Lochbihler after incorporating their formalization of multivariate polynomials based on Polynomial mappings. Moved material from Bentkamp's entry "Deep Learning".
[2019-04-18]: Added material about polynomials whose power-products are represented themselves by polynomial mappings. notify = rene.thiemann@uibk.ac.at, christian.sternagel@uibk.ac.at, alexander.maletzky@risc.jku.at, immler@in.tum.de [Sqrt_Babylonian] title = Computing N-th Roots using the Babylonian Method author = René Thiemann date = 2013-01-03 topic = Mathematics/Analysis license = LGPL abstract = We implement the Babylonian method to compute n-th roots of numbers. We provide precise algorithms for naturals, integers and rationals, and offer an approximation algorithm for square roots over linear ordered fields. Moreover, there are precise algorithms to compute the floor and the ceiling of n-th roots. extra-history = Change history: [2013-10-16]: Added algorithms to compute floor and ceiling of sqrt of integers. [2014-07-11]: Moved NthRoot_Impl from Real-Impl to this entry. notify = rene.thiemann@uibk.ac.at [Sturm_Sequences] title = Sturm's Theorem author = Manuel Eberl date = 2014-01-11 topic = Mathematics/Analysis abstract = Sturm's Theorem states that polynomial sequences with certain properties, so-called Sturm sequences, can be used to count the number of real roots of a real polynomial. This work contains a proof of Sturm's Theorem and code for constructing Sturm sequences efficiently. It also provides the “sturm” proof method, which can decide certain statements about the roots of real polynomials, such as “the polynomial P has exactly n roots in the interval I” or “P(x) > Q(x) for all x ∈ ℝ”. notify = eberlm@in.tum.de [Sturm_Tarski] title = The Sturm-Tarski Theorem author = Wenda Li date = 2014-09-19 topic = Mathematics/Analysis abstract = We have formalized the Sturm-Tarski theorem (also referred as the Tarski theorem), which generalizes Sturm's theorem. Sturm's theorem is usually used as a way to count distinct real roots, while the Sturm-Tarksi theorem forms the basis for Tarski's classic quantifier elimination for real closed field. notify = wl302@cam.ac.uk [Markov_Models] title = Markov Models author = Johannes Hölzl , Tobias Nipkow date = 2012-01-03 topic = Mathematics/Probability theory, Computer science/Automata and formal languages abstract = This is a formalization of Markov models in Isabelle/HOL. It builds on Isabelle's probability theory. The available models are currently Discrete-Time Markov Chains and a extensions of them with rewards.

As application of these models we formalize probabilistic model checking of pCTL formulas, analysis of IPv4 address allocation in ZeroConf and an analysis of the anonymity of the Crowds protocol. See here for the corresponding paper. notify = hoelzl@in.tum.de [Probabilistic_System_Zoo] title = A Zoo of Probabilistic Systems author = Johannes Hölzl , Andreas Lochbihler , Dmitriy Traytel date = 2015-05-27 topic = Computer science/Automata and formal languages abstract = Numerous models of probabilistic systems are studied in the literature. Coalgebra has been used to classify them into system types and compare their expressiveness. We formalize the resulting hierarchy of probabilistic system types by modeling the semantics of the different systems as codatatypes. This approach yields simple and concise proofs, as bisimilarity coincides with equality for codatatypes.

This work is described in detail in the ITP 2015 publication by the authors. notify = traytel@in.tum.de [Density_Compiler] title = A Verified Compiler for Probability Density Functions author = Manuel Eberl , Johannes Hölzl , Tobias Nipkow date = 2014-10-09 topic = Mathematics/Probability theory, Computer science/Programming languages/Compiling abstract = Bhat et al. [TACAS 2013] developed an inductive compiler that computes density functions for probability spaces described by programs in a probabilistic functional language. In this work, we implement such a compiler for a modified version of this language within the theorem prover Isabelle and give a formal proof of its soundness w.r.t. the semantics of the source and target language. Together with Isabelle's code generation for inductive predicates, this yields a fully verified, executable density compiler. The proof is done in two steps: First, an abstract compiler working with abstract functions modelled directly in the theorem prover's logic is defined and proved sound. Then, this compiler is refined to a concrete version that returns a target-language expression.

An article with the same title and authors is published in the proceedings of ESOP 2015. A detailed presentation of this work can be found in the first author's master's thesis. notify = hoelzl@in.tum.de [CAVA_Automata] title = The CAVA Automata Library author = Peter Lammich date = 2014-05-28 topic = Computer science/Automata and formal languages abstract = We report on the graph and automata library that is used in the fully verified LTL model checker CAVA. As most components of CAVA use some type of graphs or automata, a common automata library simplifies assembly of the components and reduces redundancy.

The CAVA Automata Library provides a hierarchy of graph and automata classes, together with some standard algorithms. Its object oriented design allows for sharing of algorithms, theorems, and implementations between its classes, and also simplifies extensions of the library. Moreover, it is integrated into the Automatic Refinement Framework, supporting automatic refinement of the abstract automata types to efficient data structures.

Note that the CAVA Automata Library is work in progress. Currently, it is very specifically tailored towards the requirements of the CAVA model checker. Nevertheless, the formalization techniques presented here allow an extension of the library to a wider scope. Moreover, they are not limited to graph libraries, but apply to class hierarchies in general.

The CAVA Automata Library is described in the paper: Peter Lammich, The CAVA Automata Library, Isabelle Workshop 2014. notify = lammich@in.tum.de [LTL] title = Linear Temporal Logic author = Salomon Sickert contributors = Benedikt Seidl date = 2016-03-01 topic = Logic/General logic/Temporal logic, Computer science/Automata and formal languages abstract = This theory provides a formalisation of linear temporal logic (LTL) and unifies previous formalisations within the AFP. This entry establishes syntax and semantics for this logic and decouples it from existing entries, yielding a common environment for theories reasoning about LTL. Furthermore a parser written in SML and an executable simplifier are provided. extra-history = Change history: [2019-03-12]: Support for additional operators, implementation of common equivalence relations, definition of syntactic fragments of LTL and the minimal disjunctive normal form.
notify = sickert@in.tum.de [LTL_to_GBA] title = Converting Linear-Time Temporal Logic to Generalized Büchi Automata author = Alexander Schimpf , Peter Lammich date = 2014-05-28 topic = Computer science/Automata and formal languages abstract = We formalize linear-time temporal logic (LTL) and the algorithm by Gerth et al. to convert LTL formulas to generalized Büchi automata. We also formalize some syntactic rewrite rules that can be applied to optimize the LTL formula before conversion. Moreover, we integrate the Stuttering Equivalence AFP-Entry by Stefan Merz, adapting the lemma that next-free LTL formula cannot distinguish between stuttering equivalent runs to our setting.

We use the Isabelle Refinement and Collection framework, as well as the Autoref tool, to obtain a refined version of our algorithm, from which efficiently executable code can be extracted. notify = lammich@in.tum.de [Gabow_SCC] title = Verified Efficient Implementation of Gabow's Strongly Connected Components Algorithm author = Peter Lammich date = 2014-05-28 topic = Computer science/Algorithms/Graph, Mathematics/Graph theory abstract = We present an Isabelle/HOL formalization of Gabow's algorithm for finding the strongly connected components of a directed graph. Using data refinement techniques, we extract efficient code that performs comparable to a reference implementation in Java. Our style of formalization allows for re-using large parts of the proofs when defining variants of the algorithm. We demonstrate this by verifying an algorithm for the emptiness check of generalized Büchi automata, re-using most of the existing proofs. notify = lammich@in.tum.de [Promela] title = Promela Formalization author = René Neumann date = 2014-05-28 topic = Computer science/System description languages abstract = We present an executable formalization of the language Promela, the description language for models of the model checker SPIN. This formalization is part of the work for a completely verified model checker (CAVA), but also serves as a useful (and executable!) description of the semantics of the language itself, something that is currently missing. The formalization uses three steps: It takes an abstract syntax tree generated from an SML parser, removes syntactic sugar and enriches it with type information. This further gets translated into a transition system, on which the semantic engine (read: successor function) operates. notify = [CAVA_LTL_Modelchecker] title = A Fully Verified Executable LTL Model Checker author = Javier Esparza , Peter Lammich , René Neumann , Tobias Nipkow , Alexander Schimpf , Jan-Georg Smaus date = 2014-05-28 topic = Computer science/Automata and formal languages abstract = We present an LTL model checker whose code has been completely verified using the Isabelle theorem prover. The checker consists of over 4000 lines of ML code. The code is produced using the Isabelle Refinement Framework, which allows us to split its correctness proof into (1) the proof of an abstract version of the checker, consisting of a few hundred lines of ``formalized pseudocode'', and (2) a verified refinement step in which mathematical sets and other abstract structures are replaced by implementations of efficient structures like red-black trees and functional arrays. This leads to a checker that, while still slower than unverified checkers, can already be used as a trusted reference implementation against which advanced implementations can be tested.

An early version of this model checker is described in the CAV 2013 paper with the same title. notify = lammich@in.tum.de [Fermat3_4] title = Fermat's Last Theorem for Exponents 3 and 4 and the Parametrisation of Pythagorean Triples author = Roelof Oosterhuis <> date = 2007-08-12 topic = Mathematics/Number theory abstract = This document presents the mechanised proofs of

  • Fermat's Last Theorem for exponents 3 and 4 and
  • the parametrisation of Pythagorean Triples.
notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com [Perfect-Number-Thm] title = Perfect Number Theorem author = Mark Ijbema date = 2009-11-22 topic = Mathematics/Number theory abstract = These theories present the mechanised proof of the Perfect Number Theorem. notify = nipkow@in.tum.de [SumSquares] title = Sums of Two and Four Squares author = Roelof Oosterhuis <> date = 2007-08-12 topic = Mathematics/Number theory abstract = This document presents the mechanised proofs of the following results:
  • any prime number of the form 4m+1 can be written as the sum of two squares;
  • any natural number can be written as the sum of four squares
notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com [Lehmer] title = Lehmer's Theorem author = Simon Wimmer , Lars Noschinski date = 2013-07-22 topic = Mathematics/Number theory abstract = In 1927, Lehmer presented criterions for primality, based on the converse of Fermat's litte theorem. This work formalizes the second criterion from Lehmer's paper, a necessary and sufficient condition for primality.

As a side product we formalize some properties of Euler's phi-function, the notion of the order of an element of a group, and the cyclicity of the multiplicative group of a finite field. notify = noschinl@gmail.com, simon.wimmer@tum.de [Pratt_Certificate] title = Pratt's Primality Certificates author = Simon Wimmer , Lars Noschinski date = 2013-07-22 topic = Mathematics/Number theory abstract = In 1975, Pratt introduced a proof system for certifying primes. He showed that a number p is prime iff a primality certificate for p exists. By showing a logarithmic upper bound on the length of the certificates in size of the prime number, he concluded that the decision problem for prime numbers is in NP. This work formalizes soundness and completeness of Pratt's proof system as well as an upper bound for the size of the certificate. notify = noschinl@gmail.com, simon.wimmer@tum.de [Monad_Memo_DP] title = Monadification, Memoization and Dynamic Programming author = Simon Wimmer , Shuwei Hu , Tobias Nipkow topic = Computer science/Programming languages/Transformations, Computer science/Algorithms, Computer science/Functional programming date = 2018-05-22 notify = wimmers@in.tum.de abstract = We present a lightweight framework for the automatic verified (functional or imperative) memoization of recursive functions. Our tool can turn a pure Isabelle/HOL function definition into a monadified version in a state monad or the Imperative HOL heap monad, and prove a correspondence theorem. We provide a variety of memory implementations for the two types of monads. A number of simple techniques allow us to achieve bottom-up computation and space-efficient memoization. The framework’s utility is demonstrated on a number of representative dynamic programming problems. A detailed description of our work can be found in the accompanying paper [2]. [Probabilistic_Timed_Automata] title = Probabilistic Timed Automata author = Simon Wimmer , Johannes Hölzl topic = Mathematics/Probability theory, Computer science/Automata and formal languages date = 2018-05-24 notify = wimmers@in.tum.de, hoelzl@in.tum.de abstract = We present a formalization of probabilistic timed automata (PTA) for which we try to follow the formula MDP + TA = PTA as far as possible: our work starts from our existing formalizations of Markov decision processes (MDP) and timed automata (TA) and combines them modularly. We prove the fundamental result for probabilistic timed automata: the region construction that is known from timed automata carries over to the probabilistic setting. In particular, this allows us to prove that minimum and maximum reachability probabilities can be computed via a reduction to MDP model checking, including the case where one wants to disregard unrealizable behavior. Further information can be found in our ITP paper [2]. [Hidden_Markov_Models] title = Hidden Markov Models author = Simon Wimmer topic = Mathematics/Probability theory, Computer science/Algorithms date = 2018-05-25 notify = wimmers@in.tum.de abstract = This entry contains a formalization of hidden Markov models [3] based on Johannes Hölzl's formalization of discrete time Markov chains [1]. The basic definitions are provided and the correctness of two main (dynamic programming) algorithms for hidden Markov models is proved: the forward algorithm for computing the likelihood of an observed sequence, and the Viterbi algorithm for decoding the most probable hidden state sequence. The Viterbi algorithm is made executable including memoization. Hidden markov models have various applications in natural language processing. For an introduction see Jurafsky and Martin [2]. [ArrowImpossibilityGS] title = Arrow and Gibbard-Satterthwaite author = Tobias Nipkow date = 2008-09-01 topic = Mathematics/Games and economics abstract = This article formalizes two proofs of Arrow's impossibility theorem due to Geanakoplos and derives the Gibbard-Satterthwaite theorem as a corollary. One formalization is based on utility functions, the other one on strict partial orders.

An article about these proofs is found here. notify = nipkow@in.tum.de [SenSocialChoice] title = Some classical results in Social Choice Theory author = Peter Gammie date = 2008-11-09 topic = Mathematics/Games and economics abstract = Drawing on Sen's landmark work "Collective Choice and Social Welfare" (1970), this development proves Arrow's General Possibility Theorem, Sen's Liberal Paradox and May's Theorem in a general setting. The goal was to make precise the classical statements and proofs of these results, and to provide a foundation for more recent results such as the Gibbard-Satterthwaite and Duggan-Schwartz theorems. notify = nipkow@in.tum.de [Vickrey_Clarke_Groves] title = VCG - Combinatorial Vickrey-Clarke-Groves Auctions author = Marco B. Caminati <>, Manfred Kerber , Christoph Lange, Colin Rowat date = 2015-04-30 topic = Mathematics/Games and economics abstract = A VCG auction (named after their inventors Vickrey, Clarke, and Groves) is a generalization of the single-good, second price Vickrey auction to the case of a combinatorial auction (multiple goods, from which any participant can bid on each possible combination). We formalize in this entry VCG auctions, including tie-breaking and prove that the functions for the allocation and the price determination are well-defined. Furthermore we show that the allocation function allocates goods only to participants, only goods in the auction are allocated, and no good is allocated twice. We also show that the price function is non-negative. These properties also hold for the automatically extracted Scala code. notify = mnfrd.krbr@gmail.com [Topology] title = Topology author = Stefan Friedrich <> date = 2004-04-26 topic = Mathematics/Topology abstract = This entry contains two theories. The first, Topology, develops the basic notions of general topology. The second, which can be viewed as a demonstration of the first, is called LList_Topology. It develops the topology of lazy lists. notify = lcp@cl.cam.ac.uk [Knot_Theory] title = Knot Theory author = T.V.H. Prathamesh date = 2016-01-20 topic = Mathematics/Topology abstract = This work contains a formalization of some topics in knot theory. The concepts that were formalized include definitions of tangles, links, framed links and link/tangle equivalence. The formalization is based on a formulation of links in terms of tangles. We further construct and prove the invariance of the Bracket polynomial. Bracket polynomial is an invariant of framed links closely linked to the Jones polynomial. This is perhaps the first attempt to formalize any aspect of knot theory in an interactive proof assistant. notify = prathamesh@imsc.res.in [Graph_Theory] title = Graph Theory author = Lars Noschinski date = 2013-04-28 topic = Mathematics/Graph theory abstract = This development provides a formalization of directed graphs, supporting (labelled) multi-edges and infinite graphs. A polymorphic edge type allows edges to be treated as pairs of vertices, if multi-edges are not required. Formalized properties are i.a. walks (and related concepts), connectedness and subgraphs and basic properties of isomorphisms.

This formalization is used to prove characterizations of Euler Trails, Shortest Paths and Kuratowski subgraphs. notify = noschinl@gmail.com [Planarity_Certificates] title = Planarity Certificates author = Lars Noschinski date = 2015-11-11 topic = Mathematics/Graph theory abstract = This development provides a formalization of planarity based on combinatorial maps and proves that Kuratowski's theorem implies combinatorial planarity. Moreover, it contains verified implementations of programs checking certificates for planarity (i.e., a combinatorial map) or non-planarity (i.e., a Kuratowski subgraph). notify = noschinl@gmail.com [Max-Card-Matching] title = Maximum Cardinality Matching author = Christine Rizkallah date = 2011-07-21 topic = Mathematics/Graph theory abstract =

A matching in a graph G is a subset M of the edges of G such that no two share an endpoint. A matching has maximum cardinality if its cardinality is at least as large as that of any other matching. An odd-set cover OSC of a graph G is a labeling of the nodes of G with integers such that every edge of G is either incident to a node labeled 1 or connects two nodes labeled with the same number i ≥ 2.

This article proves Edmonds theorem:
Let M be a matching in a graph G and let OSC be an odd-set cover of G. For any i ≥ 0, let n(i) be the number of nodes labeled i. If |M| = n(1) + ∑i ≥ 2(n(i) div 2), then M is a maximum cardinality matching.

notify = nipkow@in.tum.de [Girth_Chromatic] title = A Probabilistic Proof of the Girth-Chromatic Number Theorem author = Lars Noschinski date = 2012-02-06 topic = Mathematics/Graph theory abstract = This works presents a formalization of the Girth-Chromatic number theorem in graph theory, stating that graphs with arbitrarily large girth and chromatic number exist. The proof uses the theory of Random Graphs to prove the existence with probabilistic arguments. notify = noschinl@gmail.com [Random_Graph_Subgraph_Threshold] title = Properties of Random Graphs -- Subgraph Containment author = Lars Hupel date = 2014-02-13 topic = Mathematics/Graph theory, Mathematics/Probability theory abstract = Random graphs are graphs with a fixed number of vertices, where each edge is present with a fixed probability. We are interested in the probability that a random graph contains a certain pattern, for example a cycle or a clique. A very high edge probability gives rise to perhaps too many edges (which degrades performance for many algorithms), whereas a low edge probability might result in a disconnected graph. We prove a theorem about a threshold probability such that a higher edge probability will asymptotically almost surely produce a random graph with the desired subgraph. notify = hupel@in.tum.de [Flyspeck-Tame] title = Flyspeck I: Tame Graphs author = Gertrud Bauer <>, Tobias Nipkow date = 2006-05-22 topic = Mathematics/Graph theory abstract = These theories present the verified enumeration of tame plane graphs as defined by Thomas C. Hales in his proof of the Kepler Conjecture in his book Dense Sphere Packings. A Blueprint for Formal Proofs. [CUP 2012]. The values of the constants in the definition of tameness are identical to those in the Flyspeck project. The IJCAR 2006 paper by Nipkow, Bauer and Schultz refers to the original version of Hales' proof, the ITP 2011 paper by Nipkow refers to the Blueprint version of the proof. extra-history = Change history: [2010-11-02]: modified theories to reflect the modified definition of tameness in Hales' revised proof.
[2014-07-03]: modified constants in def of tameness and Archive according to the final state of the Flyspeck proof. notify = nipkow@in.tum.de [Well_Quasi_Orders] title = Well-Quasi-Orders author = Christian Sternagel date = 2012-04-13 topic = Mathematics/Combinatorics abstract = Based on Isabelle/HOL's type class for preorders, we introduce a type class for well-quasi-orders (wqo) which is characterized by the absence of "bad" sequences (our proofs are along the lines of the proof of Nash-Williams, from which we also borrow terminology). Our main results are instantiations for the product type, the list type, and a type of finite trees, which (almost) directly follow from our proofs of (1) Dickson's Lemma, (2) Higman's Lemma, and (3) Kruskal's Tree Theorem. More concretely:
  • If the sets A and B are wqo then their Cartesian product is wqo.
  • If the set A is wqo then the set of finite lists over A is wqo.
  • If the set A is wqo then the set of finite trees over A is wqo.
The research was funded by the Austrian Science Fund (FWF): J3202. extra-history = Change history: [2012-06-11]: Added Kruskal's Tree Theorem.
[2012-12-19]: New variant of Kruskal's tree theorem for terms (as opposed to variadic terms, i.e., trees), plus finite version of the tree theorem as corollary.
[2013-05-16]: Simplified construction of minimal bad sequences.
[2014-07-09]: Simplified proofs of Higman's lemma and Kruskal's tree theorem, based on homogeneous sequences.
[2016-01-03]: An alternative proof of Higman's lemma by open induction.
[2017-06-08]: Proved (classical) equivalence to inductive definition of almost-full relations according to the ITP 2012 paper "Stop When You Are Almost-Full" by Vytiniotis, Coquand, and Wahlstedt. notify = c.sternagel@gmail.com [Marriage] title = Hall's Marriage Theorem author = Dongchen Jiang , Tobias Nipkow date = 2010-12-17 topic = Mathematics/Combinatorics abstract = Two proofs of Hall's Marriage Theorem: one due to Halmos and Vaughan, one due to Rado. extra-history = Change history: [2011-09-09]: Added Rado's proof notify = nipkow@in.tum.de [Bondy] title = Bondy's Theorem author = Jeremy Avigad , Stefan Hetzl date = 2012-10-27 topic = Mathematics/Combinatorics abstract = A proof of Bondy's theorem following B. Bollabas, Combinatorics, 1986, Cambridge University Press. notify = avigad@cmu.edu, hetzl@logic.at [Ramsey-Infinite] title = Ramsey's theorem, infinitary version author = Tom Ridge <> date = 2004-09-20 topic = Mathematics/Combinatorics abstract = This formalization of Ramsey's theorem (infinitary version) is taken from Boolos and Jeffrey, Computability and Logic, 3rd edition, Chapter 26. It differs slightly from the text by assuming a slightly stronger hypothesis. In particular, the induction hypothesis is stronger, holding for any infinite subset of the naturals. This avoids the rather peculiar mapping argument between kj and aikj on p.263, which is unnecessary and slightly mars this really beautiful result. notify = lp15@cam.ac.uk [Derangements] title = Derangements Formula author = Lukas Bulwahn date = 2015-06-27 topic = Mathematics/Combinatorics abstract = The Derangements Formula describes the number of fixpoint-free permutations as a closed formula. This theorem is the 88th theorem in a list of the ``Top 100 Mathematical Theorems''. notify = lukas.bulwahn@gmail.com [Euler_Partition] title = Euler's Partition Theorem author = Lukas Bulwahn date = 2015-11-19 topic = Mathematics/Combinatorics abstract = Euler's Partition Theorem states that the number of partitions with only distinct parts is equal to the number of partitions with only odd parts. The combinatorial proof follows John Harrison's HOL Light formalization. This theorem is the 45th theorem of the Top 100 Theorems list. notify = lukas.bulwahn@gmail.com [Discrete_Summation] title = Discrete Summation author = Florian Haftmann contributors = Amine Chaieb <> date = 2014-04-13 topic = Mathematics/Combinatorics abstract = These theories introduce basic concepts and proofs about discrete summation: shifts, formal summation, falling factorials and stirling numbers. As proof of concept, a simple summation conversion is provided. notify = florian.haftmann@informatik.tu-muenchen.de [Open_Induction] title = Open Induction author = Mizuhito Ogawa <>, Christian Sternagel date = 2012-11-02 topic = Mathematics/Combinatorics abstract = A proof of the open induction schema based on J.-C. Raoult, Proving open properties by induction, Information Processing Letters 29, 1988, pp.19-23.

This research was supported by the Austrian Science Fund (FWF): J3202.

notify = c.sternagel@gmail.com [Category] title = Category Theory to Yoneda's Lemma author = Greg O'Keefe date = 2005-04-21 topic = Mathematics/Category theory license = LGPL abstract = This development proves Yoneda's lemma and aims to be readable by humans. It only defines what is needed for the lemma: categories, functors and natural transformations. Limits, adjunctions and other important concepts are not included. extra-history = Change history: [2010-04-23]: The definition of the constant equinumerous was slightly too weak in the original submission and has been fixed in revision 8c2b5b3c995f. notify = lcp@cl.cam.ac.uk [Category2] title = Category Theory author = Alexander Katovsky date = 2010-06-20 topic = Mathematics/Category theory abstract = This article presents a development of Category Theory in Isabelle/HOL. A Category is defined using records and locales. Functors and Natural Transformations are also defined. The main result that has been formalized is that the Yoneda functor is a full and faithful embedding. We also formalize the completeness of many sorted monadic equational logic. Extensive use is made of the HOLZF theory in both cases. For an informal description see here [pdf]. notify = alexander.katovsky@cantab.net [FunWithFunctions] title = Fun With Functions author = Tobias Nipkow date = 2008-08-26 topic = Mathematics/Misc abstract = This is a collection of cute puzzles of the form ``Show that if a function satisfies the following constraints, it must be ...'' Please add further examples to this collection! notify = nipkow@in.tum.de [FunWithTilings] title = Fun With Tilings author = Tobias Nipkow , Lawrence C. Paulson date = 2008-11-07 topic = Mathematics/Misc abstract = Tilings are defined inductively. It is shown that one form of mutilated chess board cannot be tiled with dominoes, while another one can be tiled with L-shaped tiles. Please add further fun examples of this kind! notify = nipkow@in.tum.de [Lazy-Lists-II] title = Lazy Lists II author = Stefan Friedrich <> date = 2004-04-26 topic = Computer science/Data structures abstract = This theory contains some useful extensions to the LList (lazy list) theory by Larry Paulson, including finite, infinite, and positive llists over an alphabet, as well as the new constants take and drop and the prefix order of llists. Finally, the notions of safety and liveness in the sense of Alpern and Schneider (1985) are defined. notify = lcp@cl.cam.ac.uk [Ribbon_Proofs] title = Ribbon Proofs author = John Wickerson <> date = 2013-01-19 topic = Computer science/Programming languages/Logics abstract = This document concerns the theory of ribbon proofs: a diagrammatic proof system, based on separation logic, for verifying program correctness. We include the syntax, proof rules, and soundness results for two alternative formalisations of ribbon proofs.

Compared to traditional proof outlines, ribbon proofs emphasise the structure of a proof, so are intelligible and pedagogical. Because they contain less redundancy than proof outlines, and allow each proof step to be checked locally, they may be more scalable. Where proof outlines are cumbersome to modify, ribbon proofs can be visually manoeuvred to yield proofs of variant programs. notify = [Koenigsberg_Friendship] title = The Königsberg Bridge Problem and the Friendship Theorem author = Wenda Li date = 2013-07-19 topic = Mathematics/Graph theory abstract = This development provides a formalization of undirected graphs and simple graphs, which are based on Benedikt Nordhoff and Peter Lammich's simple formalization of labelled directed graphs in the archive. Then, with our formalization of graphs, we show both necessary and sufficient conditions for Eulerian trails and circuits as well as the fact that the Königsberg Bridge Problem does not have a solution. In addition, we show the Friendship Theorem in simple graphs. notify = [Tree_Decomposition] title = Tree Decomposition author = Christoph Dittmann notify = date = 2016-05-31 topic = Mathematics/Graph theory abstract = We formalize tree decompositions and tree width in Isabelle/HOL, proving that trees have treewidth 1. We also show that every edge of a tree decomposition is a separation of the underlying graph. As an application of this theorem we prove that complete graphs of size n have treewidth n-1. [Menger] title = Menger's Theorem author = Christoph Dittmann topic = Mathematics/Graph theory date = 2017-02-26 notify = isabelle@christoph-d.de abstract = We present a formalization of Menger's Theorem for directed and undirected graphs in Isabelle/HOL. This well-known result shows that if two non-adjacent distinct vertices u, v in a directed graph have no separator smaller than n, then there exist n internally vertex-disjoint paths from u to v. The version for undirected graphs follows immediately because undirected graphs are a special case of directed graphs. [IEEE_Floating_Point] title = A Formal Model of IEEE Floating Point Arithmetic author = Lei Yu contributors = Fabian Hellauer , Fabian Immler date = 2013-07-27 topic = Computer science/Data structures abstract = This development provides a formal model of IEEE-754 floating-point arithmetic. This formalization, including formal specification of the standard and proofs of important properties of floating-point arithmetic, forms the foundation for verifying programs with floating-point computation. There is also a code generation setup for floats so that we can execute programs using this formalization in functional programming languages. notify = lp15@cam.ac.uk, immler@in.tum.de extra-history = Change history: [2017-09-25]: Added conversions from and to software floating point numbers (by Fabian Hellauer and Fabian Immler).
[2018-02-05]: 'Modernized' representation following the formalization in HOL4: former "float_format" and predicate "is_valid" is now encoded in a type "('e, 'f) float" where 'e and 'f encode the size of exponent and fraction. [Native_Word] title = Native Word author = Andreas Lochbihler contributors = Peter Lammich date = 2013-09-17 topic = Computer science/Data structures abstract = This entry makes machine words and machine arithmetic available for code generation from Isabelle/HOL. It provides a common abstraction that hides the differences between the different target languages. The code generator maps these operations to the APIs of the target languages. Apart from that, we extend the available bit operations on types int and integer, and map them to the operations in the target languages. extra-history = Change history: [2013-11-06]: added conversion function between native words and characters (revision fd23d9a7fe3a)
[2014-03-31]: added words of default size in the target language (by Peter Lammich) (revision 25caf5065833)
[2014-10-06]: proper test setup with compilation and execution of tests in all target languages (revision 5d7a1c9ae047)
[2017-09-02]: added 64-bit words (revision c89f86244e3c)
[2018-07-15]: added cast operators for default-size words (revision fc1f1fb8dd30)
notify = mail@andreas-lochbihler.de [XML] title = XML author = Christian Sternagel , René Thiemann date = 2014-10-03 topic = Computer science/Functional programming, Computer science/Data structures abstract = This entry provides an XML library for Isabelle/HOL. This includes parsing and pretty printing of XML trees as well as combinators for transforming XML trees into arbitrary user-defined data. The main contribution of this entry is an interface (fit for code generation) that allows for communication between verified programs formalized in Isabelle/HOL and the outside world via XML. This library was developed as part of the IsaFoR/CeTA project to which we refer for examples of its usage. notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at [HereditarilyFinite] title = The Hereditarily Finite Sets author = Lawrence C. Paulson date = 2013-11-17 topic = Logic/Set theory abstract = The theory of hereditarily finite sets is formalised, following the development of Swierczkowski. An HF set is a finite collection of other HF sets; they enjoy an induction principle and satisfy all the axioms of ZF set theory apart from the axiom of infinity, which is negated. All constructions that are possible in ZF set theory (Cartesian products, disjoint sums, natural numbers, functions) without using infinite sets are possible here. The definition of addition for the HF sets follows Kirby. This development forms the foundation for the Isabelle proof of Gödel's incompleteness theorems, which has been formalised separately. extra-history = Change history: [2015-02-23]: Added the theory "Finitary" defining the class of types that can be embedded in hf, including int, char, option, list, etc. notify = lp15@cam.ac.uk [Incompleteness] title = Gödel's Incompleteness Theorems author = Lawrence C. Paulson date = 2013-11-17 topic = Logic/Proof theory abstract = Gödel's two incompleteness theorems are formalised, following a careful presentation by Swierczkowski, in the theory of hereditarily finite sets. This represents the first ever machine-assisted proof of the second incompleteness theorem. Compared with traditional formalisations using Peano arithmetic (see e.g. Boolos), coding is simpler, with no need to formalise the notion of multiplication (let alone that of a prime number) in the formalised calculus upon which the theorem is based. However, other technical problems had to be solved in order to complete the argument. notify = lp15@cam.ac.uk [Finite_Automata_HF] title = Finite Automata in Hereditarily Finite Set Theory author = Lawrence C. Paulson date = 2015-02-05 topic = Computer science/Automata and formal languages abstract = Finite Automata, both deterministic and non-deterministic, for regular languages. The Myhill-Nerode Theorem. Closure under intersection, concatenation, etc. Regular expressions define regular languages. Closure under reversal; the powerset construction mapping NFAs to DFAs. Left and right languages; minimal DFAs. Brzozowski's minimization algorithm. Uniqueness up to isomorphism of minimal DFAs. notify = lp15@cam.ac.uk [Decreasing-Diagrams] title = Decreasing Diagrams author = Harald Zankl license = LGPL date = 2013-11-01 topic = Logic/Rewriting abstract = This theory contains a formalization of decreasing diagrams showing that any locally decreasing abstract rewrite system is confluent. We consider the valley (van Oostrom, TCS 1994) and the conversion version (van Oostrom, RTA 2008) and closely follow the original proofs. As an application we prove Newman's lemma. notify = Harald.Zankl@uibk.ac.at [Decreasing-Diagrams-II] title = Decreasing Diagrams II author = Bertram Felgenhauer license = LGPL date = 2015-08-20 topic = Logic/Rewriting abstract = This theory formalizes the commutation version of decreasing diagrams for Church-Rosser modulo. The proof follows Felgenhauer and van Oostrom (RTA 2013). The theory also provides important specializations, in particular van Oostrom’s conversion version (TCS 2008) of decreasing diagrams. notify = bertram.felgenhauer@uibk.ac.at [GoedelGod] title = Gödel's God in Isabelle/HOL author = Christoph Benzmüller , Bruno Woltzenlogel Paleo date = 2013-11-12 topic = Logic/Philosophical aspects abstract = Dana Scott's version of Gödel's proof of God's existence is formalized in quantified modal logic KB (QML KB). QML KB is modeled as a fragment of classical higher-order logic (HOL); thus, the formalization is essentially a formalization in HOL. notify = lp15@cam.ac.uk, c.benzmueller@fu-berlin.de [Types_Tableaus_and_Goedels_God] title = Types, Tableaus and Gödel’s God in Isabelle/HOL author = David Fuenmayor , Christoph Benzmüller topic = Logic/Philosophical aspects date = 2017-05-01 notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com abstract = A computer-formalisation of the essential parts of Fitting's textbook "Types, Tableaus and Gödel's God" in Isabelle/HOL is presented. In particular, Fitting's (and Anderson's) variant of the ontological argument is verified and confirmed. This variant avoids the modal collapse, which has been criticised as an undesirable side-effect of Kurt Gödel's (and Dana Scott's) versions of the ontological argument. Fitting's work is employing an intensional higher-order modal logic, which we shallowly embed here in classical higher-order logic. We then utilize the embedded logic for the formalisation of Fitting's argument. (See also the earlier AFP entry ``Gödel's God in Isabelle/HOL''.) [GewirthPGCProof] title = Formalisation and Evaluation of Alan Gewirth's Proof for the Principle of Generic Consistency in Isabelle/HOL author = David Fuenmayor , Christoph Benzmüller topic = Logic/Philosophical aspects date = 2018-10-30 notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com abstract = An ambitious ethical theory ---Alan Gewirth's "Principle of Generic Consistency"--- is encoded and analysed in Isabelle/HOL. Gewirth's theory has stirred much attention in philosophy and ethics and has been proposed as a potential means to bound the impact of artificial general intelligence. extra-history = Change history: [2019-04-09]: added proof for a stronger variant of the PGC and examplary inferences (revision 88182cb0a2f6)
[Lowe_Ontological_Argument] title = Computer-assisted Reconstruction and Assessment of E. J. Lowe's Modal Ontological Argument author = David Fuenmayor , Christoph Benzmüller topic = Logic/Philosophical aspects date = 2017-09-21 notify = davfuenmayor@gmail.com, c.benzmueller@gmail.com abstract = Computers may help us to understand --not just verify-- philosophical arguments. By utilizing modern proof assistants in an iterative interpretive process, we can reconstruct and assess an argument by fully formal means. Through the mechanization of a variant of St. Anselm's ontological argument by E. J. Lowe, which is a paradigmatic example of a natural-language argument with strong ties to metaphysics and religion, we offer an ideal showcase for our computer-assisted interpretive method. [AnselmGod] title = Anselm's God in Isabelle/HOL author = Ben Blumson topic = Logic/Philosophical aspects date = 2017-09-06 notify = benblumson@gmail.com abstract = Paul Oppenheimer and Edward Zalta's formalisation of Anselm's ontological argument for the existence of God is automated by embedding a free logic for definite descriptions within Isabelle/HOL. [Tail_Recursive_Functions] title = A General Method for the Proof of Theorems on Tail-recursive Functions author = Pasquale Noce date = 2013-12-01 topic = Computer science/Functional programming abstract =

Tail-recursive function definitions are sometimes more straightforward than alternatives, but proving theorems on them may be roundabout because of the peculiar form of the resulting recursion induction rules.

This paper describes a proof method that provides a general solution to this problem by means of suitable invariants over inductive sets, and illustrates the application of such method by examining two case studies.

notify = pasquale.noce.lavoro@gmail.com [CryptoBasedCompositionalProperties] title = Compositional Properties of Crypto-Based Components author = Maria Spichkova date = 2014-01-11 topic = Computer science/Security abstract = This paper presents an Isabelle/HOL set of theories which allows the specification of crypto-based components and the verification of their composition properties wrt. cryptographic aspects. We introduce a formalisation of the security property of data secrecy, the corresponding definitions and proofs. Please note that here we import the Isabelle/HOL theory ListExtras.thy, presented in the AFP entry FocusStreamsCaseStudies-AFP. notify = maria.spichkova@rmit.edu.au [Featherweight_OCL] title = Featherweight OCL: A Proposal for a Machine-Checked Formal Semantics for OCL 2.5 author = Achim D. Brucker , Frédéric Tuong , Burkhart Wolff date = 2014-01-16 topic = Computer science/System description languages abstract = The Unified Modeling Language (UML) is one of the few modeling languages that is widely used in industry. While UML is mostly known as diagrammatic modeling language (e.g., visualizing class models), it is complemented by a textual language, called Object Constraint Language (OCL). The current version of OCL is based on a four-valued logic that turns UML into a formal language. Any type comprises the elements "invalid" and "null" which are propagated as strict and non-strict, respectively. Unfortunately, the former semi-formal semantics of this specification language, captured in the "Annex A" of the OCL standard, leads to different interpretations of corner cases. We formalize the core of OCL: denotational definitions, a logical calculus and operational rules that allow for the execution of OCL expressions by a mixture of term rewriting and code compilation. Our formalization reveals several inconsistencies and contradictions in the current version of the OCL standard. Overall, this document is intended to provide the basis for a machine-checked text "Annex A" of the OCL standard targeting at tool implementors. extra-history = Change history: [2015-10-13]: afp-devel@ea3b38fc54d6 and hol-testgen@12148
   Update of Featherweight OCL including a change in the abstract.
[2014-01-16]: afp-devel@9091ce05cb20 and hol-testgen@10241
   New Entry: Featherweight OCL notify = brucker@spamfence.net, tuong@users.gforge.inria.fr, wolff@lri.fr [Relation_Algebra] title = Relation Algebra author = Alasdair Armstrong <>, Simon Foster , Georg Struth , Tjark Weber date = 2014-01-25 topic = Mathematics/Algebra abstract = Tarski's algebra of binary relations is formalised along the lines of the standard textbooks of Maddux and Schmidt and Ströhlein. This includes relation-algebraic concepts such as subidentities, vectors and a domain operation as well as various notions associated to functions. Relation algebras are also expanded by a reflexive transitive closure operation, and they are linked with Kleene algebras and models of binary relations and Boolean matrices. notify = g.struth@sheffield.ac.uk, tjark.weber@it.uu.se [PSemigroupsConvolution] title = Partial Semigroups and Convolution Algebras author = Brijesh Dongol , Victor B. F. Gomes , Ian J. Hayes , Georg Struth topic = Mathematics/Algebra date = 2017-06-13 notify = g.struth@sheffield.ac.uk, victor.gomes@cl.cam.ac.uk abstract = Partial Semigroups are relevant to the foundations of quantum mechanics and combinatorics as well as to interval and separation logics. Convolution algebras can be understood either as algebras of generalised binary modalities over ternary Kripke frames, in particular over partial semigroups, or as algebras of quantale-valued functions which are equipped with a convolution-style operation of multiplication that is parametrised by a ternary relation. Convolution algebras provide algebraic semantics for various substructural logics, including categorial, relevance and linear logics, for separation logic and for interval logics; they cover quantitative and qualitative applications. These mathematical components for partial semigroups and convolution algebras provide uniform foundations from which models of computation based on relations, program traces or pomsets, and verification components for separation or interval temporal logics can be built with little effort. [Secondary_Sylow] title = Secondary Sylow Theorems author = Jakob von Raumer date = 2014-01-28 topic = Mathematics/Algebra abstract = These theories extend the existing proof of the first Sylow theorem (written by Florian Kammueller and L. C. Paulson) by what are often called the second, third and fourth Sylow theorems. These theorems state propositions about the number of Sylow p-subgroups of a group and the fact that they are conjugate to each other. The proofs make use of an implementation of group actions and their properties. notify = psxjv4@nottingham.ac.uk [Jordan_Hoelder] title = The Jordan-Hölder Theorem author = Jakob von Raumer date = 2014-09-09 topic = Mathematics/Algebra abstract = This submission contains theories that lead to a formalization of the proof of the Jordan-Hölder theorem about composition series of finite groups. The theories formalize the notions of isomorphism classes of groups, simple groups, normal series, composition series, maximal normal subgroups. Furthermore, they provide proofs of the second isomorphism theorem for groups, the characterization theorem for maximal normal subgroups as well as many useful lemmas about normal subgroups and factor groups. The proof is inspired by course notes of Stuart Rankin. notify = psxjv4@nottingham.ac.uk [Cayley_Hamilton] title = The Cayley-Hamilton Theorem author = Stephan Adelsberger , Stefan Hetzl , Florian Pollak date = 2014-09-15 topic = Mathematics/Algebra abstract = This document contains a proof of the Cayley-Hamilton theorem based on the development of matrices in HOL/Multivariate Analysis. notify = stvienna@gmail.com [Probabilistic_Noninterference] title = Probabilistic Noninterference author = Andrei Popescu , Johannes Hölzl date = 2014-03-11 topic = Computer science/Security abstract = We formalize a probabilistic noninterference for a multi-threaded language with uniform scheduling, where probabilistic behaviour comes from both the scheduler and the individual threads. We define notions probabilistic noninterference in two variants: resumption-based and trace-based. For the resumption-based notions, we prove compositionality w.r.t. the language constructs and establish sound type-system-like syntactic criteria. This is a formalization of the mathematical development presented at CPP 2013 and CALCO 2013. It is the probabilistic variant of the Possibilistic Noninterference AFP entry. notify = hoelzl@in.tum.de [HyperCTL] title = A shallow embedding of HyperCTL* author = Markus N. Rabe , Peter Lammich , Andrei Popescu date = 2014-04-16 topic = Computer science/Security, Logic/General logic/Temporal logic abstract = We formalize HyperCTL*, a temporal logic for expressing security properties. We first define a shallow embedding of HyperCTL*, within which we prove inductive and coinductive rules for the operators. Then we show that a HyperCTL* formula captures Goguen-Meseguer noninterference, a landmark information flow property. We also define a deep embedding and connect it to the shallow embedding by a denotational semantics, for which we prove sanity w.r.t. dependence on the free variables. Finally, we show that under some finiteness assumptions about the model, noninterference is given by a (finitary) syntactic formula. notify = uuomul@yahoo.com [Bounded_Deducibility_Security] title = Bounded-Deducibility Security author = Andrei Popescu , Peter Lammich date = 2014-04-22 topic = Computer science/Security abstract = This is a formalization of bounded-deducibility security (BD security), a flexible notion of information-flow security applicable to arbitrary input-output automata. It generalizes Sutherland's classic notion of nondeducibility by factoring in declassification bounds and trigger, whereas nondeducibility states that, in a system, information cannot flow between specified sources and sinks, BD security indicates upper bounds for the flow and triggers under which these upper bounds are no longer guaranteed. notify = uuomul@yahoo.com, lammich@in.tum.de [Network_Security_Policy_Verification] title = Network Security Policy Verification author = Cornelius Diekmann date = 2014-07-04 topic = Computer science/Security abstract = We present a unified theory for verifying network security policies. A security policy is represented as directed graph. To check high-level security goals, security invariants over the policy are expressed. We cover monotonic security invariants, i.e. prohibiting more does not harm security. We provide the following contributions for the security invariant theory.
  • Secure auto-completion of scenario-specific knowledge, which eases usability.
  • Security violations can be repaired by tightening the policy iff the security invariants hold for the deny-all policy.
  • An algorithm to compute a security policy.
  • A formalization of stateful connection semantics in network security mechanisms.
  • An algorithm to compute a secure stateful implementation of a policy.
  • An executable implementation of all the theory.
  • Examples, ranging from an aircraft cabin data network to the analysis of a large real-world firewall.
  • More examples: A fully automated translation of high-level security goals to both firewall and SDN configurations (see Examples/Distributed_WebApp.thy).
For a detailed description, see extra-history = Change history: [2015-04-14]: Added Distributed WebApp example and improved graphviz visualization (revision 4dde08ca2ab8)
notify = diekmann@net.in.tum.de [Abstract_Completeness] title = Abstract Completeness author = Jasmin Christian Blanchette , Andrei Popescu , Dmitriy Traytel date = 2014-04-16 topic = Logic/Proof theory abstract = A formalization of an abstract property of possibly infinite derivation trees (modeled by a codatatype), representing the core of a proof (in Beth/Hintikka style) of the first-order logic completeness theorem, independent of the concrete syntax or inference rules. This work is described in detail in the IJCAR 2014 publication by the authors. The abstract proof can be instantiated for a wide range of Gentzen and tableau systems as well as various flavors of FOL---e.g., with or without predicates, equality, or sorts. Here, we give only a toy example instantiation with classical propositional logic. A more serious instance---many-sorted FOL with equality---is described elsewhere [Blanchette and Popescu, FroCoS 2013]. notify = traytel@in.tum.de [Pop_Refinement] title = Pop-Refinement author = Alessandro Coglio date = 2014-07-03 topic = Computer science/Programming languages/Misc abstract = Pop-refinement is an approach to stepwise refinement, carried out inside an interactive theorem prover by constructing a monotonically decreasing sequence of predicates over deeply embedded target programs. The sequence starts with a predicate that characterizes the possible implementations, and ends with a predicate that characterizes a unique program in explicit syntactic form. Pop-refinement enables more requirements (e.g. program-level and non-functional) to be captured in the initial specification and preserved through refinement. Security requirements expressed as hyperproperties (i.e. predicates over sets of traces) are always preserved by pop-refinement, unlike the popular notion of refinement as trace set inclusion. Two simple examples in Isabelle/HOL are presented, featuring program-level requirements, non-functional requirements, and hyperproperties. notify = coglio@kestrel.edu [VectorSpace] title = Vector Spaces author = Holden Lee date = 2014-08-29 topic = Mathematics/Algebra abstract = This formalisation of basic linear algebra is based completely on locales, building off HOL-Algebra. It includes basic definitions: linear combinations, span, linear independence; linear transformations; interpretation of function spaces as vector spaces; the direct sum of vector spaces, sum of subspaces; the replacement theorem; existence of bases in finite-dimensional; vector spaces, definition of dimension; the rank-nullity theorem. Some concepts are actually defined and proved for modules as they also apply there. Infinite-dimensional vector spaces are supported, but dimension is only supported for finite-dimensional vector spaces. The proofs are standard; the proofs of the replacement theorem and rank-nullity theorem roughly follow the presentation in Linear Algebra by Friedberg, Insel, and Spence. The rank-nullity theorem generalises the existing development in the Archive of Formal Proof (originally using type classes, now using a mix of type classes and locales). notify = holdenl@princeton.edu [Special_Function_Bounds] title = Real-Valued Special Functions: Upper and Lower Bounds author = Lawrence C. Paulson date = 2014-08-29 topic = Mathematics/Analysis abstract = This development proves upper and lower bounds for several familiar real-valued functions. For sin, cos, exp and sqrt, it defines and verifies infinite families of upper and lower bounds, mostly based on Taylor series expansions. For arctan, ln and exp, it verifies a finite collection of upper and lower bounds, originally obtained from the functions' continued fraction expansions using the computer algebra system Maple. A common theme in these proofs is to take the difference between a function and its approximation, which should be zero at one point, and then consider the sign of the derivative. The immediate purpose of this development is to verify axioms used by MetiTarski, an automatic theorem prover for real-valued special functions. Crucial to MetiTarski's operation is the provision of upper and lower bounds for each function of interest. notify = lp15@cam.ac.uk [Landau_Symbols] title = Landau Symbols author = Manuel Eberl date = 2015-07-14 topic = Mathematics/Analysis abstract = This entry provides Landau symbols to describe and reason about the asymptotic growth of functions for sufficiently large inputs. A number of simplification procedures are provided for additional convenience: cancelling of dominated terms in sums under a Landau symbol, cancelling of common factors in products, and a decision procedure for Landau expressions containing products of powers of functions like x, ln(x), ln(ln(x)) etc. notify = eberlm@in.tum.de [Error_Function] title = The Error Function author = Manuel Eberl topic = Mathematics/Analysis date = 2018-02-06 notify = eberlm@in.tum.de abstract =

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

[Akra_Bazzi] title = The Akra-Bazzi theorem and the Master theorem author = Manuel Eberl date = 2015-07-14 topic = Mathematics/Analysis abstract = This article contains a formalisation of the Akra-Bazzi method based on a proof by Leighton. It is a generalisation of the well-known Master Theorem for analysing the complexity of Divide & Conquer algorithms. We also include a generalised version of the Master theorem based on the Akra-Bazzi theorem, which is easier to apply than the Akra-Bazzi theorem itself.

Some proof methods that facilitate applying the Master theorem are also included. For a more detailed explanation of the formalisation and the proof methods, see the accompanying paper (publication forthcoming). notify = eberlm@in.tum.de [Dirichlet_Series] title = Dirichlet Series author = Manuel Eberl topic = Mathematics/Number theory date = 2017-10-12 notify = eberlm@in.tum.de abstract = This entry is a formalisation of much of Chapters 2, 3, and 11 of Apostol's “Introduction to Analytic Number Theory”. This includes:

  • Definitions and basic properties for several number-theoretic functions (Euler's φ, Möbius μ, Liouville's λ, the divisor function σ, von Mangoldt's Λ)
  • Executable code for most of these functions, the most efficient implementations using the factoring algorithm by Thiemann et al.
  • Dirichlet products and formal Dirichlet series
  • Analytic results connecting convergent formal Dirichlet series to complex functions
  • Euler product expansions
  • Asymptotic estimates of number-theoretic functions including the density of squarefree integers and the average number of divisors of a natural number
These results are useful as a basis for developing more number-theoretic results, such as the Prime Number Theorem. [Gauss_Sums] title = Gauss Sums and the Pólya–Vinogradov Inequality author = Rodrigo Raya , Manuel Eberl topic = Mathematics/Number theory date = 2019-12-10 notify = manuel.eberl@tum.de abstract =

This article provides a full formalisation of Chapter 8 of Apostol's Introduction to Analytic Number Theory. Subjects that are covered are:

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

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

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

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

The entry also contains Euler's analytic proof of the infinitude of primes, based on the fact that ζ(s) has a pole at s = 1.

[Linear_Recurrences] title = Linear Recurrences author = Manuel Eberl topic = Mathematics/Analysis date = 2017-10-12 notify = eberlm@in.tum.de abstract =

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

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

[Lambert_W] title = The Lambert W Function on the Reals author = Manuel Eberl topic = Mathematics/Analysis date = 2020-04-24 notify = eberlm@in.tum.de abstract =

The Lambert W function is a multi-valued function defined as the inverse function of 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 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 date = 2015-12-22 abstract = Based on existing libraries for matrices, factorization of rational polynomials, and Sturm's theorem, we formalized algebraic numbers in Isabelle/HOL. Our development serves as an implementation for real and complex numbers, and it admits to compute roots and completely factorize real and complex polynomials, provided that all coefficients are rational numbers. Moreover, we provide two implementations to display algebraic numbers, an injective and expensive one, or a faster but approximative version.

To this end, we mechanized several results on resultants, which also required us to prove that polynomials over a unique factorization domain form again a unique factorization domain.

extra-history = Change history: [2016-01-29]: Split off Polynomial Interpolation and Polynomial Factorization
[2017-04-16]: Use certified Berlekamp-Zassenhaus factorization, use subresultant algorithm for computing resultants, improved bisection algorithm notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp, sebastiaan.joosten@uibk.ac.at [Polynomial_Interpolation] title = Polynomial Interpolation topic = Mathematics/Algebra author = René Thiemann , Akihisa Yamada date = 2016-01-29 abstract = We formalized three algorithms for polynomial interpolation over arbitrary fields: Lagrange's explicit expression, the recursive algorithm of Neville and Aitken, and the Newton interpolation in combination with an efficient implementation of divided differences. Variants of these algorithms for integer polynomials are also available, where sometimes the interpolation can fail; e.g., there is no linear integer polynomial p such that p(0) = 0 and p(2) = 1. Moreover, for the Newton interpolation for integer polynomials, we proved that all intermediate results that are computed during the algorithm must be integers. This admits an early failure detection in the implementation. Finally, we proved the uniqueness of polynomial interpolation.

The development also contains improved code equations to speed up the division of integers in target languages. notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp [Polynomial_Factorization] title = Polynomial Factorization topic = Mathematics/Algebra author = René Thiemann , Akihisa Yamada date = 2016-01-29 abstract = Based on existing libraries for polynomial interpolation and matrices, we formalized several factorization algorithms for polynomials, including Kronecker's algorithm for integer polynomials, Yun's square-free factorization algorithm for field polynomials, and Berlekamp's algorithm for polynomials over finite fields. By combining the last one with Hensel's lifting, we derive an efficient factorization algorithm for the integer polynomials, which is then lifted for rational polynomials by mechanizing Gauss' lemma. Finally, we assembled a combined factorization algorithm for rational polynomials, which combines all the mentioned algorithms and additionally uses the explicit formula for roots of quadratic polynomials and a rational root test.

As side products, we developed division algorithms for polynomials over integral domains, as well as primality-testing and prime-factorization algorithms for integers. notify = rene.thiemann@uibk.ac.at, ayamada@trs.cm.is.nagoya-u.ac.jp [Perron_Frobenius] title = Perron-Frobenius Theorem for Spectral Radius Analysis author = Jose Divasón , Ondřej Kunčar , René Thiemann , Akihisa Yamada notify = rene.thiemann@uibk.ac.at date = 2016-05-20 topic = Mathematics/Algebra abstract =

The spectral radius of a matrix A is the maximum norm of all eigenvalues of A. In previous work we already formalized that for a complex matrix A, the values in An grow polynomially in n if and only if the spectral radius is at most one. One problem with the above characterization is the determination of all complex eigenvalues. In case A contains only non-negative real values, a simplification is possible with the help of the Perron–Frobenius theorem, which tells us that it suffices to consider only the real eigenvalues of A, i.e., applying Sturm's method can decide the polynomial growth of An.

We formalize the Perron–Frobenius theorem based on a proof via Brouwer's fixpoint theorem, which is available in the HOL multivariate analysis (HMA) library. Since the results on the spectral radius is based on matrices in the Jordan normal form (JNF) library, we further develop a connection which allows us to easily transfer theorems between HMA and JNF. With this connection we derive the combined result: if A is a non-negative real matrix, and no real eigenvalue of A is strictly larger than one, then An is polynomially bounded in n.

extra-history = Change history: [2017-10-18]: added Perron-Frobenius theorem for irreducible matrices with generalization (revision bda1f1ce8a1c)
[2018-05-17]: prove conjecture of CPP'18 paper: Jordan blocks of spectral radius have maximum size (revision ffdb3794e5d5) [Stochastic_Matrices] title = Stochastic Matrices and the Perron-Frobenius Theorem author = René Thiemann topic = Mathematics/Algebra, Computer science/Automata and formal languages date = 2017-11-22 notify = rene.thiemann@uibk.ac.at abstract = Stochastic matrices are a convenient way to model discrete-time and finite state Markov chains. The Perron–Frobenius theorem tells us something about the existence and uniqueness of non-negative eigenvectors of a stochastic matrix. In this entry, we formalize stochastic matrices, link the formalization to the existing AFP-entry on Markov chains, and apply the Perron–Frobenius theorem to prove that stationary distributions always exist, and they are unique if the stochastic matrix is irreducible. [Formal_SSA] title = Verified Construction of Static Single Assignment Form author = Sebastian Ullrich , Denis Lohner date = 2016-02-05 topic = Computer science/Algorithms, Computer science/Programming languages/Transformations abstract =

We define a functional variant of the static single assignment (SSA) form construction algorithm described by Braun et al., which combines simplicity and efficiency. The definition is based on a general, abstract control flow graph representation using Isabelle locales.

We prove that the algorithm's output is semantically equivalent to the input according to a small-step semantics, and that it is in minimal SSA form for the common special case of reducible inputs. We then show the satisfiability of the locale assumptions by giving instantiations for a simple While language.

Furthermore, we use a generic instantiation based on typedefs in order to extract OCaml code and replace the unverified SSA construction algorithm of the CompCertSSA project with it.

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

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

This formalization is an extension to "Verified Construction of Static Single Assignment Form". In their work, the authors have shown that Braun et al.'s static single assignment (SSA) construction algorithm produces minimal SSA form for input programs with a reducible control flow graph (CFG). However Braun et al. also proposed an extension to their algorithm that they claim produces minimal SSA form even for irreducible CFGs.
In this formalization we support that claim by giving a mechanized proof.

As the extension of Braun et al.'s algorithm aims for removing so-called redundant strongly connected components of phi functions, we show that this suffices to guarantee minimality according to Cytron et al..

[PropResPI] title = Propositional Resolution and Prime Implicates Generation author = Nicolas Peltier notify = Nicolas.Peltier@imag.fr date = 2016-03-11 topic = Logic/General logic/Mechanization of proofs abstract = We provide formal proofs in Isabelle-HOL (using mostly structured Isar proofs) of the soundness and completeness of the Resolution rule in propositional logic. The completeness proofs take into account the usual redundancy elimination rules (tautology elimination and subsumption), and several refinements of the Resolution rule are considered: ordered resolution (with selection functions), positive and negative resolution, semantic resolution and unit resolution (the latter refinement is complete only for clause sets that are Horn- renamable). We also define a concrete procedure for computing saturated sets and establish its soundness and completeness. The clause sets are not assumed to be finite, so that the results can be applied to formulas obtained by grounding sets of first-order clauses (however, a total ordering among atoms is assumed to be given). Next, we show that the unrestricted Resolution rule is deductive- complete, in the sense that it is able to generate all (prime) implicates of any set of propositional clauses (i.e., all entailment- minimal, non-valid, clausal consequences of the considered set). The generation of prime implicates is an important problem, with many applications in artificial intelligence and verification (for abductive reasoning, knowledge compilation, diagnosis, debugging etc.). We also show that implicates can be computed in an incremental way, by fixing an ordering among all the atoms in the considered sets and resolving upon these atoms one by one in the considered order (with no backtracking). This feature is critical for the efficient computation of prime implicates. Building on these results, we provide a procedure for computing such implicates and establish its soundness and completeness. [SuperCalc] title = A Variant of the Superposition Calculus author = Nicolas Peltier notify = Nicolas.Peltier@imag.fr date = 2016-09-06 topic = Logic/Proof theory abstract = We provide a formalization of a variant of the superposition calculus, together with formal proofs of soundness and refutational completeness (w.r.t. the usual redundancy criteria based on clause ordering). This version of the calculus uses all the standard restrictions of the superposition rules, together with the following refinement, inspired by the basic superposition calculus: each clause is associated with a set of terms which are assumed to be in normal form -- thus any application of the replacement rule on these terms is blocked. The set is initially empty and terms may be added or removed at each inference step. The set of terms that are assumed to be in normal form includes any term introduced by previous unifiers as well as any term occurring in the parent clauses at a position that is smaller (according to some given ordering on positions) than a previously replaced term. The standard superposition calculus corresponds to the case where the set of irreducible terms is always empty. [Nominal2] title = Nominal 2 author = Christian Urban , Stefan Berghofer , Cezary Kaliszyk date = 2013-02-21 topic = Tools abstract =

Dealing with binders, renaming of bound variables, capture-avoiding substitution, etc., is very often a major problem in formal proofs, especially in proofs by structural and rule induction. Nominal Isabelle is designed to make such proofs easy to formalise: it provides an infrastructure for declaring nominal datatypes (that is alpha-equivalence classes) and for defining functions over them by structural recursion. It also provides induction principles that have Barendregt’s variable convention already built in.

This entry can be used as a more advanced replacement for HOL/Nominal in the Isabelle distribution.

notify = christian.urban@kcl.ac.uk [First_Welfare_Theorem] title = Microeconomics and the First Welfare Theorem author = Julian Parsert , Cezary Kaliszyk topic = Mathematics/Games and economics license = LGPL date = 2017-09-01 notify = julian.parsert@uibk.ac.at, cezary.kaliszyk@uibk.ac.at abstract = Economic activity has always been a fundamental part of society. Due to modern day politics, economic theory has gained even more influence on our lives. Thus we want models and theories to be as precise as possible. This can be achieved using certification with the help of formal proof technology. Hence we will use Isabelle/HOL to construct two economic models, that of the the pure exchange economy and a version of the Arrow-Debreu Model. We will prove that the First Theorem of Welfare Economics holds within both. The theorem is the mathematical formulation of Adam Smith's famous invisible hand and states that a group of self-interested and rational actors will eventually achieve an efficient allocation of goods and services. extra-history = Change history: [2018-06-17]: Added some lemmas and a theory file, also introduced Microeconomics folder.
[Noninterference_Sequential_Composition] title = Conservation of CSP Noninterference Security under Sequential Composition author = Pasquale Noce date = 2016-04-26 topic = Computer science/Security, Computer science/Concurrency/Process calculi abstract =

In his outstanding work on Communicating Sequential Processes, Hoare has defined two fundamental binary operations allowing to compose the input processes into another, typically more complex, process: sequential composition and concurrent composition. Particularly, the output of the former operation is a process that initially behaves like the first operand, and then like the second operand once the execution of the first one has terminated successfully, as long as it does.

This paper formalizes Hoare's definition of sequential composition and proves, in the general case of a possibly intransitive policy, that CSP noninterference security is conserved under this operation, provided that successful termination cannot be affected by confidential events and cannot occur as an alternative to other events in the traces of the first operand. Both of these assumptions are shown, by means of counterexamples, to be necessary for the theorem to hold.

notify = pasquale.noce.lavoro@gmail.com [Noninterference_Concurrent_Composition] title = Conservation of CSP Noninterference Security under Concurrent Composition author = Pasquale Noce notify = pasquale.noce.lavoro@gmail.com date = 2016-06-13 topic = Computer science/Security, Computer science/Concurrency/Process calculi abstract =

In his outstanding work on Communicating Sequential Processes, Hoare has defined two fundamental binary operations allowing to compose the input processes into another, typically more complex, process: sequential composition and concurrent composition. Particularly, the output of the latter operation is a process in which any event not shared by both operands can occur whenever the operand that admits the event can engage in it, whereas any event shared by both operands can occur just in case both can engage in it.

This paper formalizes Hoare's definition of concurrent composition and proves, in the general case of a possibly intransitive policy, that CSP noninterference security is conserved under this operation. This result, along with the previous analogous one concerning sequential composition, enables the construction of more and more complex processes enforcing noninterference security by composing, sequentially or concurrently, simpler secure processes, whose security can in turn be proven using either the definition of security, or unwinding theorems.

[ROBDD] title = Algorithms for Reduced Ordered Binary Decision Diagrams author = Julius Michaelis , Maximilian Haslbeck , Peter Lammich , Lars Hupel date = 2016-04-27 topic = Computer science/Algorithms, Computer science/Data structures abstract = We present a verified and executable implementation of ROBDDs in Isabelle/HOL. Our implementation relates pointer-based computation in the Heap monad to operations on an abstract definition of boolean functions. Internally, we implemented the if-then-else combinator in a recursive fashion, following the Shannon decomposition of the argument functions. The implementation mixes and adapts known techniques and is built with efficiency in mind. notify = bdd@liftm.de, haslbecm@in.tum.de [No_FTL_observers] title = No Faster-Than-Light Observers author = Mike Stannett , István Németi date = 2016-04-28 topic = Mathematics/Physics abstract = We provide a formal proof within First Order Relativity Theory that no observer can travel faster than the speed of light. Originally reported in Stannett & Németi (2014) "Using Isabelle/HOL to verify first-order relativity theory", Journal of Automated Reasoning 52(4), pp. 361-378. notify = m.stannett@sheffield.ac.uk [Groebner_Bases] title = Gröbner Bases Theory author = Fabian Immler , Alexander Maletzky date = 2016-05-02 topic = Mathematics/Algebra, Computer science/Algorithms/Mathematical abstract = This formalization is concerned with the theory of Gröbner bases in (commutative) multivariate polynomial rings over fields, originally developed by Buchberger in his 1965 PhD thesis. Apart from the statement and proof of the main theorem of the theory, the formalization also implements Buchberger's algorithm for actually computing Gröbner bases as a tail-recursive function, thus allowing to effectively decide ideal membership in finitely generated polynomial ideals. Furthermore, all functions can be executed on a concrete representation of multivariate polynomials as association lists. extra-history = Change history: [2019-04-18]: Specialized Gröbner bases to less abstract representation of polynomials, where power-products are represented as polynomial mappings.
notify = alexander.maletzky@risc.jku.at [Nullstellensatz] title = Hilbert's Nullstellensatz author = Alexander Maletzky topic = Mathematics/Algebra, Mathematics/Geometry date = 2019-06-16 notify = alexander.maletzky@risc-software.at abstract = This entry formalizes Hilbert's Nullstellensatz, an important theorem in algebraic geometry that can be viewed as the generalization of the Fundamental Theorem of Algebra to multivariate polynomials: If a set of (multivariate) polynomials over an algebraically closed field has no common zero, then the ideal it generates is the entire polynomial ring. The formalization proves several equivalent versions of this celebrated theorem: the weak Nullstellensatz, the strong Nullstellensatz (connecting algebraic varieties and radical ideals), and the field-theoretic Nullstellensatz. The formalization follows Chapter 4.1. of Ideals, Varieties, and Algorithms by Cox, Little and O'Shea. [Bell_Numbers_Spivey] title = Spivey's Generalized Recurrence for Bell Numbers author = Lukas Bulwahn date = 2016-05-04 topic = Mathematics/Combinatorics abstract = This entry defines the Bell numbers as the cardinality of set partitions for a carrier set of given size, and derives Spivey's generalized recurrence relation for Bell numbers following his elegant and intuitive combinatorial proof.

As the set construction for the combinatorial proof requires construction of three intermediate structures, the main difficulty of the formalization is handling the overall combinatorial argument in a structured way. The introduced proof structure allows us to compose the combinatorial argument from its subparts, and supports to keep track how the detailed proof steps are related to the overall argument. To obtain this structure, this entry uses set monad notation for the set construction's definition, introduces suitable predicates and rules, and follows a repeating structure in its Isar proof. notify = lukas.bulwahn@gmail.com [Randomised_Social_Choice] title = Randomised Social Choice Theory author = Manuel Eberl date = 2016-05-05 topic = Mathematics/Games and economics abstract = This work contains a formalisation of basic Randomised Social Choice, including Stochastic Dominance and Social Decision Schemes (SDSs) along with some of their most important properties (Anonymity, Neutrality, ex-post- and SD-Efficiency, SD-Strategy-Proofness) and two particular SDSs – Random Dictatorship and Random Serial Dictatorship (with proofs of the properties that they satisfy). Many important properties of these concepts are also proven – such as the two equivalent characterisations of Stochastic Dominance and the fact that SD-efficiency of a lottery only depends on the support. The entry also provides convenient commands to define Preference Profiles, prove their well-formedness, and automatically derive restrictions that sufficiently nice SDSs need to satisfy on the defined profiles. Currently, the formalisation focuses on weak preferences and Stochastic Dominance, but it should be easy to extend it to other domains – such as strict preferences – or other lottery extensions – such as Bilinear Dominance or Pairwise Comparison. notify = eberlm@in.tum.de [SDS_Impossibility] title = The Incompatibility of SD-Efficiency and SD-Strategy-Proofness author = Manuel Eberl date = 2016-05-04 topic = Mathematics/Games and economics abstract = This formalisation contains the proof that there is no anonymous and neutral Social Decision Scheme for at least four voters and alternatives that fulfils both SD-Efficiency and SD-Strategy- Proofness. The proof is a fully structured and quasi-human-redable one. It was derived from the (unstructured) SMT proof of the case for exactly four voters and alternatives by Brandl et al. Their proof relies on an unverified translation of the original problem to SMT, and the proof that lifts the argument for exactly four voters and alternatives to the general case is also not machine-checked. In this Isabelle proof, on the other hand, all of these steps are fully proven and machine-checked. This is particularly important seeing as a previously published informal proof of a weaker statement contained a mistake in precisely this lifting step. notify = eberlm@in.tum.de [Median_Of_Medians_Selection] title = The Median-of-Medians Selection Algorithm author = Manuel Eberl topic = Computer science/Algorithms date = 2017-12-21 notify = eberlm@in.tum.de abstract =

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

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

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

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

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

[FLP] title = A Constructive Proof for FLP author = Benjamin Bisping , Paul-David Brodmann , Tim Jungnickel , Christina Rickmann , Henning Seidler , Anke Stüber , Arno Wilhelm-Weidner , Kirstin Peters , Uwe Nestmann date = 2016-05-18 topic = Computer science/Concurrency abstract = The impossibility of distributed consensus with one faulty process is a result with important consequences for real world distributed systems e.g., commits in replicated databases. Since proofs are not immune to faults and even plausible proofs with a profound formalism can conclude wrong results, we validate the fundamental result named FLP after Fischer, Lynch and Paterson. We present a formalization of distributed systems and the aforementioned consensus problem. Our proof is based on Hagen Völzer's paper "A constructive proof for FLP". In addition to the enhanced confidence in the validity of Völzer's proof, we contribute the missing gaps to show the correctness in Isabelle/HOL. We clarify the proof details and even prove fairness of the infinite execution that contradicts consensus. Our Isabelle formalization can also be reused for further proofs of properties of distributed systems. notify = henning.seidler@mailbox.tu-berlin.de [IMAP-CRDT] title = The IMAP CmRDT author = Tim Jungnickel , Lennart Oldenburg <>, Matthias Loibl <> topic = Computer science/Algorithms/Distributed, Computer science/Data structures date = 2017-11-09 notify = tim.jungnickel@tu-berlin.de abstract = We provide our Isabelle/HOL formalization of a Conflict-free Replicated Datatype for Internet Message Access Protocol commands. We show that Strong Eventual Consistency (SEC) is guaranteed by proving the commutativity of concurrent operations. We base our formalization on the recently proposed "framework for establishing Strong Eventual Consistency for Conflict-free Replicated Datatypes" (AFP.CRDT) from Gomes et al. Hence, we provide an additional example of how the recently proposed framework can be used to design and prove CRDTs. [Incredible_Proof_Machine] title = The meta theory of the Incredible Proof Machine author = Joachim Breitner , Denis Lohner date = 2016-05-20 topic = Logic/Proof theory abstract = The Incredible Proof Machine is an interactive visual theorem prover which represents proofs as port graphs. We model this proof representation in Isabelle, and prove that it is just as powerful as natural deduction. notify = mail@joachim-breitner.de [Word_Lib] title = Finite Machine Word Library author = Joel Beeren<>, Matthew Fernandez<>, Xin Gao<>, Gerwin Klein , Rafal Kolanski<>, Japheth Lim<>, Corey Lewis<>, Daniel Matichuk<>, Thomas Sewell<> notify = kleing@unsw.edu.au date = 2016-06-09 topic = Computer science/Data structures abstract = This entry contains an extension to the Isabelle library for fixed-width machine words. In particular, the entry adds quickcheck setup for words, printing as hexadecimals, additional operations, reasoning about alignment, signed words, enumerations of words, normalisation of word numerals, and an extensive library of properties about generic fixed-width words, as well as an instantiation of many of these to the commonly used 32 and 64-bit bases. [Catalan_Numbers] title = Catalan Numbers author = Manuel Eberl notify = eberlm@in.tum.de date = 2016-06-21 topic = Mathematics/Combinatorics abstract =

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

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

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

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

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

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

[Rewriting_Z] title = The Z Property author = Bertram Felgenhauer<>, Julian Nagele<>, Vincent van Oostrom<>, Christian Sternagel notify = bertram.felgenhauer@uibk.ac.at, julian.nagele@uibk.ac.at, c.sternagel@gmail.com date = 2016-06-30 topic = Logic/Rewriting abstract = We formalize the Z property introduced by Dehornoy and van Oostrom. First we show that for any abstract rewrite system, Z implies confluence. Then we give two examples of proofs using Z: confluence of lambda-calculus with respect to beta-reduction and confluence of combinatory logic. [Resolution_FOL] title = The Resolution Calculus for First-Order Logic author = Anders Schlichtkrull notify = andschl@dtu.dk date = 2016-06-30 topic = Logic/General logic/Mechanization of proofs abstract = This theory is a formalization of the resolution calculus for first-order logic. It is proven sound and complete. The soundness proof uses the substitution lemma, which shows a correspondence between substitutions and updates to an environment. The completeness proof uses semantic trees, i.e. trees whose paths are partial Herbrand interpretations. It employs Herbrand's theorem in a formulation which states that an unsatisfiable set of clauses has a finite closed semantic tree. It also uses the lifting lemma which lifts resolution derivation steps from the ground world up to the first-order world. The theory is presented in a paper in the Journal of Automated Reasoning [Sch18] which extends a paper presented at the International Conference on Interactive Theorem Proving [Sch16]. An earlier version was presented in an MSc thesis [Sch15]. The formalization mostly follows textbooks by Ben-Ari [BA12], Chang and Lee [CL73], and Leitsch [Lei97]. The theory is part of the IsaFoL project [IsaFoL].

[Sch18] Anders Schlichtkrull. "Formalization of the Resolution Calculus for First-Order Logic". Journal of Automated Reasoning, 2018.
[Sch16] Anders Schlichtkrull. "Formalization of the Resolution Calculus for First-Order Logic". In: ITP 2016. Vol. 9807. LNCS. Springer, 2016.
[Sch15] Anders Schlichtkrull. "Formalization of Resolution Calculus in Isabelle". https://people.compute.dtu.dk/andschl/Thesis.pdf. MSc thesis. Technical University of Denmark, 2015.
[BA12] Mordechai Ben-Ari. Mathematical Logic for Computer Science. 3rd. Springer, 2012.
[CL73] Chin-Liang Chang and Richard Char-Tung Lee. Symbolic Logic and Mechanical Theorem Proving. 1st. Academic Press, Inc., 1973.
[Lei97] Alexander Leitsch. The Resolution Calculus. Texts in theoretical computer science. Springer, 1997.
[IsaFoL] IsaFoL authors. IsaFoL: Isabelle Formalization of Logic. https://bitbucket.org/jasmin_blanchette/isafol. extra-history = Change history: [2018-01-24]: added several new versions of the soundness and completeness theorems as described in the paper [Sch18].
[2018-03-20]: added a concrete instance of the unification and completeness theorems using the First-Order Terms AFP-entry from IsaFoR as described in the papers [Sch16] and [Sch18]. [Surprise_Paradox] title = Surprise Paradox author = Joachim Breitner notify = mail@joachim-breitner.de date = 2016-07-17 topic = Logic/Proof theory abstract = In 1964, Fitch showed that the paradox of the surprise hanging can be resolved by showing that the judge’s verdict is inconsistent. His formalization builds on Gödel’s coding of provability. In this theory, we reproduce his proof in Isabelle, building on Paulson’s formalisation of Gödel’s incompleteness theorems. [Ptolemys_Theorem] title = Ptolemy's Theorem author = Lukas Bulwahn notify = lukas.bulwahn@gmail.com date = 2016-08-07 topic = Mathematics/Geometry abstract = This entry provides an analytic proof to Ptolemy's Theorem using polar form transformation and trigonometric identities. In this formalization, we use ideas from John Harrison's HOL Light formalization and the proof sketch on the Wikipedia entry of Ptolemy's Theorem. This theorem is the 95th theorem of the Top 100 Theorems list. [Falling_Factorial_Sum] title = The Falling Factorial of a Sum author = Lukas Bulwahn topic = Mathematics/Combinatorics date = 2017-12-22 notify = lukas.bulwahn@gmail.com abstract = This entry shows that the falling factorial of a sum can be computed with an expression using binomial coefficients and the falling factorial of its summands. The entry provides three different proofs: a combinatorial proof, an induction proof and an algebraic proof using the Vandermonde identity. The three formalizations try to follow their informal presentations from a Mathematics Stack Exchange page as close as possible. The induction and algebraic formalization end up to be very close to their informal presentation, whereas the combinatorial proof first requires the introduction of list interleavings, and significant more detail than its informal presentation. [InfPathElimination] title = Infeasible Paths Elimination by Symbolic Execution Techniques: Proof of Correctness and Preservation of Paths author = Romain Aissat<>, Frederic Voisin<>, Burkhart Wolff notify = wolff@lri.fr date = 2016-08-18 topic = Computer science/Programming languages/Static analysis abstract = TRACER is a tool for verifying safety properties of sequential C programs. TRACER attempts at building a finite symbolic execution graph which over-approximates the set of all concrete reachable states and the set of feasible paths. We present an abstract framework for TRACER and similar CEGAR-like systems. The framework provides 1) a graph- transformation based method for reducing the feasible paths in control-flow graphs, 2) a model for symbolic execution, subsumption, predicate abstraction and invariant generation. In this framework we formally prove two key properties: correct construction of the symbolic states and preservation of feasible paths. The framework focuses on core operations, leaving to concrete prototypes to “fit in” heuristics for combining them. The accompanying paper (published in ITP 2016) can be found at https://www.lri.fr/∼wolff/papers/conf/2016-itp-InfPathsNSE.pdf. [Stirling_Formula] title = Stirling's formula author = Manuel Eberl notify = eberlm@in.tum.de date = 2016-09-01 topic = Mathematics/Analysis abstract =

This work contains a proof of Stirling's formula both for the factorial $n! \sim \sqrt{2\pi n} (n/e)^n$ on natural numbers and the real Gamma function $\Gamma(x)\sim \sqrt{2\pi/x} (x/e)^x$. The proof is based on work by Graham Jameson.

This is then extended to the full asymptotic expansion $$\log\Gamma(z) = \big(z - \tfrac{1}{2}\big)\log z - z + \tfrac{1}{2}\log(2\pi) + \sum_{k=1}^{n-1} \frac{B_{k+1}}{k(k+1)} z^{-k}\\ {} - \frac{1}{n} \int_0^\infty B_n([t])(t + z)^{-n}\,\text{d}t$$ uniformly for all complex $z\neq 0$ in the cone $\text{arg}(z)\leq \alpha$ for any $\alpha\in(0,\pi)$, with which the above asymptotic relation for Γ is also extended to complex arguments.

[Lp] title = Lp spaces author = Sebastien Gouezel notify = sebastien.gouezel@univ-rennes1.fr date = 2016-10-05 topic = Mathematics/Analysis abstract = Lp is the space of functions whose p-th power is integrable. It is one of the most fundamental Banach spaces that is used in analysis and probability. We develop a framework for function spaces, and then implement the Lp spaces in this framework using the existing integration theory in Isabelle/HOL. Our development contains most fundamental properties of Lp spaces, notably the Hölder and Minkowski inequalities, completeness of Lp, duality, stability under almost sure convergence, multiplication of functions in Lp and Lq, stability under conditional expectation. [Berlekamp_Zassenhaus] title = The Factorization Algorithm of Berlekamp and Zassenhaus author = Jose Divasón , Sebastiaan Joosten , René Thiemann , Akihisa Yamada notify = rene.thiemann@uibk.ac.at date = 2016-10-14 topic = Mathematics/Algebra abstract =

We formalize the Berlekamp-Zassenhaus algorithm for factoring square-free integer polynomials in Isabelle/HOL. We further adapt an existing formalization of Yun’s square-free factorization algorithm to integer polynomials, and thus provide an efficient and certified factorization algorithm for arbitrary univariate polynomials.

The algorithm first performs a factorization in the prime field GF(p) and then performs computations in the integer ring modulo p^k, where both p and k are determined at runtime. Since a natural modeling of these structures via dependent types is not possible in Isabelle/HOL, we formalize the whole algorithm using Isabelle’s recent addition of local type definitions.

Through experiments we verify that our algorithm factors polynomials of degree 100 within seconds.

[Allen_Calculus] title = Allen's Interval Calculus author = Fadoua Ghourabi <> notify = fadouaghourabi@gmail.com date = 2016-09-29 topic = Logic/General logic/Temporal logic, Mathematics/Order abstract = Allen’s interval calculus is a qualitative temporal representation of time events. Allen introduced 13 binary relations that describe all the possible arrangements between two events, i.e. intervals with non-zero finite length. The compositions are pertinent to reasoning about knowledge of time. In particular, a consistency problem of relation constraints is commonly solved with a guideline from these compositions. We formalize the relations together with an axiomatic system. We proof the validity of the 169 compositions of these relations. We also define nests as the sets of intervals that share a meeting point. We prove that nests give the ordering properties of points without introducing a new datatype for points. [1] J.F. Allen. Maintaining Knowledge about Temporal Intervals. In Commun. ACM, volume 26, pages 832–843, 1983. [2] J. F. Allen and P. J. Hayes. A Common-sense Theory of Time. In Proceedings of the 9th International Joint Conference on Artificial Intelligence (IJCAI’85), pages 528–531, 1985. [Source_Coding_Theorem] title = Source Coding Theorem author = Quentin Hibon , Lawrence C. Paulson notify = qh225@cl.cam.ac.uk date = 2016-10-19 topic = Mathematics/Probability theory abstract = This document contains a proof of the necessary condition on the code rate of a source code, namely that this code rate is bounded by the entropy of the source. This represents one half of Shannon's source coding theorem, which is itself an equivalence. [Buffons_Needle] title = Buffon's Needle Problem author = Manuel Eberl topic = Mathematics/Probability theory, Mathematics/Geometry date = 2017-06-06 notify = eberlm@in.tum.de abstract = In the 18th century, Georges-Louis Leclerc, Comte de Buffon posed and later solved the following problem, which is often called the first problem ever solved in geometric probability: Given a floor divided into vertical strips of the same width, what is the probability that a needle thrown onto the floor randomly will cross two strips? This entry formally defines the problem in the case where the needle's position is chosen uniformly at random in a single strip around the origin (which is equivalent to larger arrangements due to symmetry). It then provides proofs of the simple solution in the case where the needle's length is no greater than the width of the strips and the more complicated solution in the opposite case. [SPARCv8] title = A formal model for the SPARCv8 ISA and a proof of non-interference for the LEON3 processor author = Zhe Hou , David Sanan , Alwen Tiu , Yang Liu notify = zhe.hou@ntu.edu.sg, sanan@ntu.edu.sg date = 2016-10-19 topic = Computer science/Security, Computer science/Hardware abstract = We formalise the SPARCv8 instruction set architecture (ISA) which is used in processors such as LEON3. Our formalisation can be specialised to any SPARCv8 CPU, here we use LEON3 as a running example. Our model covers the operational semantics for all the instructions in the integer unit of the SPARCv8 architecture and it supports Isabelle code export, which effectively turns the Isabelle model into a SPARCv8 CPU simulator. We prove the language-based non-interference property for the LEON3 processor. Our model is based on deterministic monad, which is a modified version of the non-deterministic monad from NICTA/l4v. [Separata] title = Separata: Isabelle tactics for Separation Algebra author = Zhe Hou , David Sanan , Alwen Tiu , Rajeev Gore , Ranald Clouston notify = zhe.hou@ntu.edu.sg date = 2016-11-16 topic = Computer science/Programming languages/Logics, Tools abstract = We bring the labelled sequent calculus $LS_{PASL}$ for propositional abstract separation logic to Isabelle. The tactics given here are directly applied on an extension of the Separation Algebra in the AFP. In addition to the cancellative separation algebra, we further consider some useful properties in the heap model of separation logic, such as indivisible unit, disjointness, and cross-split. The tactics are essentially a proof search procedure for the calculus $LS_{PASL}$. We wrap the tactics in an Isabelle method called separata, and give a few examples of separation logic formulae which are provable by separata. [LOFT] title = LOFT — Verified Migration of Linux Firewalls to SDN author = Julius Michaelis , Cornelius Diekmann notify = isabelleopenflow@liftm.de date = 2016-10-21 topic = Computer science/Networks abstract = We present LOFT — Linux firewall OpenFlow Translator, a system that transforms the main routing table and FORWARD chain of iptables of a Linux-based firewall into a set of static OpenFlow rules. Our implementation is verified against a model of a simplified Linux-based router and we can directly show how much of the original functionality is preserved. [Stable_Matching] title = Stable Matching author = Peter Gammie notify = peteg42@gmail.com date = 2016-10-24 topic = Mathematics/Games and economics abstract = We mechanize proofs of several results from the matching with contracts literature, which generalize those of the classical two-sided matching scenarios that go by the name of stable marriage. Our focus is on game theoretic issues. Along the way we develop executable algorithms for computing optimal stable matches. [Modal_Logics_for_NTS] title = Modal Logics for Nominal Transition Systems author = Tjark Weber , Lars-Henrik Eriksson , Joachim Parrow , Johannes Borgström , Ramunas Gutkovas notify = tjark.weber@it.uu.se date = 2016-10-25 topic = Computer science/Concurrency/Process calculi, Logic/General logic/Modal logic abstract = We formalize a uniform semantic substrate for a wide variety of process calculi where states and action labels can be from arbitrary nominal sets. A Hennessy-Milner logic for these systems is defined, and proved adequate for bisimulation equivalence. A main novelty is the construction of an infinitary nominal data type to model formulas with (finitely supported) infinite conjunctions and actions that may contain binding names. The logic is generalized to treat different bisimulation variants such as early, late and open in a systematic way. extra-history = Change history: [2017-01-29]: Formalization of weak bisimilarity added (revision c87cc2057d9c) [Abs_Int_ITP2012] title = Abstract Interpretation of Annotated Commands author = Tobias Nipkow notify = nipkow@in.tum.de date = 2016-11-23 topic = Computer science/Programming languages/Static analysis abstract = This is the Isabelle formalization of the material decribed in the eponymous ITP 2012 paper. It develops a generic abstract interpreter for a while-language, including widening and narrowing. The collecting semantics and the abstract interpreter operate on annotated commands: the program is represented as a syntax tree with the semantic information directly embedded, without auxiliary labels. The aim of the formalization is simplicity, not efficiency or precision. This is motivated by the inclusion of the material in a theorem prover based course on semantics. A similar (but more polished) development is covered in the book Concrete Semantics. [Complx] title = COMPLX: A Verification Framework for Concurrent Imperative Programs author = Sidney Amani<>, June Andronick<>, Maksym Bortin<>, Corey Lewis<>, Christine Rizkallah<>, Joseph Tuong<> notify = sidney.amani@data61.csiro.au, corey.lewis@data61.csiro.au date = 2016-11-29 topic = Computer science/Programming languages/Logics, Computer science/Programming languages/Language definitions abstract = We propose a concurrency reasoning framework for imperative programs, based on the Owicki-Gries (OG) foundational shared-variable concurrency method. Our framework combines the approaches of Hoare-Parallel, a formalisation of OG in Isabelle/HOL for a simple while-language, and Simpl, a generic imperative language embedded in Isabelle/HOL, allowing formal reasoning on C programs. We define the Complx language, extending the syntax and semantics of Simpl with support for parallel composition and synchronisation. We additionally define an OG logic, which we prove sound w.r.t. the semantics, and a verification condition generator, both supporting involved low-level imperative constructs such as function calls and abrupt termination. We illustrate our framework on an example that features exceptions, guards and function calls. We aim to then target concurrent operating systems, such as the interruptible eChronos embedded operating system for which we already have a model-level OG proof using Hoare-Parallel. extra-history = Change history: [2017-01-13]: Improve VCG for nested parallels and sequential sections (revision 30739dbc3dcb) [Paraconsistency] title = Paraconsistency author = Anders Schlichtkrull , Jørgen Villadsen topic = Logic/General logic/Paraconsistent logics date = 2016-12-07 notify = andschl@dtu.dk, jovi@dtu.dk abstract = Paraconsistency is about handling inconsistency in a coherent way. In classical and intuitionistic logic everything follows from an inconsistent theory. A paraconsistent logic avoids the explosion. Quite a few applications in computer science and engineering are discussed in the Intelligent Systems Reference Library Volume 110: Towards Paraconsistent Engineering (Springer 2016). We formalize a paraconsistent many-valued logic that we motivated and described in a special issue on logical approaches to paraconsistency (Journal of Applied Non-Classical Logics 2005). We limit ourselves to the propositional fragment of the higher-order logic. The logic is based on so-called key equalities and has a countably infinite number of truth values. We prove theorems in the logic using the definition of validity. We verify truth tables and also counterexamples for non-theorems. We prove meta-theorems about the logic and finally we investigate a case study. [Proof_Strategy_Language] title = Proof Strategy Language author = Yutaka Nagashima<> topic = Tools date = 2016-12-20 notify = Yutaka.Nagashima@data61.csiro.au abstract = Isabelle includes various automatic tools for finding proofs under certain conditions. However, for each conjecture, knowing which automation to use, and how to tweak its parameters, is currently labour intensive. We have developed a language, PSL, designed to capture high level proof strategies. PSL offloads the construction of human-readable fast-to-replay proof scripts to automatic search, making use of search-time information about each conjecture. Our preliminary evaluations show that PSL reduces the labour cost of interactive theorem proving. This submission contains the implementation of PSL and an example theory file, Example.thy, showing how to write poof strategies in PSL. [Concurrent_Ref_Alg] title = Concurrent Refinement Algebra and Rely Quotients author = Julian Fell , Ian J. Hayes , Andrius Velykis topic = Computer science/Concurrency date = 2016-12-30 notify = Ian.Hayes@itee.uq.edu.au abstract = The concurrent refinement algebra developed here is designed to provide a foundation for rely/guarantee reasoning about concurrent programs. The algebra builds on a complete lattice of commands by providing sequential composition, parallel composition and a novel weak conjunction operator. The weak conjunction operator coincides with the lattice supremum providing its arguments are non-aborting, but aborts if either of its arguments do. Weak conjunction provides an abstract version of a guarantee condition as a guarantee process. We distinguish between models that distribute sequential composition over non-deterministic choice from the left (referred to as being conjunctive in the refinement calculus literature) and those that don't. Least and greatest fixed points of monotone functions are provided to allow recursion and iteration operators to be added to the language. Additional iteration laws are available for conjunctive models. The rely quotient of processes c and i is the process that, if executed in parallel with i implements c. It represents an abstract version of a rely condition generalised to a process. [FOL_Harrison] title = First-Order Logic According to Harrison author = Alexander Birch Jensen , Anders Schlichtkrull , Jørgen Villadsen topic = Logic/General logic/Mechanization of proofs date = 2017-01-01 notify = aleje@dtu.dk, andschl@dtu.dk, jovi@dtu.dk abstract =

We present a certified declarative first-order prover with equality based on John Harrison's Handbook of Practical Logic and Automated Reasoning, Cambridge University Press, 2009. ML code reflection is used such that the entire prover can be executed within Isabelle as a very simple interactive proof assistant. As examples we consider Pelletier's problems 1-46.

Reference: Programming and Verifying a Declarative First-Order Prover in Isabelle/HOL. Alexander Birch Jensen, John Bruntse Larsen, Anders Schlichtkrull & Jørgen Villadsen. AI Communications 31:281-299 2018. https://content.iospress.com/articles/ai-communications/aic764

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

extra-history = Change history: [2018-07-21]: Proof of Pelletier's problem 34 (Andrews's Challenge) thanks to Asta Halkjær From. [Bernoulli] title = Bernoulli Numbers author = Lukas Bulwahn, Manuel Eberl topic = Mathematics/Analysis, Mathematics/Number theory date = 2017-01-24 notify = eberlm@in.tum.de abstract =

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

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

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

[Stone_Relation_Algebras] title = Stone Relation Algebras author = Walter Guttmann topic = Mathematics/Algebra date = 2017-02-07 notify = walter.guttmann@canterbury.ac.nz abstract = We develop Stone relation algebras, which generalise relation algebras by replacing the underlying Boolean algebra structure with a Stone algebra. We show that finite matrices over extended real numbers form an instance. As a consequence, relation-algebraic concepts and methods can be used for reasoning about weighted graphs. We also develop a fixpoint calculus and apply it to compare different definitions of reflexive-transitive closures in semirings. [Stone_Kleene_Relation_Algebras] title = Stone-Kleene Relation Algebras author = Walter Guttmann topic = Mathematics/Algebra date = 2017-07-06 notify = walter.guttmann@canterbury.ac.nz abstract = We develop Stone-Kleene relation algebras, which expand Stone relation algebras with a Kleene star operation to describe reachability in weighted graphs. Many properties of the Kleene star arise as a special case of a more general theory of iteration based on Conway semirings extended by simulation axioms. This includes several theorems representing complex program transformations. We formally prove the correctness of Conway's automata-based construction of the Kleene star of a matrix. We prove numerous results useful for reasoning about weighted graphs. [Abstract_Soundness] title = Abstract Soundness author = Jasmin Christian Blanchette , Andrei Popescu , Dmitriy Traytel topic = Logic/Proof theory date = 2017-02-10 notify = jasmin.blanchette@gmail.com abstract = A formalized coinductive account of the abstract development of Brotherston, Gorogiannis, and Petersen [APLAS 2012], in a slightly more general form since we work with arbitrary infinite proofs, which may be acyclic. This work is described in detail in an article by the authors, published in 2017 in the Journal of Automated Reasoning. The abstract proof can be instantiated for various formalisms, including first-order logic with inductive predicates. [Differential_Dynamic_Logic] title = Differential Dynamic Logic author = Brandon Bohrer topic = Logic/General logic/Modal logic, Computer science/Programming languages/Logics date = 2017-02-13 notify = bbohrer@cs.cmu.edu abstract = We formalize differential dynamic logic, a logic for proving properties of hybrid systems. The proof calculus in this formalization is based on the uniform substitution principle. We show it is sound with respect to our denotational semantics, which provides increased confidence in the correctness of the KeYmaera X theorem prover based on this calculus. As an application, we include a proof term checker embedded in Isabelle/HOL with several example proofs. Published in: Brandon Bohrer, Vincent Rahli, Ivana Vukotic, Marcus Völp, André Platzer: Formally verified differential dynamic logic. CPP 2017. [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 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, 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 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 topic = Mathematics/Number theory, Mathematics/Algebra date = 2017-12-21 notify = eberlm@in.tum.de abstract =

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

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

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

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

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

  • Vieta's formula, which gives an explicit expression for the k-th coefficient of a univariate monic polynomial in terms of its roots x1,…,xn, namely ck = (-1)n-k en-k(x1,…,xn).
  • Second, the Fundamental Theorem of Symmetric Polynomials, which states that any symmetric polynomial is itself a uniquely determined polynomial combination of the elementary symmetric polynomials.
  • Third, as a corollary of the previous two, that given a polynomial over some ring R, any symmetric polynomial combination of its roots is also in R even when the roots are not.

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

[Taylor_Models] title = Taylor Models author = Christoph Traut<>, Fabian Immler topic = Computer science/Algorithms/Mathematical, Computer science/Data structures, Mathematics/Analysis, Mathematics/Algebra date = 2018-01-08 notify = immler@in.tum.de abstract = We present a formally verified implementation of multivariate Taylor models. Taylor models are a form of rigorous polynomial approximation, consisting of an approximation polynomial based on Taylor expansions, combined with a rigorous bound on the approximation error. Taylor models were introduced as a tool to mitigate the dependency problem of interval arithmetic. Our implementation automatically computes Taylor models for the class of elementary functions, expressed by composition of arithmetic operations and basic functions like exp, sin, or square root. [Green] title = An Isabelle/HOL formalisation of Green's Theorem author = Mohammad Abdulaziz , Lawrence C. Paulson topic = Mathematics/Analysis date = 2018-01-11 notify = mohammad.abdulaziz8@gmail.com, lp15@cam.ac.uk abstract = We formalise a statement of Green’s theorem—the first formalisation to our knowledge—in Isabelle/HOL. The theorem statement that we formalise is enough for most applications, especially in physics and engineering. Our formalisation is made possible by a novel proof that avoids the ubiquitous line integral cancellation argument. This eliminates the need to formalise orientations and region boundaries explicitly with respect to the outwards-pointing normal vector. Instead we appeal to a homological argument about equivalences between paths. [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 abstract =

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

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

[Skip_Lists] title = Skip Lists author = Max W. Haslbeck , Manuel Eberl topic = Computer science/Data structures date = 2020-01-09 notify = max.haslbeck@gmx.de abstract =

Skip lists are sorted linked lists enhanced with shortcuts and are an alternative to binary search trees. A skip lists consists of multiple levels of sorted linked lists where a list on level n is a subsequence of the list on level n − 1. In the ideal case, elements are skipped in such a way that a lookup in a skip lists takes O(log n) time. In a randomised skip list the skipped elements are choosen randomly.

This entry contains formalized proofs of the textbook results about the expected height and the expected length of a search path in a randomised skip list.

[Mersenne_Primes] title = Mersenne primes and the Lucas–Lehmer test author = Manuel Eberl topic = Mathematics/Number theory date = 2020-01-17 notify = eberlm@in.tum.de abstract =

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

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

[Hoare_Time] title = Hoare Logics for Time Bounds author = Maximilian P. L. Haslbeck , Tobias Nipkow topic = Computer science/Programming languages/Logics date = 2018-02-26 notify = haslbema@in.tum.de abstract = We study three different Hoare logics for reasoning about time bounds of imperative programs and formalize them in Isabelle/HOL: a classical Hoare like logic due to Nielson, a logic with potentials due to Carbonneaux et al. and a separation logic following work by Atkey, Chaguérand and Pottier. These logics are formally shown to be sound and complete. Verification condition generators are developed and are shown sound and complete too. We also consider variants of the systems where we abstract from multiplicative constants in the running time bounds, thus supporting a big-O style of reasoning. Finally we compare the expressive power of the three systems. [Architectural_Design_Patterns] title = A Theory of Architectural Design Patterns author = Diego Marmsoler topic = Computer science/System description languages date = 2018-03-01 notify = diego.marmsoler@tum.de abstract = The following document formalizes and verifies several architectural design patterns. Each pattern specification is formalized in terms of a locale where the locale assumptions correspond to the assumptions which a pattern poses on an architecture. Thus, pattern specifications may build on top of each other by interpreting the corresponding locale. A pattern is verified using the framework provided by the AFP entry Dynamic Architectures. Currently, the document consists of formalizations of 4 different patterns: the singleton, the publisher subscriber, the blackboard pattern, and the blockchain pattern. Thereby, the publisher component of the publisher subscriber pattern is modeled as an instance of the singleton pattern and the blackboard pattern is modeled as an instance of the publisher subscriber pattern. In general, this entry provides the first steps towards an overall theory of architectural design patterns. extra-history = Change history: [2018-05-25]: changing the major assumption for blockchain architectures from alternative minings to relative mining frequencies (revision 5043c5c71685)
[2019-04-08]: adapting the terminology: honest instead of trusted, dishonest instead of untrusted (revision 7af3431a22ae) [Weight_Balanced_Trees] title = Weight-Balanced Trees author = Tobias Nipkow , Stefan Dirix<> topic = Computer science/Data structures date = 2018-03-13 notify = nipkow@in.tum.de abstract = This theory provides a verified implementation of weight-balanced trees following the work of Hirai and Yamamoto who proved that all parameters in a certain range are valid, i.e. guarantee that insertion and deletion preserve weight-balance. Instead of a general theorem we provide parameterized proofs of preservation of the invariant that work for many (all?) valid parameters. [Fishburn_Impossibility] title = The Incompatibility of Fishburn-Strategyproofness and Pareto-Efficiency author = Felix Brandt , Manuel Eberl , Christian Saile , Christian Stricker topic = Mathematics/Games and economics date = 2018-03-22 notify = eberlm@in.tum.de abstract =

This formalisation contains the proof that there is no anonymous Social Choice Function for at least three agents and alternatives that fulfils both Pareto-Efficiency and Fishburn-Strategyproofness. It was derived from a proof of Brandt et al., which relies on an unverified translation of a fixed finite instance of the original problem to SAT. This Isabelle proof contains a machine-checked version of both the statement for exactly three agents and alternatives and the lifting to the general case.

[BNF_CC] title = Bounded Natural Functors with Covariance and Contravariance author = Andreas Lochbihler , Joshua Schneider topic = Computer science/Functional programming, Tools date = 2018-04-24 notify = mail@andreas-lochbihler.de, joshua.schneider@inf.ethz.ch abstract = Bounded natural functors (BNFs) provide a modular framework for the construction of (co)datatypes in higher-order logic. Their functorial operations, the mapper and relator, are restricted to a subset of the parameters, namely those where recursion can take place. For certain applications, such as free theorems, data refinement, quotients, and generalised rewriting, it is desirable that these operations do not ignore the other parameters. In this article, we formalise the generalisation BNFCC that extends the mapper and relator to covariant and contravariant parameters. We show that
  1. BNFCCs are closed under functor composition and least and greatest fixpoints,
  2. subtypes inherit the BNFCC structure under conditions that generalise those for the BNF case, and
  3. BNFCCs preserve quotients under mild conditions.
These proofs are carried out for abstract BNFCCs similar to the AFP entry BNF Operations. In addition, we apply the BNFCC theory to several concrete functors. [Modular_Assembly_Kit_Security] title = An Isabelle/HOL Formalization of the Modular Assembly Kit for Security Properties author = Oliver Bračevac , Richard Gay , Sylvia Grewe , Heiko Mantel , Henning Sudbrock , Markus Tasch topic = Computer science/Security date = 2018-05-07 notify = tasch@mais.informatik.tu-darmstadt.de abstract = The "Modular Assembly Kit for Security Properties" (MAKS) is a framework for both the definition and verification of possibilistic information-flow security properties at the specification-level. MAKS supports the uniform representation of a wide range of possibilistic information-flow properties and provides support for the verification of such properties via unwinding results and compositionality results. We provide a formalization of this framework in Isabelle/HOL. [AxiomaticCategoryTheory] title = Axiom Systems for Category Theory in Free Logic author = Christoph Benzmüller , Dana Scott topic = Mathematics/Category theory date = 2018-05-23 notify = c.benzmueller@gmail.com abstract = This document provides a concise overview on the core results of our previous work on the exploration of axioms systems for category theory. Extending the previous studies (http://arxiv.org/abs/1609.01493) we include one further axiomatic theory in our experiments. This additional theory has been suggested by Mac Lane in 1948. We show that the axioms proposed by Mac Lane are equivalent to the ones we studied before, which includes an axioms set suggested by Scott in the 1970s and another axioms set proposed by Freyd and Scedrov in 1990, which we slightly modified to remedy a minor technical issue. [OpSets] title = OpSets: Sequential Specifications for Replicated Datatypes author = Martin Kleppmann , Victor B. F. Gomes , Dominic P. Mulligan , Alastair R. Beresford topic = Computer science/Algorithms/Distributed, Computer science/Data structures date = 2018-05-10 notify = vb358@cam.ac.uk abstract = We introduce OpSets, an executable framework for specifying and reasoning about the semantics of replicated datatypes that provide eventual consistency in a distributed system, and for mechanically verifying algorithms that implement these datatypes. Our approach is simple but expressive, allowing us to succinctly specify a variety of abstract datatypes, including maps, sets, lists, text, graphs, trees, and registers. Our datatypes are also composable, enabling the construction of complex data structures. To demonstrate the utility of OpSets for analysing replication algorithms, we highlight an important correctness property for collaborative text editing that has traditionally been overlooked; algorithms that do not satisfy this property can exhibit awkward interleaving of text. We use OpSets to specify this correctness property and prove that although one existing replication algorithm satisfies this property, several other published algorithms do not. [Irrationality_J_Hancl] title = Irrational Rapidly Convergent Series author = Angeliki Koutsoukou-Argyraki , Wenda Li topic = Mathematics/Number theory, Mathematics/Analysis date = 2018-05-23 notify = ak2110@cam.ac.uk, wl302@cam.ac.uk abstract = We formalize with Isabelle/HOL a proof of a theorem by J. Hancl asserting the irrationality of the sum of a series consisting of rational numbers, built up by sequences that fulfill certain properties. Even though the criterion is a number theoretic result, the proof makes use only of analytical arguments. We also formalize a corollary of the theorem for a specific series fulfilling the assumptions of the theorem. [Optimal_BST] title = Optimal Binary Search Trees author = Tobias Nipkow , Dániel Somogyi <> topic = Computer science/Algorithms, Computer science/Data structures date = 2018-05-27 notify = nipkow@in.tum.de abstract = This article formalizes recursive algorithms for the construction of optimal binary search trees given fixed access frequencies. We follow Knuth (1971), Yao (1980) and Mehlhorn (1984). The algorithms are memoized with the help of the AFP article Monadification, Memoization and Dynamic Programming, thus yielding dynamic programming algorithms. [Projective_Geometry] title = Projective Geometry author = Anthony Bordg topic = Mathematics/Geometry date = 2018-06-14 notify = apdb3@cam.ac.uk abstract = We formalize the basics of projective geometry. In particular, we give a proof of the so-called Hessenberg's theorem in projective plane geometry. We also provide a proof of the so-called Desargues's theorem based on an axiomatization of (higher) projective space geometry using the notion of rank of a matroid. This last approach allows to handle incidence relations in an homogeneous way dealing only with points and without the need of talking explicitly about lines, planes or any higher entity. [Localization_Ring] title = The Localization of a Commutative Ring author = Anthony Bordg topic = Mathematics/Algebra date = 2018-06-14 notify = apdb3@cam.ac.uk abstract = We formalize the localization of a commutative ring R with respect to a multiplicative subset (i.e. a submonoid of R seen as a multiplicative monoid). This localization is itself a commutative ring and we build the natural homomorphism of rings from R to its localization. [Minsky_Machines] title = Minsky Machines author = Bertram Felgenhauer<> topic = Logic/Computability date = 2018-08-14 notify = int-e@gmx.de abstract =

We formalize undecidablity results for Minsky machines. To this end, we also formalize recursive inseparability.

We start by proving that Minsky machines can compute arbitrary primitive recursive and recursive functions. We then show that there is a deterministic Minsky machine with one argument and two final states such that the set of inputs that are accepted in one state is recursively inseparable from the set of inputs that are accepted in the other state.

As a corollary, the set of Minsky configurations that reach the first state but not the second recursively inseparable from the set of Minsky configurations that reach the second state but not the first. In particular both these sets are undecidable.

We do not prove that recursive functions can simulate Minsky machines.

[Neumann_Morgenstern_Utility] title = Von-Neumann-Morgenstern Utility Theorem author = Julian Parsert, Cezary Kaliszyk topic = Mathematics/Games and economics license = LGPL date = 2018-07-04 notify = julian.parsert@uibk.ac.at, cezary.kaliszyk@uibk.ac.at abstract = Utility functions form an essential part of game theory and economics. In order to guarantee the existence of utility functions most of the time sufficient properties are assumed in an axiomatic manner. One famous and very common set of such assumptions is that of expected utility theory. Here, the rationality, continuity, and independence of preferences is assumed. The von-Neumann-Morgenstern Utility theorem shows that these assumptions are necessary and sufficient for an expected utility function to exists. This theorem was proven by Neumann and Morgenstern in ``Theory of Games and Economic Behavior'' which is regarded as one of the most influential works in game theory. The formalization includes formal definitions of the underlying concepts including continuity and independence of preferences. [Simplex] title = An Incremental Simplex Algorithm with Unsatisfiable Core Generation author = Filip Marić , Mirko Spasić , René Thiemann topic = Computer science/Algorithms/Optimization date = 2018-08-24 notify = rene.thiemann@uibk.ac.at abstract = We present an Isabelle/HOL formalization and total correctness proof for the incremental version of the Simplex algorithm which is used in most state-of-the-art SMT solvers. It supports extraction of satisfying assignments, extraction of minimal unsatisfiable cores, incremental assertion of constraints and backtracking. The formalization relies on stepwise program refinement, starting from a simple specification, going through a number of refinement steps, and ending up in a fully executable functional implementation. Symmetries present in the algorithm are handled with special care. [Budan_Fourier] title = The Budan-Fourier Theorem and Counting Real Roots with Multiplicity author = Wenda Li topic = Mathematics/Analysis date = 2018-09-02 notify = wl302@cam.ac.uk, liwenda1990@hotmail.com abstract = This entry is mainly about counting and approximating real roots (of a polynomial) with multiplicity. We have first formalised the Budan-Fourier theorem: given a polynomial with real coefficients, we can calculate sign variations on Fourier sequences to over-approximate the number of real roots (counting multiplicity) within an interval. When all roots are known to be real, the over-approximation becomes tight: we can utilise this theorem to count real roots exactly. It is also worth noting that Descartes' rule of sign is a direct consequence of the Budan-Fourier theorem, and has been included in this entry. In addition, we have extended previous formalised Sturm's theorem to count real roots with multiplicity, while the original Sturm's theorem only counts distinct real roots. Compared to the Budan-Fourier theorem, our extended Sturm's theorem always counts roots exactly but may suffer from greater computational cost. [Quaternions] title = Quaternions author = Lawrence C. Paulson topic = Mathematics/Algebra, Mathematics/Geometry date = 2018-09-05 notify = lp15@cam.ac.uk abstract = This theory is inspired by the HOL Light development of quaternions, but follows its own route. Quaternions are developed coinductively, as in the existing formalisation of the complex numbers. Quaternions are quickly shown to belong to the type classes of real normed division algebras and real inner product spaces. And therefore they inherit a great body of facts involving algebraic laws, limits, continuity, etc., which must be proved explicitly in the HOL Light version. The development concludes with the geometric interpretation of the product of imaginary quaternions. [Octonions] title = Octonions author = Angeliki Koutsoukou-Argyraki topic = Mathematics/Algebra, Mathematics/Geometry date = 2018-09-14 notify = ak2110@cam.ac.uk abstract = We develop the basic theory of Octonions, including various identities and properties of the octonions and of the octonionic product, a description of 7D isometries and representations of orthogonal transformations. To this end we first develop the theory of the vector cross product in 7 dimensions. The development of the theory of Octonions is inspired by that of the theory of Quaternions by Lawrence Paulson. However, we do not work within the type class real_algebra_1 because the octonionic product is not associative. [Aggregation_Algebras] title = Aggregation Algebras author = Walter Guttmann topic = Mathematics/Algebra date = 2018-09-15 notify = walter.guttmann@canterbury.ac.nz abstract = We develop algebras for aggregation and minimisation for weight matrices and for edge weights in graphs. We verify the correctness of Prim's and Kruskal's minimum spanning tree algorithms based on these algebras. We also show numerous instances of these algebras based on linearly ordered commutative semigroups. [Prime_Number_Theorem] title = The Prime Number Theorem author = Manuel Eberl , Lawrence C. Paulson topic = Mathematics/Number theory date = 2018-09-19 notify = eberlm@in.tum.de abstract =

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

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

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

[Kruskal] title = Kruskal's Algorithm for Minimum Spanning Forest author = Maximilian P.L. Haslbeck , Peter Lammich , Julian Biendarra<> topic = Computer science/Algorithms/Graph date = 2019-02-14 notify = haslbema@in.tum.de, lammich@in.tum.de abstract = This Isabelle/HOL formalization defines a greedy algorithm for finding a minimum weight basis on a weighted matroid and proves its correctness. This algorithm is an abstract version of Kruskal's algorithm. We interpret the abstract algorithm for the cycle matroid (i.e. forests in a graph) and refine it to imperative executable code using an efficient union-find data structure. Our formalization can be instantiated for different graph representations. We provide instantiations for undirected graphs and symmetric directed graphs. [List_Inversions] title = The Inversions of a List author = Manuel Eberl topic = Computer science/Algorithms date = 2019-02-01 notify = eberlm@in.tum.de abstract =

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

[Prime_Distribution_Elementary] title = Elementary Facts About the Distribution of Primes author = Manuel Eberl topic = Mathematics/Number theory date = 2019-02-21 notify = eberlm@in.tum.de abstract =

This entry is a formalisation of Chapter 4 (and parts of Chapter 3) of Apostol's Introduction to Analytic Number Theory. The main topics that are addressed are properties of the distribution of prime numbers that can be shown in an elementary way (i. e. without the Prime Number Theorem), the various equivalent forms of the PNT (which imply each other in elementary ways), and consequences that follow from the PNT in elementary ways. The latter include, most notably, asymptotic bounds for the number of distinct prime factors of n, the divisor function d(n), Euler's totient function φ(n), and lcm(1,…,n).

[Safe_OCL] title = Safe OCL author = Denis Nikiforov <> topic = Computer science/Programming languages/Language definitions license = LGPL date = 2019-03-09 notify = denis.nikif@gmail.com abstract =

The theory is a formalization of the OCL type system, its abstract syntax and expression typing rules. The theory does not define a concrete syntax and a semantics. In contrast to Featherweight OCL, it is based on a deep embedding approach. The type system is defined from scratch, it is not based on the Isabelle HOL type system.

The Safe OCL distincts nullable and non-nullable types. Also the theory gives a formal definition of safe navigation operations. The Safe OCL typing rules are much stricter than rules given in the OCL specification. It allows one to catch more errors on a type checking phase.

The type theory presented is four-layered: classes, basic types, generic types, errorable types. We introduce the following new types: non-nullable types (T[1]), nullable types (T[?]), OclSuper. OclSuper is a supertype of all other types (basic types, collections, tuples). This type allows us to define a total supremum function, so types form an upper semilattice. It allows us to define rich expression typing rules in an elegant manner.

The Preliminaries Chapter of the theory defines a number of helper lemmas for transitive closures and tuples. It defines also a generic object model independent from OCL. It allows one to use the theory as a reference for formalization of analogous languages.

[QHLProver] title = Quantum Hoare Logic author = Junyi Liu<>, Bohua Zhan , Shuling Wang<>, Shenggang Ying<>, Tao Liu<>, Yangjia Li<>, Mingsheng Ying<>, Naijun Zhan<> topic = Computer science/Programming languages/Logics, Computer science/Semantics date = 2019-03-24 notify = bzhan@ios.ac.cn abstract = We formalize quantum Hoare logic as given in [1]. In particular, we specify the syntax and denotational semantics of a simple model of quantum programs. Then, we write down the rules of quantum Hoare logic for partial correctness, and show the soundness and completeness of the resulting proof system. As an application, we verify the correctness of Grover’s algorithm. [Transcendence_Series_Hancl_Rucki] title = The Transcendence of Certain Infinite Series author = Angeliki Koutsoukou-Argyraki , Wenda Li topic = Mathematics/Analysis, Mathematics/Number theory date = 2019-03-27 notify = wl302@cam.ac.uk, ak2110@cam.ac.uk abstract = We formalize the proofs of two transcendence criteria by J. Hančl and P. Rucki that assert the transcendence of the sums of certain infinite series built up by sequences that fulfil certain properties. Both proofs make use of Roth's celebrated theorem on diophantine approximations to algebraic numbers from 1955 which we implement as an assumption without having formalised its proof. [Binding_Syntax_Theory] title = A General Theory of Syntax with Bindings author = Lorenzo Gheri , Andrei Popescu topic = Computer science/Programming languages/Lambda calculi, Computer science/Functional programming, Logic/General logic/Mechanization of proofs date = 2019-04-06 notify = a.popescu@mdx.ac.uk, lor.gheri@gmail.com abstract = We formalize a theory of syntax with bindings that has been developed and refined over the last decade to support several large formalization efforts. Terms are defined for an arbitrary number of constructors of varying numbers of inputs, quotiented to alpha-equivalence and sorted according to a binding signature. The theory includes many properties of the standard operators on terms: substitution, swapping and freshness. It also includes bindings-aware induction and recursion principles and support for semantic interpretation. This work has been presented in the ITP 2017 paper “A Formalized General Theory of Syntax with Bindings”. [LTL_Master_Theorem] title = A Compositional and Unified Translation of LTL into ω-Automata author = Benedikt Seidl , Salomon Sickert topic = Computer science/Automata and formal languages date = 2019-04-16 notify = benedikt.seidl@tum.de, s.sickert@tum.de abstract = We present a formalisation of the unified translation approach of linear temporal logic (LTL) into ω-automata from [1]. This approach decomposes LTL formulas into ``simple'' languages and allows a clear separation of concerns: first, we formalise the purely logical result yielding this decomposition; second, we instantiate this generic theory to obtain a construction for deterministic (state-based) Rabin automata (DRA). We extract from this particular instantiation an executable tool translating LTL to DRAs. To the best of our knowledge this is the first verified translation from LTL to DRAs that is proven to be double exponential in the worst case which asymptotically matches the known lower bound.

[1] Javier Esparza, Jan Kretínský, Salomon Sickert. One Theorem to Rule Them All: A Unified Translation of LTL into ω-Automata. LICS 2018 [LambdaAuth] title = Formalization of Generic Authenticated Data Structures author = Matthias Brun<>, Dmitriy Traytel topic = Computer science/Security, Computer science/Programming languages/Lambda calculi date = 2019-05-14 notify = traytel@inf.ethz.ch abstract = Authenticated data structures are a technique for outsourcing data storage and maintenance to an untrusted server. The server is required to produce an efficiently checkable and cryptographically secure proof that it carried out precisely the requested computation. Miller et al. introduced λ• (pronounced lambda auth)—a functional programming language with a built-in primitive authentication construct, which supports a wide range of user-specified authenticated data structures while guaranteeing certain correctness and security properties for all well-typed programs. We formalize λ• and prove its correctness and security properties. With Isabelle's help, we uncover and repair several mistakes in the informal proofs and lemma statements. Our findings are summarized in a paper draft. [IMP2_Binary_Heap] title = Binary Heaps for IMP2 author = Simon Griebel<> topic = Computer science/Data structures, Computer science/Algorithms date = 2019-06-13 notify = s.griebel@tum.de abstract = In this submission array-based binary minimum heaps are formalized. The correctness of the following heap operations is proved: insert, get-min, delete-min and make-heap. These are then used to verify an in-place heapsort. The formalization is based on IMP2, an imperative program verification framework implemented in Isabelle/HOL. The verified heap functions are iterative versions of the partly recursive functions found in "Algorithms and Data Structures – The Basic Toolbox" by K. Mehlhorn and P. Sanders and "Introduction to Algorithms" by T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein. [Groebner_Macaulay] title = Gröbner Bases, Macaulay Matrices and Dubé's Degree Bounds author = Alexander Maletzky topic = Mathematics/Algebra date = 2019-06-15 notify = alexander.maletzky@risc.jku.at abstract = This entry formalizes the connection between Gröbner bases and Macaulay matrices (sometimes also referred to as `generalized Sylvester matrices'). In particular, it contains a method for computing Gröbner bases, which proceeds by first constructing some Macaulay matrix of the initial set of polynomials, then row-reducing this matrix, and finally converting the result back into a set of polynomials. The output is shown to be a Gröbner basis if the Macaulay matrix constructed in the first step is sufficiently large. In order to obtain concrete upper bounds on the size of the matrix (and hence turn the method into an effectively executable algorithm), Dubé's degree bounds on Gröbner bases are utilized; consequently, they are also part of the formalization. [Linear_Inequalities] title = Linear Inequalities author = Ralph Bottesch , Alban Reynaud <>, René Thiemann topic = Mathematics/Algebra date = 2019-06-21 notify = rene.thiemann@uibk.ac.at abstract = We formalize results about linear inqualities, mainly from Schrijver's book. The main results are the proof of the fundamental theorem on linear inequalities, Farkas' lemma, Carathéodory's theorem, the Farkas-Minkowsky-Weyl theorem, the decomposition theorem of polyhedra, and Meyer's result that the integer hull of a polyhedron is a polyhedron itself. Several theorems include bounds on the appearing numbers, and in particular we provide an a-priori bound on mixed-integer solutions of linear inequalities. [Linear_Programming] title = Linear Programming author = Julian Parsert , Cezary Kaliszyk topic = Mathematics/Algebra date = 2019-08-06 notify = julian.parsert@gmail.com, cezary.kaliszyk@uibk.ac.at abstract = We use the previous formalization of the general simplex algorithm to formulate an algorithm for solving linear programs. We encode the linear programs using only linear constraints. Solving these constraints also solves the original linear program. This algorithm is proven to be sound by applying the weak duality theorem which is also part of this formalization. [Differential_Game_Logic] title = Differential Game Logic author = André Platzer topic = Computer science/Programming languages/Logics date = 2019-06-03 notify = aplatzer@cs.cmu.edu abstract = This formalization provides differential game logic (dGL), a logic for proving properties of hybrid game. In addition to the syntax and semantics, it formalizes a uniform substitution calculus for dGL. Church's uniform substitutions substitute a term or formula for a function or predicate symbol everywhere. The uniform substitutions for dGL also substitute hybrid games for a game symbol everywhere. We prove soundness of one-pass uniform substitutions and the axioms of differential game logic with respect to their denotational semantics. One-pass uniform substitutions are faster by postponing soundness-critical admissibility checks with a linear pass homomorphic application and regain soundness by a variable condition at the replacements. The formalization is based on prior non-mechanized soundness proofs for dGL. [Complete_Non_Orders] title = Complete Non-Orders and Fixed Points author = Akihisa Yamada , Jérémy Dubut topic = Mathematics/Order date = 2019-06-27 notify = akihisayamada@nii.ac.jp, dubut@nii.ac.jp abstract = We develop an Isabelle/HOL library of order-theoretic concepts, such as various completeness conditions and fixed-point theorems. We keep our formalization as general as possible: we reprove several well-known results about complete orders, often without any properties of ordering, thus complete non-orders. In particular, we generalize the Knaster–Tarski theorem so that we ensure the existence of a quasi-fixed point of monotone maps over complete non-orders, and show that the set of quasi-fixed points is complete under a mild condition—attractivity—which is implied by either antisymmetry or transitivity. This result generalizes and strengthens a result by Stauti and Maaden. Finally, we recover Kleene’s fixed-point theorem for omega-complete non-orders, again using attractivity to prove that Kleene’s fixed points are least quasi-fixed points. [Priority_Search_Trees] title = Priority Search Trees author = Peter Lammich , Tobias Nipkow topic = Computer science/Data structures date = 2019-06-25 notify = lammich@in.tum.de abstract = We present a new, purely functional, simple and efficient data structure combining a search tree and a priority queue, which we call a priority search tree. The salient feature of priority search trees is that they offer a decrease-key operation, something that is missing from other simple, purely functional priority queue implementations. Priority search trees can be implemented on top of any search tree. This entry does the implementation for red-black trees. This entry formalizes the first part of our ITP-2019 proof pearl Purely Functional, Simple and Efficient Priority Search Trees and Applications to Prim and Dijkstra. [Prim_Dijkstra_Simple] title = Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra author = Peter Lammich , Tobias Nipkow topic = Computer science/Algorithms/Graph date = 2019-06-25 notify = lammich@in.tum.de abstract = We verify purely functional, simple and efficient implementations of Prim's and Dijkstra's algorithms. This constitutes the first verification of an executable and even efficient version of Prim's algorithm. This entry formalizes the second part of our ITP-2019 proof pearl Purely Functional, Simple and Efficient Priority Search Trees and Applications to Prim and Dijkstra. [MFOTL_Monitor] title = Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic author = Joshua Schneider , Dmitriy Traytel topic = Computer science/Algorithms, Logic/General logic/Temporal logic, Computer science/Automata and formal languages date = 2019-07-04 notify = joshua.schneider@inf.ethz.ch, traytel@inf.ethz.ch abstract = A monitor is a runtime verification tool that solves the following problem: Given a stream of time-stamped events and a policy formulated in a specification language, decide whether the policy is satisfied at every point in the stream. We verify the correctness of an executable monitor for specifications given as formulas in metric first-order temporal logic (MFOTL), an expressive extension of linear temporal logic with real-time constraints and first-order quantification. The verified monitor implements a simplified variant of the algorithm used in the efficient MonPoly monitoring tool. The formalization is presented in a RV 2019 paper, which also compares the output of the verified monitor to that of other monitoring tools on randomly generated inputs. This case study revealed several errors in the optimized but unverified tools. extra-history = Change history: [2020-08-13]: added the formalization of the abstract slicing framework and joint data slicer (revision b1639ed541b7)
[FOL_Seq_Calc1] title = A Sequent Calculus for First-Order Logic author = Asta Halkjær From contributors = Alexander Birch Jensen , Anders Schlichtkrull , Jørgen Villadsen topic = Logic/Proof theory date = 2019-07-18 notify = ahfrom@dtu.dk abstract = This work formalizes soundness and completeness of a one-sided sequent calculus for first-order logic. The completeness is shown via a translation from a complete semantic tableau calculus, the proof of which is based on the First-Order Logic According to Fitting theory. The calculi and proof techniques are taken from Ben-Ari's Mathematical Logic for Computer Science. [Szpilrajn] title = Szpilrajn Extension Theorem author = Peter Zeller topic = Mathematics/Order date = 2019-07-27 notify = p_zeller@cs.uni-kl.de abstract = We formalize the Szpilrajn extension theorem, also known as order-extension principal: Every strict partial order can be extended to a strict linear order. [TESL_Language] title = A Formal Development of a Polychronous Polytimed Coordination Language author = Hai Nguyen Van , Frédéric Boulanger , Burkhart Wolff topic = Computer science/System description languages, Computer science/Semantics, Computer science/Concurrency date = 2019-07-30 notify = frederic.boulanger@centralesupelec.fr, burkhart.wolff@lri.fr abstract = The design of complex systems involves different formalisms for modeling their different parts or aspects. The global model of a system may therefore consist of a coordination of concurrent sub-models that use different paradigms. We develop here a theory for a language used to specify the timed coordination of such heterogeneous subsystems by addressing the following issues:

  • the behavior of the sub-systems is observed only at a series of discrete instants,
  • events may occur in different sub-systems at unrelated times, leading to polychronous systems, which do not necessarily have a common base clock,
  • coordination between subsystems involves causality, so the occurrence of an event may enforce the occurrence of other events, possibly after a certain duration has elapsed or an event has occurred a given number of times,
  • the domain of time (discrete, rational, continuous...) may be different in the subsystems, leading to polytimed systems,
  • the time frames of different sub-systems may be related (for instance, time in a GPS satellite and in a GPS receiver on Earth are related although they are not the same).
Firstly, a denotational semantics of the language is defined. Then, in order to be able to incrementally check the behavior of systems, an operational semantics is given, with proofs of progress, soundness and completeness with regard to the denotational semantics. These proofs are made according to a setup that can scale up when new operators are added to the language. In order for specifications to be composed in a clean way, the language should be invariant by stuttering (i.e., adding observation instants at which nothing happens). The proof of this invariance is also given. [Stellar_Quorums] title = Stellar Quorum Systems author = Giuliano Losa topic = Computer science/Algorithms/Distributed date = 2019-08-01 notify = giuliano@galois.com abstract = We formalize the static properties of personal Byzantine quorum systems (PBQSs) and Stellar quorum systems, as described in the paper ``Stellar Consensus by Reduction'' (to appear at DISC 2019). [IMO2019] title = Selected Problems from the International Mathematical Olympiad 2019 author = Manuel Eberl topic = Mathematics/Misc date = 2019-08-05 notify = eberlm@in.tum.de abstract =

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

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

[Adaptive_State_Counting] title = Formalisation of an Adaptive State Counting Algorithm author = Robert Sachtleben topic = Computer science/Automata and formal languages, Computer science/Algorithms date = 2019-08-16 notify = rob_sac@uni-bremen.de abstract = This entry provides a formalisation of a refinement of an adaptive state counting algorithm, used to test for reduction between finite state machines. The algorithm has been originally presented by Hierons in the paper Testing from a Non-Deterministic Finite State Machine Using Adaptive State Counting. Definitions for finite state machines and adaptive test cases are given and many useful theorems are derived from these. The algorithm is formalised using mutually recursive functions, for which it is proven that the generated test suite is sufficient to test for reduction against finite state machines of a certain fault domain. Additionally, the algorithm is specified in a simple WHILE-language and its correctness is shown using Hoare-logic. [Jacobson_Basic_Algebra] title = A Case Study in Basic Algebra author = Clemens Ballarin topic = Mathematics/Algebra date = 2019-08-30 notify = ballarin@in.tum.de abstract = The focus of this case study is re-use in abstract algebra. It contains locale-based formalisations of selected parts of set, group and ring theory from Jacobson's Basic Algebra leading to the respective fundamental homomorphism theorems. The study is not intended as a library base for abstract algebra. It rather explores an approach towards abstract algebra in Isabelle. [Hybrid_Systems_VCs] title = Verification Components for Hybrid Systems author = Jonathan Julian Huerta y Munive <> topic = Mathematics/Algebra, Mathematics/Analysis date = 2019-09-10 notify = jjhuertaymunive1@sheffield.ac.uk, jonjulian23@gmail.com abstract = These components formalise a semantic framework for the deductive verification of hybrid systems. They support reasoning about continuous evolutions of hybrid programs in the style of differential dynamics logic. Vector fields or flows model these evolutions, and their verification is done with invariants for the former or orbits for the latter. Laws of modal Kleene algebra or categorical predicate transformers implement the verification condition generation. Examples show the approach at work. 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 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 topic = Mathematics/Number theory date = 2020-03-22 notify = manuel.eberl@tum.de abstract =

This article gives a formal version of Furstenberg's topological proof of the infinitude of primes. He defines a topology on the integers based on arithmetic progressions (or, equivalently, residue classes). Using some fairly obvious properties of this topology, the infinitude of primes is then easily obtained.

Apart from this, this topology is also fairly ‘nice’ in general: it is second countable, metrizable, and perfect. All of these (well-known) facts are formally proven, including an explicit metric for the topology given by Zulfeqarr.

[Saturation_Framework] title = A Comprehensive Framework for Saturation Theorem Proving author = Sophie Tourret topic = Logic/General logic/Mechanization of proofs date = 2020-04-09 notify = stourret@mpi-inf.mpg.de abstract = This Isabelle/HOL formalization is the companion of the technical report “A comprehensive framework for saturation theorem proving”, itself companion of the eponym IJCAR 2020 paper, written by Uwe Waldmann, Sophie Tourret, Simon Robillard and Jasmin Blanchette. It verifies a framework for formal refutational completeness proofs of abstract provers that implement saturation calculi, such as ordered resolution or superposition, and allows to model entire prover architectures in such a way that the static refutational completeness of a calculus immediately implies the dynamic refutational completeness of a prover implementing the calculus using a variant of the given clause loop. The technical report “A comprehensive framework for saturation theorem proving” is available on the Matryoshka website. The names of the Isabelle lemmas and theorems corresponding to the results in the report are indicated in the margin of the report. [Saturation_Framework_Extensions] title = Extensions to the Comprehensive Framework for Saturation Theorem Proving author = Jasmin Blanchette , Sophie Tourret topic = Logic/General logic/Mechanization of proofs date = 2020-08-25 notify = jasmin.blanchette@gmail.com abstract = This Isabelle/HOL formalization extends the AFP entry Saturation_Framework with the following contributions:
  • an application of the framework to prove Bachmair and Ganzinger's resolution prover RP refutationally complete, which was formalized in a more ad hoc fashion by Schlichtkrull et al. in the AFP entry Ordered_Resultion_Prover;
  • generalizations of various basic concepts formalized by Schlichtkrull et al., which were needed to verify RP and could be useful to formalize other calculi, such as superposition;
  • alternative proofs of fairness (and hence saturation and ultimately refutational completeness) for the given clause procedures GC and LGC, based on invariance.
[MFODL_Monitor_Optimized] title = Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations author = Thibault Dardinier<>, Lukas Heimes<>, Martin Raszyk , Joshua Schneider , Dmitriy Traytel topic = Computer science/Algorithms, Logic/General logic/Modal logic, Computer science/Automata and formal languages date = 2020-04-09 notify = martin.raszyk@inf.ethz.ch, joshua.schneider@inf.ethz.ch, traytel@inf.ethz.ch abstract = A monitor is a runtime verification tool that solves the following problem: Given a stream of time-stamped events and a policy formulated in a specification language, decide whether the policy is satisfied at every point in the stream. We verify the correctness of an executable monitor for specifications given as formulas in metric first-order dynamic logic (MFODL), which combines the features of metric first-order temporal logic (MFOTL) and metric dynamic logic. Thus, MFODL supports real-time constraints, first-order parameters, and regular expressions. Additionally, the monitor supports aggregation operations such as count and sum. This formalization, which is described in a forthcoming paper at IJCAR 2020, significantly extends previous work on a verified monitor for MFOTL. Apart from the addition of regular expressions and aggregations, we implemented multi-way joins and a specialized sliding window algorithm to further optimize the monitor. [Sliding_Window_Algorithm] title = Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows author = Lukas Heimes<>, Dmitriy Traytel , Joshua Schneider<> topic = Computer science/Algorithms date = 2020-04-10 notify = heimesl@student.ethz.ch, traytel@inf.ethz.ch, joshua.schneider@inf.ethz.ch abstract = Basin et al.'s sliding window algorithm (SWA) is an algorithm for combining the elements of subsequences of a sequence with an associative operator. It is greedy and minimizes the number of operator applications. We formalize the algorithm and verify its functional correctness. We extend the algorithm with additional operations and provide an alternative interface to the slide operation that does not require the entire input sequence. [Lucas_Theorem] title = Lucas's Theorem author = Chelsea Edmonds topic = Mathematics/Number theory date = 2020-04-07 notify = cle47@cam.ac.uk abstract = This work presents a formalisation of a generating function proof for Lucas's theorem. We first outline extensions to the existing Formal Power Series (FPS) library, including an equivalence relation for coefficients modulo n, an alternate binomial theorem statement, and a formalised proof of the Freshman's dream (mod p) lemma. The second part of the work presents the formal proof of Lucas's Theorem. Working backwards, the formalisation first proves a well known corollary of the theorem which is easier to formalise, and then applies induction to prove the original theorem statement. The proof of the corollary aims to provide a good example of a formalised generating function equivalence proof using the FPS library. The final theorem statement is intended to be integrated into the formalised proof of Hilbert's 10th Problem. [ADS_Functor] title = Authenticated Data Structures As Functors author = Andreas Lochbihler , Ognjen Marić topic = Computer science/Data structures date = 2020-04-16 notify = andreas.lochbihler@digitalasset.com, mail@andreas-lochbihler.de abstract = Authenticated data structures allow several systems to convince each other that they are referring to the same data structure, even if each of them knows only a part of the data structure. Using inclusion proofs, knowledgeable systems can selectively share their knowledge with other systems and the latter can verify the authenticity of what is being shared. In this article, we show how to modularly define authenticated data structures, their inclusion proofs, and operations thereon as datatypes in Isabelle/HOL, using a shallow embedding. Modularity allows us to construct complicated trees from reusable building blocks, which we call Merkle functors. Merkle functors include sums, products, and function spaces and are closed under composition and least fixpoints. As a practical application, we model the hierarchical transactions of Canton, a practical interoperability protocol for distributed ledgers, as authenticated data structures. This is a first step towards formalizing the Canton protocol and verifying its integrity and security guarantees. [Power_Sum_Polynomials] title = Power Sum Polynomials author = Manuel Eberl topic = Mathematics/Algebra date = 2020-04-24 notify = eberlm@in.tum.de abstract =

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

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

[Formal_Puiseux_Series] title = Formal Puiseux Series author = Manuel Eberl topic = Mathematics/Algebra date = 2021-02-17 notify = eberlm@in.tum.de 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 topic = Mathematics/Number theory date = 2020-04-24 notify = eberlm@in.tum.de abstract =

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

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

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

While elementary proofs for both of these are already available in the AFP, the theory of Gaussian integers provides more concise proofs and a more high-level view.

[Forcing] title = Formalization of Forcing in Isabelle/ZF author = Emmanuel Gunther , Miguel Pagano , Pedro Sánchez Terraf topic = Logic/Set theory date = 2020-05-06 notify = gunther@famaf.unc.edu.ar, pagano@famaf.unc.edu.ar, sterraf@famaf.unc.edu.ar abstract = We formalize the theory of forcing in the set theory framework of Isabelle/ZF. Under the assumption of the existence of a countable transitive model of ZFC, we construct a proper generic extension and show that the latter also satisfies ZFC. [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. [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 [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 topic = Mathematics/Probability theory date = 2021-02-10 notify = eberlm@in.tum.de 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 and insertion 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 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. + +[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. + diff --git a/metadata/templates/about.tpl b/metadata/templates/about.tpl --- a/metadata/templates/about.tpl +++ b/metadata/templates/about.tpl @@ -1,76 +1,78 @@ {% extends "base.tpl" %} {% block headline %} Archive of Formal Proofs {% endblock %} {% block content %}

About

The Archive of Formal Proofs is a collection of proof libraries, examples, and larger scientific developments, mechanically checked in the theorem prover Isabelle. It is organized in the way of a scientific journal. Submissions are refereed.

The archive repository is hosted on Heptapod to provide easy free access to archive entries. The entries are tested and maintained continuously against the current stable release of Isabelle. Older versions of archive entries will remain available.

Editors

The editors of the archive are

Why

We aim to strengthen the community and to foster the development of formal proofs.

We hope that the archive will provide

  • a resource of knowledge, examples, and libraries for users,
  • a large and relevant test bed of theories for Isabelle developers, and
  • a central, citable place for authors to publish their theories

We encourage authors of publications that contain Isabelle developments to make their theories available in the Archive of Formal Proofs and to refer to the archive entry in their publication. It makes it easier for referees to check the validity of theorems (all entries in the archive are mechanically checked), it makes it easier for readers of the publication to understand details of your development, and it makes it easier to use and build on your work.

License

All entries in the Archive of Formal Proofs are licensed under a BSD-style License or the GNU LGPL. This means they are free to download, free to use, free to change, and free to redistribute with minimal restrictions.

The authors retain their full copyright on their original work, including their right to make the development available under another, additional license in the future.

{% endblock %} diff --git a/thys/Hermite_Lindemann/Algebraic_Integer_Divisibility.thy b/thys/Hermite_Lindemann/Algebraic_Integer_Divisibility.thy new file mode 100644 --- /dev/null +++ b/thys/Hermite_Lindemann/Algebraic_Integer_Divisibility.thy @@ -0,0 +1,221 @@ +(* + File: Algebraic_Integer_Divisibility.thy + Author: Manuel Eberl, TU München +*) +section \Divisibility of algebraic integers\ +theory Algebraic_Integer_Divisibility + imports "Algebraic_Numbers.Algebraic_Numbers" +begin + +text \ + In this section, we define a notion of divisibility of algebraic integers: \y\ is divisible + by \x\ if \y / x\ is an algebraic integer (or if \x\ and \y\ are both zero). + + Technically, the definition does not require \x\ and \y\ to be algebraic integers themselves, + but we will always use it that way (in fact, in our case \x\ will always be a rational integer). +\ + +definition alg_dvd :: "'a :: field \ 'a \ bool" (infix "alg'_dvd" 50) where + "x alg_dvd y \ (x = 0 \ y = 0) \ algebraic_int (y / x)" + +lemma alg_dvd_imp_algebraic_int: + fixes x y :: "'a :: field_char_0" + shows "x alg_dvd y \ algebraic_int x \ algebraic_int y" + using algebraic_int_times[of "y / x" x] by (auto simp: alg_dvd_def) + +lemma alg_dvd_0_left_iff [simp]: "0 alg_dvd x \ x = 0" + by (auto simp: alg_dvd_def) + +lemma alg_dvd_0_right [iff]: "x alg_dvd 0" + by (auto simp: alg_dvd_def) + +lemma one_alg_dvd_iff [simp]: "1 alg_dvd x \ algebraic_int x" + by (auto simp: alg_dvd_def) + +lemma alg_dvd_of_int [intro]: + assumes "x dvd y" + shows "of_int x alg_dvd of_int y" +proof (cases "of_int x = (0 :: 'a)") + case False + from assms obtain z where z: "y = x * z" + by (elim dvdE) + have "algebraic_int (of_int z)" + by auto + also have "of_int z = of_int y / (of_int x :: 'a)" + using False by (simp add: z field_simps) + finally show ?thesis + using False by (simp add: alg_dvd_def) +qed (use assms in \auto simp: alg_dvd_def\) + +lemma alg_dvd_of_nat [intro]: + assumes "x dvd y" + shows "of_nat x alg_dvd of_nat y" + using alg_dvd_of_int[of "int x" "int y"] assms by simp + +lemma alg_dvd_of_int_iff [simp]: + "(of_int x :: 'a :: field_char_0) alg_dvd of_int y \ x dvd y" +proof + assume "(of_int x :: 'a) alg_dvd of_int y" + hence "of_int y / (of_int x :: 'a) \ \" and nz: "of_int x = (0::'a) \ of_int y = (0::'a)" + by (auto simp: alg_dvd_def dest!: rational_algebraic_int_is_int) + then obtain n where "of_int y / of_int x = (of_int n :: 'a)" + by (elim Ints_cases) + hence "of_int y = (of_int (x * n) :: 'a)" + unfolding of_int_mult using nz by (auto simp: field_simps) + hence "y = x * n" + by (subst (asm) of_int_eq_iff) + thus "x dvd y" + by auto +qed blast + +lemma alg_dvd_of_nat_iff [simp]: + "(of_nat x :: 'a :: field_char_0) alg_dvd of_nat y \ x dvd y" +proof - + have "(of_int (int x) :: 'a) alg_dvd of_int (int y) \ x dvd y" + by (subst alg_dvd_of_int_iff) auto + thus ?thesis unfolding of_int_of_nat_eq . +qed + +lemma alg_dvd_add [intro]: + fixes x y z :: "'a :: field_char_0" + shows "x alg_dvd y \ x alg_dvd z \ x alg_dvd (y + z)" + unfolding alg_dvd_def by (auto simp: add_divide_distrib) + +lemma alg_dvd_uminus_right [intro]: "x alg_dvd y \ x alg_dvd -y" + by (auto simp: alg_dvd_def) + +lemma alg_dvd_uminus_right_iff [simp]: "x alg_dvd -y \ x alg_dvd y" + using alg_dvd_uminus_right[of x y] alg_dvd_uminus_right[of x "-y"] by auto + +lemma alg_dvd_diff [intro]: + fixes x y z :: "'a :: field_char_0" + shows "x alg_dvd y \ x alg_dvd z \ x alg_dvd (y - z)" + unfolding alg_dvd_def by (auto simp: diff_divide_distrib) + +lemma alg_dvd_triv_left [intro]: "algebraic_int y \ x alg_dvd x * y" + by (auto simp: alg_dvd_def) + +lemma alg_dvd_triv_right [intro]: "algebraic_int x \ y alg_dvd x * y" + by (auto simp: alg_dvd_def) + +lemma alg_dvd_triv_left_iff: "x alg_dvd x * y \ x = 0 \ algebraic_int y" + by (auto simp: alg_dvd_def) + +lemma alg_dvd_triv_right_iff: "y alg_dvd x * y \ y = 0 \ algebraic_int x" + by (auto simp: alg_dvd_def) + +lemma alg_dvd_triv_left_iff' [simp]: "x \ 0 \ x alg_dvd x * y \ algebraic_int y" + by (simp add: alg_dvd_triv_left_iff) + +lemma alg_dvd_triv_right_iff' [simp]: "y \ 0 \ y alg_dvd x * y \ algebraic_int x" + by (simp add: alg_dvd_triv_right_iff) + +lemma alg_dvd_trans [trans]: + fixes x y z :: "'a :: field_char_0" + shows "x alg_dvd y \ y alg_dvd z \ x alg_dvd z" + using algebraic_int_times[of "y / x" "z / y"] by (auto simp: alg_dvd_def) + +lemma alg_dvd_mono [simp]: + fixes a b c d :: "'a :: field_char_0" + shows "a alg_dvd c \ b alg_dvd d \ (a * b) alg_dvd (c * d)" + using algebraic_int_times[of "c / a" "d / b"] by (auto simp: alg_dvd_def) + +lemma alg_dvd_mult [simp]: + fixes a b c :: "'a :: field_char_0" + shows "a alg_dvd c \ algebraic_int b \ a alg_dvd (b * c)" + using alg_dvd_mono[of a c 1 b] by (auto simp: mult.commute) + +lemma alg_dvd_mult2 [simp]: + fixes a b c :: "'a :: field_char_0" + shows "a alg_dvd b \ algebraic_int c \ a alg_dvd (b * c)" + using alg_dvd_mult[of a b c] by (simp add: mult.commute) + +text \ + A crucial theorem: if an integer \x\ divides a rational number \y\, then \y\ is in fact + also an integer, and that integer is a multiple of \x\. +\ +lemma alg_dvd_int_rat: + fixes y :: "'a :: field_char_0" + assumes "of_int x alg_dvd y" and "y \ \" + shows "\n. y = of_int n \ x dvd n" +proof (cases "x = 0") + case False + have "y / of_int x \ \" + by (intro rational_algebraic_int_is_int) (use assms in \auto simp: alg_dvd_def\) + then obtain n where n: "of_int n = y / (of_int x :: 'a)" + by (elim Ints_cases) auto + hence "y = of_int (n * x)" + using False by (simp add: field_simps) + thus ?thesis by (intro exI[of _ "x * n"]) auto +qed (use assms in auto) + +lemma prod_alg_dvd_prod: + fixes f :: "'a \ 'b :: field_char_0" + assumes "\x. x \ A \ f x alg_dvd g x" + shows "prod f A alg_dvd prod g A" + using assms by (induction A rule: infinite_finite_induct) auto + +lemma alg_dvd_sum: + fixes f :: "'a \ 'b :: field_char_0" + assumes "\x. x \ A \ y alg_dvd f x" + shows "y alg_dvd sum f A" + using assms by (induction A rule: infinite_finite_induct) auto + +lemma not_alg_dvd_sum: + fixes f :: "'a \ 'b :: field_char_0" + assumes "\x. x \ A-{x'} \ y alg_dvd f x" + assumes "\y alg_dvd f x'" + assumes "x' \ A" "finite A" + shows "\y alg_dvd sum f A" +proof + assume *: "y alg_dvd sum f A" + have "y alg_dvd sum f A - sum f (A - {x'})" + using \x' \ A\ by (intro alg_dvd_diff[OF * alg_dvd_sum] assms) auto + also have "\ = sum f (A - (A - {x'}))" + using assms by (subst sum_diff) auto + also have "A - (A - {x'}) = {x'}" + using assms by auto + finally show False using assms by simp +qed + +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 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 fact_alg_dvd_poly_higher_pderiv: + fixes p :: "'a :: field_char_0 poly" + assumes "\i. algebraic_int (poly.coeff p i)" "algebraic_int x" "m \ k" + shows "fact m alg_dvd poly ((pderiv ^^ k) p) x" + unfolding poly_altdef +proof (intro alg_dvd_sum, goal_cases) + case (1 i) + have "(of_int (fact m) :: 'a) alg_dvd (of_int (fact k))" + by (intro alg_dvd_of_int fact_dvd assms) + also have "(of_int (fact k) :: 'a) alg_dvd of_int (pochhammer (int i + 1) k)" + using fact_dvd_pochhammer[of k "i + k"] + by (intro alg_dvd_of_int fact_dvd_pochhammer) (auto simp: algebra_simps) + finally have "fact m alg_dvd (pochhammer (of_nat i + 1) k :: 'a)" + by (simp flip: pochhammer_of_int) + also have "\ alg_dvd pochhammer (of_nat i + 1) k * poly.coeff p (i + k)" + by (rule alg_dvd_triv_left) (rule assms) + also have "\ = poly.coeff ((pderiv ^^ k) p) i" + unfolding coeff_higher_pderiv by (simp add: add_ac flip: pochhammer_of_int) + also have "\ alg_dvd poly.coeff ((pderiv ^^ k) p) i * x ^ i" + by (intro alg_dvd_triv_left algebraic_int_power assms) + finally show ?case . +qed + +end \ No newline at end of file diff --git a/thys/Hermite_Lindemann/Complex_Lexorder.thy b/thys/Hermite_Lindemann/Complex_Lexorder.thy new file mode 100644 --- /dev/null +++ b/thys/Hermite_Lindemann/Complex_Lexorder.thy @@ -0,0 +1,89 @@ +(* + File: Complex_Lexorder.thy + Author: Manuel Eberl, TU München +*) +section \The lexicographic ordering on complex numbers\ +theory Complex_Lexorder + imports Complex_Main "HOL-Library.Multiset" +begin + +text \ + We define a lexicographic order on the complex numbers, comparing first the real parts + and, if they are equal, the imaginary parts. This ordering is of course not compatible with + multiplication, but it is compatible with addition. +\ + +definition less_eq_complex_lex (infix "\\<^sub>\" 50) where + "less_eq_complex_lex x y \ Re x < Re y \ Re x = Re y \ Im x \ Im y" + +definition less_complex_lex (infix "<\<^sub>\" 50) where + "less_complex_lex x y \ Re x < Re y \ Re x = Re y \ Im x < Im y" + +interpretation complex_lex: + linordered_ab_group_add "(+)" 0 "(-)" "uminus" less_eq_complex_lex less_complex_lex + by standard (auto simp: less_eq_complex_lex_def less_complex_lex_def complex_eq_iff) + +lemmas [trans] = + complex_lex.order.trans complex_lex.less_le_trans + complex_lex.less_trans complex_lex.le_less_trans + +lemma (in ordered_comm_monoid_add) sum_mono_complex_lex: + "(\i. i\K \ f i \\<^sub>\ g i) \ (\i\K. f i) \\<^sub>\ (\i\K. g i)" + by (induct K rule: infinite_finite_induct) (use complex_lex.add_mono in auto) + +lemma sum_strict_mono_ex1_complex_lex: + fixes f g :: "'i \ complex" + assumes "finite A" + and "\x\A. f x \\<^sub>\ g x" + and "\a\A. f a <\<^sub>\ g a" + shows "sum f A <\<^sub>\ sum g A" +proof- + from assms(3) obtain a where a: "a \ A" "f a <\<^sub>\ g a" by blast + have "sum f A = sum f ((A - {a}) \ {a})" + by (simp add: insert_absorb[OF \a \ A\]) + also have "\ = sum f (A - {a}) + sum f {a}" + using \finite A\ by (subst sum.union_disjoint) auto + also have "\ \\<^sub>\ sum g (A - {a}) + sum f {a}" + by (intro complex_lex.add_mono sum_mono_complex_lex) (simp_all add: assms) + also have "\ <\<^sub>\ sum g (A - {a}) + sum g {a}" + using a by (intro complex_lex.add_strict_left_mono) auto + also have "\ = sum g ((A - {a}) \ {a})" + using \finite A\ by (subst sum.union_disjoint[symmetric]) auto + also have "\ = sum g A" by (simp add: insert_absorb[OF \a \ A\]) + finally show ?thesis + by simp +qed + +lemma sum_list_mono_complex_lex: + assumes "list_all2 (\\<^sub>\) xs ys" + shows "sum_list xs \\<^sub>\ sum_list ys" + using assms by induction (auto intro: complex_lex.add_mono) + +lemma sum_mset_mono_complex_lex: + assumes "rel_mset (\\<^sub>\) A B" + shows "sum_mset A \\<^sub>\ sum_mset B" + using assms by (auto simp: rel_mset_def sum_mset_sum_list intro: sum_list_mono_complex_lex) + +lemma rel_msetI: + assumes "list_all2 R xs ys" "mset xs = A" "mset ys = B" + shows "rel_mset R A B" + using assms by (auto simp: rel_mset_def) + +lemma mset_replicate [simp]: "mset (replicate n x) = replicate_mset n x" + by (induction n) auto + +lemma rel_mset_replicate_mset_right: + assumes "\x. x \# A \ R x y" "size A = n" + shows "rel_mset R A (replicate_mset n y)" +proof - + obtain xs where [simp]: "A = mset xs" + by (metis ex_mset) + from assms have "\x\set xs. R x y" + by auto + hence "list_all2 R xs (replicate (length xs) y)" + by (induction xs) auto + with assms(2) show ?thesis + by (intro rel_msetI[of R xs "replicate n y"]) auto +qed + +end \ No newline at end of file diff --git a/thys/Hermite_Lindemann/Hermite_Lindemann.thy b/thys/Hermite_Lindemann/Hermite_Lindemann.thy new file mode 100644 --- /dev/null +++ b/thys/Hermite_Lindemann/Hermite_Lindemann.thy @@ -0,0 +1,2558 @@ +(* + File: Hermite_Lindemann.thy + Author: Manuel Eberl, TU München +*) +section \The Hermite--Lindemann--Weierstraß Transcendence Theorem\ +theory Hermite_Lindemann +imports + Pi_Transcendental.Pi_Transcendental + Algebraic_Numbers.Algebraic_Numbers + Algebraic_Integer_Divisibility + Min_Int_Poly + Complex_Lexorder + More_Polynomial_HLW + More_Multivariate_Polynomial_HLW + More_Algebraic_Numbers_HLW + Misc_HLW +begin + +text \ + The Hermite--Lindemann--Weierstraß theorem answers questions about the transcendence of + the exponential function and other related complex functions. It proves that a large number of + combinations of exponentials is always transcendental. + + A first (much weaker) version of the theorem was proven by Hermite. Lindemann and Weierstraß then + successively generalised it shortly afterwards, and finally Baker gave another, arguably more + elegant formulation (which is the one that we will prove, and then derive the traditional version + from it). + + To honour the contributions of all three of these 19th-century mathematicians, I refer to the + theorem as the Hermite--Lindemann--Weierstraß theorem, even though in other literature it is + often called Hermite--Lindemann or Lindemann--Weierstraß. To keep things short, the Isabelle + name of the theorem, however, will omit Weierstraß's name. +\ + +subsection \Main proof\ + +text \ + Following Baker, We first prove the following special form of the theorem: + Let $m > 0$ and $q_1, \ldots, q_m \in\mathbb{Z}[X]$ be irreducible, non-constant, + and pairwise coprime polynomials. Let $\beta_1, \ldots, \beta_m$ be non-zero integers. Then + \[\sum_{i=1}^m \beta_i \sum_{q_i(\alpha) = 0} e^\alpha \neq 0\] + + The difference to the final theorem is that + + \<^enum> The coefficients $\beta_i$ are non-zero integers (as opposed to arbitrary algebraic numbers) + + \<^enum> The exponents $\alpha_i$ occur in full sets of conjugates, and each set has the same + coefficient. + + In a similar fashion to the proofs of the transcendence of \e\ and \\\, we define some number + $J$ depending on the $\alpha_i$ and $\beta_i$ and an arbitrary sufficiently large prime \p\. We + then show that, on one hand, $J$ is an integer multiple of $(p-1)!$, but on the other hand it + is bounded from above by a term of the form $C_1 \cdot C_2^p$. This is then clearly a + contradiction if \p\ is chosen large enough. +\ + +lemma Hermite_Lindemann_aux1: + fixes P :: "int poly set" and \ :: "int poly \ int" + assumes "finite P" and "P \ {}" + assumes distinct: "pairwise Rings.coprime P" + assumes irred: "\p. p \ P \ irreducible p" + assumes nonconstant: "\p. p \ P \ Polynomial.degree p > 0" + assumes \_nz: "\p. p \ P \ \ p \ 0" + defines "Roots \ (\p. {\::complex. poly (of_int_poly p) \ = 0})" + shows "(\p\P. of_int (\ p) * (\\\Roots p. exp \)) \ 0" +proof + note [intro] = \finite P\ + assume sum_eq_0: "(\p\P. of_int (\ p) * (\\\Roots p. exp \)) = 0" + + define Roots' where "Roots' = (\p\P. Roots p)" + have finite_Roots [intro]: "finite (Roots p)" if "p \ P" for p + using nonconstant[of p] that by (auto intro: poly_roots_finite simp: Roots_def) + have [intro]: "finite Roots'" + by (auto simp: Roots'_def) + have [simp]: "0 \ P" + using nonconstant[of 0] by auto + have [simp]: "p \ 0" if "p \ P" for p + using that by auto + + text \ + The polynomials in \<^term>\P\ do not have multiple roots: + \ + have rsquarefree: "rsquarefree (of_int_poly q :: complex poly)" if "q \ P" for q + by (rule irreducible_imp_rsquarefree_of_int_poly) (use that in \auto intro: irred nonconstant\) + + text \ + No two different polynomials in \<^term>\P\ have roots in common: + \ + have disjoint: "disjoint_family_on Roots P" + using distinct + proof (rule pairwise_imp_disjoint_family_on) + fix p q assume P: "p \ P" "q \ P" and "Rings.coprime p q" + hence "Rings.coprime (of_int_poly p :: complex poly) (of_int_poly q)" + by (intro coprime_of_int_polyI) + thus "Roots p \ Roots q = {}" + using poly_eq_0_coprime[of "of_int_poly p" "of_int_poly q :: complex poly"] P + by (auto simp: Roots_def) + qed + + define n_roots :: "int poly \ nat" ("\_") + where "n_roots = (\p. card (Roots p))" + define n where "n = (\p\P. \p)" + have n_altdef: "n = card Roots'" + unfolding n_def Roots'_def n_roots_def using disjoint + by (subst card_UN_disjoint) (auto simp: disjoint_family_on_def) + have Roots_nonempty: "Roots p \ {}" if "p \ P" for p + using nonconstant[OF that] by (auto simp: Roots_def fundamental_theorem_of_algebra constant_degree) + have "Roots' \ {}" + using Roots_nonempty \P \ {}\ by (auto simp: Roots'_def) + have "n > 0" + using \Roots' \ {}\ \finite Roots'\ by (auto simp: n_altdef) + + text \ + We can split each polynomial in \P\ into a product of linear factors: + \ + have of_int_poly_P: + "of_int_poly q = Polynomial.smult (Polynomial.lead_coeff q) (\x\Roots q. [:-x, 1:])" + if "q \ P" for q + using complex_poly_decompose_rsquarefree[OF rsquarefree[OF that]] by (simp add: Roots_def) + + text \ + We let \l\ be an integer such that $l\alpha$ is an algebraic integer for all our roots \\\: + \ + define l where "l = (LCM q\P. Polynomial.lead_coeff q)" + have alg_int: "algebraic_int (of_int l * x)" if "x \ Roots'" for x + proof - + from that obtain q where q: "q \ P" "ipoly q x = 0" + by (auto simp: Roots'_def Roots_def) + show ?thesis + by (rule algebraic_imp_algebraic_int'[of q]) (use q in \auto simp: l_def\) + qed + have "l \ 0" + using \finite P\ by (auto simp: l_def Lcm_0_iff) + moreover have "l \ 0" + unfolding l_def by (rule Lcm_int_greater_eq_0) + ultimately have "l > 0" by linarith + + text \ + We can split the product of all the polynomials in \P\ into linear factors: + \ + define lc_factor where "lc_factor = (\q\P. l ^ Polynomial.degree q div Polynomial.lead_coeff q)" + have lc_factor: "Polynomial.smult (of_int l ^ n) (\\'\Roots'. [:-\',1:]) = + of_int_poly (Polynomial.smult lc_factor (\P))" + proof - + define lc where "lc = (\q. Polynomial.lead_coeff q :: int)" + define d where "d = (Polynomial.degree :: int poly \ nat)" + have "(\q\P. of_int_poly q) = + (\q\P. Polynomial.smult (lc q) (\x\Roots q. [:-x, 1:]) :: complex poly)" + unfolding lc_def by (intro prod.cong of_int_poly_P refl) + also have "\ = Polynomial.smult (\q\P. lc q) (\q\P. (\x\Roots q. [:-x, 1:]))" + by (simp add: prod_smult) + also have "(\q\P. (\x\Roots q. [:-x, 1:])) = (\x\Roots'. [:-x, 1:])" + unfolding Roots'_def using disjoint + by (intro prod.UNION_disjoint [symmetric]) (auto simp: disjoint_family_on_def) + also have "Polynomial.smult (of_int lc_factor) (Polynomial.smult (\q\P. lc q) \) = + Polynomial.smult (\q\P. of_int (l ^ d q div lc q * lc q)) (\x\Roots'. pCons (- x) 1)" + by (simp add: lc_factor_def prod.distrib lc_def d_def) + also have "(\q\P. of_int (l ^ d q div lc q * lc q)) = (\q\P. of_int l ^ d q :: complex)" + proof (intro prod.cong, goal_cases) + case (2 q) + have "lc q dvd l" + unfolding l_def lc_def using 2 by auto + also have "\ dvd l ^ d q" + using 2 nonconstant[of q] by (intro dvd_power) (auto simp: d_def) + finally show ?case by simp + qed auto + also have "\ = l ^ (\q\P. d q)" + by (simp add: power_sum) + also have "(\q\P. d q) = (\q\P. n_roots q)" + proof (intro sum.cong, goal_cases) + case (2 q) + thus ?case using rsquarefree[OF 2] + by (subst (asm) rsquarefree_card_degree) (auto simp: d_def n_roots_def Roots_def) + qed auto + also have "\ = n" + by (simp add: n_def) + finally show ?thesis + by (simp add: of_int_hom.map_poly_hom_smult of_int_poly_hom.hom_prod) + qed + + text \ + We define \R\ to be the radius of the smallest circle around the origin in which all our + roots lie: + \ + define R :: real where "R = Max (norm ` Roots')" + have R_ge: "R \ norm \" if "\ \ Roots'" for \ + unfolding R_def using that by (intro Max_ge) auto + have "R \ 0" + proof - + from \Roots' \ {}\ obtain \ where "\ \ Roots'" + by auto + have "0 \ norm \" + by simp + also have "\ \ R" + by (intro R_ge) fact + finally show "R \ 0" + by simp + qed + + text \ + Now the main part of the proof: for any sufficiently large prime \p\, our assumptions + imply $(p-1)! ^ n \leq C' l^{np} (2R)^{np-1}$ for some constant $C'$: + \ + define C :: "nat \ real" where "C = (\p. l ^ (n * p) * (2*R) ^ (n * p - 1))" + define C' where + "C' = (\x\Roots'. \q\P. real_of_int \\ q\ * (\\\Roots q. cmod \ * exp (cmod \)))" + + text \ + We commence with the proof of the main inequality. + \ + have ineq: "fact (p - 1) ^ n \ C' * C p ^ n" + if p: "prime p" + and p_ineqs: "\q\P. p > \\ q\" + "real p > norm (\\\Roots'. of_int (l^n) * (\x\Roots'-{\}. \ - x))" + for p :: nat + proof - + have "p > 1" + using prime_gt_1_nat[OF p] . + + text \ + We define the polynomial function + \[f_i(X) = l^{np} \frac{\prod_\alpha (X-\alpha)^p}{X - \alpha_i}\] + where the product runs over all roots $\alpha$. + \ + define f_poly :: "complex \ complex poly" where + "f_poly = (\\. Polynomial.smult (l^(n*p)) ((\\'\Roots'. [:-\', 1:]^p) div [:-\, 1:]))" + have f_poly_altdef: "f_poly \ = Polynomial.smult (l^(n*p)) + ((\\'\Roots'. [:-\', 1:]^(if \' = \ then p - 1 else p)))" + if "\ \ Roots'" for \ + proof - + have "(\\'\Roots'. [:-\', 1:] ^ (if \'=\ then p-1 else p)) * [:-\, 1:] = + [:- \, 1:] ^ (p - 1) * (\x\Roots' - {\}. [:- x, 1:] ^ p) * [:- \, 1:]" + using that by (subst prod.If_eq) (auto simp: algebra_simps) + also have "\ = (\x\Roots' - {\}. [:- x, 1:] ^ p) * [:- \, 1:] ^ Suc (p - 1)" + by (simp only: power_Suc mult_ac) + also have "Suc (p - 1) = p" + using \p > 1\ by auto + also have "(\x\Roots' - {\}. [:- x, 1:] ^ p) * [:- \, 1:] ^ p = (\x\Roots'. [:- x, 1:] ^ p)" + using that by (subst prod.remove[of _ \]) auto + finally have eq: "(\\'\Roots'. [:-\', 1:] ^ (if \'=\ then p-1 else p)) * [:-\, 1:] = + (\x\Roots'. [:- x, 1:] ^ p)" . + show ?thesis + unfolding f_poly_def eq[symmetric] by (subst nonzero_mult_div_cancel_right) auto + qed + + define f :: "complex \ complex \ complex" + where "f = (\\ x. l^(n*p) * (\\'\Roots'. (x - \')^(if \' = \ then p - 1 else p)))" + have eval_f: "poly (f_poly \) x = f \ x" if "\ \ Roots'" for \ x + using that by (simp add: f_poly_altdef poly_prod f_def) + have deg_f: "Polynomial.degree (f_poly \) = n * p - 1" if "\ \ Roots'" for \ + proof - + have "Polynomial.degree (f_poly \) = p - 1 + (n - 1) * p" + unfolding f_poly_altdef[OF that] using that \l > 0\ \finite Roots'\ + by (subst prod.If_eq) (auto simp: degree_prod_eq degree_power_eq degree_mult_eq n_altdef) + also have "p - 1 + (n - 1) * p = n * p - 1" + using \n > 0\ \p > 1\ by (cases n) auto + finally show ?thesis . + qed + + text \ + Next, we define the function $I_i(z) = \int_0^z e^{z-t} f_i(t) \text{d}t$, and, + based on that, the numbers $J_i = \sum_{i=1}^m \beta_i \sum_{q_i(x) = 0} I_i(x)$, + and the number $J$, which is the product of all the $J_i$: + \ + define I :: "complex \ complex \ complex" + where "I = (\\ x. lindemann_weierstrass_aux.I (f_poly \) x)" + define J :: "complex \ complex" + where "J = (\\. \q\P. \ q * (\x\Roots q. I \ x))" + + define J' :: complex + where "J' = (\\\Roots'. J \)" + + text \ + Reusing some of the machinery from the proof that \e\ is transcendental, + we find the following equality for $J_i$: + \ + have J_eq: "J \ = -(\q\P. of_int (\ q) * (\x\Roots q. \j)) x))" + if "\ \ Roots'" for \ + proof - + have "n * p \ 1 * 2" + using \n > 0\ \p > 1\ by (intro mult_mono) auto + hence [simp]: "{..n*p-Suc 0} = {.. = (\q\P. \ q * (\x\Roots q. I \ x))" + unfolding J_def .. + also have "\ = (\q\P. of_int (\ q) * (\x\Roots q. exp x * (\j)) 0))) - + (\q\P. of_int (\ q) * (\x\Roots q. \j)) x))" + unfolding I_def lindemann_weierstrass_aux.I_def + by (simp add: deg_f that ring_distribs sum_subtractf sum_distrib_left sum_distrib_right mult_ac) + also have "\ = -(\q\P. of_int (\ q) * (\x\Roots q. \j)) x))" + unfolding sum_distrib_right [symmetric] mult.assoc [symmetric] sum_eq_0 by simp + finally show ?thesis . + qed + + text \ + The next big step is to show that $(p-1)! \mid J_i$ as an algebraic integer (i.e. + $J_i / (p-1)!$ is an algebraic integer), but $p \not\mid J_i$. This is done by brute force: + We show that every summand in the above sum has $p!$ as a factor, except for + the one corresponding to $x = \alpha_i$, $j = p - 1$, which has $(p-1)!$ as a factor but + not \p\. + \ + have J: "fact (p - 1) alg_dvd J \" "\of_nat p alg_dvd J \" if \: "\ \ Roots'" for \ + proof - + define h where "h = (\\' j. poly ((pderiv ^^ j) (f_poly \)) \')" + from \ obtain q where q: "q \ P" "\ \ Roots q" + by (auto simp: Roots'_def) + + have "J \ = -(\(q, \')\Sigma P Roots. \j q) * h \' j)" + unfolding J_eq[OF \] h_def sum_distrib_left by (subst (2) sum.Sigma) auto + also have "\ = -(\((q,\'),i)\Sigma P Roots\{.. q) * h \' i)" + by (subst (2) sum.Sigma [symmetric]) (auto simp: case_prod_unfold) + finally have J_eq': "J \ = - (\((q, \'), i)\Sigma P Roots \ {.. q) * h \' i)" . + + have h_\_pm1_eq: "h \ (p-1) = of_int (l^(n*p)) * fact (p-1) * (\\'\Roots'-{\}. (\-\')^p)" + proof - + have "h \ (p - 1) = of_int (l ^ (n * p)) * + poly ((pderiv ^^ (p-1)) (\\'\Roots'. [:-\',1:] ^ (if \' = \ then p - 1 else p))) \" + unfolding h_def f_poly_altdef[OF \] higher_pderiv_smult poly_smult .. + also have "(\\'\Roots'. [:-\',1:] ^ (if \' = \ then p - 1 else p)) = + [:-\,1:]^(p-1) * (\\'\Roots'-{\}. [:-\',1:]^p)" + using \ by (subst prod.If_eq) auto + also have "poly ((pderiv ^^ (p-1)) \) \ = fact (p - 1) * (\\'\Roots' - {\}. (\ - \') ^ p)" + by (subst poly_higher_pderiv_aux2) (simp_all add: poly_prod) + finally show ?thesis by (simp only: mult.assoc) + qed + + have "fact (p-1) alg_dvd h \ (p-1)" + proof - + have "fact (p-1) alg_dvd fact (p-1) * (of_int (l^p) * (\\'\Roots'-{\}. (l*\-l*\')^p))" + by (intro alg_dvd_triv_left algebraic_int_times[of "of_int (l^p)"] + algebraic_int_prod algebraic_int_power algebraic_int_diff + alg_int \ algebraic_int_of_int) auto + also have "(\\'\Roots'-{\}. (l*\-l*\')^p) = (\\'\Roots'-{\}. of_int l^p * (\-\')^p)" + by (subst power_mult_distrib [symmetric]) (simp_all add: algebra_simps) + also have "\ = of_int (l ^ (p * (n-1))) * (\\'\Roots'-{\}. (\-\')^p)" + using \ by (subst prod.distrib) (auto simp: card_Diff_subset n_altdef simp flip: power_mult) + also have "of_int (l^p) * \ = of_int (l^(p+p*(n-1))) * (\\'\Roots'-{\}. (\-\')^p)" + unfolding mult.assoc [symmetric] power_add [symmetric] of_int_power .. + also have "p + p * (n - 1) = n * p" + using \n > 0\ by (cases n) (auto simp: mult_ac) + also have "fact (p - 1) * (of_int (l^(n*p)) * (\\'\Roots'-{\}. (\-\')^p)) = h \ (p-1)" + unfolding h_\_pm1_eq by (simp add: mult_ac) + finally show ?thesis . + qed + + have "\of_nat p alg_dvd of_int (\ q) * h \ (p-1)" + unfolding h_\_pm1_eq mult.assoc [symmetric] of_int_mult [symmetric] + proof + define r where "r = (\\. of_int (l^n) * (\\'\Roots'-{\}. \-\'))" + have alg_int_r: "algebraic_int (r \)" if "\ \ Roots'" for \ + proof - + have "algebraic_int (of_int l * (\\'\Roots'-{\}. of_int l * \ - of_int l * \'))" + by (intro algebraic_int_times[OF algebraic_int_of_int] algebraic_int_prod + algebraic_int_power algebraic_int_diff alg_int that) auto + also have "\ = of_int l * (\\'\Roots'-{\}. of_int l * (\ - \'))" + by (simp add: algebra_simps flip: power_mult_distrib) + also have "\ = of_int (l^(1 + (n-1))) * (\\'\Roots'-{\}. \ - \')" + using that by (simp add: r_def prod.distrib card_Diff_subset + n_altdef power_add mult_ac flip: power_mult) + also have "1 + (n - 1) = n" + using \n > 0\ by auto + finally show "algebraic_int (r \)" + unfolding r_def . + qed + + have "(\\'\Roots'. r \') \ \" + proof - + obtain Root where Root_bij: "bij_betw Root {..finite Roots'\] unfolding n_altdef atLeast0LessThan by metis + have Root_in_Roots': "Root i \ Roots'" if "i < n" for i + using Root_bij that by (auto simp: bij_betw_def) + + define R :: "complex mpoly" where + "R = (\ij\{.. \" + proof (rule symmetric_poly_of_roots_in_subring) + show "symmetric_mpoly {..\. \"], goal_cases) + case (2 i \) + from \\ permutes {.. have [simp]: "bij \" + by (rule permutes_bij) + have "mpoly_map_vars \ (Const (of_int (l ^ n)) * + (\j\{..j\{.. i) - Var (\ j))" + by simp + also have "(\j\{.. i) - Var (\ j)) = + (\j\{.. i}. Var (\ i) - Var j)" + using 2 permutes_in_image[OF 2(2), of i] + by (intro prod.reindex_bij_betw bij_betw_Diff permutes_imp_bij[OF 2(2)]) + (auto simp: bij_betw_singleton) + finally show ?case by simp + qed + next + show "vars R \ {.. :: complex set)" + by unfold_locales auto + then interpret ring_closed "\ :: complex set" . + show "\m. MPoly_Type.coeff R m \ \" + unfolding R_def + by (intro allI coeff_prod_closed coeff_mult_closed coeff_power_closed) + (auto simp: mpoly_coeff_Const coeff_Var when_def) + next + let ?lc = "of_int (\p\P. Polynomial.lead_coeff p) :: complex" + have "(\q\P. of_int_poly q) = (\q\P. Polynomial.smult + (of_int (Polynomial.lead_coeff q)) (\x\Roots q. [:-x, 1:]))" + by (intro prod.cong of_int_poly_P refl) + also have "\ = Polynomial.smult ?lc (\q\P. \x\Roots q. [:-x, 1:])" + by (simp add: prod_smult) + also have "(\q\P. \x\Roots q. [:-x, 1:]) = (\x\Roots'. [:-x, 1:])" + unfolding Roots'_def using disjoint + by (intro prod.UNION_disjoint [symmetric]) (auto simp: disjoint_family_on_def) + also have "\ = (\iP) = Polynomial.smult ?lc (\i 0" + by (intro prod_nonzeroI) auto + thus "inverse ?lc * ?lc = 1" "inverse ?lc \ \" + by (auto simp: field_simps simp flip: of_int_prod) + qed auto + also have "insertion Root R = (\ij\{.. = (\i\'\Roots'-{Root i}. Root i - \'))" + proof (intro prod.cong, goal_cases) + case (2 i) + hence "(\j\{..\'\Roots'-{Root i}. Root i - \')" + by (intro prod.reindex_bij_betw bij_betw_Diff Root_bij) + (auto intro: Root_in_Roots' simp: bij_betw_singleton) + thus ?case by simp + qed auto + also have "\ = (\\'\Roots'. r \')" + unfolding r_def by (intro prod.reindex_bij_betw Root_bij) + finally show "(\\'\Roots'. r \') \ \" . + qed + moreover have "algebraic_int (\\'\Roots'. r \')" + by (intro algebraic_int_prod alg_int_r) + ultimately have is_int: "(\\'\Roots'. r \') \ \" + using rational_algebraic_int_is_int by blast + then obtain R' where R': "(\\'\Roots'. r \') = of_int R'" + by (elim Ints_cases) + have "(\\'\Roots'. r \') \ 0" + using \l > 0\ by (intro prod_nonzeroI) (auto simp: r_def \finite Roots'\) + with R' have [simp]: "R' \ 0" + by auto + + assume "of_nat p alg_dvd of_int (\ q * l^(n*p)) * fact (p-1) * (\\'\Roots'-{\}. (\-\') ^ p)" + also have "\ = of_int (\ q) * fact (p-1) * r \ ^ p" + by (simp add: r_def mult_ac power_mult_distrib power_mult prod_power_distrib) + also have "\ alg_dvd of_int (\ q) * fact (p-1) * r \ ^ p * (\\'\Roots'-{\}. r \') ^ p" + by (intro alg_dvd_triv_left algebraic_int_prod alg_int_r algebraic_int_power) auto + also have "\ = of_int (\ q) * fact (p-1) * (\\'\Roots'. r \') ^ p" + using \ by (subst (2) prod.remove[of _ "\"]) (auto simp: mult_ac power_mult_distrib) + also have "\ = of_int (\ q * fact (p - 1) * R' ^ p)" + by (simp add: R') + also have "of_nat p = of_int (int p)" + by simp + finally have "int p dvd \ q * fact (p - 1) * R' ^ p" + by (subst (asm) alg_dvd_of_int_iff) + moreover have "prime (int p)" + using \prime p\ by auto + ultimately have "int p dvd \ q \ int p dvd fact (p - 1) \ int p dvd R' ^ p" + by (simp add: prime_dvd_mult_iff) + moreover have "\int p dvd \ q" + proof + assume "int p dvd \ q" + hence "int p \ \\ q\" + using \_nz[of q] dvd_imp_le_int[of "\ q" "int p"] q by auto + with p_ineqs(1) q show False by auto + qed + moreover have "\int p dvd fact (p - 1)" + proof - + have "\p dvd fact (p - 1)" + using \p > 1\ p by (subst prime_dvd_fact_iff) auto + hence "\int p dvd int (fact (p - 1))" + by (subst int_dvd_int_iff) + thus ?thesis unfolding of_nat_fact . + qed + moreover have "\int p dvd R' ^ p" + proof + assume "int p dvd R' ^ p" + hence "int p dvd R'" + using \prime (int p)\ prime_dvd_power by metis + hence "int p \ \R'\" + using \_nz[of q] dvd_imp_le_int[of R' "int p"] q by auto + hence "real p \ real_of_int \R'\" + by linarith + also have "\ = norm (\\\Roots'. r \)" + unfolding R' by simp + finally show False unfolding r_def using p_ineqs(2) + by linarith + qed + ultimately show False + by blast + qed + + have fact_p_dvd: "fact p alg_dvd h \' j" if "\' \ Roots'" "\' \ \ \ j \ p - 1" for \' j + proof (cases "j \ p") + case False + with that have j: "j < (if \' = \ then p - 1 else p)" + by auto + have "h \' j = 0" + unfolding h_def f_poly_altdef[OF \] + by (intro poly_higher_pderiv_aux1'[OF j] dvd_smult dvd_prodI that) auto + thus ?thesis by simp + next + case True + define e where "e = (\x. if x = \ then p - 1 else p)" + define Q where "Q = (\x\Roots'. [:-x, 1:] ^ e x)" + define Q' where "Q' = Polynomial.smult (of_int (l^(n*p+j))) (pcompose Q [:0, 1 / of_int l:])" + have "poly ((pderiv ^^ j) Q) \' / l ^ j = + poly ((pderiv ^^ j) (pcompose Q [:0, 1 / of_int l:])) (l * \')" + using \l > 0\ by (simp add: higher_pderiv_pcompose_linear poly_pcompose field_simps) + + have "sum e Roots' = (n - 1) * p + (p - 1)" + unfolding e_def using \ + by (subst sum.If_eq) (auto simp: card_Diff_subset n_altdef algebra_simps) + also have "\ = n * p - 1" + using \n > 0\ \p > 1\ by (cases n) auto + finally have [simp]: "sum e Roots' = n * p - 1" . + + have "h \' j = of_int (l^(n*p)) * poly ((pderiv ^^ j) Q) \'" + unfolding h_def f_poly_altdef[OF \] higher_pderiv_smult poly_smult e_def Q_def .. + also have "poly ((pderiv ^^ j) Q) \' = + of_int l ^ j * poly ((pderiv ^^ j) (pcompose Q [:0, 1 / of_int l:])) (l * \')" + using \l > 0\ by (simp add: higher_pderiv_pcompose_linear poly_pcompose field_simps) + also have "of_int (l ^ (n * p)) * \ = poly ((pderiv ^^ j) Q') (l * \')" + by (simp add: Q'_def higher_pderiv_smult power_add) + also have "fact p alg_dvd \" + proof (rule fact_alg_dvd_poly_higher_pderiv) + show "j \ p" by fact + show "algebraic_int (of_int l * \')" + by (rule alg_int) fact + interpret alg_int: ring_closed "{x::complex. algebraic_int x}" + by standard auto + show "algebraic_int (poly.coeff Q' i)" for i + proof (cases "i \ Polynomial.degree Q'") + case False + thus ?thesis + by (simp add: coeff_eq_0) + next + case True + hence "i \ n * p - 1" using \l > 0\ + by (simp add: Q'_def degree_prod_eq Q_def degree_power_eq) + also have "n * p > 0" + using \n > 0\ \p > 1\ by auto + hence "n * p - 1 < n * p" + by simp + finally have i: "i < n * p" . + + have "poly.coeff Q' i = of_int l ^ (n * p + j) / of_int l ^ i * poly.coeff Q i" + by (simp add: Q'_def coeff_pcompose_linear field_simps) + also have "of_int l ^ (n * p + j) = (of_int l ^ (n * p + j - i) :: complex) * of_int l ^ i" + unfolding power_add [symmetric] using i by simp + hence "of_int l ^ (n * p + j) / of_int l ^ i = (of_int l ^ (n * p + j - i) :: complex)" + using \l > 0\ by (simp add: field_simps) + also have "\ * poly.coeff Q i = + (\X\{X. X \ (SIGMA x:Roots'. {.. i = n * p - Suc (card X)}. + of_int l ^ (n * p + j - (n * p - Suc (card X))) * ((- 1) ^ card X * prod fst X))" + unfolding Q_def by (subst coeff_prod_linear_factors) (auto simp: sum_distrib_left) + also have "algebraic_int \" + proof (intro algebraic_int_sum, goal_cases) + case (1 X) + hence X: "X \ (SIGMA x:Roots'. {.. card (SIGMA x:Roots'. {.. n * p - 1" + using card_eq by auto + also have "\ < n * p" + using \n * p > 0\ by simp + finally have card_less: "card X < n * p" . + have "algebraic_int ((-1) ^ card X * of_int l ^ (j + 1) * (\x\X. of_int l * fst x))" + using X by (intro algebraic_int_times algebraic_int_prod alg_int) auto + thus ?case + using card_less by (simp add: power_add prod.distrib mult_ac) + qed + finally show ?thesis . + qed + qed + finally show ?thesis . + qed + + have p_dvd: "of_nat p alg_dvd h \' j" if "\' \ Roots'" "\' \ \ \ j \ p - 1" for \' j + proof - + have "of_nat p alg_dvd (of_nat (fact p) :: complex)" + by (intro alg_dvd_of_nat dvd_fact) (use \p > 1\ in auto) + hence "of_nat p alg_dvd (fact p :: complex)" + by simp + also have "\ alg_dvd h \' j" + using that by (intro fact_p_dvd) + finally show ?thesis . + qed + + show "fact (p - 1) alg_dvd J \" + unfolding J_eq' + proof (intro alg_dvd_uminus_right alg_dvd_sum, safe intro!: alg_dvd_mult algebraic_int_of_int) + fix q \' j + assume "q \ P" "\' \ Roots q" "j < n * p" + hence "\' \ Roots'" + by (auto simp: Roots'_def) + show "fact (p - 1) alg_dvd h \' j" + proof (cases "\' = \ \ j = p - 1") + case True + thus ?thesis using \fact (p - 1) alg_dvd h \ (p - 1)\ + by simp + next + case False + have "of_int (fact (p - 1)) alg_dvd (of_int (fact p) :: complex)" + by (intro alg_dvd_of_int fact_dvd) auto + hence "fact (p - 1) alg_dvd (fact p :: complex)" + by simp + also have "\ alg_dvd h \' j" + using False \\' \ Roots'\ by (intro fact_p_dvd) auto + finally show ?thesis . + qed + qed + + show "\of_nat p alg_dvd J \" + unfolding J_eq' alg_dvd_uminus_right_iff + proof (rule not_alg_dvd_sum) + have "p - 1 < 1 * p" + using \p > 1\ by simp + also have "1 * p \ n * p" + using \n > 0\ by (intro mult_right_mono) auto + finally show "((q, \), p - 1) \ Sigma P Roots \ {..n > 0\ by auto + next + fix z assume z: "z \ Sigma P Roots \ {..),p-1)}" + from z have "snd (fst z) \ Roots'" + by (auto simp: Roots'_def) + moreover have "fst (fst z) = q" if "\ \ Roots (fst (fst z))" + proof - + have "\ \ Roots (fst (fst z)) \ Roots q" "q \ P" "fst (fst z) \ P" + using that q z by auto + with disjoint show ?thesis + unfolding disjoint_family_on_def by blast + qed + ultimately have "of_nat p alg_dvd h (snd (fst z)) (snd z)" + using z by (intro p_dvd) auto + thus "of_nat p alg_dvd (case z of (x, xa) \ (case x of (q, \') \ \i. of_int (\ q) * h \' i) xa)" + using z by auto + qed (use \\of_nat p alg_dvd of_int (\ q) * h \ (p-1)\ in auto) + qed + + text \ + Our next goal is to show that $J$ is rational. This is done by repeated applications + of the fundamental theorem of symmetric polynomials, exploiting the fact that $J$ is + symmetric in all the $\alpha_i$ for each set of conjugates. + \ + define g :: "int poly poly" + where "g = synthetic_div (map_poly (\x. [:x:]) + ((Polynomial.smult lc_factor (\P)) ^ p)) [:0, 1:]" + have g: "map_poly (\p. ipoly p \) g = f_poly \" if \: "\ \ Roots'" for \ + proof - + interpret \: comm_ring_hom "\p. ipoly p \" + by standard (auto simp: of_int_hom.poly_map_poly_eval_poly of_int_poly_hom.hom_mult) + define Q :: "int poly" where "Q = (Polynomial.smult lc_factor (\P)) ^ p" + have "f_poly \ = Polynomial.smult (of_int (l^(n*p))) ((\\'\Roots'. [:-\',1:])^p) div [:-\,1:]" + unfolding f_poly_def div_smult_left [symmetric] prod_power_distrib[symmetric] .. + also have "of_int (l^(n*p)) = (of_int l^n)^p" + by (simp add: power_mult) + also have "Polynomial.smult \ ((\\'\Roots'. [:-\',1:])^p) = + (Polynomial.smult (of_int l ^ n) (\\'\Roots'. [:-\',1:])) ^ p" + by (simp only: smult_power) + also have "\ = of_int_poly Q" + by (subst lc_factor) (simp_all add: Q_def of_int_poly_hom.hom_power) + also have "\ div [:-\, 1:] = synthetic_div (of_int_poly Q) \" + unfolding synthetic_div_altdef .. + also have "\ = synthetic_div (map_poly (\p. ipoly p \) (map_poly (\x. [:x:]) Q)) (ipoly [:0, 1:] \)" + by (simp add: map_poly_map_poly o_def) + also have "\ = map_poly (\p. ipoly p \) g" + unfolding g_def Q_def by (rule \.synthetic_div_hom) + finally show ?thesis .. + qed + + obtain Q where Q: "J \ = -(\q\P. of_int (\ q) * eval_poly of_rat (Q q) \)" + if "\ \ Roots'" for \ + proof - + define g' :: "nat \ complex poly poly" + where "g' = (\j. (map_poly of_int_poly ((pderiv ^^ j) g)))" + obtain root :: "int poly \ nat \ complex" + where root: "\q. q \ P \ bij_betw (root q) {..<\q} (Roots q)" + using ex_bij_betw_nat_finite[OF finite_Roots] unfolding n_roots_def atLeast0LessThan + by metis + have "\Q'. map_poly of_rat Q' = (\x\Roots q. poly (g' j) [:x:])" if q: "q \ P" for q j + proof - + define Q :: "nat \ complex poly mpoly" + where "Q = (\j. (\i<\q. mpoly_of_poly i (g' j)))" + define ratpolys :: "complex poly set" where "ratpolys = {p. \i. poly.coeff p i \ \}" + have "insertion ((\x. [:x:]) \ root q) (Q j) \ ratpolys" + proof (rule symmetric_poly_of_roots_in_subring) + show "ring_closed ratpolys" + by standard (auto simp: ratpolys_def intro!: coeff_mult_semiring_closed) + show "\m. MPoly_Type.coeff (Q j) m \ ratpolys" + by (auto simp: Q_def ratpolys_def Polynomial.coeff_sum coeff_mpoly_of_poly when_def g'_def + intro!: sum_in_Rats) + show "vars (Q j) \ {..<\q}" unfolding Q_def + by (intro order.trans[OF vars_sum] UN_least order.trans[OF vars_mpoly_of_poly]) auto + show "symmetric_mpoly {..<\q} (Q j)" unfolding Q_def + by (rule symmetric_mpoly_symmetric_sum[of _ id]) (auto simp: permutes_bij) + interpret coeff_lift_hom: map_poly_idom_hom "\x. [:x:]" + by standard + define lc :: complex where "lc = of_int (Polynomial.lead_coeff q)" + have "of_int_poly q = Polynomial.smult (Polynomial.lead_coeff q) (\x\Roots q. [:-x, 1:])" + by (rule of_int_poly_P) fact + also have "poly_lift \ = Polynomial.smult [:lc:] (\a\Roots q. [:-[:a:], 1:])" + by (simp add: poly_lift_def map_poly_smult coeff_lift_hom.hom_prod lc_def) + also have "(\a\Roots q. [:-[:a:], 1:]) = (\i<\q. [:-[:root q i:], 1:])" + by (intro prod.reindex_bij_betw [symmetric] root q) + also have "\ = (\i<\q. [:- ((\x. [:x:]) \ root q) i, 1:])" + by simp + finally show "poly_lift (Ring_Hom_Poly.of_int_poly q) = Polynomial.smult [:lc:] \" . + have "lc \ 0" + using q by (auto simp: lc_def) + thus "[:inverse lc:] * [:lc:] = 1" + by (simp add: field_simps) + qed (auto simp: ratpolys_def coeff_pCons split: nat.splits) + + also have "insertion ((\x. [:x:]) \ root q) (Q j) = (\i<\q. poly (g' j) [:root q i:])" + by (simp add: Q_def insertion_sum poly_sum) + also have "\ = (\x\Roots q. poly (g' j) [:x:])" + by (intro sum.reindex_bij_betw root q) + finally have "\i. poly.coeff (\x\Roots q. poly (g' j) [:x:]) i \ \" + by (auto simp: ratpolys_def) + thus ?thesis + using ratpolyE by metis + qed + then obtain Q where Q: "\q j. q \ P \ map_poly of_rat (Q q j) = (\x\Roots q. poly (g' j) [:x:])" + by metis + define Q' where "Q' = (\q. \j = - (\q\P. of_int (\ q) * eval_poly of_rat (Q' q) \)" if \: "\ \ Roots'" for \ + proof - + have "J \ = -(\q\P. of_int (\ q) * (\x\Roots q. \j)) x))" + (is "_ = -?S") unfolding J_eq[OF \] .. + also have "?S = (\q\P. of_int (\ q) * eval_poly of_rat (Q' q) \)" + proof (rule sum.cong, goal_cases) + case q: (2 q) + interpret \: idom_hom "\p. ipoly p \" + by standard (auto simp: of_int_hom.poly_map_poly_eval_poly of_int_poly_hom.hom_mult) + + have "(\x\Roots q. \j)) x) = + (\jx\Roots q. poly ((pderiv ^^ j) (f_poly \)) x)" + by (rule sum.swap) + also have "\ = (\j)" + proof (rule sum.cong, goal_cases) + case j: (2 j) + have "(\x\Roots q. poly ((pderiv ^^ j) (f_poly \)) x) = + (\x\Roots q. poly (poly (g' j) [:x:]) \)" + proof (rule sum.cong, goal_cases) + case (2 x) + have "poly ((pderiv ^^ j) (f_poly \)) x = + poly ((pderiv ^^ j) (map_poly (\p. ipoly p \) g)) x" + by (subst g[OF \, symmetric]) (rule refl) + also have "\ = poly (eval_poly ((\p. [:poly p \:]) \ of_int_poly) ((pderiv ^^ j) g) [:0, 1:]) x" + unfolding o_def \.map_poly_higher_pderiv [symmetric] + by (simp only: \.map_poly_eval_poly) + also have "\ = poly (eval_poly (\p. [:poly p \:]) + (map_poly of_int_poly ((pderiv ^^ j) g)) [:0, 1:]) x" + unfolding eval_poly_def by (subst map_poly_map_poly) auto + also have "\ = poly (poly (map_poly of_int_poly ((pderiv ^^ j) g)) [:x:]) \" + by (rule poly_poly_eq [symmetric]) + also have "\ = poly (poly (g' j) [:x:]) \" + by (simp add: g'_def) + finally show ?case . + qed auto + also have "\ = poly (\x\Roots q. poly (g' j) [:x:]) \" + by (simp add: poly_sum) + also have "\ = eval_poly of_rat (Q q j) \" + using q by (simp add: Q eval_poly_def) + finally show ?case . + qed auto + also have "\ = eval_poly of_rat (Q' q) \" + by (simp add: Q'_def of_rat_hom.eval_poly_sum) + finally show ?case by simp + qed auto + finally show "J \ = - (\q\P. of_int (\ q) * eval_poly of_rat (Q' q) \)" . + qed + thus ?thesis using that[of Q'] by metis + qed + + have "J' \ \" + proof - + have "(\\\Roots q. J \) \ \" if q: "q \ P" for q + proof - + obtain root where root: "bij_betw root {..<\q} (Roots q)" + using ex_bij_betw_nat_finite[OF finite_Roots[OF q]] + unfolding atLeast0LessThan n_roots_def by metis + define Q' :: "complex poly" + where "Q' = -(\q\P. Polynomial.smult (of_int (\ q)) (map_poly of_rat (Q q)))" + + have "(\\\Roots q. J \) = (\\\Roots q. -(\q\P. of_int (\ q) * eval_poly of_rat (Q q) \))" + by (intro prod.cong refl Q) (auto simp: Roots'_def q) + also have "\ = (\\\Roots q. poly Q' \)" + by (simp add: Q'_def poly_sum eval_poly_def) + also have "\ = (\i<\q. poly Q' (root i))" + by (intro prod.reindex_bij_betw [symmetric] root) + also have "\ = insertion root (\i<\q. mpoly_of_poly i Q')" + by (simp add: insertion_prod) + also have "\ \ \" + proof (rule symmetric_poly_of_roots_in_subring) + show "ring_closed (\ :: complex set)" + by standard auto + then interpret Q: ring_closed "\ :: complex set" . + show "\m. MPoly_Type.coeff (\i<\q. mpoly_of_poly i Q') m \ \" + by (auto intro!: Q.coeff_prod_closed sum_in_Rats + simp: coeff_mpoly_of_poly when_def Q'_def Polynomial.coeff_sum) + show "symmetric_mpoly {..<\q} (\i<\q. mpoly_of_poly i Q')" + by (intro symmetric_mpoly_symmetric_prod'[of _ id]) (auto simp: permutes_bij) + show "vars (\i<\q. mpoly_of_poly i Q') \ {..<\q}" + by (intro order.trans[OF vars_prod] order.trans[OF vars_mpoly_of_poly] UN_least) auto + define lc where "lc = (of_int (Polynomial.lead_coeff q) :: complex)" + have "of_int_poly q = Polynomial.smult lc (\x\Roots q. [:- x, 1:])" + unfolding lc_def by (rule of_int_poly_P) fact + also have "(\x\Roots q. [:- x, 1:]) = (\i<\q. [:- root i, 1:])" + by (intro prod.reindex_bij_betw [symmetric] root) + finally show "of_int_poly q = Polynomial.smult lc (\i<\q. [:- root i, 1:])" . + have "lc \ 0" + using q by (auto simp: lc_def) + thus "inverse lc * lc = 1" "inverse lc \ \" + by (auto simp: lc_def) + qed auto + finally show ?thesis . + qed + hence "(\q\P. \\\Roots q. J \) \ \" + by (rule prod_in_Rats) + also have "(\q\P. \\\Roots q. J \) = J'" + unfolding Roots'_def J'_def using disjoint + by (intro prod.UNION_disjoint [symmetric]) (auto simp: disjoint_family_on_def) + finally show "J' \ \" . + qed + + text \ + Since \J'\ is clearly an algebraic integer, we now know that it is in fact an integer. + \ + moreover have "algebraic_int J'" + unfolding J'_def + proof (intro algebraic_int_prod) + fix x assume "x \ Roots'" + hence "fact (p - 1) alg_dvd J x" + by (intro J) + thus "algebraic_int (J x)" + by (rule alg_dvd_imp_algebraic_int) auto + qed + ultimately have "J' \ \" + using rational_algebraic_int_is_int by blast + + text \ + It is also non-zero, as none of the $J_i$ have $p$ as a factor and such cannot be zero. + \ + have "J' \ 0" + unfolding J'_def + proof (intro prod_nonzeroI) + fix \ assume "\ \ Roots'" + hence "\of_nat p alg_dvd J \" + using J(2)[of \] by auto + thus "J \ \ 0" + by auto + qed + + text \ + It then clearly follows that $(p-1)!^n \leq J$: + \ + have "fact (p - 1) ^ n alg_dvd J'" + proof - + have "fact (p - 1) ^ n = (\\\Roots'. fact (p - 1))" + by (simp add: n_altdef) + also have "\ alg_dvd J'" + unfolding J'_def by (intro prod_alg_dvd_prod J(1)) + finally show ?thesis . + qed + + have "fact (p - 1) ^ n \ norm J'" + proof - + from \J' \ \\ obtain J'' where [simp]: "J' = of_int J''" + by (elim Ints_cases) + have "of_int (fact (p - 1) ^ n) = (fact (p - 1) ^ n :: complex)" + by simp + also have "\ alg_dvd J'" + by fact + also have "J' = of_int J''" + by fact + finally have "fact (p - 1) ^ n dvd J''" + by (subst (asm) alg_dvd_of_int_iff) + moreover from \J' \ 0\ have "J'' \ 0" + by auto + ultimately have "\J''\ \ \fact (p - 1) ^ n\" + by (intro dvd_imp_le_int) + hence "real_of_int \J''\ \ real_of_int \fact (p - 1) ^ n\" + by linarith + also have "real_of_int \J''\ = norm J'" + by simp + finally show ?thesis + by simp + qed + + text \The standard M-L bound for $I_i(x)$ shows the following inequality:\ + also have "norm J' \ C' * C p ^ n" + proof - + have "norm J' = (\x\Roots'. norm (J x))" + unfolding J'_def prod_norm [symmetric] .. + also have "\ \ (\x\Roots'. \q\P. real_of_int \\ q\ * (\\\Roots q. cmod \ * exp (cmod \) * C p))" + proof (intro prod_mono conjI) + fix x assume x: "x \ Roots'" + show "norm (J x) \ (\q\P. real_of_int \\ q\ * (\\\Roots q. norm \ * exp (norm \) * C p))" + unfolding J_def + proof (intro sum_norm_le) + fix q assume "q \ P" + show "norm (of_int (\ q) * sum (I x) (Roots q)) \ + real_of_int \\ q\ * (\\\Roots q. norm \ * exp (norm \) * C p)" + unfolding norm_mult norm_of_int of_int_abs + proof (intro mult_left_mono sum_norm_le) + fix \ assume "\ \ Roots q" + hence \: "\ \ Roots'" + using \q \ P\ by (auto simp: Roots'_def) + show "norm (I x \) \ norm \ * exp (norm \) * C p" + unfolding I_def + proof (intro lindemann_weierstrass_aux.lindemann_weierstrass_integral_bound) + fix t assume "t \ closed_segment 0 \" + also have "closed_segment 0 \ \ cball 0 R" + using \R \ 0\ R_ge[OF \] by (intro closed_segment_subset) auto + finally have "norm t \ R" by simp + + have norm_diff_le: "norm (t - y) \ 2 * R" if "y \ Roots'" for y + proof - + have "norm (t - y) \ norm t + norm y" + by (meson norm_triangle_ineq4) + also have "\ \ R + R" + by (intro add_mono[OF \norm t \ R\ R_ge] that) + finally show ?thesis by simp + qed + + have "norm (poly (f_poly x) t) = + \real_of_int l\ ^ (n * p) * (\y\Roots'. cmod (t - y) ^ (if y = x then p - 1 else p))" + by (simp add: eval_f x f_def norm_mult norm_power flip: prod_norm) + also have "\ \ \real_of_int l\ ^ (n * p) * (\y\Roots'. (2*R) ^ (if y = x then p - 1 else p))" + by (intro mult_left_mono prod_mono conjI power_mono norm_diff_le) auto + also have "\ = \real_of_int l\^(n*p) * (2^(p-1) * R^(p-1) * (2^p*R^p)^(n-1))" + using x by (subst prod.If_eq) (auto simp: card_Diff_subset n_altdef) + also have "2^(p-1) * R^(p-1) * (2^p*R^p)^(n-1) = (2^((p-1)+p*(n-1))) * (R^((p-1)+p*(n-1)))" + unfolding power_mult power_mult_distrib power_add by (simp add: mult_ac) + also have "(p-1)+p*(n-1) = p*n - 1" + using \n > 0\ \p > 1\ by (cases n) (auto simp: algebra_simps) + also have "2 ^ (p * n - 1) * R ^ (p * n - 1) = (2*R)^(n * p-1)" + unfolding power_mult_distrib by (simp add: mult_ac) + finally show "norm (poly (f_poly x) t) \ C p" + unfolding C_def using \l > 0\ by simp + qed (use \R \ 0\ \l > 0\ in \auto simp: C_def\) + qed auto + qed + qed auto + also have "\ = C' * C p ^ n" + by (simp add: C'_def power_mult_distrib n_altdef flip: sum_distrib_right mult.assoc) + finally show ?thesis . + qed + + text \And with that, we have our inequality:\ + finally show "fact (p - 1) ^ n \ C' * C p ^ n" . + qed + + text \ + Some simple asymptotic estimates show that this is clearly a contradiction, since + the left-hand side grows much faster than the right-hand side and there are infinitely many + sufficiently large primes: + \ + have freq: "frequently prime sequentially" + using frequently_prime_cofinite unfolding cofinite_eq_sequentially . + have ev: "eventually (\p. (\q\P. int p > \\ q\) \ + real p > norm (\\\Roots'. of_int (l^n) * (\\'\Roots'-{\}. (\-\')))) sequentially" + by (intro eventually_ball_finite \finite P\ ballI eventually_conj filterlim_real_sequentially + eventually_compose_filterlim[OF eventually_gt_at_top] filterlim_int_sequentially) + + have "frequently (\p. fact (p - 1) ^ n \ C' * C p ^ n) sequentially" + by (rule frequently_eventually_mono[OF freq ev]) (use ineq in blast) + moreover have "eventually (\p. fact (p - 1) ^ n > C' * C p ^ n) sequentially" + proof (cases "R = 0") + case True + have "eventually (\p. p * n > 1) at_top" using \n > 0\ + by (intro eventually_compose_filterlim[OF eventually_gt_at_top] mult_nat_right_at_top) + thus ?thesis + by eventually_elim (use \n > 0\ True in \auto simp: C_def power_0_left mult_ac\) + next + case False + hence "R > 0" + using \R \ 0\ by auto + define D :: real where "D = (2 * R * \real_of_int l\) ^ n" + have "D > 0" + using \R > 0\ \l > 0\ unfolding D_def by (intro zero_less_power) auto + + have "(\p. C' * C p ^ n) \ O(\p. C p ^ n)" + by simp + also have "(\p. C p ^ n) \ O(\p. ((2 * R * l) ^ (n * p)) ^ n)" + proof (rule landau_o.big_power[OF bigthetaD1]) + have np: "eventually (\p. p * n > 0) at_top" using \n > 0\ + by (intro eventually_compose_filterlim[OF eventually_gt_at_top] mult_nat_right_at_top) + have "eventually (\p. (2 * R) * C p = (2 * R * l) ^ (n * p)) at_top" + using np + proof eventually_elim + case (elim p) + have "2 * R * C p = l ^ (n * p) * (2 * R) ^ (Suc (n * p - 1))" + by (simp add: C_def algebra_simps) + also have "Suc (n * p - 1) = n * p" + using elim by auto + finally show ?case + by (simp add: algebra_simps) + qed + hence "(\p. (2 * R) * C p) \ \(\p. (2 * R * l) ^ (n * p))" + by (intro bigthetaI_cong) + thus "C \ \(\p. (2 * R * l) ^ (n * p))" + using \R > 0\ by simp + qed + also have "\ = O(\p. (D ^ p) ^ n)" + using \l > 0\ by (simp flip: power_mult add: power2_eq_square mult_ac D_def) + also have "(\p. (D ^ p) ^ n) \ o(\p. fact (p - 1) ^ n)" + proof (intro landau_o.small_power) + have "eventually (\p. D ^ p = D * D ^ (p - 1)) at_top" + using eventually_gt_at_top[of 0] + by eventually_elim (use \D > 0\ in \auto simp flip: power_Suc\) + hence "(\p. D ^ p) \ \(\p. D * D ^ (p - 1))" + by (intro bigthetaI_cong) + hence "(\p. D ^ p) \ \(\p. D ^ (p - 1))" + using \D > 0\ by simp + also have "(\p. D ^ (p - 1)) \ o(\p. fact (p - 1))" + by (intro smalloI_tendsto[OF filterlim_compose[OF power_over_fact_tendsto_0]] + filterlim_minus_nat_at_top) auto + finally show "(\p. D ^ p) \ o(\x. fact (x - 1))" . + qed fact+ + finally have smallo: "(\p. C' * C p ^ n) \ o(\p. fact (p - 1) ^ n)" . + have "eventually (\p. \C' * C p ^ n\ \ 1/2 * fact (p - 1) ^ n) at_top" + using landau_o.smallD[OF smallo, of "1/2"] by simp + thus "eventually (\p. C' * C p ^ n < fact (p - 1) ^ n) at_top" + proof eventually_elim + case (elim p) + have "C' * C p ^ n \ \C' * C p ^ n\" + by simp + also have "\ \ 1/2 * fact (p - 1) ^ n" + by fact + also have "\ < fact (p - 1) ^ n" + by simp + finally show ?case . + qed + qed + ultimately have "frequently (\p::nat. False) sequentially" + by (rule frequently_eventually_mono) auto + thus False + by simp +qed + + +subsection \Removing the restriction of full sets of conjugates\ + +text \ + We will now remove the restriction that the $\alpha_i$ must occur in full sets of conjugates + by multiplying the equality with all permutations of roots. +\ +lemma Hermite_Lindemann_aux2: + fixes X :: "complex set" and \ :: "complex \ int" + assumes "finite X" + assumes nz: "\x. x \ X \ \ x \ 0" + assumes alg: "\x. x \ X \ algebraic x" + assumes sum0: "(\x\X. of_int (\ x) * exp x) = 0" + shows "X = {}" +proof (rule ccontr) + assume "X \ {}" + note [intro] = \finite X\ + + text \ + Let \P\ be the smallest integer polynomial whose roots are a superset of \X\: + \ + define P :: "int poly" where "P = \(min_int_poly ` X)" + define Roots :: "complex set" where "Roots = {x. ipoly P x = 0}" + have [simp]: "P \ 0" + using \finite X\ by (auto simp: P_def) + have [intro]: "finite Roots" + unfolding Roots_def by (intro poly_roots_finite) auto + + have "X \ Roots" + proof safe + fix x assume "x \ X" + hence "ipoly (min_int_poly x) x = 0" + by (intro ipoly_min_int_poly alg) + thus "x \ Roots" + using \finite X\ \x \ X\ + by (auto simp: Roots_def P_def of_int_poly_hom.hom_prod poly_prod) + qed + + have "squarefree (of_int_poly P :: complex poly)" + unfolding P_def of_int_poly_hom.hom_prod + proof (rule squarefree_prod_coprime; safe) + fix x assume "x \ X" + thus "squarefree (of_int_poly (min_int_poly x) :: complex poly)" + by (intro squarefree_of_int_polyI) auto + next + fix x y assume xy: "x \ X" "y \ X" "min_int_poly x \ min_int_poly y" + thus "Rings.coprime (of_int_poly (min_int_poly x)) (of_int_poly (min_int_poly y) :: complex poly)" + by (intro coprime_of_int_polyI[OF primes_coprime]) auto + qed + + text \ + Since we will need a numbering of these roots, we obtain one: + \ + define n where "n = card Roots" + obtain Root where Root: "bij_betw Root {..finite Roots\] unfolding n_def atLeast0LessThan by metis + define unRoot :: "complex \ nat" where "unRoot = inv_into {.. Roots" for x + unfolding unRoot_def using Root that by (subst f_inv_into_f) (auto simp: bij_betw_def) + have [simp, intro]: "Root i \ Roots" if "i < n" for i + using Root that by (auto simp: bij_betw_def) + have [simp, intro]: "unRoot x < n" if "x \ Roots" for x + using unRoot that by (auto simp: bij_betw_def) + + text \ + We will also need to convert between permutations of natural numbers less than \n\ and + permutations of the roots: + \ + define convert_perm :: "(nat \ nat) \ (complex \ complex)" where + "convert_perm = (\\ x. if x \ Roots then Root (\ (unRoot x)) else x)" + have bij_convert: "bij_betw convert_perm {\. \ permutes {... \ permutes Roots}" + using bij_betw_permutations[OF Root] unfolding convert_perm_def unRoot_def . + have permutes_convert_perm [intro]: "convert_perm \ permutes Roots" if "\ permutes {.. + using that bij_convert unfolding bij_betw_def by blast + have convert_perm_compose: "convert_perm (\ \ \) = convert_perm \ \ convert_perm \" + if "\ permutes {.. permutes {.. \ + proof (intro ext) + fix x show "convert_perm (\ \ \) x = (convert_perm \ \ convert_perm \) x" + proof (cases "x \ Roots") + case True + thus ?thesis + using permutes_in_image[OF that(2), of "unRoot x"] + by (auto simp: convert_perm_def bij_betw_def) + qed (auto simp: convert_perm_def) + qed + + text \ + We extend the coefficient vector to the new roots by setting their coefficients to 0: + \ + define \' where "\' = (\x. if x \ X then \ x else 0)" + + text \ + We now define the set of all permutations of our roots: + \ + define perms where "perms = {\. \ permutes Roots}" + have [intro]: "finite perms" + unfolding perms_def by (rule finite_permutations) auto + have [simp]: "card perms = fact n" + unfolding perms_def n_def by (intro card_permutations) auto + + text \ + The following is the set of all \n!\-tuples of roots, disregarding permutation of components. + In other words: all multisets of roots with size \n!\. + \ + define Roots_ms :: "complex multiset set" where + "Roots_ms = {X. set_mset X \ Roots \ size X = fact n}" + have [intro]: "finite Roots_ms" + unfolding Roots_ms_def by (rule finite_multisets_of_size) auto + + text \ + Next, the following is the set of \n!\-tuples whose entries are precisely the multiset \X\: + \ + define tuples :: "complex multiset \ ((complex \ complex) \ complex) set" where + "tuples = (\X. {f\perms \\<^sub>E Roots. image_mset f (mset_set perms) = X})" + have fin_tuples [intro]: "finite (tuples X)" for X + unfolding tuples_def by (rule finite_subset[of _ "perms \\<^sub>E Roots", OF _ finite_PiE]) auto + define tuples' :: "(complex multiset \ ((complex \ complex) \ complex)) set" where + "tuples' = (SIGMA X:Roots_ms. tuples X)" + + text \ + The following shows that our \<^term>\tuples\ definition is stable under permutation of + the roots. + \ + have bij_convert': "bij_betw (\f. f \ (\g. \ \ g)) (tuples X) (tuples X)" + if \: "\ permutes Roots" for \ X + proof (rule bij_betwI) + have *: "(\f. f \ (\) \) \ tuples X \ tuples X" if \: "\ permutes Roots" for \ + proof + fix f assume f: "f \ tuples X" + show "f \ (\) \ \ tuples X" + unfolding tuples_def + proof safe + fix \' + assume \': "\' \ perms" + show "(f \ (\) \) \' \ Roots" + using permutes_compose[OF _ \, of \'] \ \' f by (auto simp: perms_def tuples_def) + next + fix \' + assume \': "\' \ perms" + have "\(\ \ \') permutes Roots" + proof + assume "(\ \ \') permutes Roots" + hence "inv_into UNIV \ \ (\ \ \') permutes Roots" + by (rule permutes_compose) (use permutes_inv[OF \] in simp_all) + also have "inv_into UNIV \ \ (\ \ \') = \'" + by (auto simp: fun_eq_iff permutes_inverses[OF \]) + finally show False using \' by (simp add: perms_def) + qed + thus "(f \ (\) \) \' = undefined" + using f by (auto simp: perms_def tuples_def) + next + have "image_mset (f \ (\) \) (mset_set perms) = + image_mset f (image_mset ((\) \) (mset_set perms))" + by (rule multiset.map_comp [symmetric]) + also have "image_mset ((\) \) (mset_set perms) = mset_set perms" + using bij_betw_permutes_compose_left[OF \] + by (subst image_mset_mset_set) (auto simp: bij_betw_def perms_def) + also have "image_mset f \ = X" + using f by (auto simp: tuples_def) + finally show "image_mset (f \ (\) \) (mset_set perms) = X" . + qed + qed + + show "(\f. f \ (\) \) \ tuples X \ tuples X" + by (rule *) fact + show "(\f. f \ (\) (inv_into UNIV \)) \ tuples X \ tuples X" + by (intro * permutes_inv) fact + show "f \ (\) \ \ (\) (inv_into UNIV \) = f" if "f \ tuples X" for f + by (auto simp: fun_eq_iff o_def permutes_inverses[OF \]) + show "f \ (\) (inv_into UNIV \) \ (\) \ = f" if "f \ tuples X" for f + by (auto simp: fun_eq_iff o_def permutes_inverses[OF \]) + qed + + text \ + Next, we define the multiset of of possible exponents that we can get for a given + \n!\-multiset of roots, + \ + define R :: "complex multiset \ complex multiset" where + "R = (\X. image_mset (\f. \\\perms. \ (f \)) (mset_set (tuples X)))" + + text \ + We show that, for each such multiset, there is a content-free integer polynomial that has + exactly these exponents as roots. This shows that they form a full set of conjugates (but + note this polynomial is not necessarily squarefree). + + The proof is yet another application of the fundamental theorem of symmetric polynomials. + \ + obtain Q :: "complex multiset \ int poly" + where Q: "\X. X \ Roots_ms \ poly_roots (of_int_poly (Q X)) = R X" + "\X. X \ Roots_ms \ content (Q X) = 1" + proof - + { + fix X :: "complex multiset" + assume X: "X \ Roots_ms" + define Q :: "complex poly mpoly" where + "Q = (\f\tuples X. Const [:0, 1:] - + (\\ | \ permutes {.. (unRoot (f (convert_perm \))))))" + define Q1 where "Q1 = (\f\tuples X. [:- (\\ | \ permutes Roots. \ (f \)), 1:])" + define ratpolys :: "complex poly set" where "ratpolys = {p. \i. poly.coeff p i \ \}" + + have "insertion (\x. [:Root x:]) Q \ ratpolys" + proof (rule symmetric_poly_of_roots_in_subring[where l = "\x. [:x:]"]) + show "ring_closed ratpolys" + unfolding ratpolys_def by standard (auto intro: coeff_mult_semiring_closed) + then interpret ratpolys: ring_closed ratpolys . + have "pCons 0 1 \ ratpolys " + by (auto simp: ratpolys_def coeff_pCons split: nat.splits) + thus "\m. MPoly_Type.coeff Q m \ ratpolys" + unfolding Q_def + by (intro allI ratpolys.coeff_prod_closed) + (auto intro!: ratpolys.minus_closed ratpolys.sum_closed ratpolys.uminus_closed simp: coeff_Var mpoly_coeff_Const when_def) + next + show "ring_homomorphism (\x::complex. [:x:])" .. + next + have "\ (unRoot (f (convert_perm \))) < n" if "f \ tuples X" "\ permutes {.. + proof - + have "convert_perm \ \ perms" + using bij_convert that(2) by (auto simp: bij_betw_def perms_def) + hence "f (convert_perm \) \ Roots" + using that by (auto simp: tuples_def) + thus ?thesis + using permutes_in_image[OF that(2)] by simp + qed + thus "vars Q \ {.. ratpolys" + by (auto simp: ratpolys_def coeff_pCons lc_def split: nat.splits) + show "\i. [:poly.coeff (of_int_poly P) i:] \ ratpolys" + by (auto simp: ratpolys_def coeff_pCons split: nat.splits) + have "lc \ 0" + by (auto simp: lc_def) + thus "[:inverse lc:] * [:lc:] = 1" + by auto + have "rsquarefree (of_int_poly P :: complex poly)" + using \squarefree (of_int_poly P :: complex poly)\ by (intro squarefree_imp_rsquarefree) + hence "of_int_poly P = Polynomial.smult lc (\x\Roots. [:-x, 1:])" + unfolding lc_def Roots_def of_int_hom.hom_lead_coeff[symmetric] + by (rule complex_poly_decompose_rsquarefree [symmetric]) + also have "(\x\Roots. [:-x, 1:]) = (\ii assume \: "\ permutes {.. Q = (\f\tuples X. Const (pCons 0 1) - (\ \ | \ permutes {.. \ \) (unRoot (f (convert_perm \))))))" + by (simp add: Q_def permutes_bij[OF \]) + also have "\ = (\f\tuples X. Const (pCons 0 1) - (\ \ | \ permutes {.. \ \) (unRoot ((f \ (\\. convert_perm \ \ \)) (convert_perm \))))))" + using \ by (intro prod.reindex_bij_betw [OF bij_convert', symmetric]) auto + also have "\ = Q" + unfolding Q_def + proof (rule prod.cong, goal_cases) + case (2 f) + have "(\ \ | \ permutes {.. \ \) (unRoot ((f \ (\\. convert_perm \ \ \)) (convert_perm \))))) = + (\ \ | \ permutes {.. \ \) (unRoot (f (convert_perm (\ \ \))))))" + using \ by (intro sum.cong refl, subst convert_perm_compose) simp_all + also have "\ = (\ \ | \ permutes {.. (unRoot (f (convert_perm \)))))" + using \ by (rule setum_permutations_compose_left [symmetric]) + finally show ?case by simp + qed auto + finally show "mpoly_map_vars \ Q = Q" . + qed + qed auto + also have "insertion (\x. [:Root x:]) Q = Q1" + unfolding Q_def Q1_def insertion_prod insertion_sum insertion_diff insertion_Const insertion_Var + proof (intro prod.cong, goal_cases) + case f: (2 f) + have "(\\ | \ permutes {.. (unRoot (f (convert_perm \)))):]) = + (\\ | \ permutes {.. (f (convert_perm \)):])" + proof (rule sum.cong, goal_cases) + case (2 \) + have "convert_perm \ permutes Roots" + using bij_convert 2 by (auto simp: bij_betw_def) + hence "f (convert_perm \) \ Roots" + using f by (auto simp: tuples_def perms_def) + thus ?case by (simp add: convert_perm_def) + qed simp_all + also have "\ = (\\ | \ permutes Roots. [:\ (f \):])" + by (rule sum.reindex_bij_betw[OF bij_convert]) + finally show ?case + by (simp flip: pCons_one coeff_lift_hom.hom_sum) + qed simp_all + finally have "Q1 \ ratpolys" + by auto + then obtain Q2 :: "rat poly" where Q2: "Q1 = map_poly of_rat Q2" + unfolding ratpolys_def using ratpolyE[of Q1] by blast + + have "Q1 \ 0" + unfolding Q1_def using fin_tuples[of X] by auto + with Q2 have "Q2 \ 0" + by auto + obtain Q3 :: "int poly" and lc :: rat + where Q3: "Q2 = Polynomial.smult lc (of_int_poly Q3)" and "lc > 0" and "content Q3 = 1" + using rat_to_normalized_int_poly_exists[OF \Q2 \ 0\] by metis + + have "poly_roots (of_int_poly Q3) = poly_roots (map_poly (of_rat \ of_int) Q3)" + by simp + also have "map_poly (of_rat \ of_int) Q3 = map_poly of_rat (map_poly of_int Q3)" + by (subst map_poly_map_poly) auto + also have "poly_roots \ = poly_roots (Polynomial.smult (of_rat lc) \)" + using \lc > 0\ by simp + also have "Polynomial.smult (of_rat lc) (map_poly of_rat (map_poly of_int Q3)) = + map_poly of_rat (Polynomial.smult lc (map_poly of_int Q3))" + by (simp add: of_rat_hom.map_poly_hom_smult) + also have "\ = Q1" + by (simp only: Q3 [symmetric] Q2 [symmetric]) + also have "poly_roots Q1 = R X" + unfolding Q1_def + by (subst poly_roots_prod, force, subst poly_roots_linear) + (auto simp: R_def perms_def sum_mset_image_mset_singleton sum_unfold_sum_mset) + finally have "\Q. poly_roots (of_int_poly Q) = R X \ content Q = 1" + using \content Q3 = 1\ by metis + } + hence "\Q. \X\Roots_ms. poly_roots (of_int_poly (Q X)) = R X \ content (Q X) = 1" + by metis + thus ?thesis using that by metis + qed + + text \ + We can now collect all the $e^{\sum \alpha_i}$ that happen to be equal and let the following + be their coefficients: + \ + define \'' :: "int poly \ int" + where "\'' = (\q. \X\Roots_ms. int (count (prime_factorization (Q X)) q) * (\x\#X. \' x))" + have supp_\'': "{q. \'' q \ 0} \ (\X\Roots_ms. prime_factors (Q X))" + unfolding \''_def using sum.not_neutral_contains_not_neutral by fastforce + + text \ + We have to prove that \\''\ is not zero everywhere. We do this by selecting the nonzero term + with the maximal exponent (w.r.t. the lexicographic ordering on the complex numbers) in every + factor of the product and show that there is no other summand corresponding to these, so + that their non-zero coefficient cannot get cancelled. + \ + have "{q. \'' q \ 0} \ {}" + proof - + define f where "f = restrict (\\. inv_into UNIV \ (complex_lex.Max (\ ` X))) perms" + have f: "f \ perms \ X" + proof + fix \ assume \: "\ \ perms" + have "complex_lex.Max (\ ` X) \ \ ` X" + using \X \ {}\ by (intro complex_lex.Max_in finite_imageI) auto + thus "f \ \ X" + using \ by (auto simp: f_def permutes_inverses[of \ Roots] perms_def) + qed + hence f': "f \ perms \\<^sub>E Roots" + using \X \ Roots\ by (auto simp: f_def PiE_def) + + define Y where "Y = image_mset f (mset_set perms)" + have "Y \ Roots_ms" using f' \finite perms\ + by (auto simp: Roots_ms_def Y_def) + + have "(\\\perms. \ (f \)) \# R Y" + proof - + from f' have "f \ tuples Y" + unfolding tuples_def Y_def by simp + thus ?thesis + unfolding R_def using fin_tuples[of Y] by auto + qed + also have "R Y = poly_roots (of_int_poly (Q Y))" + by (rule Q(1) [symmetric]) fact + also have "\ = (\p\#prime_factorization (Q Y). poly_roots (of_int_poly p))" + by (rule poly_roots_of_int_conv_sum_prime_factors) + finally obtain q where q: "q \ prime_factors (Q Y)" "(\\\perms. \ (f \)) \# poly_roots (of_int_poly q)" + by auto + + have "\'' q = (\X\{Y}. int (count (prime_factorization (Q X)) q) * prod_mset (image_mset \' X))" + unfolding \''_def + proof (intro sum.mono_neutral_right ballI) + fix Y' assume Y': "Y' \ Roots_ms - {Y}" + show "int (count (prime_factorization (Q Y')) q) * \\<^sub># (image_mset \' Y') = 0" + proof (cases "set_mset Y' \ X") + case Y'_subset: True + have "q \ prime_factors (Q Y')" + proof + assume q': "q \ prime_factors (Q Y')" + have "poly_roots (of_int_poly q :: complex poly) \# + poly_roots (of_int_poly (Q Y'))" + using q' by (intro dvd_imp_poly_roots_subset of_int_poly_hom.hom_dvd) auto + with q(2) have "(\\\perms. \ (f \)) \# poly_roots (of_int_poly (Q Y'))" + by (meson mset_subset_eqD) + also have "poly_roots (of_int_poly (Q Y')) = R Y'" + using Q(1)[of Y'] Y' by auto + finally obtain g where g: "g \ tuples Y'" "(\\\perms. \ (f \)) = (\\\perms. \ (g \))" + unfolding R_def using fin_tuples[of Y'] by auto + + moreover have "(\\\perms. \ (g \)) <\<^sub>\ (\\\perms. \ (f \))" + proof (rule sum_strict_mono_ex1_complex_lex) + show le: "\\\perms. \ (g \) \\<^sub>\ \ (f \)" + proof + fix \ assume \: "\ \ perms" + hence \': "\ permutes Roots" + by (auto simp: perms_def) + have "image_mset g (mset_set perms) = Y'" + using g by (auto simp: tuples_def) + also have "set_mset \ \ X" + by fact + finally have "g ` perms \ X" + using \finite perms\ by auto + hence "\ (g \) \\<^sub>\ complex_lex.Max (\ ` X)" + using \finite perms\ \ + by (intro complex_lex.Max.coboundedI finite_imageI imageI) + (auto simp: tuples_def) + also have "\ = \ (f \)" + using \ by (simp add: f_def permutes_inverses[OF \']) + finally show "\ (g \) \\<^sub>\ \ (f \)" . + qed + + have "image_mset g (mset_set perms) \ image_mset f (mset_set perms)" + using Y' g by (auto simp: tuples_def Y_def) + then obtain \ where \: "\ \# mset_set perms" "g \ \ f \" + by (meson multiset.map_cong) + have "\ permutes Roots" + using \ \finite perms\ by (auto simp: perms_def) + have "\ (g \) \ \ (f \)" + using permutes_inj[OF \\ permutes Roots\] \ by (auto simp: inj_def) + moreover have "\ (g \) \\<^sub>\ \ (f \)" + using le \ \finite perms\ by auto + ultimately have "\ (g \) <\<^sub>\ \ (f \)" + by simp + thus "\\\perms. \ (g \) <\<^sub>\ \ (f \)" + using \ \finite perms\ by auto + qed (use \finite perms\ in simp_all) + ultimately show False by simp + qed + thus ?thesis by auto + qed (auto simp: \'_def) + qed (use \Y \ Roots_ms\ in auto) + also have "\ = int (count (prime_factorization (Q Y)) q) * prod_mset (image_mset \' Y)" + by simp + also have "\ \ 0" + using q nz \finite X\ \X \ {}\ \finite perms\ f by (auto simp: \'_def Y_def) + finally show "{q. \'' q \ 0} \ {}" + by auto + qed + + text \ + We are now ready for the final push: we start with the original sum that we know to be zero, + multiply it with the other permutations, and then multiply out the sum. + \ + have "0 = (\x\X. \ x * exp x)" + using sum0 .. + also have "\ = (\x\Roots. \' x * exp x)" + by (intro sum.mono_neutral_cong_left \X \ Roots\) (auto simp: \'_def) + also have "\ dvd (\\\perms. \x\Roots. \' x * exp (\ x))" + by (rule dvd_prodI[OF \finite perms\]) + (use permutes_id[of Roots] in \simp_all add: id_def perms_def\) + also have "\ = (\f\perms \\<^sub>E Roots. \\\perms. \' (f \) * exp (\ (f \)))" + by (rule prod_sum_PiE) auto + also have "\ = (\f\perms \\<^sub>E Roots. (\\\perms. \' (f \)) * exp (\\\perms. \ (f \)))" + using \finite perms\ by (simp add: prod.distrib exp_sum) + also have "\ = (\(X,f)\tuples'. (\\\perms. \' (f \)) * exp (\\\perms. \ (f \)))" + using \finite perms\ + by (intro sum.reindex_bij_witness[of _ snd "\f. (image_mset f (mset_set perms), f)"]) + (auto simp: tuples'_def tuples_def Roots_ms_def PiE_def Pi_def) + also have "\ = (\(X,f)\tuples'. (\x\#X. \' x) * exp (\\\perms. \ (f \)))" + proof (safe intro!: sum.cong) + fix X :: "complex multiset" and f :: "(complex \ complex) \ complex" + assume "(X, f) \ tuples'" + hence X: "X \ Roots_ms" "X = image_mset f (mset_set perms)" and f: "f \ perms \\<^sub>E Roots" + by (auto simp: tuples'_def tuples_def) + have "(\\\perms. \' (f \)) = (\\\#mset_set perms. \' (f \))" + by (meson prod_unfold_prod_mset) + also have "\ = (\x\#X. \' x)" + unfolding X(2) by (simp add: multiset.map_comp o_def) + finally show "(\\\perms. \' (f \)) * exp (\\\perms. \ (f \)) = + (\x\#X. \' x) * exp (\\\perms. \ (f \))" by simp + qed + also have "\ = (\X\Roots_ms. \f\tuples X. (\x\#X. \' x) * exp (\\\perms. \ (f \)))" + unfolding tuples'_def by (intro sum.Sigma [symmetric]) auto + also have "\ = (\X\Roots_ms. of_int (\x\#X. \' x) * (\f\tuples X. exp (\\\perms. \ (f \))))" + by (simp add: sum_distrib_left) + also have "\ = (\X\Roots_ms. of_int (\x\#X. \' x) * (\x\#R X. exp x))" + by (simp only: R_def multiset.map_comp o_def sum_unfold_sum_mset) + also have "\ = (\X\Roots_ms. of_int (\x\#X. \' x) * (\x\#poly_roots (of_int_poly (Q X)). exp x))" + by (intro sum.cong) (simp_all flip: Q) + + text \ + Our problem now is that the polynomials \Q X\ can still contain multiple roots and that their + roots might not be disjoint. We therefore split them all into irreducible factors and collect + equal terms. + \ + also have "\ = (\X\Roots_ms. (\p. of_int (int (count (prime_factorization (Q X)) p) * + (\x\#X. \' x)) * (\x | ipoly p x = 0. exp x)))" + proof (rule sum.cong, goal_cases) + case (2 X) + have "(\x\#poly_roots (of_int_poly (Q X) :: complex poly). exp x) = + (\x \# (\p\#prime_factorization (Q X). poly_roots (of_int_poly p)). exp x)" + by (subst poly_roots_of_int_conv_sum_prime_factors) (rule refl) + also have "\ = (\p\#prime_factorization (Q X). \x\#poly_roots (of_int_poly p). exp x)" + by (rule sum_mset_image_mset_sum_mset_image_mset) + also have "rsquarefree (of_int_poly p :: complex poly)" if "p \ prime_factors (Q X)" for p + proof (rule irreducible_imp_rsquarefree_of_int_poly) + have "prime p" + using that by auto + thus "irreducible p" + by blast + next + show "Polynomial.degree p > 0" + by (intro content_1_imp_nonconstant_prime_factors[OF Q(2) that] 2) + qed + hence "(\p\#prime_factorization (Q X). \x\#poly_roots (of_int_poly p). exp x) = + (\p\#prime_factorization (Q X). \x | ipoly p x = 0. exp (x :: complex))" + unfolding sum_unfold_sum_mset + by (intro arg_cong[of _ _ sum_mset] image_mset_cong sum.cong refl, + subst rsquarefree_poly_roots_eq) auto + also have "\ = (\p. count (prime_factorization (Q X)) p * (\x | ipoly p x = 0. exp (x :: complex)))" + by (rule sum_mset_conv_Sum_any) + also have "of_int (\x\#X. \' x) * \ = + (\p. of_int (int (count (prime_factorization (Q X)) p) * (\x\#X. \' x)) * (\x | ipoly p x = 0. exp x))" + by (subst Sum_any_right_distrib) (auto simp: mult_ac) + finally show ?case by simp + qed auto + also have "\ = (\q. of_int (\'' q) * (\x | ipoly q x = 0. exp x))" + unfolding \''_def of_int_sum + by (subst Sum_any_sum_swap [symmetric]) (auto simp: sum_distrib_right) + also have "\ = (\q | \'' q \ 0. of_int (\'' q) * (\x | ipoly q x = 0. exp x))" + by (intro Sum_any.expand_superset finite_subset[OF supp_\'']) auto + finally have "(\q | \'' q \ 0. of_int (\'' q) * (\x | ipoly q x = 0. exp (x :: complex))) = 0" + by simp + + text \ + We are now in the situation of our the specialised Hermite--Lindemann Theorem we proved + earlier and can easily derive a contradiction. + \ + moreover have "(\q | \'' q \ 0. of_int (\'' q) * (\x | ipoly q x = 0. exp (x :: complex))) \ 0" + proof (rule Hermite_Lindemann_aux1) + show "finite {q. \'' q \ 0}" + by (rule finite_subset[OF supp_\'']) auto + next + show "pairwise Rings.coprime {q. \'' q \ 0}" + proof (rule pairwiseI, clarify) + fix p q assume pq: "p \ q" "\'' p \ 0" "\'' q \ 0" + hence "prime p" "prime q" + using supp_\'' Q(2) by auto + with pq show "Rings.coprime p q" + by (simp add: primes_coprime) + qed + next + fix q :: "int poly" + assume q: "q \ {q. \'' q \ 0}" + also note supp_\'' + finally obtain X where X: "X \ Roots_ms" "q \ prime_factors (Q X)" + by blast + show "irreducible q" + using X by (intro prime_elem_imp_irreducible prime_imp_prime_elem) auto + show "Polynomial.degree q > 0" using X + by (intro content_1_imp_nonconstant_prime_factors[OF Q(2)[of X]]) + qed (use \{x. \'' x \ 0} \ {}\ in auto) + + ultimately show False by contradiction +qed + + +subsection \Removing the restriction to integer coefficients\ + +text \ + Next, we weaken the restriction that the $\beta_i$ must be integers to the restriction + that they must be rationals. This is done simply by multiplying with the least common multiple + of the demoninators. +\ +lemma Hermite_Lindemann_aux3: + fixes X :: "complex set" and \ :: "complex \ rat" + assumes "finite X" + assumes nz: "\x. x \ X \ \ x \ 0" + assumes alg: "\x. x \ X \ algebraic x" + assumes sum0: "(\x\X. of_rat (\ x) * exp x) = 0" + shows "X = {}" +proof - + define l :: int where "l = Lcm ((snd \ quotient_of \ \) ` X)" + have [simp]: "snd (quotient_of r) \ 0" for r + using quotient_of_denom_pos'[of r] by simp + have [simp]: "l \ 0" + using \finite X\ by (auto simp: l_def Lcm_0_iff) + + have "of_int l * \ x \ \" if "x \ X" for x + proof - + define a b where "a = fst (quotient_of (\ x))" and "b = snd (quotient_of (\ x))" + have "b > 0" + using quotient_of_denom_pos'[of "\ x"] by (auto simp: b_def) + have "\ x = of_int a / of_int b" + by (intro quotient_of_div) (auto simp: a_def b_def) + also have "of_int l * \ = of_int (l * a) / of_int b" + using \b > 0\ by (simp add: field_simps) + also have "\ \ \" using that + by (intro of_int_divide_in_Ints) (auto simp: l_def b_def) + finally show ?thesis . + qed + hence "\x\X. \n. of_int n = of_int l * \ x" + using Ints_cases by metis + then obtain \' where \': "of_int (\' x) = of_int l * \ x" if "x \ X" for x + by metis + + show ?thesis + proof (rule Hermite_Lindemann_aux2) + have "0 = of_int l * (\x\X. of_rat (\ x) * exp x :: complex)" + by (simp add: sum0) + also have "\ = (\x\X. of_int (\' x) * exp x)" + unfolding sum_distrib_left + proof (rule sum.cong, goal_cases) + case (2 x) + have "of_int l * of_rat (\ x) = of_rat (of_int l * \ x)" + by (simp add: of_rat_mult) + also have "of_int l * \ x = of_int (\' x)" + using 2 by (rule \' [symmetric]) + finally show ?case by (simp add: mult_ac) + qed simp_all + finally show "\ = 0" .. + next + fix x assume "x \ X" + hence "of_int (\' x) \ (0 :: rat)" using nz + by (subst \') auto + thus "\' x \ 0" + by auto + qed (use alg \finite X\ in auto) +qed + +text \ + Next, we weaken the restriction that the $\beta_i$ must be rational to them being algebraic. + Similarly to before, this is done by multiplying over all possible permutations of the $\beta_i$ + (in some sense) to introduce more symmetry, from which it then follows by the fundamental theorem + of symmetric polynomials that the resulting coefficients are rational. +\ +lemma Hermite_Lindemann_aux4: + fixes \ :: "complex \ complex" + assumes [intro]: "finite X" + assumes alg1: "\x. x \ X \ algebraic x" + assumes alg2: "\x. x \ X \ algebraic (\ x)" + assumes nz: "\x. x \ X \ \ x \ 0" + assumes sum0: "(\x\X. \ x * exp x) = 0" + shows "X = {}" +proof (rule ccontr) + assume X: "X \ {}" + note [intro!] = finite_PiE + + text \ + We now take more or less the same approach as before, except that now we find a polynomial + that has all of the conjugates of the coefficients \\\ as roots. Note that this is a slight + deviation from Baker's proof, who picks one polynomial for each \\\ independently. I did it + this way because, as Bernard~\cite{bernard} observed, it makes the proof a bit easier. + \ + define P :: "int poly" where "P = \((min_int_poly \ \) ` X)" + define Roots :: "complex set" where "Roots = {x. ipoly P x = 0}" + have "0 \ Roots" using \finite X\ alg2 nz + by (auto simp: Roots_def P_def poly_prod) + have [simp]: "P \ 0" + using \finite X\ by (auto simp: P_def) + have [intro]: "finite Roots" + unfolding Roots_def by (intro poly_roots_finite) auto + + have "\ ` X \ Roots" + proof safe + fix x assume "x \ X" + hence "ipoly (min_int_poly (\ x)) (\ x) = 0" + by (intro ipoly_min_int_poly alg2) + thus "\ x \ Roots" + using \finite X\ \x \ X\ + by (auto simp: Roots_def P_def of_int_poly_hom.hom_prod poly_prod) + qed + + have "squarefree (of_int_poly P :: complex poly)" + unfolding P_def of_int_poly_hom.hom_prod o_def + proof (rule squarefree_prod_coprime; safe) + fix x assume "x \ X" + thus "squarefree (of_int_poly (min_int_poly (\ x)) :: complex poly)" + by (intro squarefree_of_int_polyI) auto + next + fix x y assume xy: "x \ X" "y \ X" "min_int_poly (\ x) \ min_int_poly (\ y)" + thus "Rings.coprime (of_int_poly (min_int_poly (\ x))) + (of_int_poly (min_int_poly (\ y)) :: complex poly)" + by (intro coprime_of_int_polyI[OF primes_coprime]) auto + qed + + define n where "n = card Roots" + define m where "m = card X" + have "Roots \ {}" + using \\ ` X \ Roots\ \X \ {}\ by auto + hence "n > 0" "m > 0" + using \finite Roots\ \finite X\ \X \ {}\ by (auto simp: n_def m_def) + have fin1 [simp]: "finite (X \\<^sub>E Roots)" + by auto + have [simp]: "card (X \\<^sub>E Roots) = n ^ m" + by (subst card_PiE) (auto simp: m_def n_def) + + text \ + We again find a bijection between the roots and the natural numbers less than \n\: + \ + obtain Root where Root: "bij_betw Root {..finite Roots\] unfolding n_def atLeast0LessThan by metis + define unRoot :: "complex \ nat" where "unRoot = inv_into {.. Roots" for x + unfolding unRoot_def using Root that by (subst f_inv_into_f) (auto simp: bij_betw_def) + have [simp, intro]: "Root i \ Roots" if "i < n" for i + using Root that by (auto simp: bij_betw_def) + have [simp, intro]: "unRoot x < n" if "x \ Roots" for x + using unRoot that by (auto simp: bij_betw_def) + + text \ + And we again define the set of multisets and tuples that we will get in the expanded product. + \ + define Roots_ms :: "complex multiset set" where + "Roots_ms = {Y. set_mset Y \ X \ size Y = n ^ m}" + have [intro]: "finite Roots_ms" + unfolding Roots_ms_def by (rule finite_multisets_of_size) auto + define tuples :: "complex multiset \ ((complex \ complex) \ complex) set" + where "tuples = (\Y. {f\(X \\<^sub>E Roots) \\<^sub>E X. image_mset f (mset_set (X \\<^sub>E Roots)) = Y})" + have [intro]: "finite (tuples Y)" for Y + unfolding tuples_def by (rule finite_subset[of _ "(X \\<^sub>E Roots) \\<^sub>E X"]) auto + + text \ + We will also need to convert permutations over the natural and over the roots again. + \ + define convert_perm :: "(nat \ nat) \ (complex \ complex)" where + "convert_perm = (\\ x. if x \ Roots then Root (\ (unRoot x)) else x)" + have bij_convert: "bij_betw convert_perm {\. \ permutes {... \ permutes Roots}" + using bij_betw_permutations[OF Root] unfolding convert_perm_def unRoot_def . + have permutes_convert_perm [intro]: "convert_perm \ permutes Roots" if "\ permutes {.. + using that bij_convert unfolding bij_betw_def by blast + + text \ + We also need a small lemma showing that our tuples are stable under permutation of the roots. + \ + have bij_betw_compose_perm: + "bij_betw (\f. restrict (\g. f (restrict (\ \ g) X)) (X \\<^sub>E Roots)) (tuples Y) (tuples Y)" + if \: "\ permutes Roots" and "Y \ Roots_ms" for \ Y + proof (rule bij_betwI) + have *: "(\f. restrict (\g. f (restrict (\ \ g) X)) (X \\<^sub>E Roots)) \ tuples Y \ tuples Y" + if \: "\ permutes Roots" for \ + proof + fix f assume f: "f \ tuples Y" + hence f': "f \ (X \\<^sub>E Roots) \\<^sub>E X" + by (auto simp: tuples_def) + define f' where "f' = (\g. f (restrict (\ \ g) X))" + have "f' \ (X \\<^sub>E Roots) \ X" unfolding f'_def + using f' bij_betw_apply[OF bij_betw_compose_left_perm_PiE[OF \, of X]] by blast + hence "restrict f' (X \\<^sub>E Roots) \ (X \\<^sub>E Roots) \\<^sub>E X" + by simp + moreover have "image_mset (restrict f' (X \\<^sub>E Roots)) (mset_set (X \\<^sub>E Roots)) = Y" + proof - + have "image_mset (restrict f' (X \\<^sub>E Roots)) (mset_set (X \\<^sub>E Roots)) = + image_mset f' (mset_set (X \\<^sub>E Roots))" + by (intro image_mset_cong) auto + also have "\ = image_mset f (image_mset (\g. restrict (\ \ g) X) (mset_set (X \\<^sub>E Roots)))" + unfolding f'_def o_def multiset.map_comp by (simp add: o_def) + also have "image_mset (\g. restrict (\ \ g) X) (mset_set (X \\<^sub>E Roots)) = + mset_set (X \\<^sub>E Roots)" + by (intro bij_betw_image_mset_set bij_betw_compose_left_perm_PiE \) + also have "image_mset f \ = Y" + using f by (simp add: tuples_def) + finally show ?thesis . + qed + ultimately show "restrict f' (X \\<^sub>E Roots) \ tuples Y" + by (auto simp: tuples_def) + qed + show "(\f. restrict (\g. f (restrict (\ \ g) X)) (X \\<^sub>E Roots)) \ tuples Y \ tuples Y" + by (intro * \) + show "(\f. restrict (\g. f (restrict (inv_into UNIV \ \ g) X)) (X \\<^sub>E Roots)) \ tuples Y \ tuples Y" + by (intro * permutes_inv \) + next + have *: "(\g\X \\<^sub>E Roots. (\g\X \\<^sub>E Roots. f (restrict (\ \ g) X)) + (restrict (inv_into UNIV \ \ g) X)) = f" (is "?lhs = _") + if f: "f \ tuples Y" and \: "\ permutes Roots" for f \ + proof + fix g show "?lhs g = f g" + proof (cases "g \ X \\<^sub>E Roots") + case True + have "restrict (\ \ restrict (inv_into UNIV \ \ g) X) X = g" + using True + by (intro ext) (auto simp: permutes_inverses[OF \]) + thus ?thesis using True + by (auto simp: permutes_in_image[OF permutes_inv[OF \]]) + qed (use f in \auto simp: tuples_def\) + qed + show "(\g\X \\<^sub>E Roots. (\g\X \\<^sub>E Roots. f (restrict (\ \ g) X)) + (restrict (inv_into UNIV \ \ g) X)) = f" if "f \ tuples Y" for f + using *[OF that \] . + show "(\g\X \\<^sub>E Roots. (\g\X \\<^sub>E Roots. f (restrict (inv_into UNIV \ \ g) X)) + (restrict (\ \ g) X)) = f" if "f \ tuples Y" for f + using *[OF that permutes_inv[OF \]] permutes_inv_inv[OF \] by simp + qed + + text \ + We show that the coefficients in the expanded new sum are rational -- again using the + fundamental theorem of symmetric polynomials. + \ + define \' :: "complex multiset \ complex" + where "\' = (\Y. \f\tuples Y. \g\X \\<^sub>E Roots. g (f g))" + + have "\' Y \ \" if Y: "Y \ Roots_ms" for Y + proof - + define Q :: "complex mpoly" + where "Q = (\f\tuples Y. \g\X \\<^sub>E Roots. Var (unRoot (g (f g))))" + + have "insertion Root Q \ \" + proof (rule symmetric_poly_of_roots_in_subring) + show "ring_closed (\ :: complex set)" + by standard auto + then interpret ring_closed "\ :: complex set" . + show "\m. coeff Q m \ \" + by (auto simp: Q_def coeff_Var when_def intro!: sum_in_Rats coeff_prod_closed) + next + show "symmetric_mpoly {.. assume \: "\ permutes {..' where "\' = convert_perm (inv_into UNIV \)" + have \': "\' permutes Roots" + unfolding \'_def by (intro permutes_convert_perm permutes_inv \) + have "mpoly_map_vars \ Q = (\f\tuples Y. \g\X \\<^sub>E Roots. Var (\ (unRoot (g (f g)))))" + unfolding Q_def by (simp add: permutes_bij[OF \]) + also have "\ = (\f\tuples Y. \g\X \\<^sub>E Roots. Var (unRoot (g (f (restrict (\' \ g) X)))))" + proof (rule sum.cong, goal_cases) + case (2 f) + have f: "f \ (X \\<^sub>E Roots) \\<^sub>E X" + using 2 by (auto simp: tuples_def) + have "(\g\X \\<^sub>E Roots. Var (\ (unRoot (g (f g))))) = + (\g\X \\<^sub>E Roots. Var (\ (unRoot (restrict (\' \ g) X (f (restrict (\' \ g) X))))))" + using \' by (intro prod.reindex_bij_betw [symmetric] bij_betw_compose_left_perm_PiE) + also have "\ = (\g\X \\<^sub>E Roots. Var (unRoot (g (f (restrict (\' \ g) X)))))" + proof (intro prod.cong refl arg_cong[of _ _ Var]) + fix g assume g: "g \ X \\<^sub>E Roots" + have "restrict (\' \ g) X \ X \\<^sub>E Roots" + using bij_betw_compose_left_perm_PiE[OF \', of X] g unfolding bij_betw_def by blast + hence *: "f (restrict (\' \ g) X) \ X" + by (rule PiE_mem[OF f]) + hence **: "g (f (restrict (\' \ g) X)) \ Roots" + by (rule PiE_mem[OF g]) + + have "unRoot (restrict (\' \ g) X (f (restrict (\' \ g) X))) = + unRoot (Root (inv_into UNIV \ (unRoot (g (f (restrict (\' \ g) X))))))" + using * ** by (subst \'_def) (auto simp: convert_perm_def) + also have "inv_into UNIV \ (unRoot (g (f (restrict (\' \ g) X)))) \ {..]]) auto + hence "unRoot (Root (inv_into UNIV \ (unRoot (g (f (restrict (\' \ g) X)))))) = + inv_into UNIV \ (unRoot (g (f (restrict (\' \ g) X))))" + by (intro unRoot_Root) auto + also have "\ \ = unRoot (g (f (restrict (\' \ g) X)))" + by (rule permutes_inverses[OF \]) + finally show "\ (unRoot (restrict (\' \ g) X (f (restrict (\' \ g) X)))) = + unRoot (g (f (restrict (\' \ g) X)))" . + qed + finally show ?case . + qed simp_all + also have "\ = (\x\tuples Y. \g\X \\<^sub>E Roots. Var (unRoot (g ((\g\X \\<^sub>E Roots. x (restrict (\' \ g) X)) g))))" + by (intro sum.cong prod.cong refl) auto + also have "\ = Q" + unfolding Q_def + by (rule sum.reindex_bij_betw[OF bij_betw_compose_perm]) (use \' Y in simp_all) + finally show "mpoly_map_vars \ Q = Q" . + qed + next + show "vars Q \ {.. 0" + unfolding lc_def by auto + thus "inverse (of_int lc) * (of_int lc :: complex) = 1" and "inverse (of_int lc) \ \" + by auto + have "rsquarefree (of_int_poly P :: complex poly)" + using \squarefree (of_int_poly P :: complex poly)\ by (intro squarefree_imp_rsquarefree) + hence "of_int_poly P = Polynomial.smult (of_int lc) (\x\Roots. [:-x, 1:])" + unfolding lc_def of_int_hom.hom_lead_coeff[symmetric] Roots_def + by (rule complex_poly_decompose_rsquarefree [symmetric]) + also have "(\x\Roots. [:-x, 1:]) = (\iif\tuples Y. \g\X \\<^sub>E Roots. Root (unRoot (g (f g))))" + by (simp add: Q_def insertion_sum insertion_prod) + also have "\ = \' Y" + unfolding \'_def by (intro sum.cong prod.cong refl Root_unRoot) (auto simp: tuples_def) + finally show ?thesis . + qed + hence "\Y\Roots_ms. \x. \' Y = of_rat x" + by (auto elim!: Rats_cases) + then obtain \'' :: "complex multiset \ rat" + where \'': "\Y. Y \ Roots_ms \ \' Y = of_rat (\'' Y)" + by metis + + text \ + We again collect all the terms that happen to have equal exponents and call their + coefficients \\''\: + \ + define \''' :: "complex \ rat" where "\''' = (\\. \Y\Roots_ms. (\'' Y when \\<^sub>#Y = \))" + have supp_\''': "{x. \''' x \ 0} \ sum_mset ` Roots_ms" + by (auto simp: \'''_def when_def elim!: sum.not_neutral_contains_not_neutral split: if_splits) + + text \ + We again start with the sum that we now to be zero and multiply it with all the sums that can + be obtained with different choices for the roots. + \ + have "0 = (\x\X. \ x * exp x)" + using sum0 .. + also have "\ = (\x\X. restrict \ X x * exp x)" + by (intro sum.cong) auto + also have "\ dvd (\f \ X \\<^sub>E Roots. \x\X. f x * exp x)" + by (rule dvd_prodI) (use \\ ` X \ Roots\ in \auto simp: id_def\) + also have "\ = (\f\(X \\<^sub>E Roots) \\<^sub>E X. \g\X \\<^sub>E Roots. g (f g) * exp (f g))" + by (rule prod_sum_PiE) auto + also have "\ = (\f\(X \\<^sub>E Roots) \\<^sub>E X. (\g\X \\<^sub>E Roots. g (f g)) * exp (\g\X \\<^sub>E Roots. f g))" + by (simp add: prod.distrib exp_sum) + also have "\ = (\(Y,f)\Sigma Roots_ms tuples. + (\g\X \\<^sub>E Roots. g (f g)) * exp (\g\X \\<^sub>E Roots. f g))" + by (intro sum.reindex_bij_witness[of _ snd "\f. (image_mset f (mset_set (X \\<^sub>E Roots)), f)"]) + (auto simp: Roots_ms_def tuples_def) + also have "\ = (\(Y,f)\Sigma Roots_ms tuples. (\g\X \\<^sub>E Roots. g (f g)) * exp (\\<^sub>#Y))" + by (intro sum.cong) (auto simp: tuples_def sum_unfold_sum_mset) + also have "\ = (\Y\Roots_ms. \' Y * exp (\\<^sub>#Y))" + unfolding \'_def sum_distrib_right by (rule sum.Sigma [symmetric]) auto + also have "\ = (\Y\Roots_ms. of_rat (\'' Y) * exp (\\<^sub>#Y))" + by (intro sum.cong) (auto simp: \'') + also have "\ = (\Y\Roots_ms. Sum_any (\\. of_rat (\'' Y when \\<^sub># Y = \) * exp \))" + proof (rule sum.cong, goal_cases) + case (2 Y) + have "Sum_any (\\. of_rat (\'' Y when \\<^sub># Y = \) * exp \) = + (\\\{\\<^sub># Y}. of_rat (\'' Y when \\<^sub># Y = \) * exp \)" + by (intro Sum_any.expand_superset) auto + thus ?case by simp + qed auto + also have "\ = Sum_any (\\. of_rat (\''' \) * exp \)" + unfolding \'''_def of_rat_sum sum_distrib_right by (subst Sum_any_sum_swap) auto + also have "\ = (\\ | \''' \ \ 0. of_rat (\''' \) * exp \)" + by (intro Sum_any.expand_superset finite_subset[OF supp_\''']) auto + finally have "(\\ | \''' \ \ 0. of_rat (\''' \) * exp \) = 0" + by auto + + text \ + We are now in the situation of our previous version of the theorem and can apply it to find + that all the coefficients are zero. + \ + have "{\. \''' \ \ 0} = {}" + proof (rule Hermite_Lindemann_aux3) + show "finite {\. \''' \ \ 0}" + by (rule finite_subset[OF supp_\''']) auto + next + show "(\\ | \''' \ \ 0. of_rat (\''' \) * exp \) = 0" + by fact + next + fix \ assume \: "\ \ {\. \''' \ \ 0}" + then obtain Y where Y: "Y \ Roots_ms" "\ = sum_mset Y" + using supp_\''' by auto + thus "algebraic \" using alg1 + by (auto simp: Roots_ms_def) + qed auto + + text \ + However, similarly to before, we can show that the coefficient corresponding to the + term with the lexicographically greatest exponent (which is obtained by picking the + term with the lexicographically greatest term in each of the factors of our big product) + is non-zero. + \ + moreover have "\\. \''' \ \ 0" + proof - + define \_max where "\_max = complex_lex.Max X" + have [simp]: "\_max \ X" + unfolding \_max_def using \X \ {}\ by (intro complex_lex.Max_in) auto + define Y_max :: "complex multiset" where "Y_max = replicate_mset (n ^ m) \_max" + define f_max where "f_max = restrict (\_. \_max) (X \\<^sub>E Roots)" + have [simp]: "Y_max \ Roots_ms" + by (auto simp: Y_max_def Roots_ms_def) + have "tuples Y_max = {f_max}" + proof safe + have "image_mset (\_\X \\<^sub>E Roots. \_max) (mset_set (X \\<^sub>E Roots)) = + image_mset (\_. \_max) (mset_set (X \\<^sub>E Roots))" + by (intro image_mset_cong) auto + thus "f_max \ tuples Y_max" + by (auto simp: f_max_def tuples_def Y_max_def image_mset_const_eq) + next + fix f assume "f \ tuples Y_max" + hence f: "f \ (X \\<^sub>E Roots) \\<^sub>E X" "image_mset f (mset_set (X \\<^sub>E Roots)) = Y_max" + by (auto simp: tuples_def) + hence "\g \# mset_set (X \\<^sub>E Roots). f g = \_max" + by (intro image_mset_eq_replicate_msetD[where n = "n ^ m"]) (auto simp: Y_max_def) + thus "f = f_max" + using f by (auto simp: Y_max_def fun_eq_iff f_max_def) + qed + + have "\''' (of_nat (n ^ m) * \_max) = (\Y\Roots_ms. \'' Y when \\<^sub># Y = of_nat (n ^ m) * \_max)" + unfolding \'''_def Roots_ms_def .. + also have "\\<^sub># Y \ of_nat n ^ m * \_max" if "Y \ Roots_ms" "Y \ Y_max" for Y + proof - + have "\set_mset Y \ {\_max}" + using set_mset_subset_singletonD[of Y "\_max"] that + by (auto simp: Roots_ms_def Y_max_def split: if_splits) + then obtain y where y: "y \# Y" "y \ \_max" + by auto + have "y \ X" "set_mset (Y - {#y#}) \ X" + using y that by (auto simp: Roots_ms_def dest: in_diffD) + hence "y \\<^sub>\ \_max" + using y unfolding \_max_def by (intro complex_lex.Max_ge) auto + with y have "y <\<^sub>\ \_max" + by auto + have *: "Y = {#y#} + (Y - {#y#})" + using y by simp + have "sum_mset Y = y + sum_mset (Y - {#y#})" + by (subst *) auto + also have "\ <\<^sub>\ \_max + sum_mset (Y - {#y#})" + by (intro complex_lex.add_strict_right_mono) fact + also have "\ \\<^sub>\ \_max + sum_mset (replicate_mset (n ^ m - 1) \_max)" + unfolding \_max_def using that y \set_mset (Y - {#y#}) \ X\ + by (intro complex_lex.add_left_mono sum_mset_mono_complex_lex + rel_mset_replicate_mset_right complex_lex.Max_ge) + (auto simp: Roots_ms_def size_Diff_singleton) + also have "\ = of_nat (Suc (n ^ m - 1)) * \_max" + by (simp add: algebra_simps) + also have "Suc (n ^ m - 1) = n ^ m" + using \n > 0\ by simp + finally show ?thesis by simp + qed + hence "(\Y\Roots_ms. \'' Y when \\<^sub># Y = of_nat (n ^ m) * \_max) = (\Y\{Y_max}. \'' Y when \\<^sub># Y = of_nat (n ^ m) * \_max)" + by (intro sum.mono_neutral_right ballI) auto + also have "\ = \'' Y_max" + by (auto simp: when_def Y_max_def) + also have "of_rat \ = \' Y_max" + using \''[of Y_max] by auto + also have "\ = (\g\X \\<^sub>E Roots. g (f_max g))" + by (auto simp: \'_def \tuples Y_max = {f_max}\) + also have "\ = (\g\X \\<^sub>E Roots. g \_max)" + by (intro prod.cong) (auto simp: f_max_def) + also have "\ \ 0" + using \0 \ Roots\ \\_max \ X\ by (intro prod_nonzeroI) (metis PiE_mem) + finally show ?thesis by blast + qed + + ultimately show False by blast +qed + + +subsection \The final theorem\ + +text \ + We now additionally allow some of the $\beta_i$ to be zero: +\ +lemma Hermite_Lindemann': + fixes \ :: "complex \ complex" + assumes "finite X" + assumes "\x. x \ X \ algebraic x" + assumes "\x. x \ X \ algebraic (\ x)" + assumes "(\x\X. \ x * exp x) = 0" + shows "\x\X. \ x = 0" +proof - + have "{x\X. \ x \ 0} = {}" + proof (rule Hermite_Lindemann_aux4) + have "(\x | x \ X \ \ x \ 0. \ x * exp x) = (\x\X. \ x * exp x)" + by (intro sum.mono_neutral_left assms(1)) auto + also have "\ = 0" + by fact + finally show "(\x | x \ X \ \ x \ 0. \ x * exp x) = 0" . + qed (use assms in auto) + thus ?thesis by blast +qed + +text \ + Lastly, we switch to indexed summation in order to obtain a version of the theorem that + is somewhat nicer to use: +\ +theorem Hermite_Lindemann: + fixes \ \ :: "'a \ complex" + assumes "finite I" + assumes "\x. x \ I \ algebraic (\ x)" + assumes "\x. x \ I \ algebraic (\ x)" + assumes "inj_on \ I" + assumes "(\x\I. \ x * exp (\ x)) = 0" + shows "\x\I. \ x = 0" +proof - + define f where "f = inv_into I \" + have [simp]: "f (\ x) = x" if "x \ I" for x + using that by (auto simp: f_def inv_into_f_f[OF assms(4)]) + have "\x\\`I. (\ \ f) x = 0" + proof (rule Hermite_Lindemann') + have "0 = (\x\I. \ x * exp (\ x))" + using assms(5) .. + also have "\ = (\x\I. (\ \ f) (\ x) * exp (\ x))" + by (intro sum.cong) auto + also have "\ = (\x\\`I. (\ \ f) x * exp x)" + using assms(4) by (subst sum.reindex) auto + finally show "(\x\\ ` I. (\ \ f) x * exp x) = 0" .. + qed (use assms in auto) + thus ?thesis by auto +qed + +text \ + The following version using lists instead of sequences is even more convenient to use + in practice: +\ +corollary Hermite_Lindemann_list: + fixes xs :: "(complex \ complex) list" + assumes alg: "\(x,y)\set xs. algebraic x \ algebraic y" + assumes distinct: "distinct (map snd xs)" + assumes sum0: "(\(c,\)\xs. c * exp \) = 0" + shows "\c\(fst ` set xs). c = 0" +proof - + define n where "n = length xs" + have *: "\i\{..i. map snd xs ! i) {.. inj_on (\i. snd (xs ! i)) {..i. snd (xs ! i)) {..(c,\)\xs. c * exp \)" + using sum0 .. + also have "\ = (\i = 0" .. + next + fix i assume i: "i \ {.. set xs" + by (auto simp: n_def) + with alg show "algebraic (fst (xs ! i))" "algebraic (snd (xs ! i))" + by blast+ + qed auto + + show ?thesis + proof (intro ballI, elim imageE) + fix c x assume cx: "c = fst x" "x \ set xs" + then obtain i where "i \ {..The traditional formulation of the theorem\ + +text \ + What we proved above was actually Baker's reformulation of the theorem. Thus, we now also derive + the original one, which uses linear independence and algebraic independence. + + It states that if $\alpha_1, \ldots, \alpha_n$ are algebraic numbers that are linearly + independent over \\\, then $e^{\alpha_1}, \ldots, e^{\alpha_n}$ are algebraically independent + over \\\. +\ + +text \ + Linear independence over the integers is just independence of a set of complex numbers when + viewing the complex numbers as a \\\-module. +\ +definition linearly_independent_over_int :: "'a :: field_char_0 set \ bool" where + "linearly_independent_over_int = module.independent (\r x. of_int r * x)" + +text \ + Algebraic independence over the rationals means that the given set \X\ of numbers fulfils + no non-trivial polynomial equation with rational coefficients, i.e. there is no non-zero + multivariate polynomial with rational coefficients that, when inserting the numbers from \X\, + becomes zero. + + Note that we could easily replace `rational coefficients' with `algebraic coefficients' here + and the proof would still go through without any modifications. +\ +definition algebraically_independent_over_rat :: "nat \ (nat \ 'a :: field_char_0) \ bool" where + "algebraically_independent_over_rat n a \ + (\p. vars p \ {.. (\m. coeff p m \ \) \ insertion a p = 0 \ p = 0)" + +corollary Hermite_Lindemann_original: + fixes n :: nat and \ :: "nat \ complex" + assumes "inj_on \ {..i. i < n \ algebraic (\ i)" + assumes "linearly_independent_over_int (\ ` {..i. exp (\ i))" + unfolding algebraically_independent_over_rat_def +proof safe + fix p assume p: "vars p \ {..m. coeff p m \ \" "insertion (\i. exp (\ i)) p = 0" + define \' where "\' = (\m. \i i)" + define I where "I = {m. coeff p m \ 0}" + + have lookup_eq_0: "lookup m i = 0" if "m \ I" "i \ {.. vars p" + using that coeff_notin_vars[of m p] by (auto simp: I_def) + thus "lookup m i = 0" + using in_keys_iff[of i m] that p(1) by blast + qed + + have "\x\I. coeff p x = 0" + proof (rule Hermite_Lindemann) + show "finite I" + by (auto simp: I_def) + next + show "algebraic (\' m)" if "m \ I" for m + unfolding \'_def using assms(2) by fastforce + next + show "algebraic (coeff p m)" if "m \ I" for m + unfolding \'_def using p(2) by blast + next + show "inj_on \' I" + proof + fix m1 m2 assume m12: "m1 \ I" "m2 \ I" "\' m1 = \' m2" + define lu :: "(nat \\<^sub>0 nat) \ nat \ int" where "lu = (\m i. int (lookup m i))" + interpret int: Modules.module "\r x. of_int r * (x :: complex)" + by standard (auto simp: algebra_simps of_rat_mult of_rat_add) + define idx where "idx = inv_into {.." + + have "lu m1 i = lu m2 i" if "i < n" for i + proof - + have "lu m1 (idx (\ i)) - lu m2 (idx (\ i)) = 0" + proof (rule int.independentD) + show "int.independent (\ ` {..x\\`{..i i)) - lu m2 (idx (\ i))) * \ i)" + using assms(1) by (subst sum.reindex) auto + also have "\ = (\i i)" + by (intro sum.cong) (auto simp: idx_def inv_into_f_f[OF assms(1)]) + also have "\ = 0" + using m12 by (simp add: \'_def ring_distribs of_rat_diff sum_subtractf lu_def) + finally show "(\x\\`{..'_def ring_distribs of_rat_diff sum_subtractf lu_def) + qed (use that in auto) + thus ?thesis + using that by (auto simp: idx_def inv_into_f_f[OF assms(1)]) + qed + hence "lookup m1 i = lookup m2 i" for i + using m12 by (cases "i < n") (auto simp: lu_def lookup_eq_0) + thus "m1 = m2" + by (rule poly_mapping_eqI) + qed + next + have "0 = insertion (\i. exp (\ i)) p" + using p(3) .. + also have "\ = (\m\I. coeff p m * Prod_any (\i. exp (\ i) ^ lookup m i))" + unfolding insertion_altdef by (rule Sum_any.expand_superset) (auto simp: I_def) + also have "\ = (\m\I. coeff p m * exp (\' m))" + proof (intro sum.cong, goal_cases) + case (2 m) + have "Prod_any (\i. exp (\ i) ^ lookup m i) = (\i i) ^ lookup m i)" + using 2 lookup_eq_0[of m] by (intro Prod_any.expand_superset; force) + also have "\ = exp (\' m)" + by (simp add: exp_sum exp_of_nat_mult \'_def) + finally show ?case by simp + qed simp_all + finally show "(\m\I. coeff p m * exp (\' m)) = 0" .. + qed + thus "p = 0" + by (intro mpoly_eqI) (auto simp: I_def) +qed + + +subsection \Simple corollaries\ + +text \ + Now, we derive all the usual obvious corollaries of the theorem in the obvious way. + + First, the exponential of a non-zero algebraic number is transcendental. +\ +corollary algebraic_exp_complex_iff: + assumes "algebraic x" + shows "algebraic (exp x :: complex) \ x = 0" + using Hermite_Lindemann_list[of "[(1, x), (-exp x, 0)]"] assms by auto + +text \ + More generally, any sum of exponentials with algebraic coefficients and exponents is + transcendental if the exponents are all distinct and non-zero and at least one coefficient + is non-zero. +\ +corollary sum_of_exp_transcendentalI: + fixes xs :: "(complex \ complex) list" + assumes "\(x,y)\set xs. algebraic x \ algebraic y \ y \ 0" + assumes "\x\fst`set xs. x \ 0" + assumes distinct: "distinct (map snd xs)" + shows "\algebraic (\(c,\)\xs. c * exp \)" +proof + define S where "S = (\(c,\)\xs. c * exp \)" + assume S: "algebraic S" + have "\c\fst`set ((-S,0) # xs). c = 0" + proof (rule Hermite_Lindemann_list) + show "(\(c, \)\(- S, 0) # xs. c * exp \) = 0" + by (auto simp: S_def) + qed (use S assms in auto) + with assms(2) show False + by auto +qed + +text \ + Any complex logarithm of an algebraic number other than 1 is transcendental + (no matter which branch cut). +\ +corollary transcendental_complex_logarithm: + assumes "algebraic x" "exp y = (x :: complex)" "x \ 1" + shows "\algebraic y" + using algebraic_exp_complex_iff[of y] assms by auto + +text \ + In particular, this holds for the standard branch of the logarithm. +\ +corollary transcendental_Ln: + assumes "algebraic x" "x \ 0" "x \ 1" + shows "\algebraic (Ln x)" + by (rule transcendental_complex_logarithm) (use assms in auto) + +text \ + The transcendence of \e\ and \\\, which I have already formalised directly in other AFP + entries, now follows as a simple corollary. +\ +corollary exp_1_complex_transcendental: "\algebraic (exp 1 :: complex)" + by (subst algebraic_exp_complex_iff) auto + +corollary pi_transcendental: "\algebraic pi" +proof - + have "\algebraic (\ * pi)" + by (rule transcendental_complex_logarithm[of "-1"]) auto + thus ?thesis by simp +qed + + +subsection \Transcendence of the trigonometric and hyperbolic functions\ + +text \ + In a similar fashion, we can also prove the transcendence of all the trigonometric and + hyperbolic functions such as $\sin$, $\tan$, $\sinh$, $\arcsin$, etc. +\ + +lemma transcendental_sinh: + assumes "algebraic z" "z \ 0" + shows "\algebraic (sinh z :: complex)" +proof - + have "\algebraic (\(a,b)\[(1/2, z), (-1/2, -z)]. a * exp b)" + using assms by (intro sum_of_exp_transcendentalI) auto + also have "(\(a,b)\[(1/2, z), (-1/2, -z)]. a * exp b) = sinh z" + by (simp add: sinh_def field_simps scaleR_conv_of_real) + finally show ?thesis . +qed + +lemma transcendental_cosh: + assumes "algebraic z" "z \ 0" + shows "\algebraic (cosh z :: complex)" +proof - + have "\algebraic (\(a,b)\[(1/2, z), (1/2, -z)]. a * exp b)" + using assms by (intro sum_of_exp_transcendentalI) auto + also have "(\(a,b)\[(1/2, z), (1/2, -z)]. a * exp b) = cosh z" + by (simp add: cosh_def field_simps scaleR_conv_of_real) + finally show ?thesis . +qed + +lemma transcendental_sin: + assumes "algebraic z" "z \ 0" + shows "\algebraic (sin z :: complex)" + unfolding sin_conv_sinh using transcendental_sinh[of "\ * z"] assms by simp + +lemma transcendental_cos: + assumes "algebraic z" "z \ 0" + shows "\algebraic (cos z :: complex)" + unfolding cos_conv_cosh using transcendental_cosh[of "\ * z"] assms by simp + +(* TODO: Move? *) +lemma tan_square_neq_neg1: "tan (z :: complex) ^ 2 \ -1" +proof + assume "tan z ^ 2 = -1" + hence "sin z ^ 2 = -(cos z ^ 2)" + by (auto simp: tan_def divide_simps split: if_splits) + also have "cos z ^ 2 = 1 - sin z ^ 2" + by (simp add: cos_squared_eq) + finally show False + by simp +qed + +lemma transcendental_tan: + assumes "algebraic z" "z \ 0" + shows "\algebraic (tan z :: complex)" +proof + assume "algebraic (tan z)" + + have nz1: "real_of_int n + 1 / 2 \ 0" for n + proof - + have "real_of_int (2 * n + 1) / real_of_int 2 \ \" + by (intro fraction_not_in_ints) auto + also have "real_of_int (2 * n + 1) / real_of_int 2 = real_of_int n + 1 / 2" + by simp + finally show "\ \ 0" + by auto + qed + + have nz2: "1 + tan z ^ 2 \ 0" + using tan_square_neq_neg1[of z] by (subst add_eq_0_iff) + + have nz3: "cos z \ 0" + proof + assume "cos z = 0" + then obtain n where "z = complex_of_real (real_of_int n * pi) + complex_of_real pi / 2" + by (subst (asm) cos_eq_0) blast + also have "\ = complex_of_real ((real_of_int n + 1 / 2) * pi)" + by (simp add: ring_distribs) + also have "algebraic \ \ algebraic ((real_of_int n + 1 / 2) * pi)" + by (rule algebraic_of_real_iff) + also have "\algebraic ((real_of_int n + 1 / 2) * pi)" + using nz1[of n] transcendental_pi by simp + finally show False using assms(1) by contradiction + qed + + from nz3 have *: "sin z ^ 2 = tan z ^ 2 * cos z ^ 2" + by (simp add: tan_def field_simps) + also have "cos z ^ 2 = 1 - sin z ^ 2" + by (simp add: cos_squared_eq) + finally have "sin z ^ 2 * (1 + tan z ^ 2) = tan z ^ 2" + by (simp add: algebra_simps) + hence "sin z ^ 2 = tan z ^ 2 / (1 + tan z ^ 2)" + using nz2 by (simp add: field_simps) + also have "algebraic (tan z ^ 2 / (1 + tan z ^ 2))" + using \algebraic (tan z)\ by auto + finally have "algebraic (sin z ^ 2)" . + hence "algebraic (sin z)" + by simp + thus False + using transcendental_sin[OF \algebraic z\ \z \ 0\] by contradiction +qed + +lemma transcendental_cot: + assumes "algebraic z" "z \ 0" + shows "\algebraic (cot z :: complex)" +proof - + have "\algebraic (tan z)" + by (rule transcendental_tan) fact+ + also have "algebraic (tan z) \ algebraic (inverse (tan z))" + by simp + also have "inverse (tan z) = cot z" + by (simp add: cot_def tan_def) + finally show ?thesis . +qed + +lemma transcendental_tanh: + assumes "algebraic z" "z \ 0" "cosh z \ 0" + shows "\algebraic (tanh z :: complex)" + using transcendental_tan[of "\ * z"] assms unfolding tanh_conv_tan by simp + +lemma transcendental_Arcsin: + assumes "algebraic z" "z \ 0" + shows "\algebraic (Arcsin z)" +proof - + have "\ * z + csqrt (1 - z\<^sup>2) \ 0" + using Arcsin_body_lemma by blast + moreover have "\ * z + csqrt (1 - z\<^sup>2) \ 1" + proof + assume "\ * z + csqrt (1 - z\<^sup>2) = 1" + hence "Arcsin z = 0" + by (simp add: Arcsin_def) + hence "sin (Arcsin z) = 0" + by (simp only: sin_zero) + also have "sin (Arcsin z) = z" + by simp + finally show False using \z \ 0\ by simp + qed + ultimately have "\ algebraic (Ln (\ * z + csqrt (1 - z\<^sup>2)))" + using assms by (intro transcendental_Ln) auto + thus ?thesis + by (simp add: Arcsin_def) +qed + +lemma transcendental_Arccos: + assumes "algebraic z" "z \ 1" + shows "\algebraic (Arccos z)" +proof - + have "z + \ * csqrt (1 - z\<^sup>2) \ 0" + using Arccos_body_lemma by blast + moreover have "z + \ * csqrt (1 - z\<^sup>2) \ 1" + proof + assume "z + \ * csqrt (1 - z\<^sup>2) = 1" + hence "Arccos z = 0" + by (simp add: Arccos_def) + hence "cos (Arccos z) = 1" + by (simp only: cos_zero) + also have "cos (Arccos z) = z" + by simp + finally show False using \z \ 1\ by simp + qed + ultimately have "\ algebraic (Ln (z + \ * csqrt (1 - z\<^sup>2)))" + using assms by (intro transcendental_Ln) auto + thus ?thesis + by (simp add: Arccos_def) +qed + +lemma transcendental_Arctan: + assumes "algebraic z" "z \ {0, \, -\}" + shows "\algebraic (Arctan z)" +proof - + have "\ * z \ 1" "1 + \ * z \ 0" + using assms(2) by (auto simp: complex_eq_iff) + hence "\ algebraic (Ln ((1 - \ * z) / (1 + \ * z)))" + using assms by (intro transcendental_Ln) auto + thus ?thesis + by (simp add: Arctan_def) +qed + +end \ No newline at end of file diff --git a/thys/Hermite_Lindemann/Min_Int_Poly.thy b/thys/Hermite_Lindemann/Min_Int_Poly.thy new file mode 100644 --- /dev/null +++ b/thys/Hermite_Lindemann/Min_Int_Poly.thy @@ -0,0 +1,190 @@ +(* + File: Min_Int_Poly.thy + Author: Manuel Eberl, TU München +*) +section \The minimal polynomial of an algebraic number\ +theory Min_Int_Poly +imports + "Algebraic_Numbers.Algebraic_Numbers" + "HOL-Computational_Algebra.Computational_Algebra" + More_Polynomial_HLW +begin + +text \ + Given an algebraic number \x\ in a field, the minimal polynomial is the unique irreducible + integer polynomial with positive leading coefficient that has \x\ as a root. + + Note that we assume characteristic 0 since the material upon which all of this builds also + assumes it. +\ + +(* TODO Move *) + +definition min_int_poly :: "'a :: field_char_0 \ int poly" where + "min_int_poly x = + (if algebraic x then THE p. p represents x \ irreducible p \ Polynomial.lead_coeff p > 0 + else [:0, 1:])" + +lemma + fixes x :: "'a :: {field_char_0, field_gcd}" + shows min_int_poly_represents [intro]: "algebraic x \ min_int_poly x represents x" + and min_int_poly_irreducible [intro]: "irreducible (min_int_poly x)" + and lead_coeff_min_int_poly_pos: "Polynomial.lead_coeff (min_int_poly x) > 0" +proof - + note * = theI'[OF algebraic_imp_represents_unique, of x] + show "min_int_poly x represents x" if "algebraic x" + using *[OF that] by (simp add: that min_int_poly_def) + have "irreducible [:0, 1::int:]" + by (rule irreducible_linear_poly) auto + thus "irreducible (min_int_poly x)" + using * by (auto simp: min_int_poly_def) + show "Polynomial.lead_coeff (min_int_poly x) > 0" + using * by (auto simp: min_int_poly_def) +qed + +lemma + fixes x :: "'a :: {field_char_0, field_gcd}" + shows degree_min_int_poly_pos [intro]: "Polynomial.degree (min_int_poly x) > 0" + and degree_min_int_poly_nonzero [simp]: "Polynomial.degree (min_int_poly x) \ 0" +proof - + show "Polynomial.degree (min_int_poly x) > 0" + proof (cases "algebraic x") + case True + hence "min_int_poly x represents x" + by auto + thus ?thesis by blast + qed (auto simp: min_int_poly_def) + thus "Polynomial.degree (min_int_poly x) \ 0" + by blast +qed + +lemma min_int_poly_squarefree [intro]: + fixes x :: "'a :: {field_char_0, field_gcd}" + shows "squarefree (min_int_poly x)" + by (rule irreducible_imp_squarefree) auto + +lemma min_int_poly_primitive [intro]: + fixes x :: "'a :: {field_char_0, field_gcd}" + shows "primitive (min_int_poly x)" + by (rule irreducible_imp_primitive) auto + +lemma min_int_poly_content [simp]: + fixes x :: "'a :: {field_char_0, field_gcd}" + shows "content (min_int_poly x) = 1" + using min_int_poly_primitive[of x] by (simp add: primitive_def) + +lemma ipoly_min_int_poly [simp]: + "algebraic x \ ipoly (min_int_poly x) (x :: 'a :: {field_gcd, field_char_0}) = 0" + using min_int_poly_represents[of x] by (auto simp: represents_def) + +lemma min_int_poly_nonzero [simp]: + fixes x :: "'a :: {field_char_0, field_gcd}" + shows "min_int_poly x \ 0" + using lead_coeff_min_int_poly_pos[of x] by auto + +lemma min_int_poly_normalize [simp]: + fixes x :: "'a :: {field_char_0, field_gcd}" + shows "normalize (min_int_poly x) = min_int_poly x" + unfolding normalize_poly_def using lead_coeff_min_int_poly_pos[of x] by simp + +lemma min_int_poly_prime_elem [intro]: + fixes x :: "'a :: {field_char_0, field_gcd}" + shows "prime_elem (min_int_poly x)" + using min_int_poly_irreducible[of x] by blast + +lemma min_int_poly_prime [intro]: + fixes x :: "'a :: {field_char_0, field_gcd}" + shows "prime (min_int_poly x)" + using min_int_poly_prime_elem[of x] + by (simp only: prime_normalize_iff [symmetric] min_int_poly_normalize) + +lemma min_int_poly_unique: + fixes x :: "'a :: {field_char_0, field_gcd}" + assumes "p represents x" "irreducible p" "Polynomial.lead_coeff p > 0" + shows "min_int_poly x = p" +proof - + from assms(1) have x: "algebraic x" + using algebraic_iff_represents by blast + thus ?thesis + using the1_equality[OF algebraic_imp_represents_unique[OF x], of p] assms + unfolding min_int_poly_def by auto +qed + +lemma min_int_poly_of_int [simp]: + "min_int_poly (of_int n :: 'a :: {field_char_0, field_gcd}) = [:-of_int n, 1:]" + by (intro min_int_poly_unique irreducible_linear_poly) auto + +lemma min_int_poly_of_nat [simp]: + "min_int_poly (of_nat n :: 'a :: {field_char_0, field_gcd}) = [:-of_nat n, 1:]" + using min_int_poly_of_int[of "int n"] by (simp del: min_int_poly_of_int) + +lemma min_int_poly_0 [simp]: "min_int_poly (0 :: 'a :: {field_char_0, field_gcd}) = [:0, 1:]" + using min_int_poly_of_int[of 0] unfolding of_int_0 by simp + +lemma min_int_poly_1 [simp]: "min_int_poly (1 :: 'a :: {field_char_0, field_gcd}) = [:-1, 1:]" + using min_int_poly_of_int[of 1] unfolding of_int_1 by simp + +lemma poly_min_int_poly_0_eq_0_iff [simp]: + fixes x :: "'a :: {field_char_0, field_gcd}" + assumes "algebraic x" + shows "poly (min_int_poly x) 0 = 0 \ x = 0" +proof + assume *: "poly (min_int_poly x) 0 = 0" + show "x = 0" + proof (rule ccontr) + assume "x \ 0" + hence "poly (min_int_poly x) 0 \ 0" + using assms by (intro represents_irr_non_0) auto + with * show False by contradiction + qed +qed auto + +lemma min_int_poly_conv_Gcd: + fixes x :: "'a :: {field_char_0, field_gcd}" + assumes "algebraic x" + shows "min_int_poly x = Gcd {p. p \ 0 \ p represents x}" +proof (rule sym, rule Gcd_eqI, (safe)?) + fix p assume p: "\q. q \ {p. p \ 0 \ p represents x} \ p dvd q" + show "p dvd min_int_poly x" + using assms by (intro p) auto +next + fix p assume p: "p \ 0" "p represents x" + have "min_int_poly x represents x" + using assms by auto + hence "poly (gcd (of_int_poly (min_int_poly x)) (of_int_poly p)) x = 0" + using p by (intro poly_gcd_eq_0I) auto + hence "ipoly (gcd (min_int_poly x) p) x = 0" + by (subst (asm) gcd_of_int_poly) auto + hence "gcd (min_int_poly x) p represents x" + using p unfolding represents_def by auto + + have "min_int_poly x dvd gcd (min_int_poly x) p \ is_unit (gcd (min_int_poly x) p)" + by (intro irreducibleD') auto + moreover from \gcd (min_int_poly x) p represents x\ have "\is_unit (gcd (min_int_poly x) p)" + by (auto simp: represents_def) + ultimately have "min_int_poly x dvd gcd (min_int_poly x) p" + by blast + also have "\ dvd p" + by blast + finally show "min_int_poly x dvd p" . +qed auto + +lemma min_int_poly_eqI: + fixes x :: "'a :: {field_char_0, field_gcd}" + assumes "p represents x" "irreducible p" "Polynomial.lead_coeff p \ 0" + shows "min_int_poly x = p" +proof - + from assms have [simp]: "p \ 0" + by auto + have "Polynomial.lead_coeff p \ 0" + by auto + with assms(3) have "Polynomial.lead_coeff p > 0" + by linarith + moreover have "algebraic x" + using \p represents x\ by (meson algebraic_iff_represents) + ultimately show ?thesis + unfolding min_int_poly_def + using the1_equality[OF algebraic_imp_represents_unique[OF \algebraic x\], of p] assms by auto +qed + +end \ No newline at end of file diff --git a/thys/Hermite_Lindemann/Misc_HLW.thy b/thys/Hermite_Lindemann/Misc_HLW.thy new file mode 100644 --- /dev/null +++ b/thys/Hermite_Lindemann/Misc_HLW.thy @@ -0,0 +1,231 @@ +(* + File: Misc_HLW.thy + Author: Manuel Eberl, TU München +*) +section \Miscellaneous facts\ +theory Misc_HLW +imports + Complex_Main + "HOL-Library.Multiset" + "HOL-Library.Permutations" + "HOL-Library.FuncSet" + "HOL-Library.Groups_Big_Fun" + "HOL-Library.Poly_Mapping" + "HOL-Library.Landau_Symbols" + "HOL-Computational_Algebra.Computational_Algebra" +begin + +lemma set_mset_subset_singletonD: + assumes "set_mset A \ {x}" + shows "A = replicate_mset (size A) x" + using assms by (induction A) auto + +lemma image_mset_eq_replicate_msetD: + assumes "image_mset f A = replicate_mset n y" + shows "\x\#A. f x = y" +proof - + have "f ` set_mset A = set_mset (image_mset f A)" + by simp + also note assms + finally show ?thesis by (auto split: if_splits) +qed + +lemma bij_betw_permutes_compose_left: + assumes "\ permutes A" + shows "bij_betw (\\. \ \ \) {\. \ permutes A} {\. \ permutes A}" +proof (rule bij_betwI) + show "(\) \ \ {\. \ permutes A} \ {\. \ permutes A}" + by (auto intro: permutes_compose assms) + show "(\) (inv_into UNIV \) \ {\. \ permutes A} \ {\. \ permutes A}" + by (auto intro: permutes_compose assms permutes_inv) +qed (use permutes_inverses[OF assms] in auto) + +lemma bij_betw_compose_left_perm_Pi: + assumes "\ permutes B" + shows "bij_betw (\f. (\ \ f)) (A \ B) (A \ B)" +proof (rule bij_betwI) + have *: "(\f. (\ \ f)) \ (A \ B) \ A \ B" if \: "\ permutes B" for \ + by (auto simp: permutes_in_image[OF \]) + show "(\f. (\ \ f)) \ (A \ B) \ A \ B" + by (rule *) fact + show "(\f. (inv_into UNIV \ \ f)) \ (A \ B) \ A \ B" + by (intro * permutes_inv) fact +qed (auto simp: permutes_inverses[OF assms] fun_eq_iff) + +lemma bij_betw_compose_left_perm_PiE: + assumes "\ permutes B" + shows "bij_betw (\f. restrict (\ \ f) A) (A \\<^sub>E B) (A \\<^sub>E B)" +proof (rule bij_betwI) + have *: "(\f. restrict (\ \ f) A) \ (A \\<^sub>E B) \ A \\<^sub>E B" if \: "\ permutes B" for \ + by (auto simp: permutes_in_image[OF \]) + show "(\f. restrict (\ \ f) A) \ (A \\<^sub>E B) \ A \\<^sub>E B" + by (rule *) fact + show "(\f. restrict (inv_into UNIV \ \ f) A) \ (A \\<^sub>E B) \ A \\<^sub>E B" + by (intro * permutes_inv) fact +qed (auto simp: permutes_inverses[OF assms] fun_eq_iff) + +lemma bij_betw_image_mset_set: + assumes "bij_betw f A B" + shows "image_mset f (mset_set A) = mset_set B" + using assms by (simp add: bij_betw_def image_mset_mset_set) + +lemma finite_multisets_of_size: + assumes "finite A" + shows "finite {X. set_mset X \ A \ size X = n}" +proof (rule finite_subset) + show "{X. set_mset X \ A \ size X = n} \ mset ` {xs. set xs \ A \ length xs = n}" + proof + fix X assume X: "X \ {X. set_mset X \ A \ size X = n}" + obtain xs where [simp]: "X = mset xs" + by (metis ex_mset) + thus "X \ mset ` {xs. set xs \ A \ length xs = n}" + using X by auto + qed +next + show "finite (mset ` {xs. set xs \ A \ length xs = n})" + by (intro finite_imageI finite_lists_length_eq assms) +qed + +lemma sum_mset_image_mset_sum_mset_image_mset: + "sum_mset (image_mset g (sum_mset (image_mset f A))) = + sum_mset (image_mset (\x. sum_mset (image_mset g (f x))) A)" + by (induction A) auto + +lemma sum_mset_image_mset_singleton: "sum_mset (image_mset (\x. {#f x#}) A) = image_mset f A" + by (induction A) auto + +lemma sum_mset_conv_sum: + "sum_mset (image_mset f A) = (\x\set_mset A. of_nat (count A x) * f x)" +proof (induction A rule: full_multiset_induct) + case (less A) + show ?case + proof (cases "A = {#}") + case False + then obtain x where x: "x \# A" + by auto + define n where "n = count A x" + define A' where "A' = filter_mset (\y. y \ x) A" + have A_eq: "A = replicate_mset n x + A'" + by (intro multiset_eqI) (auto simp: A'_def n_def) + have [simp]: "x \# A'" "count A' x = 0" + by (auto simp: A'_def) + have "n \ 0" + using x by (auto simp: n_def) + + have "sum_mset (image_mset f A) = of_nat n * f x + sum_mset (image_mset f A')" + by (simp add: A_eq) + also have "A' \# A" + unfolding A'_def using x by (simp add: filter_mset_eq_conv subset_mset_def) + with less.IH have "sum_mset (image_mset f A') = (\x\set_mset A'. of_nat (count A' x) * f x)" + by simp + also have "\ = (\x\set_mset A'. of_nat (count A x) * f x)" + by (intro sum.cong) (auto simp: A_eq) + also have "of_nat n * f x + \ = (\x\insert x (set_mset A'). of_nat (count A x) * f x)" + by (subst sum.insert) (auto simp: A_eq) + also from \n \ 0\ have "insert x (set_mset A') = set_mset A" + by (auto simp: A_eq) + finally show ?thesis . + qed auto +qed + +lemma sum_mset_conv_Sum_any: + "sum_mset (image_mset f A) = Sum_any (\x. of_nat (count A x) * f x)" +proof - + have "sum_mset (image_mset f A) = (\x\set_mset A. of_nat (count A x) * f x)" + by (rule sum_mset_conv_sum) + also have "\ = Sum_any (\x. of_nat (count A x) * f x)" + proof (rule Sum_any.expand_superset [symmetric]) + show "{x. of_nat (count A x) * f x \ 0} \ set_mset A" + proof + fix x assume "x \ {x. of_nat (count A x) * f x \ 0}" + hence "count A x \ 0" + by (intro notI) auto + thus "x \# A" + by auto + qed + qed auto + finally show ?thesis . +qed + +lemma Sum_any_sum_swap: + assumes "finite A" "\y. finite {x. f x y \ 0}" + shows "Sum_any (\x. sum (f x) A) = (\y\A. Sum_any (\x. f x y))" +proof - + have "Sum_any (\x. sum (f x) A) = Sum_any (\x. Sum_any (\y. f x y when y \ A))" + unfolding when_def by (subst Sum_any.conditionalize) (use assms in simp_all) + also have "\ = Sum_any (\y. Sum_any (\x. f x y when y \ A))" + by (intro Sum_any.swap[of "(\y\A. {x. f x y \ 0}) \ A"] finite_SigmaI finite_UN_I assms) auto + also have "(\y. Sum_any (\x. f x y when y \ A)) = (\y. Sum_any (\x. f x y) when y \ A)" + by (auto simp: when_def) + also have "Sum_any \ = (\y\A. Sum_any (\x. f x y))" + unfolding when_def by (subst Sum_any.conditionalize) (use assms in simp_all) + finally show ?thesis . +qed + +lemma (in landau_pair) big_power: + assumes "f \ L F g" + shows "(\x. f x ^ n) \ L F (\x. g x ^ n)" + using big_prod[of "{.._. f" F "\_. g"] assms by simp + +lemma (in landau_pair) small_power: + assumes "f \ l F g" "n > 0" + shows "(\x. f x ^ n) \ l F (\x. g x ^ n)" + using assms(2,1) + by (induction rule: nat_induct_non_zero) (auto intro!: small.mult) + +lemma pairwise_imp_disjoint_family_on: + assumes "pairwise R A" + assumes "\m n. m \ A \ n \ A \ R m n \ f m \ f n = {}" + shows "disjoint_family_on f A" + using assms + unfolding disjoint_family_on_def pairwise_def by blast + +lemma (in comm_monoid_set) If_eq: + assumes "y \ A" "finite A" + shows "F (\x. g x (if x = y then h1 x else h2 x)) A = f (g y (h1 y)) (F (\x. g x (h2 x)) (A-{y}))" +proof - + have "F (\x. g x (if x = y then h1 x else h2 x)) A = + f (g y (h1 y)) (F (\x. g x (if x = y then h1 x else h2 x)) (A-{y}))" + using assms by (subst remove[of _ y]) auto + also have "F (\x. g x (if x = y then h1 x else h2 x)) (A-{y}) = F (\x. g x (h2 x)) (A-{y})" + by (intro cong) auto + finally show ?thesis by simp +qed + +lemma prod_nonzeroI: + fixes f :: "'a \ 'b :: {semiring_no_zero_divisors, comm_semiring_1}" + assumes "\x. x \ A \ f x \ 0" + shows "prod f A \ 0" + using assms by (induction rule: infinite_finite_induct) auto + +lemma frequently_prime_cofinite: "frequently (prime :: nat \ bool) cofinite" + unfolding INFM_nat_le by (meson bigger_prime less_imp_le) + +lemma frequently_eventually_mono: + assumes "frequently Q F" "eventually P F" "\x. P x \ Q x \ R x" + shows "frequently R F" +proof (rule frequently_mp[OF _ assms(1)]) + show "eventually (\x. Q x \ R x) F" + using assms(2) by eventually_elim (use assms(3) in blast) +qed + +lemma bij_betw_Diff: + assumes "bij_betw f A B" "bij_betw f A' B'" "A' \ A" "B' \ B" + shows "bij_betw f (A - A') (B - B')" + unfolding bij_betw_def +proof + have "inj_on f A" + using assms(1) by (auto simp: bij_betw_def) + thus "inj_on f (A - A')" + by (rule inj_on_subset) auto + have "f ` (A - A') = f ` A - f ` A'" + by (intro inj_on_image_set_diff[OF \inj_on f A\]) (use \A' \ A\ in auto) + also have "\ = B - B'" + using assms(1,2) by (auto simp: bij_betw_def) + finally show "f` (A - A') = B - B'" . +qed + +lemma bij_betw_singleton: "bij_betw f {x} {y} \ f x = y" + by (auto simp: bij_betw_def) + +end \ No newline at end of file diff --git a/thys/Hermite_Lindemann/More_Algebraic_Numbers_HLW.thy b/thys/Hermite_Lindemann/More_Algebraic_Numbers_HLW.thy new file mode 100644 --- /dev/null +++ b/thys/Hermite_Lindemann/More_Algebraic_Numbers_HLW.thy @@ -0,0 +1,245 @@ +(* + File: More_Algebraic_Numbers_HLW.thy + Author: Manuel Eberl, TU München +*) +section \More facts about algebraic numbers\ +theory More_Algebraic_Numbers_HLW + imports "Algebraic_Numbers.Algebraic_Numbers" +begin + +subsection \Miscellaneous\ + +(* TODO: Move! All of this belongs in Algebraic_Numbers *) + +lemma in_Ints_imp_algebraic [simp, intro]: "x \ \ \ algebraic x" + by (intro algebraic_int_imp_algebraic int_imp_algebraic_int) + +lemma in_Rats_imp_algebraic [simp, intro]: "x \ \ \ algebraic x" + by (auto elim!: Rats_cases' intro: algebraic_div) + +lemma algebraic_uminus_iff [simp]: "algebraic (-x) \ algebraic x" + using algebraic_uminus[of x] algebraic_uminus[of "-x"] by auto + +lemma algebraic_0 [simp]: "algebraic (0 :: 'a :: field_char_0)" + and algebraic_1 [simp]: "algebraic (1 :: 'a :: field_char_0)" + by auto + +lemma algebraic_sum [intro]: + "(\x. x \ A \ algebraic (f x)) \ algebraic (sum f A)" + by (induction A rule: infinite_finite_induct) (auto intro!: algebraic_plus) + +lemma algebraic_prod [intro]: + "(\x. x \ A \ algebraic (f x)) \ algebraic (prod f A)" + by (induction A rule: infinite_finite_induct) (auto intro!: algebraic_times) + +lemma algebraic_sum_list [intro]: + "(\x. x \ set xs \ algebraic x) \ algebraic (sum_list xs)" + by (induction xs) (auto intro!: algebraic_plus) + +lemma algebraic_prod_list [intro]: + "(\x. x \ set xs \ algebraic x) \ algebraic (prod_list xs)" + by (induction xs) (auto intro!: algebraic_times) + +lemma algebraic_sum_mset [intro]: + "(\x. x \# A \ algebraic x) \ algebraic (sum_mset A)" + by (induction A) (auto intro!: algebraic_plus) + +lemma algebraic_prod_mset [intro]: + "(\x. x \# A \ algebraic x) \ algebraic (prod_mset A)" + by (induction A) (auto intro!: algebraic_times) + +lemma algebraic_power [intro]: "algebraic x \ algebraic (x ^ n)" + by (induction n) (auto intro: algebraic_times) + +lemma algebraic_csqrt [intro]: "algebraic x \ algebraic (csqrt x)" + by (rule algebraic_nth_root[of 2 x]) auto + +lemma algebraic_csqrt_iff [simp]: "algebraic (csqrt x) \ algebraic x" +proof + assume "algebraic (csqrt x)" + hence "algebraic (csqrt x ^ 2)" + by (rule algebraic_power) + also have "csqrt x ^ 2 = x" + by simp + finally show "algebraic x" . +qed auto + +lemmas [intro] = algebraic_plus algebraic_times algebraic_uminus algebraic_div + +lemma algebraic_power_iff [simp]: + assumes "n > 0" + shows "algebraic (x ^ n) \ algebraic x" + using algebraic_nth_root[of n "x ^ n" x] assms by auto + +lemma algebraic_ii [simp]: "algebraic \" + by (intro algebraic_int_imp_algebraic) auto + +lemma algebraic_int_fact [simp, intro]: "algebraic_int (fact n)" + by (intro int_imp_algebraic_int fact_in_Ints) + +lemma algebraic_minus [intro]: "algebraic x \ algebraic y \ algebraic (x - y)" + using algebraic_plus[of x "-y"] by simp + +lemma algebraic_add_cancel_left [simp]: + assumes "algebraic x" + shows "algebraic (x + y) \ algebraic y" +proof + assume "algebraic (x + y)" + hence "algebraic (x + y - x)" + using assms by (intro algebraic_minus) auto + thus "algebraic y" by simp +qed (auto intro: algebraic_plus assms) + +lemma algebraic_add_cancel_right [simp]: + assumes "algebraic y" + shows "algebraic (x + y) \ algebraic x" + using algebraic_add_cancel_left[of y x] assms + by (simp add: add.commute del: algebraic_add_cancel_left) + +lemma algebraic_diff_cancel_left [simp]: + assumes "algebraic x" + shows "algebraic (x - y) \ algebraic y" + using algebraic_add_cancel_left[of x "-y"] assms by (simp del: algebraic_add_cancel_left) + +lemma algebraic_diff_cancel_right [simp]: + assumes "algebraic y" + shows "algebraic (x - y) \ algebraic x" + using algebraic_add_cancel_right[of "-y" x] assms by (simp del: algebraic_add_cancel_right) + +lemma algebraic_mult_cancel_left [simp]: + assumes "algebraic x" "x \ 0" + shows "algebraic (x * y) \ algebraic y" +proof + assume "algebraic (x * y)" + hence "algebraic (x * y / x)" + using assms by (intro algebraic_div) auto + also have "x * y / x = y" + using assms by auto + finally show "algebraic y" . +qed (auto intro: algebraic_times assms) + +lemma algebraic_mult_cancel_right [simp]: + assumes "algebraic y" "y \ 0" + shows "algebraic (x * y) \ algebraic x" + using algebraic_mult_cancel_left[of y x] assms + by (simp add: mult.commute del: algebraic_mult_cancel_left) + +lemma algebraic_inverse_iff [simp]: "algebraic (inverse y) \ algebraic y" +proof + assume "algebraic (inverse y)" + hence "algebraic (inverse (inverse y))" + by (rule algebraic_inverse) + thus "algebraic y" by simp +qed (auto intro: algebraic_inverse) + +lemma algebraic_divide_cancel_left [simp]: + assumes "algebraic x" "x \ 0" + shows "algebraic (x / y) \ algebraic y" +proof - + have "algebraic (x * inverse y) \ algebraic (inverse y)" + by (intro algebraic_mult_cancel_left assms) + also have "\ \ algebraic y" + by (intro algebraic_inverse_iff) + finally show ?thesis by (simp add: field_simps) +qed + +lemma algebraic_divide_cancel_right [simp]: + assumes "algebraic y" "y \ 0" + shows "algebraic (x / y) \ algebraic x" +proof - + have "algebraic (x * inverse y) \ algebraic x" + using assms by (intro algebraic_mult_cancel_right) auto + thus ?thesis by (simp add: field_simps) +qed + + +subsection \Turning an algebraic number into an algebraic integer\ + +subsection \ + Multiplying an algebraic number with a suitable integer turns it into an algebraic integer. +\ + +lemma algebraic_imp_algebraic_int: + fixes x :: "'a :: field_char_0" + assumes "ipoly p x = 0" "p \ 0" + defines "c \ Polynomial.lead_coeff p" + shows "algebraic_int (of_int c * x)" +proof - + define n where "n = Polynomial.degree p" + define p' where "p' = Abs_poly (\i. if i = n then 1 else c ^ (n - i - 1) * poly.coeff p i)" + have "n > 0" + using assms unfolding n_def by (intro Nat.gr0I) (auto elim!: degree_eq_zeroE) + + have coeff_p': "poly.coeff p' i = + (if i = n then 1 else c ^ (n - i - 1) * poly.coeff p i)" + (is "_ = ?f i") for i unfolding p'_def + proof (subst poly.Abs_poly_inverse) + have "eventually (\i. poly.coeff p i = 0) cofinite" + using MOST_coeff_eq_0 by blast + hence "eventually (\i. ?f i = 0) cofinite" + by eventually_elim (use assms in \auto simp: n_def\) + thus "?f \ {f. eventually (\i. f i = 0) cofinite}" by simp + qed auto + + have deg_p': "Polynomial.degree p' = n" + proof - + from assms have "(\n. \i>n. poly.coeff p' i = 0) = (\n. \i>n. poly.coeff p i = 0)" + by (auto simp: coeff_p' fun_eq_iff n_def) + thus ?thesis + by (simp add: Polynomial.degree_def n_def) + qed + + have lead_coeff_p': "Polynomial.lead_coeff p' = 1" + by (simp add: coeff_p' deg_p') + + have "0 = of_int (c ^ (n - 1)) * (\i\n. of_int (poly.coeff p i) * x ^ i)" + using assms unfolding n_def poly_altdef by simp + also have "\ = (\i\n. of_int (c ^ (n - 1) * poly.coeff p i) * x ^ i)" + by (simp add: sum_distrib_left sum_distrib_right mult_ac) + also have "\ = (\i\n. of_int (poly.coeff p' i) * (of_int c * x) ^ i)" + proof (intro sum.cong, goal_cases) + case (2 i) + have "of_int (poly.coeff p' i) * (of_int c * x) ^ i = + of_int (c ^ i * poly.coeff p' i) * x ^ i" + by (simp add: algebra_simps) + also have "c ^ i * poly.coeff p' i = c ^ (n - 1) * poly.coeff p i" + proof (cases "i = n") + case True + hence "c ^ i * poly.coeff p' i = c ^ n" + by (auto simp: coeff_p' simp flip: power_Suc) + also have "n = Suc (n - 1)" + using \n > 0\ by simp + also have "c ^ \ = c * c ^ (n - 1)" + by simp + finally show ?thesis + using True by (simp add: c_def n_def) + next + case False + thus ?thesis using 2 + by (auto simp: coeff_p' simp flip: power_add) + qed + finally show ?case .. + qed auto + also have "\ = ipoly p' (of_int c * x)" + by (simp add: poly_altdef n_def deg_p') + finally have "ipoly p' (of_int c * x) = 0" .. + + with lead_coeff_p' show ?thesis + unfolding algebraic_int_altdef_ipoly by blast +qed + +lemma algebraic_imp_algebraic_int': + fixes x :: "'a :: field_char_0" + assumes "ipoly p x = 0" "p \ 0" "Polynomial.lead_coeff p dvd c" + shows "algebraic_int (of_int c * x)" +proof - + from assms(3) obtain c' where c_eq: "c = Polynomial.lead_coeff p * c'" + by auto + have "algebraic_int (of_int c' * (of_int (Polynomial.lead_coeff p) * x))" + by (rule algebraic_int_times[OF _ algebraic_imp_algebraic_int]) (use assms in auto) + also have "of_int c' * (of_int (Polynomial.lead_coeff p) * x) = of_int c * x" + by (simp add: c_eq mult_ac) + finally show ?thesis . +qed + +end \ No newline at end of file diff --git a/thys/Hermite_Lindemann/More_Multivariate_Polynomial_HLW.thy b/thys/Hermite_Lindemann/More_Multivariate_Polynomial_HLW.thy new file mode 100644 --- /dev/null +++ b/thys/Hermite_Lindemann/More_Multivariate_Polynomial_HLW.thy @@ -0,0 +1,202 @@ +(* + File: More_Multivariate_Polynomial_HLW.thy + Author: Manuel Eberl, TU München +*) +section \Additional facts about multivariate polynomials\ +theory More_Multivariate_Polynomial_HLW + imports "Power_Sum_Polynomials.Power_Sum_Polynomials_Library" +begin + +subsection \Miscellaneous\ + +lemma Var_altdef: "Var i = monom (Poly_Mapping.single i 1) 1" + by transfer' (simp add: Var\<^sub>0_def) + +lemma Const_conv_monom: "Const c = monom 0 c" + by transfer' (auto simp: Const\<^sub>0_def) + +lemma smult_conv_mult_Const: "smult c p = Const c * p" + by (simp add: smult_conv_mult Const_conv_monom) + +lemma mpoly_map_vars_Var [simp]: "bij f \ mpoly_map_vars f (Var i) = Var (f i)" + unfolding Var_altdef + by (subst mpoly_map_vars_monom) (auto simp: permutep_single bij_imp_bij_inv inv_inv_eq) + +lemma symmetric_mpoly_symmetric_prod': + assumes "\\. \ permutes A \ g \ permutes X" + assumes "\x \. x \ X \ \ permutes A \ mpoly_map_vars \ (f x) = f (g \ x)" + shows "symmetric_mpoly A (\x\X. f x)" + unfolding symmetric_mpoly_def +proof safe + fix \ assume \: "\ permutes A" + have "mpoly_map_vars \ (prod f X) = (\x\X. mpoly_map_vars \ (f x))" + by simp + also have "\ = (\x\X. f (g \ x))" + by (intro prod.cong assms \ refl) + also have "\ = (\x\g \`X. f x)" + using assms(1)[OF \] by (subst prod.reindex) (auto simp: permutes_inj_on) + also have "g \ ` X = X" + using assms(1)[OF \] by (simp add: permutes_image) + finally show "mpoly_map_vars \ (prod f X) = prod f X" . +qed + + + +subsection \Converting a univariate polynomial into a multivariate one\ + +lift_definition mpoly_of_poly_aux :: "nat \ 'a :: zero poly \ (nat \\<^sub>0 nat) \\<^sub>0 'a" is + "\i c m. if Poly_Mapping.keys m \ {i} then c (Poly_Mapping.lookup m i) else 0" +proof goal_cases + case (1 i c) + hence fin: "finite {n. c n \ 0}" + by (metis eventually_cofinite) + show "finite {x. (if keys x \ {i} then c (lookup x i) else 0) \ 0}" + proof (rule finite_subset) + show "finite (Poly_Mapping.single i ` {n. c n \ 0})" + by (intro finite_imageI fin) + next + show "{x. (if keys x \ {i} then c (lookup x i) else 0) \ 0} \ + Poly_Mapping.single i ` {n. c n \ 0}" + proof (safe, split if_splits) + fix x :: "(nat \\<^sub>0 nat)" + assume x: "keys x \ {i}" "c (lookup x i) \ 0" + hence "x = Poly_Mapping.single i (lookup x i)" + by (metis Diff_eq_empty_iff keys_empty_iff lookup_single_eq + remove_key_keys remove_key_single remove_key_sum) + thus "x \ Poly_Mapping.single i ` {n. c n \ 0}" + using x by blast + qed auto + qed +qed + +lift_definition mpoly_of_poly :: "nat \ 'a :: zero poly \ 'a mpoly" is + "mpoly_of_poly_aux" . + +lemma mpoly_of_poly_0 [simp]: "mpoly_of_poly i 0 = 0" + by (transfer', transfer) auto + +lemma coeff_mpoly_of_poly1 [simp]: + "coeff (mpoly_of_poly i p) (Poly_Mapping.single i n) = poly.coeff p n" + by (transfer', transfer') auto + +lemma coeff_mpoly_of_poly2 [simp]: + assumes "\keys x \ {i}" + shows "coeff (mpoly_of_poly i p) x = 0" + using assms by (transfer', transfer') auto + +lemma coeff_mpoly_of_poly: + "coeff (mpoly_of_poly i p) m = + (poly.coeff p (Poly_Mapping.lookup m i) when keys m \ {i})" + by (transfer', transfer') auto + +lemma poly_mapping_single_eq_0_iff [simp]: "Poly_Mapping.single i n = 0 \ n = 0" + by (metis lookup_single_eq single_zero) + +lemma mpoly_of_poly_pCons [simp]: + fixes p :: "'a :: semiring_1 poly" + shows "mpoly_of_poly i (pCons c p) = Const c + Var i * mpoly_of_poly i p" +proof (rule mpoly_eqI) + fix mon :: "nat \\<^sub>0 nat" + define moni :: "nat \\<^sub>0 nat" where "moni = Poly_Mapping.single i 1" + have "coeff (Var i * mpoly_of_poly i p) mon = + (\l. (1 when l = moni) * (\q. coeff (mpoly_of_poly i p) q when mon = moni + q))" + unfolding coeff_mpoly_times prod_fun_def coeff_Var moni_def + by (rule Sum_any.cong) (auto simp: when_def) + also have "\ = (\a. coeff (mpoly_of_poly i p) a when mon = moni + a)" + by (subst Sum_any_left_distrib [symmetric]) simp_all + finally have eq: "coeff (Var i * mpoly_of_poly i p) mon = \" . + + show "coeff (mpoly_of_poly i (pCons c p)) mon = coeff (Const c + Var i * mpoly_of_poly i p) mon" + proof (cases "keys mon \ {i}") + case False + hence [simp]: "mon \ 0" + by auto + obtain j where j: "j \ keys mon" "j \ i" + using False by auto + have "coeff (mpoly_of_poly i p) mon' = 0" if mon_eq: "mon = moni + mon'" for mon' + proof - + have "Poly_Mapping.lookup mon j \ 0" + using j by (meson lookup_eq_zero_in_keys_contradict) + also have "Poly_Mapping.lookup mon j = Poly_Mapping.lookup mon' j" + unfolding mon_eq moni_def using j by (simp add: lookup_add lookup_single) + finally have "j \ keys mon'" + by (meson lookup_not_eq_zero_eq_in_keys) + with j have "\keys mon' \ {i}" + by blast + thus ?thesis by simp + qed + hence "coeff (Var i * mpoly_of_poly i p) mon = 0" + unfolding eq by (intro Sum_any_zeroI) (auto simp: when_def) + thus ?thesis using False + by (simp add: mpoly_coeff_Const) + next + case True + define n where "n = Poly_Mapping.lookup mon i" + have mon_eq: "mon = Poly_Mapping.single i n" + using True unfolding n_def + by (metis Diff_eq_empty_iff add_cancel_right_left keys_empty_iff remove_key_keys remove_key_sum) + have eq': "mon = moni + mon' \ n > 0 \ mon' = Poly_Mapping.single i (n - 1)" for mon' + proof safe + assume eq: "mon = moni + mon'" + thus "n > 0" "mon' = Poly_Mapping.single i (n - 1)" + unfolding moni_def mon_eq using gr0I by (force simp: single_diff)+ + next + assume "n > 0" "mon' = Poly_Mapping.single i (n - 1)" + thus "mon = moni + Poly_Mapping.single i (n - 1)" + unfolding mon_eq moni_def by (subst single_add [symmetric]) auto + qed + have "coeff (Var i * mpoly_of_poly i p) mon = (poly.coeff p (n - 1) when (n > 0))" + unfolding eq eq' by (auto simp: when_def) + thus ?thesis + by (auto simp: mon_eq when_def mpoly_coeff_Const coeff_pCons split: nat.splits) + qed +qed + +lemma mpoly_of_poly_1 [simp]: "mpoly_of_poly i 1 = 1" + unfolding one_pCons mpoly_of_poly_pCons mpoly_of_poly_0 by simp + +lemma mpoly_of_poly_uminus [simp]: "mpoly_of_poly i (-p) = -mpoly_of_poly i p" + by (rule mpoly_eqI) (auto simp: coeff_mpoly_of_poly when_def) + +lemma mpoly_of_poly_add [simp]: "mpoly_of_poly i (p + q) = mpoly_of_poly i p + mpoly_of_poly i q" + by (rule mpoly_eqI) (auto simp: coeff_mpoly_of_poly when_def) + +lemma mpoly_of_poly_diff [simp]: "mpoly_of_poly i (p - q) = mpoly_of_poly i p - mpoly_of_poly i q" + by (rule mpoly_eqI) (auto simp: coeff_mpoly_of_poly when_def) + +lemma mpoly_of_poly_smult [simp]: + "mpoly_of_poly i (Polynomial.smult c p) = smult c (mpoly_of_poly i p)" + by (rule mpoly_eqI) (auto simp: coeff_mpoly_of_poly when_def) + +lemma mpoly_of_poly_mult [simp]: + fixes p q :: "'a :: comm_semiring_1 poly" + shows "mpoly_of_poly i (p * q) = mpoly_of_poly i p * mpoly_of_poly i q" + by (induction p) (auto simp: algebra_simps smult_conv_mult_Const) + +lemma insertion_mpoly_of_poly [simp]: "insertion f (mpoly_of_poly i p) = poly p (f i)" + by (induction p) (auto simp: insertion_add insertion_mult) + +lemma mapping_of_mpoly_of_poly [simp]: "mapping_of (mpoly_of_poly i p) = mpoly_of_poly_aux i p" + by transfer' simp + +lemma vars_mpoly_of_poly: "vars (mpoly_of_poly i p) \ {i}" +proof - + have "x = i" if "xa \ keys (mpoly_of_poly_aux i p)" "x \ keys xa" for x xa + using that + by (meson in_mono lookup_eq_zero_in_keys_contradict mpoly_of_poly_aux.rep_eq singletonD) + thus ?thesis + by (auto simp: vars_def) +qed + +lemma mpoly_map_vars_mpoly_of_poly [simp]: + assumes "bij f" + shows "mpoly_map_vars f (mpoly_of_poly i p) = mpoly_of_poly (f i) p" +proof (rule mpoly_eqI, goal_cases) + case (1 mon) + have "f -` keys mon \ {i} \ keys mon \ {f i}" + using assms by (simp add: vimage_subset_eq) + thus ?case using assms + by (simp add: coeff_mpoly_map_vars coeff_mpoly_of_poly lookup_permutep keys_permutep when_def) +qed + +end \ No newline at end of file diff --git a/thys/Hermite_Lindemann/More_Polynomial_HLW.thy b/thys/Hermite_Lindemann/More_Polynomial_HLW.thy new file mode 100644 --- /dev/null +++ b/thys/Hermite_Lindemann/More_Polynomial_HLW.thy @@ -0,0 +1,518 @@ +(* + File: More_Polynomial_HLW.thy + Author: Manuel Eberl, TU München +*) +section \Auxiliary facts about univariate polynomials\ +theory More_Polynomial_HLW +imports + "HOL-Computational_Algebra.Computational_Algebra" + "Polynomial_Factorization.Gauss_Lemma" + "Power_Sum_Polynomials.Power_Sum_Polynomials_Library" + "Algebraic_Numbers.Algebraic_Numbers" +begin + +instance poly :: ("{idom_divide,normalization_semidom_multiplicative,factorial_ring_gcd, + semiring_gcd_mult_normalize}") factorial_semiring_multiplicative .. + +lemma lead_coeff_prod_mset: + fixes A :: "'a::{comm_semiring_1, semiring_no_zero_divisors} poly multiset" + shows "Polynomial.lead_coeff (prod_mset A) = prod_mset (image_mset Polynomial.lead_coeff A)" + by (induction A) (auto simp: Polynomial.lead_coeff_mult) + +lemma content_normalize [simp]: + fixes p :: "'a :: {factorial_semiring, idom_divide, semiring_gcd, normalization_semidom_multiplicative} poly" + shows "content (normalize p) = content p" +proof (cases "p = 0") + case [simp]: False + have "content p = content (unit_factor p * normalize p)" + by simp + also have "\ = content (unit_factor p) * content (normalize p)" + by (rule content_mult) + also have "content (unit_factor p) = 1" + by (auto simp: unit_factor_poly_def) + finally show ?thesis by simp +qed auto + +lemma rat_to_normalized_int_poly_exists: + fixes p :: "rat poly" + assumes "p \ 0" + obtains q lc where "p = Polynomial.smult lc (of_int_poly q)" "lc > 0" "content q = 1" +proof - + define lc where "lc = fst (rat_to_normalized_int_poly p)" + define q where "q = snd (rat_to_normalized_int_poly p)" + have eq: "rat_to_normalized_int_poly p = (lc, q)" + by (simp add: lc_def q_def) + show ?thesis + using rat_to_normalized_int_poly[OF eq] assms + by (intro that[of lc q]) auto +qed + +lemma irreducible_imp_squarefree: + assumes "irreducible p" + shows "squarefree p" +proof (rule squarefreeI) + fix q assume "q ^ 2 dvd p" + then obtain r where qr: "p = q ^ 2 * r" + by (elim dvdE) + have "q dvd 1 \ q * r dvd 1" + by (intro irreducibleD[OF assms]) (use qr in \simp_all add: power2_eq_square mult_ac\) + thus "q dvd 1" + by (meson dvd_mult_left) +qed + +lemma squarefree_imp_rsquarefree: + fixes p :: "'a :: idom poly" + assumes "squarefree p" + shows "rsquarefree p" + unfolding rsquarefree_def +proof (intro conjI allI) + fix x :: 'a + have "Polynomial.order x p < 2" + proof (rule ccontr) + assume "\(Polynomial.order x p < 2)" + hence "[:-x, 1:] ^ 2 dvd p" + by (subst order_divides) auto + from assms and this have "[:-x, 1:] dvd 1" + by (rule squarefreeD) + hence "Polynomial.degree [:-x, 1:] \ Polynomial.degree (1 :: 'a poly)" + by (rule dvd_imp_degree_le) auto + thus False by simp + qed + thus "Polynomial.order x p = 0 \ Polynomial.order x p = 1" + by linarith +qed (use assms in auto) + +lemma squarefree_imp_coprime_pderiv: + fixes p :: "'a :: {factorial_ring_gcd,semiring_gcd_mult_normalize,semiring_char_0} poly" + assumes "squarefree p" and "content p = 1" + shows "Rings.coprime p (pderiv p)" +proof (rule coprimeI_primes) + fix d assume d: "prime d" "d dvd p" "d dvd pderiv p" + show False + proof (cases "Polynomial.degree d = 0") + case deg: False + obtain q where dq: "p = d * q" + using d by (elim dvdE) + have \d dvd q * pderiv d\ + using d by (simp add: dq pderiv_mult dvd_add_right_iff) + moreover have "\d dvd pderiv d" + proof + assume "d dvd pderiv d" + hence "Polynomial.degree d \ Polynomial.degree (pderiv d)" + using d deg by (intro dvd_imp_degree_le) (auto simp: pderiv_eq_0_iff) + hence "Polynomial.degree d = 0" + by (subst (asm) degree_pderiv) auto + thus False using deg by contradiction + qed + ultimately have "d dvd q" + using d(1) by (simp add: prime_dvd_mult_iff) + hence "d ^ 2 dvd p" + by (auto simp: dq power2_eq_square) + from assms(1) and this have "is_unit d" + by (rule squarefreeD) + thus False using \prime d\ by auto + next + case True + then obtain d' where [simp]: "d = [:d':]" + by (elim degree_eq_zeroE) + from d have "d' dvd content p" + by (simp add: const_poly_dvd_iff_dvd_content) + with assms and prime_imp_prime_elem[OF \prime d\] show False + by (auto simp: prime_elem_const_poly_iff) + qed +qed (use assms in auto) + +lemma irreducible_imp_coprime_pderiv: + fixes p :: "'a :: {idom_divide,semiring_char_0} poly" + assumes "irreducible p" "Polynomial.degree p \ 0" + shows "Rings.coprime p (pderiv p)" +proof (rule Rings.coprimeI) + fix d assume d: "d dvd p" "d dvd pderiv p" + obtain q where dq: "p = d * q" + using d by (elim dvdE) + have "is_unit d \ is_unit q" + using assms dq by (auto simp: irreducible_def) + thus "is_unit d" + proof + assume unit: "is_unit q" + with d have "p dvd pderiv p" + using algebraic_semidom_class.mult_unit_dvd_iff dq by blast + hence "Polynomial.degree p = 0" + by (meson not_dvd_pderiv) + with assms(2) show ?thesis by contradiction + qed +qed + +lemma poly_gcd_eq_0I: + assumes "poly p x = 0" "poly q x = 0" + shows "poly (gcd p q) x = 0" + using assms by (simp add: poly_eq_0_iff_dvd) + +lemma poly_eq_0_coprime: + assumes "Rings.coprime p q" "p \ 0" "q \ 0" + shows "poly p x \ 0 \ poly q x \ 0" +proof - + have False if "poly p x = 0" "poly q x = 0" + proof - + have "[:-x, 1:] dvd p" "[:-x, 1:] dvd q" + using that by (simp_all add: poly_eq_0_iff_dvd) + hence "[:-x, 1:] dvd 1" + using \Rings.coprime p q\ by (meson not_coprimeI) + thus False + by (simp add: is_unit_poly_iff) + qed + thus ?thesis + by blast +qed + +lemma coprime_of_int_polyI: + assumes "Rings.coprime p q" + shows "Rings.coprime (of_int_poly p) (of_int_poly q :: 'a :: {field_char_0,field_gcd} poly)" + using assms gcd_of_int_poly[of p q, where ?'a = 'a] unfolding coprime_iff_gcd_eq_1 by simp + +lemma irreducible_imp_rsquarefree_of_int_poly: + fixes p :: "int poly" + assumes "irreducible p" and "Polynomial.degree p > 0" + shows "rsquarefree (of_int_poly p :: 'a :: {field_gcd, field_char_0} poly)" +proof - + { + fix x :: 'a + assume x: "poly (of_int_poly p) x = 0" "poly (pderiv (of_int_poly p)) x = 0" + define d where "d = gcd (of_int_poly p) (pderiv (of_int_poly p) :: 'a poly)" + have "poly d x = 0" + using x unfolding d_def by (intro poly_gcd_eq_0I) auto + moreover have "d \ 0" + using assms by (auto simp: d_def) + ultimately have "0 < Polynomial.degree d" + by (intro Nat.gr0I) (auto elim!: degree_eq_zeroE) + also have "Polynomial.degree d = Polynomial.degree (gcd p (pderiv p))" + unfolding d_def of_int_hom.map_poly_pderiv[symmetric] gcd_of_int_poly by simp + finally have deg: "\ > 0" . + + have "gcd p (pderiv p) dvd p" + by auto + from irreducibleD'[OF assms(1) this] and deg have "p dvd gcd p (pderiv p)" + by auto + also have "\ dvd pderiv p" + by auto + finally have "Polynomial.degree p = 0" + by auto + with assms have False by simp + } + thus ?thesis by (auto simp: rsquarefree_roots) +qed + +lemma squarefree_of_int_polyI: + assumes "squarefree p" "content p = 1" + shows "squarefree (of_int_poly p :: 'a :: {field_char_0,field_gcd} poly)" +proof - + have "Rings.coprime p (pderiv p)" + by (rule squarefree_imp_coprime_pderiv) fact+ + hence "Rings.coprime (of_int_poly p :: 'a poly) (of_int_poly (pderiv p))" + by (rule coprime_of_int_polyI) + also have "of_int_poly (pderiv p) = pderiv (of_int_poly p :: 'a poly)" + by (simp add: of_int_hom.map_poly_pderiv) + finally show ?thesis + using coprime_pderiv_imp_squarefree by blast +qed + +lemma higher_pderiv_pcompose_linear: + "(pderiv ^^ n) (pcompose p [:0, c:]) = + Polynomial.smult (c ^ n) (pcompose ((pderiv ^^ n) p) [:0, c:])" + by (induction n) (simp_all add: pderiv_pcompose pderiv_smult pderiv_pCons pcompose_smult mult_ac) + +lemma poly_poly_eq: + "poly (poly p [:x:]) y = poly (eval_poly (\p. [:poly p y:]) p [:0, 1:]) x" + by (induction p) (auto simp: eval_poly_def) + +lemma poly_poly_poly_y_x [simp]: + fixes p :: "'a :: idom poly poly" + shows "poly (poly (poly_y_x p) [:y:]) x = poly (poly p [:x:]) y" +proof (induction p) + case (pCons a p) + have "poly (poly (poly_y_x (pCons a p)) [:y:]) x = + poly a y + poly (poly (map_poly (pCons 0) (poly_y_x p)) [:y:]) x" + by (simp add: poly_y_x_pCons eval_poly_def) + also have "pCons 0 = (\p::'a poly. Polynomial.monom 1 1 * p)" + by (simp add: Polynomial.monom_altdef) + also have "map_poly \ (poly_y_x p) = Polynomial.smult (Polynomial.monom 1 1) (poly_y_x p)" + by (simp add: smult_conv_map_poly) + also have "poly \ [:y:] = Polynomial.monom 1 1 * poly (poly_y_x p) [:y:]" + by simp + also have "poly a y + poly \ x = poly (poly (pCons a p) [:x:]) y" + by (simp add: pCons poly_monom) + finally show ?case . +qed auto + +lemma (in idom_hom) map_poly_higher_pderiv [hom_distribs]: + "map_poly hom ((pderiv ^^ n) p) = (pderiv ^^ n) (map_poly hom p)" + by (induction n) (simp_all add: map_poly_pderiv) + +lemma coeff_prod_linear_factors: + fixes f :: "'a \ 'b :: comm_ring_1" + assumes [intro]: "finite A" + shows "Polynomial.coeff (\x\A. [:-f x, 1:] ^ e x) i = + (\X | X \ Pow (SIGMA x:A. {.. i = sum e A - card X. + (-1) ^ card X * (\x\X. f (fst x)))" +proof - + define poly_X where "poly_X = (Polynomial.monom 1 1 :: 'b poly)" + have [simp]: "(- 1) ^ n = [:(- 1) ^ n :: 'b:]" for n :: nat + by (simp flip: pCons_one add: poly_const_pow) + have "(\x\A. [:-f x, 1:] ^ e x) = (\(x,_)\Sigma A (\x. {.. = (\(x,_)\Sigma A (\x. {.. = (\X\Pow (SIGMA x:A. {..x\X. f (fst x))) + (poly_X ^ card ((SIGMA x:A. {.. = (\X\Pow (SIGMA x:A. {..x\X. f (fst x))) (card ((SIGMA x:A. {.. i = (\X\{X\Pow (SIGMA x:A. {..x\X. f (fst x)))" + unfolding Polynomial.coeff_sum + proof (intro sum.mono_neutral_cong_right ballI, goal_cases) + case (3 X) + hence X: "X \ (SIGMA x:A. {.. card (SIGMA x:A. {.. (SIGMA x:A. {..i. poly.coeff p i \ A" "x \ A" + shows "poly p x \ A" + unfolding poly_altdef by (intro sum_closed mult_closed power_closed assms) + +lemma (in ring_closed) coeff_pCons_closed [intro]: + assumes "\i. poly.coeff p i \ A" "x \ A" + shows "poly.coeff (pCons x p) i \ A" + unfolding poly_altdef using assms by (auto simp: coeff_pCons split: nat.splits) + +lemma (in ring_closed) coeff_poly_mult_closed [intro]: + assumes "\i. poly.coeff p i \ A" "\i. poly.coeff q i \ A" + shows "poly.coeff (p * q) i \ A" + unfolding coeff_mult using assms by auto + +lemma (in ring_closed) coeff_poly_prod_closed [intro]: + assumes "\x i. x \ X \ poly.coeff (f x) i \ A" + shows "poly.coeff (prod f X) i \ A" + using assms by (induction X arbitrary: i rule: infinite_finite_induct) auto + +lemma (in ring_closed) coeff_poly_power_closed [intro]: + assumes "\i. poly.coeff p i \ A" + shows "poly.coeff (p ^ n) i \ A" + using coeff_poly_prod_closed[of "{.._. p" i] assms by simp + +lemma (in ring_closed) synthetic_div_closed: + assumes "\i. poly.coeff p i \ A" "x \ A" + shows "poly.coeff (synthetic_div p x) i \ A" +proof - + from assms(1) have "\i. poly.coeff p i \ A" + by blast + from this and assms(2) show ?thesis + by (induction p arbitrary: i) (auto simp: coeff_pCons split: nat.splits) +qed + +lemma pcompose_monom: "pcompose (Polynomial.monom c n) p = Polynomial.smult c (p ^ n)" + by (simp add: monom_altdef pcompose_hom.hom_power pcompose_smult) + +lemma poly_roots_uminus [simp]: "poly_roots (-p) = poly_roots p" + using poly_roots_smult[of "-1" p] by (simp del: poly_roots_smult) + +lemma poly_roots_normalize [simp]: + fixes p :: "'a :: {normalization_semidom, idom_divide} poly" + shows "poly_roots (normalize p) = poly_roots p" +proof (cases "p = 0") + case [simp]: False + have "poly_roots p = poly_roots (unit_factor p * normalize p)" + by simp + also have "\ = poly_roots (normalize p)" + unfolding unit_factor_poly_def by simp + finally show ?thesis .. +qed auto + + +lemma poly_roots_of_int_normalize [simp]: + "poly_roots (of_int_poly (normalize p) :: 'a :: {idom, ring_char_0} poly) = + poly_roots (of_int_poly p)" +proof (cases "p = 0") + case [simp]: False + have "poly_roots (of_int_poly p :: 'a poly) = poly_roots (of_int_poly (unit_factor p * normalize p))" + by simp + also have "\ = poly_roots (Polynomial.smult (of_int (sgn (Polynomial.lead_coeff p))) + (of_int_poly (normalize p)))" + by (simp add: unit_factor_poly_def of_int_hom.map_poly_hom_smult) + also have "\ = poly_roots (Ring_Hom_Poly.of_int_poly (normalize p) :: 'a poly)" + by (intro poly_roots_smult) (auto simp: sgn_if) + finally show ?thesis .. +qed auto + +lemma poly_roots_power [simp]: "poly_roots (p ^ n) = repeat_mset n (poly_roots p)" +proof (cases "p = 0") + case True + thus ?thesis by (cases n) auto +next + case False + thus ?thesis by (induction n) (auto simp: poly_roots_mult) +qed + +lemma poly_roots_conv_sum_prime_factors: + "poly_roots q = (\p\#prime_factorization q. poly_roots p)" +proof (cases "q = 0") + case [simp]: False + + have "(\p\#prime_factorization q. poly_roots p) = + poly_roots (prod_mset (prime_factorization q))" + by (rule poly_roots_prod_mset [symmetric]) auto + also have "\ = poly_roots (normalize (prod_mset (prime_factorization q)))" + by simp + also have "normalize (prod_mset (prime_factorization q)) = normalize q" + by (rule prod_mset_prime_factorization_weak) auto + also have "poly_roots \ = poly_roots q" + by simp + finally show ?thesis .. +qed auto + +lemma poly_roots_of_int_conv_sum_prime_factors: + "poly_roots (of_int_poly q :: 'a :: {idom, ring_char_0} poly) = + (\p\#prime_factorization q. poly_roots (of_int_poly p))" +proof (cases "q = 0") + case [simp]: False + + have "(\p\#prime_factorization q. poly_roots (of_int_poly p :: 'a poly)) = + poly_roots (\p\#prime_factorization q. of_int_poly p)" + by (subst poly_roots_prod_mset) (auto simp: multiset.map_comp o_def) + also have "(\p\#prime_factorization q. of_int_poly p :: 'a poly) = + of_int_poly (prod_mset (prime_factorization q))" + by simp + also have "poly_roots \ = poly_roots (of_int_poly (normalize (prod_mset (prime_factorization q))))" + by (rule poly_roots_of_int_normalize [symmetric]) + also have "normalize (prod_mset (prime_factorization q)) = normalize q" + by (rule prod_mset_prime_factorization_weak) auto + also have "poly_roots (of_int_poly \ :: 'a poly) = poly_roots (of_int_poly q)" + by simp + finally show ?thesis .. +qed auto + +lemma dvd_imp_poly_roots_subset: + assumes "q \ 0" "p dvd q" + shows "poly_roots p \# poly_roots q" +proof - + from assms have "p \ 0" + by auto + thus ?thesis + using assms by (intro mset_subset_eqI) (auto intro: dvd_imp_order_le) +qed + +lemma abs_prod_mset: "\prod_mset (A :: 'a :: idom_abs_sgn multiset)\ = prod_mset (image_mset abs A)" + by (induction A) (auto simp: abs_mult) + +lemma content_1_imp_nonconstant_prime_factors: + assumes "content (p :: int poly) = 1" and "q \ prime_factors p" + shows "Polynomial.degree q > 0" +proof - + let ?d = "Polynomial.degree :: int poly \ nat" + let ?lc = "Polynomial.lead_coeff :: int poly \ int" + define P where "P = prime_factorization p" + define P1 where "P1 = filter_mset (\p. ?d p = 0) P" + define P2 where "P2 = filter_mset (\p. ?d p > 0) P" + have [simp]: "p \ 0" + using assms by auto + have "1 = content (normalize p)" + using assms by simp + also have "normalize p = prod_mset P" + unfolding P_def by (rule prod_mset_prime_factorization [symmetric]) auto + also have "P = filter_mset (\p. ?d p = 0) P + filter_mset (\p. ?d p > 0) P" + by (induction P) auto + also have "prod_mset \ = prod_mset P1 * prod_mset P2" + unfolding P1_def P2_def by (subst prod_mset.union) auto + also have "content \ = content (prod_mset P1) * content (prod_mset P2)" + unfolding content_mult .. + also have "image_mset id P1 = image_mset (\q. [:?lc q:]) P1" + by (intro image_mset_cong) (auto simp: P1_def elim!: degree_eq_zeroE) + hence "P1 = image_mset (\q. [:?lc q:]) P1" + by simp + also have "content (prod_mset \) = \(\q\#P1. ?lc q)\" + by (simp add: content_prod_mset multiset.map_comp o_def abs_prod_mset) + finally have "\(\q\#P1. ?lc q)\ * content (prod_mset P2) = 1" .. + hence "\(\q\#P1. ?lc q)\ dvd 1" + unfolding dvd_def by metis + + have "set_mset P1 = {}" + proof (rule ccontr) + assume "set_mset P1 \ {}" + then obtain q where q: "q \# P1" + by blast + have "\?lc q\ dvd (\q\#P1. \?lc q\)" + by (rule dvd_prod_mset) (use q in auto) + also have "\ = \(\q\#P1. ?lc q)\" + by (simp add: abs_prod_mset multiset.map_comp o_def) + also have "\ dvd 1" + by fact + finally have "is_unit (?lc q)" + by simp + hence "is_unit q" + using q unfolding P1_def by (auto elim!: degree_eq_zeroE) + moreover have "prime q" + using q unfolding P1_def P_def by auto + ultimately show False by auto + qed + with assms show ?thesis + by (auto simp: P1_def P_def) +qed + +end \ No newline at end of file diff --git a/thys/Hermite_Lindemann/ROOT b/thys/Hermite_Lindemann/ROOT new file mode 100644 --- /dev/null +++ b/thys/Hermite_Lindemann/ROOT @@ -0,0 +1,14 @@ +chapter AFP + +session Hermite_Lindemann (AFP) = "Pi_Transcendental" + + options [timeout = 1200] + sessions + "HOL-Library" + Algebraic_Numbers + Power_Sum_Polynomials + theories + Hermite_Lindemann + document_files + "root.tex" + "root.bib" + diff --git a/thys/Hermite_Lindemann/document/root.bib b/thys/Hermite_Lindemann/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Hermite_Lindemann/document/root.bib @@ -0,0 +1,36 @@ +@book{baker, + series={Cambridge Mathematical Library}, + title={Transcendental Number Theory}, + DOI={10.1017/CBO9780511565977}, + isbn={9780521397919}, + publisher={Cambridge University Press}, + author={Baker, Alan}, + year={1975}, +} + +@article{redheffer_steinberg, +author = {Robert Steinberg and Raymond Moos Redheffer}, +title = {Analytic proof of the {L}indemann theorem}, +volume = {2}, +journal = {Pacific Journal of Mathematics}, +number = {2}, +pages = {231--242}, +year = {1952}, +doi = {10.2140/pjm.1952.2.231} +} + + +@inproceedings{bernard, + author = {Sophie Bernard}, + editor = {Mauricio Ayala{-}Rinc{\'{o}}n and + C{\'{e}}sar A. Mu{\~{n}}oz}, + title = {Formalization of the {L}indemann-{W}eierstrass Theorem}, + booktitle = {Interactive Theorem Proving - 8th International Conference, {ITP} + 2017, Bras{\'i}lia, Brazil, September 26-29, 2017, Proceedings}, + series = {Lecture Notes in Computer Science}, + volume = {10499}, + pages = {65--80}, + publisher = {Springer}, + year = {2017}, + doi = {10.1007/978-3-319-66107-0_5} +} \ No newline at end of file diff --git a/thys/Hermite_Lindemann/document/root.tex b/thys/Hermite_Lindemann/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Hermite_Lindemann/document/root.tex @@ -0,0 +1,63 @@ +\documentclass[11pt,a4paper]{article} +\usepackage{isabelle,isabellesym} +\usepackage{amsfonts, amsmath, amssymb} + +% this should be the last package used +\usepackage{pdfsetup} +\usepackage[shortcuts]{extdash} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + +\begin{document} + +\title{The Hermite--Lindemann--Weierstraß Transcendence Theorem} +\author{Manuel Eberl} +\maketitle + +\begin{abstract} +This article provides a formalisation of the Her\-mite\--Lin\-de\-mann\--Wei\-er\-straß Theorem +(also known as simply Her\-mite\--Lin\-de\-mann or Lin\-de\-mann\--Wei\-er\-straß). + 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~\cite{bernard}, I proceeded by formalising +Baker's alternative formulation of the theorem~\cite{baker} 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 \quad\quad\text{iff}\quad\quad + \forall i.\ \beta_i = 0\] + +This has a number of immediate corollaries, e.g.: +\begin{itemize} +\item $e$ and $\pi$ are transcendental +\item $e^z$, $\sin z$, $\tan z$, etc.\ are transcendental for algebraic $z\in\mathbb{C}\setminus\{0\}$ +\item $\ln z$ is transcendental for algebraic $z\in\mathbb{C}\setminus\{0, 1\}$ +\end{itemize} +\end{abstract} + +\newpage +\tableofcontents +\newpage +\parindent 0pt\parskip 0.5ex + +\input{session} + +\nocite{baker} +\nocite{redheffer_steinberg} +\nocite{bernard} + +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/Mereology/CEM.thy b/thys/Mereology/CEM.thy new file mode 100644 --- /dev/null +++ b/thys/Mereology/CEM.thy @@ -0,0 +1,1170 @@ +section \ Closed Extensional Mereology \ + +(*<*) +theory CEM + imports CM EM +begin +(*>*) + +text \ Closed extensional mereology combines closed mereology with extensional mereology.\footnote{ +See @{cite "varzi_parts_1996"} p. 263 and @{cite "casati_parts_1999"} p. 43.} \ + +locale CEM = CM + EM + +text \ Likewise, closed minimal mereology combines closed mereology with minimal mereology.\footnote{ +See @{cite "casati_parts_1999"} p. 43.} \ + +locale CMM = CM + MM + +text \ But famously closed minimal mereology and closed extensional mereology are the same theory, +because in closed minimal mereology product closure and weak supplementation entail strong +supplementation.\footnote{See @{cite "simons_parts:_1987"} p. 31 and @{cite "casati_parts_1999"} p. 44.} \ + +sublocale CMM \ CEM +proof + fix x y + show strong_supplementation: "\ P x y \ (\ z. P z x \ \ O z y)" + proof - + assume "\ P x y" + show "\ z. P z x \ \ O z y" + proof cases + assume "O x y" + with `\ P x y` have "\ P x y \ O x y".. + hence "PP (x \ y) x" by (rule nonpart_implies_proper_product) + hence "\ z. P z x \ \ O z (x \ y)" by (rule weak_supplementation) + then obtain z where z: "P z x \ \ O z (x \ y)".. + hence "\ O z y" by (rule disjoint_from_second_factor) + moreover from z have "P z x".. + hence "P z x \ \ O z y" + using `\ O z y`.. + thus "\ z. P z x \ \ O z y".. + next + assume "\ O x y" + with part_reflexivity have "P x x \ \ O x y".. + thus "(\ z. P z x \ \ O z y)".. + qed + qed +qed + +sublocale CEM \ CMM.. + +subsection \ Sums \ + +context CEM +begin + +lemma sum_intro: + "(\ w. O w z \ (O w x \ O w y)) \ x \ y = z" +proof - + assume sum: "\ w. O w z \ (O w x \ O w y)" + hence "(THE v. \ w. O w v \ (O w x \ O w y)) = z" + proof (rule the_equality) + fix a + assume a: "\ w. O w a \ (O w x \ O w y)" + have "\ w. O w a \ O w z" + proof + fix w + from sum have "O w z \ (O w x \ O w y)".. + moreover from a have "O w a \ (O w x \ O w y)".. + ultimately show "O w a \ O w z" by (rule ssubst) + qed + with overlap_extensionality show "a = z".. + qed + thus "x \ y = z" + using sum_eq by (rule subst) +qed + +lemma sum_idempotence: "x \ x = x" +proof - + have "\ w. O w x \ (O w x \ O w x)" + proof + fix w + show "O w x \ (O w x \ O w x)" + proof (rule iffI) + assume "O w x" + thus "O w x \ O w x".. + next + assume "O w x \ O w x" + thus "O w x" by (rule disjE) + qed + qed + thus "x \ x = x" by (rule sum_intro) +qed + +lemma part_sum_identity: "P y x \ x \ y = x" +proof - + assume "P y x" + have "\ w. O w x \ (O w x \ O w y)" + proof + fix w + show "O w x \ (O w x \ O w y)" + proof + assume "O w x" + thus "O w x \ O w y".. + next + assume "O w x \ O w y" + thus "O w x" + proof + assume "O w x" + thus "O w x". + next + assume "O w y" + with `P y x` show "O w x" + by (rule overlap_monotonicity) + qed + qed + qed + thus "x \ y = x" by (rule sum_intro) +qed + +lemma sum_character: "\ w. O w (x \ y) \ (O w x \ O w y)" +proof - + from sum_closure have "(\ z. \ w. O w z \ (O w x \ O w y))". + then obtain a where a: "\ w. O w a \ (O w x \ O w y)".. + hence "x \ y = a" by (rule sum_intro) + thus "\ w. O w (x \ y) \ (O w x \ O w y)" + using a by (rule ssubst) +qed + +lemma sum_overlap: "O w (x \ y) \ (O w x \ O w y)" + using sum_character.. + +lemma sum_part_character: + "P w (x \ y) \ (\ v. O v w \ O v x \ O v y)" +proof + assume "P w (x \ y)" + show "\ v. O v w \ O v x \ O v y" + proof + fix v + show "O v w \ O v x \ O v y" + proof + assume "O v w" + with `P w (x \ y)` have "O v (x \ y)" + by (rule overlap_monotonicity) + with sum_overlap show "O v x \ O v y".. + qed + qed +next + assume right: "\ v. O v w \ O v x \ O v y" + have "\ v. O v w \ O v (x \ y)" + proof + fix v + from right have "O v w \ O v x \ O v y".. + with sum_overlap show "O v w \ O v (x \ y)" + by (rule ssubst) + qed + with part_overlap_eq show "P w (x \ y)".. +qed + +lemma sum_commutativity: "x \ y = y \ x" +proof - + from sum_character have "\ w. O w (y \ x) \ O w y \ O w x". + hence "\ w. O w (y \ x) \ O w x \ O w y" by metis + thus "x \ y = y \ x" by (rule sum_intro) +qed + +lemma first_summand_overlap: "O z x \ O z (x \ y)" +proof - + assume "O z x" + hence "O z x \ O z y".. + with sum_overlap show "O z (x \ y)".. +qed + +lemma first_summand_disjointness: "\ O z (x \ y) \ \ O z x" +proof - + assume "\ O z (x \ y)" + show "\ O z x" + proof + assume "O z x" + hence "O z (x \ y)" by (rule first_summand_overlap) + with `\ O z (x \ y)` show "False".. + qed +qed + +lemma first_summand_in_sum: "P x (x \ y)" +proof - + have "\ w. O w x \ O w (x \ y)" + proof + fix w + show "O w x \ O w (x \ y)" + proof + assume "O w x" + thus "O w (x \ y)" + by (rule first_summand_overlap) + qed + qed + with part_overlap_eq show "P x (x \ y)".. +qed + +lemma common_first_summand: "P x (x \ y) \ P x (x \ z)" +proof + from first_summand_in_sum show "P x (x \ y)". + from first_summand_in_sum show "P x (x \ z)". +qed + +lemma common_first_summand_overlap: "O (x \ y) (x \ z)" +proof - + from first_summand_in_sum have "P x (x \ y)". + moreover from first_summand_in_sum have "P x (x \ z)". + ultimately have "P x (x \ y) \ P x (x \ z)".. + hence "\ v. P v (x \ y) \ P v (x \ z)".. + with overlap_eq show ?thesis.. +qed + +lemma second_summand_overlap: "O z y \ O z (x \ y)" +proof - + assume "O z y" + from sum_character have "O z (x \ y) \ (O z x \ O z y)".. + moreover from `O z y` have "O z x \ O z y".. + ultimately show "O z (x \ y)".. +qed + +lemma second_summand_disjointness: "\ O z (x \ y) \ \ O z y" +proof - + assume "\ O z (x \ y)" + show "\ O z y" + proof + assume "O z y" + hence "O z (x \ y)" + by (rule second_summand_overlap) + with `\ O z (x \ y)` show False.. + qed +qed + +lemma second_summand_in_sum: "P y (x \ y)" +proof - + have "\ w. O w y \ O w (x \ y)" + proof + fix w + show "O w y \ O w (x \ y)" + proof + assume "O w y" + thus "O w (x \ y)" + by (rule second_summand_overlap) + qed + qed + with part_overlap_eq show "P y (x \ y)".. +qed + +lemma second_summands_in_sums: "P y (x \ y) \ P v (z \ v)" +proof + show "P y (x \ y)" using second_summand_in_sum. + show "P v (z \ v)" using second_summand_in_sum. +qed + +lemma disjoint_from_sum: "\ O z (x \ y) \ \ O z x \ \ O z y" +proof - + from sum_character have "O z (x \ y) \ (O z x \ O z y)".. + thus ?thesis by simp +qed + +lemma summands_part_implies_sum_part: + "P x z \ P y z \ P (x \ y) z" +proof - + assume antecedent: "P x z \ P y z" + have "\ w. O w (x \ y) \ O w z" + proof + fix w + have w: "O w (x \ y) \ (O w x \ O w y)" + using sum_character.. + show "O w (x \ y) \ O w z" + proof + assume "O w (x \ y)" + with w have "O w x \ O w y".. + thus "O w z" + proof + from antecedent have "P x z".. + moreover assume "O w x" + ultimately show "O w z" + by (rule overlap_monotonicity) + next + from antecedent have "P y z".. + moreover assume "O w y" + ultimately show "O w z" + by (rule overlap_monotonicity) + qed + qed + qed + with part_overlap_eq show "P (x \ y) z".. +qed + +lemma sum_part_implies_summands_part: + "P (x \ y) z \ P x z \ P y z" +proof - + assume antecedent: "P (x \ y) z" + show "P x z \ P y z" + proof + from first_summand_in_sum show "P x z" + using antecedent by (rule part_transitivity) + next + from second_summand_in_sum show "P y z" + using antecedent by (rule part_transitivity) + qed +qed + +lemma in_second_summand: "P z (x \ y) \ \ O z x \ P z y" +proof - + assume antecedent: "P z (x \ y) \ \ O z x" + hence "P z (x \ y)".. + show "P z y" + proof (rule ccontr) + assume "\ P z y" + hence "\ v. P v z \ \ O v y" + by (rule strong_supplementation) + then obtain v where v: "P v z \ \ O v y".. + hence "\ O v y".. + from v have "P v z".. + hence "P v (x \ y)" + using `P z (x \ y)` by (rule part_transitivity) + hence "O v (x \ y)" by (rule part_implies_overlap) + from sum_character have "O v (x \ y) \ O v x \ O v y".. + hence "O v x \ O v y" using `O v (x \ y)`.. + thus "False" + proof (rule disjE) + from antecedent have "\ O z x".. + moreover assume "O v x" + hence "O x v" by (rule overlap_symmetry) + with `P v z` have "O x z" + by (rule overlap_monotonicity) + hence "O z x" by (rule overlap_symmetry) + ultimately show "False".. + next + assume "O v y" + with `\ O v y` show "False".. + qed + qed +qed + +lemma disjoint_second_summands: + "P v (x \ y) \ P v (x \ z) \ \ O y z \ P v x" +proof - + assume antecedent: "P v (x \ y) \ P v (x \ z)" + hence "P v (x \ z)".. + assume "\ O y z" + show "P v x" + proof (rule ccontr) + assume "\ P v x" + hence "\ w. P w v \ \ O w x" by (rule strong_supplementation) + then obtain w where w: "P w v \ \ O w x".. + hence "\ O w x".. + from w have "P w v".. + moreover from antecedent have "P v (x \ z)".. + ultimately have "P w (x \ z)" by (rule part_transitivity) + hence "P w (x \ z) \ \ O w x" using `\ O w x`.. + hence "P w z" by (rule in_second_summand) + from antecedent have "P v (x \ y)".. + with `P w v` have "P w (x \ y)" by (rule part_transitivity) + hence "P w (x \ y) \ \ O w x" using `\ O w x`.. + hence "P w y" by (rule in_second_summand) + hence "P w y \ P w z" using `P w z`.. + hence "\ w. P w y \ P w z".. + with overlap_eq have "O y z".. + with `\ O y z` show "False".. + qed +qed + +lemma right_associated_sum: + "O w (x \ (y \ z)) \ O w x \ (O w y \ O w z)" +proof - + from sum_character have "O w (y \ z) \ O w y \ O w z".. + moreover from sum_character have + "O w (x \ (y \ z)) \ (O w x \ O w (y \ z))".. + ultimately show ?thesis + by (rule subst) +qed + +lemma left_associated_sum: + "O w ((x \ y) \ z) \ (O w x \ O w y) \ O w z" +proof - + from sum_character have "O w (x \ y) \ (O w x \ O w y)".. + moreover from sum_character have + "O w ((x \ y) \ z) \ O w (x \ y) \ O w z".. + ultimately show ?thesis + by (rule subst) +qed + +theorem sum_associativity: "x \ (y \ z) = (x \ y) \ z" +proof - + have "\ w. O w (x \ (y \ z)) \ O w ((x \ y) \ z)" + proof + fix w + have "O w (x \ (y \ z)) \ (O w x \ O w y) \ O w z" + using right_associated_sum by simp + with left_associated_sum show + "O w (x \ (y \ z)) \ O w ((x \ y) \ z)" by (rule ssubst) + qed + with overlap_extensionality show "x \ (y \ z) = (x \ y) \ z".. +qed + +subsection \ Distributivity \ + +text \ The proofs in this section are adapted from @{cite "pietruszczak_metamereology_2018"} pp. 102-4. \ + +lemma common_summand_in_product: "P x ((x \ y) \ (x \ z))" + using common_first_summand by (rule common_part_in_product) + +lemma product_in_first_summand: + "\ O y z \ P ((x \ y) \ (x \ z)) x" +proof - + assume "\ O y z" + have "\ v. P v ((x \ y) \ (x \ z)) \ P v x" + proof + fix v + show "P v ((x \ y) \ (x \ z)) \ P v x" + proof + assume "P v ((x \ y) \ (x \ z))" + with common_first_summand_overlap have + "P v (x \ y) \ P v (x \ z)" by (rule product_part_in_factors) + thus "P v x" using `\ O y z` by (rule disjoint_second_summands) + qed + qed + hence "P ((x \ y) \ (x \ z)) ((x \ y) \ (x \ z)) \ + P ((x \ y) \ (x \ z)) x".. + thus "P ((x \ y) \ (x \ z)) x" using part_reflexivity.. +qed + +lemma product_is_first_summand: + "\ O y z \ (x \ y) \ (x \ z) = x" +proof - + assume "\ O y z" + hence "P ((x \ y) \ (x \ z)) x" + by (rule product_in_first_summand) + thus "(x \ y) \ (x \ z) = x" + using common_summand_in_product + by (rule part_antisymmetry) +qed + +lemma sum_over_product_left: "O y z \ P (x \ (y \ z)) ((x \ y) \ (x \ z))" +proof - + assume "O y z" + hence "P (y \ z) ((x \ y) \ (x \ z))" using second_summands_in_sums + by (rule part_product_in_whole_product) + with common_summand_in_product have + "P x ((x \ y) \ (x \ z)) \ P (y \ z) ((x \ y) \ (x \ z))".. + thus "P (x \ (y \ z)) ((x \ y) \ (x \ z))" + by (rule summands_part_implies_sum_part) +qed + +lemma sum_over_product_right: + "O y z \ P ((x \ y) \ (x \ z)) (x \ (y \ z))" +proof - + assume "O y z" + show "P ((x \ y) \ (x \ z)) (x \ (y \ z))" + proof (rule ccontr) + assume "\ P ((x \ y) \ (x \ z)) (x \ (y \ z))" + hence "\ v. P v ((x \ y) \ (x \ z)) \ \ O v (x \ (y \ z))" + by (rule strong_supplementation) + then obtain v where v: + "P v ((x \ y) \ (x \ z)) \ \ O v (x \ (y \ z))".. + hence " \ O v (x \ (y \ z))".. + with disjoint_from_sum have vd: "\ O v x \ \ O v (y \ z)".. + hence "\ O v (y \ z)".. + from vd have "\ O v x".. + from v have "P v ((x \ y) \ (x \ z))".. + with common_first_summand_overlap have + vs: "P v (x \ y) \ P v (x \ z)" by (rule product_part_in_factors) + hence "P v (x \ y)".. + hence "P v (x \ y) \ \ O v x" using `\ O v x`.. + hence "P v y" by (rule in_second_summand) + moreover from vs have "P v (x \ z)".. + hence "P v (x \ z) \ \ O v x" using `\ O v x`.. + hence "P v z" by (rule in_second_summand) + ultimately have "P v y \ P v z".. + hence "P v (y \ z)" by (rule common_part_in_product) + hence "O v (y \ z)" by (rule part_implies_overlap) + with `\ O v (y \ z)` show "False".. + qed +qed + +text \ Sums distribute over products. \ + +theorem sum_over_product: + "O y z \ x \ (y \ z) = (x \ y) \ (x \ z)" +proof - + assume "O y z" + hence "P (x \ (y \ z)) ((x \ y) \ (x \ z))" + by (rule sum_over_product_left) + moreover have "P ((x \ y) \ (x \ z)) (x \ (y \ z))" + using `O y z` by (rule sum_over_product_right) + ultimately show "x \ (y \ z) = (x \ y) \ (x \ z)" + by (rule part_antisymmetry) +qed + +lemma product_in_factor_by_sum: + "O x y \ P (x \ y) (x \ (y \ z))" +proof - + assume "O x y" + hence "P (x \ y) x" + by (rule product_in_first_factor) + moreover have "P (x \ y) y" + using `O x y` by (rule product_in_second_factor) + hence "P (x \ y) (y \ z)" + using first_summand_in_sum by (rule part_transitivity) + with `P (x \ y) x` have "P (x \ y) x \ P (x \ y) (y \ z)".. + thus "P (x \ y) (x \ (y \ z))" + by (rule common_part_in_product) +qed + +lemma product_of_first_summand: + "O x y \ \ O x z \ P (x \ (y \ z)) (x \ y)" +proof - + assume "O x y" + hence "O x (y \ z)" + by (rule first_summand_overlap) + assume "\ O x z" + show "P (x \ (y \ z)) (x \ y)" + proof (rule ccontr) + assume "\ P (x \ (y \ z)) (x \ y)" + hence "\ v. P v (x \ (y \ z)) \ \ O v (x \ y)" + by (rule strong_supplementation) + then obtain v where v: "P v (x \ (y \ z)) \ \ O v (x \ y)".. + hence "P v (x \ (y \ z))".. + with `O x (y \ z)` have "P v x \ P v (y \ z)" + by (rule product_part_in_factors) + hence "P v x".. + moreover from v have "\ O v (x \ y)".. + ultimately have "P v x \ \ O v (x \ y)".. + hence "\ O v y" by (rule disjoint_from_second_factor) + from `P v x \ P v (y \ z)` have "P v (y \ z)".. + hence "P v (y \ z) \ \ O v y" using `\ O v y`.. + hence "P v z" by (rule in_second_summand) + with `P v x` have "P v x \ P v z".. + hence "\ v. P v x \ P v z".. + with overlap_eq have "O x z".. + with `\ O x z` show "False".. + qed +qed + +theorem disjoint_product_over_sum: + "O x y \ \ O x z \ x \ (y \ z) = x \ y" +proof - + assume "O x y" + moreover assume "\ O x z" + ultimately have "P (x \ (y \ z)) (x \ y)" + by (rule product_of_first_summand) + moreover have "P (x \ y)(x \ (y \ z))" + using `O x y` by (rule product_in_factor_by_sum) + ultimately show "x \ (y \ z) = x \ y" + by (rule part_antisymmetry) +qed + +lemma product_over_sum_left: + "O x y \ O x z \ P (x \ (y \ z))((x \ y) \ (x \ z))" +proof - + assume "O x y \ O x z" + hence "O x y".. + hence "O x (y \ z)" by (rule first_summand_overlap) + show "P (x \ (y \ z))((x \ y) \ (x \ z))" + proof (rule ccontr) + assume "\ P (x \ (y \ z))((x \ y) \ (x \ z))" + hence "\ v. P v (x \ (y \ z)) \ \ O v ((x \ y) \ (x \ z))" + by (rule strong_supplementation) + then obtain v where v: + "P v (x \ (y \ z)) \ \ O v ((x \ y) \ (x \ z))".. + hence "\ O v ((x \ y) \ (x \ z))".. + with disjoint_from_sum have oxyz: + "\ O v (x \ y) \ \ O v (x \ z)".. + from v have "P v (x \ (y \ z))".. + with `O x (y \ z)` have pxyz: "P v x \ P v (y \ z)" + by (rule product_part_in_factors) + hence "P v x".. + moreover from oxyz have "\ O v (x \ y)".. + ultimately have "P v x \ \ O v (x \ y)".. + hence "\ O v y" by (rule disjoint_from_second_factor) + from oxyz have "\ O v (x \ z)".. + with `P v x` have "P v x \ \ O v (x \ z)".. + hence "\ O v z" by (rule disjoint_from_second_factor) + with `\ O v y` have "\ O v y \ \ O v z".. + with disjoint_from_sum have "\ O v (y \ z)".. + from pxyz have "P v (y \ z)".. + hence "O v (y \ z)" by (rule part_implies_overlap) + with `\ O v (y \ z)` show "False".. + qed +qed + +lemma product_over_sum_right: + "O x y \ O x z \ P((x \ y) \ (x \ z))(x \ (y \ z))" +proof - + assume antecedent: "O x y \ O x z" + have "P (x \ y) (x \ (y \ z)) \ P (x \ z) (x \ (y \ z))" + proof + from antecedent have "O x y".. + thus "P (x \ y) (x \ (y \ z))" + by (rule product_in_factor_by_sum) + next + from antecedent have "O x z".. + hence "P (x \ z) (x \ (z \ y))" + by (rule product_in_factor_by_sum) + with sum_commutativity show "P (x \ z) (x \ (y \ z))" + by (rule subst) + qed + thus "P((x \ y) \ (x \ z))(x \ (y \ z))" + by (rule summands_part_implies_sum_part) +qed + +theorem product_over_sum: + "O x y \ O x z \ x \ (y \ z) = (x \ y) \ (x \ z)" +proof - + assume antecedent: "O x y \ O x z" + hence "P (x \ (y \ z))((x \ y) \ (x \ z))" + by (rule product_over_sum_left) + moreover have "P((x \ y) \ (x \ z))(x \ (y \ z))" + using antecedent by (rule product_over_sum_right) + ultimately show "x \ (y \ z) = (x \ y) \ (x \ z)" + by (rule part_antisymmetry) +qed + +lemma joint_identical_sums: + "v \ w = x \ y \ O x v \ O x w \ ((x \ v) \ (x \ w)) = x" +proof - + assume "v \ w = x \ y" + moreover assume "O x v \ O x w" + hence "x \ (v \ w) = x \ v \ x \ w" + by (rule product_over_sum) + ultimately have "x \ (x \ y) = x \ v \ x \ w" by (rule subst) + moreover have "(x \ (x \ y)) = x" using first_summand_in_sum + by (rule part_product_identity) + ultimately show "((x \ v) \ (x \ w)) = x" by (rule subst) +qed + +lemma disjoint_identical_sums: + "v \ w = x \ y \ \ O y v \ \ O w x \ x = v \ y = w" +proof - + assume identical: "v \ w = x \ y" + assume disjoint: "\ O y v \ \ O w x" + show "x = v \ y = w" + proof + from disjoint have "\ O y v".. + hence "(x \ y) \ (x \ v) = x" + by (rule product_is_first_summand) + with identical have "(v \ w) \ (x \ v) = x" + by (rule ssubst) + moreover from disjoint have "\ O w x".. + hence "(v \ w) \ (v \ x) = v" + by (rule product_is_first_summand) + with sum_commutativity have "(v \ w) \ (x \ v) = v" + by (rule subst) + ultimately show "x = v" by (rule subst) + next + from disjoint have "\ O w x".. + hence "(y \ w) \ (y \ x) = y" + by (rule product_is_first_summand) + moreover from disjoint have "\ O y v".. + hence "(w \ y) \ (w \ v) = w" + by (rule product_is_first_summand) + with sum_commutativity have "(w \ y) \ (v \ w) = w" + by (rule subst) + with identical have "(w \ y) \ (x \ y) = w" + by (rule subst) + with sum_commutativity have "(w \ y) \ (y \ x) = w" + by (rule subst) + with sum_commutativity have "(y \ w) \ (y \ x) = w" + by (rule subst) + ultimately show "y = w" + by (rule subst) + qed +qed + +end + +subsection \ Differences \ + +locale CEMD = CEM + CMD +begin + +lemma plus_minus: "PP y x \ y \ (x \ y) = x" +proof - + assume "PP y x" + hence "\ z. P z x \ \ O z y" by (rule weak_supplementation) + hence xmy:"\ w. P w (x \ y) \ (P w x \ \ O w y)" + by (rule difference_character) + have "\ w. O w x \ (O w y \ O w (x \ y))" + proof + fix w + from xmy have w: "P w (x \ y) \ (P w x \ \ O w y)".. + show "O w x \ (O w y \ O w (x \ y))" + proof + assume "O w x" + with overlap_eq have "\ v. P v w \ P v x".. + then obtain v where v: "P v w \ P v x".. + hence "P v w".. + from v have "P v x".. + show "O w y \ O w (x \ y)" + proof cases + assume "O v y" + hence "O y v" by (rule overlap_symmetry) + with `P v w` have "O y w" by (rule overlap_monotonicity) + hence "O w y" by (rule overlap_symmetry) + thus "O w y \ O w (x \ y)".. + next + from xmy have "P v (x \ y) \ (P v x \ \ O v y)".. + moreover assume "\ O v y" + with `P v x` have "P v x \ \ O v y".. + ultimately have "P v (x \ y)".. + with `P v w` have "P v w \ P v (x \ y)".. + hence "\ v. P v w \ P v (x \ y)".. + with overlap_eq have "O w (x \ y)".. + thus "O w y \ O w (x \ y)".. + qed + next + assume "O w y \ O w (x \ y)" + thus "O w x" + proof + from `PP y x` have "P y x" + by (rule proper_implies_part) + moreover assume "O w y" + ultimately show "O w x" + by (rule overlap_monotonicity) + next + assume "O w (x \ y)" + with overlap_eq have "\ v. P v w \ P v (x \ y)".. + then obtain v where v: "P v w \ P v (x \ y)".. + hence "P v w".. + from xmy have "P v (x \ y) \ (P v x \ \ O v y)".. + moreover from v have "P v (x \ y)".. + ultimately have "P v x \ \ O v y".. + hence "P v x".. + with `P v w` have "P v w \ P v x".. + hence "\ v. P v w \ P v x".. + with overlap_eq show "O w x".. + qed + qed + qed + thus "y \ (x \ y) = x" + by (rule sum_intro) +qed + +end + +subsection \ The Universe \ + +locale CEMU = CEM + CMU +begin + +lemma something_disjoint: "x \ u \ (\ v. \ O v x)" +proof - + assume "x \ u" + with universe_character have "P x u \ x \ u".. + with nip_eq have "PP x u".. + hence "\ v. P v u \ \ O v x" + by (rule weak_supplementation) + then obtain v where "P v u \ \ O v x".. + hence "\ O v x".. + thus "\ v. \ O v x".. +qed + +lemma overlaps_universe: "O x u" +proof - + from universe_character have "P x u". + thus "O x u" by (rule part_implies_overlap) +qed + +lemma universe_absorbing: "x \ u = u" +proof - + from universe_character have "P (x \ u) u". + thus "x \ u = u" using second_summand_in_sum + by (rule part_antisymmetry) +qed + +lemma second_summand_not_universe: "x \ y \ u \ y \ u" +proof - + assume antecedent: "x \ y \ u" + show "y \ u" + proof + assume "y = u" + hence "x \ u \ u" using antecedent by (rule subst) + thus "False" using universe_absorbing.. + qed +qed + +lemma first_summand_not_universe: "x \ y \ u \ x \ u" +proof - + assume "x \ y \ u" + with sum_commutativity have "y \ x \ u" by (rule subst) + thus "x \ u" by (rule second_summand_not_universe) +qed + +end + +subsection \ Complements \ + +locale CEMC = CEM + CMC + + assumes universe_eq: "u = (THE x. \ y. P y x)" +begin + +lemma complement_sum_character: "\ y. P y (x \ (\x))" +proof + fix y + have "\ v. O v y \ O v x \ O v (\x)" + proof + fix v + show "O v y \ O v x \ O v (\x)" + proof + assume "O v y" + show "O v x \ O v (\x)" + using or_complement_overlap.. + qed + qed + with sum_part_character show "P y (x \ (\x))".. +qed + +lemma universe_closure: "\ x. \ y. P y x" + using complement_sum_character by (rule exI) + +end + +sublocale CEMC \ CEMU +proof + show "u = (THE z. \w. P w z)" using universe_eq. + show "\ x. \ y. P y x" using universe_closure. +qed + +sublocale CEMC \ CEMD +proof +qed + +context CEMC +begin + +corollary universe_is_complement_sum: "u = x \ (\x)" + using complement_sum_character by (rule universe_intro) + +lemma strong_complement_character: + "x \ u \ (\ v. P v (\x) \ \ O v x)" +proof - + assume "x \ u" + hence "\ v. \ O v x" by (rule something_disjoint) + thus "\ v. P v (\x) \ \ O v x" by (rule complement_character) +qed + +lemma complement_part_not_part: "x \ u \ P y (\x) \ \ P y x" +proof - + assume "x \ u" + hence "\ w. P w (\x) \ \ O w x" + by (rule strong_complement_character) + hence y: "P y (\x) \ \ O y x".. + moreover assume "P y (\x)" + ultimately have "\ O y x".. + thus "\ P y x" + by (rule disjoint_implies_not_part) +qed + +lemma complement_involution: "x \ u \ x = \(\x)" +proof - + assume "x \ u" + have "\ P u x" + proof + assume "P u x" + with universe_character have "x = u" + by (rule part_antisymmetry) + with `x \ u` show "False".. + qed + hence "\ v. P v u \ \ O v x" + by (rule strong_supplementation) + then obtain v where v: "P v u \ \ O v x".. + hence "\ O v x".. + hence "\ v. \ O v x".. + hence notx: "\ w. P w (\x) \ \ O w x" + by (rule complement_character) + have "\x \ u" + proof + assume "\x = u" + hence "\ w. P w u \ \ O w x" using notx by (rule subst) + hence "P x u \ \ O x x".. + hence "\ O x x" using universe_character.. + thus "False" using overlap_reflexivity.. + qed + have "\ P u (\x)" + proof + assume "P u (\x)" + with universe_character have "\x = u" + by (rule part_antisymmetry) + with `\x \ u` show "False".. + qed + hence "\ v. P v u \ \ O v (\x)" + by (rule strong_supplementation) + then obtain w where w: "P w u \ \ O w (\x)".. + hence "\ O w (\x)".. + hence "\ v. \ O v (\x)".. + hence notnotx: "\ w. P w (\(\x)) \ \ O w (\x)" + by (rule complement_character) + hence "P x (\(\x)) \ \ O x (\x)".. + moreover have "\ O x (\x)" + proof + assume "O x (\x)" + with overlap_eq have "\ s. P s x \ P s (\x)".. + then obtain s where s: "P s x \ P s (\x)".. + hence "P s x".. + hence "O s x" by (rule part_implies_overlap) + from notx have "P s (\x) \ \ O s x".. + moreover from s have "P s (\x)".. + ultimately have "\ O s x".. + thus "False" using `O s x`.. + qed + ultimately have "P x (\(\x))".. + moreover have "P (\(\x)) x" + proof (rule ccontr) + assume "\ P (\(\x)) x" + hence "\ s. P s (\(\x)) \ \ O s x" + by (rule strong_supplementation) + then obtain s where s: "P s (\(\x)) \ \ O s x".. + hence "\ O s x".. + from notnotx have "P s (\(\x)) \ (\ O s (\x))".. + moreover from s have "P s (\(\x))".. + ultimately have "\ O s (\x)".. + from or_complement_overlap have "O s x \ O s (\x)".. + thus "False" + proof + assume "O s x" + with `\ O s x` show "False".. + next + assume "O s (\x)" + with `\ O s (\x )` show "False".. + qed + qed + ultimately show "x = \(\x)" + by (rule part_antisymmetry) +qed + +lemma part_complement_reversal: "y \ u \ P x y \ P (\y) (\x)" +proof - + assume "y \ u" + hence ny: "\ w. P w (\y) \ \ O w y" + by (rule strong_complement_character) + assume "P x y" + have "x \ u" + proof + assume "x = u" + hence "P u y" using `P x y` by (rule subst) + with universe_character have "y = u" + by (rule part_antisymmetry) + with `y \ u` show "False".. + qed + hence "\ w. P w (\x) \ \ O w x" + by (rule strong_complement_character) + hence "P (\y) (\x) \ \ O (\y) x".. + moreover have "\ O (\y) x" + proof + assume "O (\y) x" + with overlap_eq have "\ v. P v (\y) \ P v x".. + then obtain v where v: "P v (\y) \ P v x".. + hence "P v (\y)".. + from ny have "P v (\y) \ \ O v y".. + hence "\ O v y" using `P v (\y)`.. + moreover from v have "P v x".. + hence "P v y" using `P x y` + by (rule part_transitivity) + hence "O v y" + by (rule part_implies_overlap) + ultimately show "False".. + qed + ultimately show "P (\y) (\x)".. +qed + +lemma complements_overlap: "x \ y \ u \ O(\x)(\y)" +proof - + assume "x \ y \ u" + hence "\ z. \ O z (x \ y)" + by (rule something_disjoint) + then obtain z where z:"\ O z (x \ y)".. + hence "\ O z x" by (rule first_summand_disjointness) + hence "P z (\x)" by (rule complement_part) + moreover from z have "\ O z y" + by (rule second_summand_disjointness) + hence "P z (\y)" by (rule complement_part) + ultimately show "O(\x)(\y)" + by (rule overlap_intro) +qed + +lemma sum_complement_in_complement_product: + "x \ y \ u \ P(\(x \ y))(\x \ \y)" +proof - + assume "x \ y \ u" + hence "O (\x) (\y)" + by (rule complements_overlap) + hence "\ w. P w (\x \ \y) \ (P w (\x) \ P w (\y))" + by (rule product_character) + hence "P(\(x \ y))(\x \ \y)\(P(\(x \ y))(\x) \ P(\(x \ y))(\y))".. + moreover have "P (\(x \ y))(\x) \ P (\(x \ y))(\y)" + proof + show "P (\(x \ y))(\x)" using `x \ y \ u` first_summand_in_sum + by (rule part_complement_reversal) + next + show "P (\(x \ y))(\y)" using `x \ y \ u` second_summand_in_sum + by (rule part_complement_reversal) + qed + ultimately show "P (\(x \ y))(\x \ \y)".. +qed + +lemma complement_product_in_sum_complement: + "x \ y \ u \ P(\x \ \y)(\(x \ y))" +proof - + assume "x \ y \ u" + hence "\w. P w (\(x \ y)) \ \ O w (x \ y)" + by (rule strong_complement_character) + hence "P (\x \ \y) (\(x \ y)) \ (\ O (\x \ \y) (x \ y))".. + moreover have "\ O (\x \ \y) (x \ y)" + proof + have "O(\x)(\y)" using `x \ y \ u` by (rule complements_overlap) + hence p: "\ v. P v ((\x) \ (\y)) \ (P v (\x) \ P v (\y))" + by (rule product_character) + have "O(\x \ \y)(x \ y) \ (O(\x \ \y) x \ O(\x \ \y)y)" + using sum_character.. + moreover assume "O (\x \ \y)(x \ y)" + ultimately have "O (\x \ \y) x \ O (\x \ \y) y".. + thus "False" + proof + assume "O (\x \ \y) x" + with overlap_eq have "\ v. P v (\x \ \y) \ P v x".. + then obtain v where v: "P v (\x \ \y) \ P v x".. + hence "P v (\x \ \y)".. + from p have "P v ((\x) \ (\y)) \ (P v (\x) \ P v (\y))".. + hence "P v (\x) \ P v (\y)" using `P v (\x \ \y)`.. + hence "P v (\x)".. + have "x \ u" using `x \ y \ u` + by (rule first_summand_not_universe) + hence "\w. P w (\x) \ \ O w x" + by (rule strong_complement_character) + hence "P v (\x) \ \ O v x".. + hence "\ O v x" using `P v (\x)`.. + moreover from v have "P v x".. + hence "O v x" by (rule part_implies_overlap) + ultimately show "False".. + next + assume "O (\x \ \y) y" + with overlap_eq have "\ v. P v (\x \ \y) \ P v y".. + then obtain v where v: "P v (\x \ \y) \ P v y".. + hence "P v (\x \ \y)".. + from p have "P v ((\x) \ (\y)) \ (P v (\x) \ P v (\y))".. + hence "P v (\x) \ P v (\y)" using `P v (\x \ \y)`.. + hence "P v (\y)".. + have "y \ u" using `x \ y \ u` + by (rule second_summand_not_universe) + hence "\w. P w (\y) \ \ O w y" + by (rule strong_complement_character) + hence "P v (\y) \ \ O v y".. + hence "\ O v y" using `P v (\y)`.. + moreover from v have "P v y".. + hence "O v y" by (rule part_implies_overlap) + ultimately show "False".. + qed + qed + ultimately show "P (\x \ \y) (\(x \ y))".. +qed + +theorem sum_complement_is_complements_product: + "x \ y \ u \ \(x \ y) = (\x \ \y)" +proof - + assume "x \ y \ u" + show "\(x \ y) = (\x \ \y)" + proof (rule part_antisymmetry) + show "P (\ (x \ y)) (\ x \ \ y)" using `x \ y \ u` + by (rule sum_complement_in_complement_product) + show "P (\ x \ \ y) (\ (x \ y))" using `x \ y \ u` + by (rule complement_product_in_sum_complement) + qed +qed + +lemma complement_sum_in_product_complement: + "O x y \ x \ u \ y \ u \ P ((\x) \ (\y))(\(x \ y))" +proof - + assume "O x y" + assume "x \ u" + assume "y \ u" + have "x \ y \ u" + proof + assume "x \ y = u" + with `O x y` have "x = u" + by (rule product_universe_implies_factor_universe) + with `x \ u` show "False".. + qed + hence notxty: "\ w. P w (\(x \ y)) \ \ O w (x \ y)" + by (rule strong_complement_character) + hence "P((\x)\(\y))(\(x \ y)) \ \O((\x)\(\y))(x \ y)".. + moreover have "\ O ((\x) \ (\y)) (x \ y)" + proof + from sum_character have + "\ w. O w ((\x) \ (\y)) \ (O w (\x) \ O w (\y))". + hence "O(x \ y)((\x)\(\y)) \ (O(x \ y)(\x) \ O(x \ y)(\y))".. + moreover assume "O ((\x) \ (\y)) (x \ y)" + hence "O (x \ y) ((\x) \ (\y))" by (rule overlap_symmetry) + ultimately have "O (x \ y) (\x) \ O (x \ y) (\y)".. + thus False + proof + assume "O (x \ y)(\x)" + with overlap_eq have "\ v. P v (x \ y) \ P v (\x)".. + then obtain v where v: "P v (x \ y) \ P v (\x)".. + hence "P v (\x)".. + with `x \ u` have "\ P v x" + by (rule complement_part_not_part) + moreover from v have "P v (x \ y)".. + with `O x y` have "P v x" by (rule product_part_in_first_factor) + ultimately show "False".. + next + assume "O (x \ y) (\y)" + with overlap_eq have "\ v. P v (x \ y) \ P v (\y)".. + then obtain v where v: "P v (x \ y) \ P v (\y)".. + hence "P v (\y)".. + with `y \ u` have "\ P v y" + by (rule complement_part_not_part) + moreover from v have "P v (x \ y)".. + with `O x y` have "P v y" by (rule product_part_in_second_factor) + ultimately show "False".. + qed + qed + ultimately show "P ((\x) \ (\y))(\(x \ y))".. +qed + +lemma product_complement_in_complements_sum: + "x \ u \ y \ u \ P(\(x \ y))((\x) \ (\y))" +proof - + assume "x \ u" + hence "x = \(\x)" + by (rule complement_involution) + assume "y \ u" + hence "y = \(\y)" + by (rule complement_involution) + show "P (\(x \ y))((\x) \ (\y))" + proof cases + assume "\x \ \y = u" + thus "P (\(x \ y))((\x) \ (\y))" + using universe_character by (rule ssubst) + next + assume "\x \ \y \ u" + hence "\x \ \y = \(\(\x \ \ y))" + by (rule complement_involution) + moreover have "\(\x \ \y) = \(\x) \ \(\y)" + using `\x \ \y \ u` + by (rule sum_complement_is_complements_product) + with `x = \(\x)` have "\(\x \ \y) = x \ \(\y)" + by (rule ssubst) + with `y = \(\y)` have "\(\x \ \y) = x \ y" + by (rule ssubst) + hence "P (\(x \ y))(\(\(\x \ \y)))" + using part_reflexivity by (rule subst) + ultimately show "P (\(x \ y))(\x \ \y)" + by (rule ssubst) + qed +qed + +theorem complement_of_product_is_sum_of_complements: + "O x y \ x \ y \ u \ \(x \ y) = (\x) \ (\y)" +proof - + assume "O x y" + assume "x \ y \ u" + show "\(x \ y) = (\x) \ (\y)" + proof (rule part_antisymmetry) + have "x \ u" using \x \ y \ u\ + by (rule first_summand_not_universe) + have "y \ u" using \x \ y \ u\ + by (rule second_summand_not_universe) + show "P (\ (x \ y)) (\ x \ \ y)" + using `x \ u` `y \ u` by (rule product_complement_in_complements_sum) + show " P (\ x \ \ y) (\ (x \ y))" + using `O x y` `x \ u` `y \ u` by (rule complement_sum_in_product_complement) + qed +qed + +end + +(*<*) end (*>*) \ No newline at end of file diff --git a/thys/Mereology/CM.thy b/thys/Mereology/CM.thy new file mode 100644 --- /dev/null +++ b/thys/Mereology/CM.thy @@ -0,0 +1,739 @@ +section \ Closed Mereology \ + +(*<*) +theory CM + imports M +begin +(*>*) + +text \ The theory of \emph{closed mereology} adds to ground mereology conditions guaranteeing the +existence of sums and products.\footnote{See @{cite "masolo_atomicity_1999"} p. 238. @{cite "varzi_parts_1996"} p. 263 +and @{cite "casati_parts_1999"} p. 43 give a slightly weaker version of the sum closure axiom, which is +equivalent given axioms considered later.} \ + +locale CM = M + + assumes sum_eq: "x \ y = (THE z. \v. O v z \ O v x \ O v y)" + assumes sum_closure: "\z. \v. O v z \ O v x \ O v y" + assumes product_eq: + "x \ y = (THE z. \v. P v z \ P v x \ P v y)" + assumes product_closure: + "O x y \ \z. \v. P v z \ P v x \ P v y" +begin + +subsection \ Products \ + +lemma product_intro: + "(\w. P w z \ (P w x \ P w y)) \ x \ y = z" +proof - + assume z: "\w. P w z \ (P w x \ P w y)" + hence "(THE v. \w. P w v \ P w x \ P w y) = z" + proof (rule the_equality) + fix v + assume v: "\w. P w v \ (P w x \ P w y)" + have "\w. P w v \ P w z" + proof + fix w + from z have "P w z \ (P w x \ P w y)".. + moreover from v have "P w v \ (P w x \ P w y)".. + ultimately show "P w v \ P w z" by (rule ssubst) + qed + with part_extensionality show "v = z".. + qed + thus "x \ y = z" + using product_eq by (rule subst) +qed + +lemma product_idempotence: "x \ x = x" +proof - + have "\w. P w x \ P w x \ P w x" + proof + fix w + show "P w x \ P w x \ P w x" + proof + assume "P w x" + thus "P w x \ P w x" using `P w x`.. + next + assume "P w x \ P w x" + thus "P w x".. + qed + qed + thus "x \ x = x" by (rule product_intro) +qed + +lemma product_character: + "O x y \ (\w. P w (x \ y) \ (P w x \ P w y))" +proof - + assume "O x y" + hence "\z. \w. P w z \ (P w x \ P w y)" by (rule product_closure) + then obtain z where z: "\w. P w z \ (P w x \ P w y)".. + hence "x \ y = z" by (rule product_intro) + thus "\w. P w (x \ y) \ P w x \ P w y" + using z by (rule ssubst) +qed + +lemma product_commutativity: "O x y \ x \ y = y \ x" +proof - + assume "O x y" + hence "O y x" by (rule overlap_symmetry) + hence "\w. P w (y \ x) \ (P w y \ P w x)" by (rule product_character) + hence "\w. P w (y \ x) \ (P w x \ P w y)" by auto + thus "x \ y = y \ x" by (rule product_intro) +qed + +lemma product_in_factors: "O x y \ P (x \ y) x \ P (x \ y) y" +proof - + assume "O x y" + hence "\w. P w (x \ y) \ P w x \ P w y" by (rule product_character) + hence "P (x \ y) (x \ y) \ P (x \ y) x \ P (x \ y) y".. + moreover have "P (x \ y) (x \ y)" by (rule part_reflexivity) + ultimately show "P (x \ y) x \ P (x \ y) y".. +qed + +lemma product_in_first_factor: "O x y \ P (x \ y) x" +proof - + assume "O x y" + hence "P (x \ y) x \ P (x \ y) y" by (rule product_in_factors) + thus "P (x \ y) x".. +qed + +lemma product_in_second_factor: "O x y \ P (x \ y) y" +proof - + assume "O x y" + hence "P (x \ y) x \ P (x \ y) y" by (rule product_in_factors) + thus "P (x \ y) y".. +qed + +lemma nonpart_implies_proper_product: + "\ P x y \ O x y \ PP (x \ y) x" +proof - + assume antecedent: "\ P x y \ O x y" + hence "\ P x y".. + from antecedent have "O x y".. + hence "P (x \ y) x" by (rule product_in_first_factor) + moreover have "(x \ y) \ x" + proof + assume "(x \ y) = x" + hence "\ P (x \ y) y" + using `\ P x y` by (rule ssubst) + moreover have "P (x \ y) y" + using `O x y` by (rule product_in_second_factor) + ultimately show "False".. + qed + ultimately have "P (x \ y) x \ x \ y \ x".. + with nip_eq show "PP (x \ y) x".. +qed + +lemma common_part_in_product: "P z x \ P z y \ P z (x \ y)" +proof - + assume antecedent: "P z x \ P z y" + hence "\z. P z x \ P z y".. + with overlap_eq have "O x y".. + hence "\w. P w (x \ y) \ (P w x \ P w y)" + by (rule product_character) + hence "P z (x \ y) \ (P z x \ P z y)".. + thus "P z (x \ y)" + using `P z x \ P z y`.. +qed + +lemma product_part_in_factors: + "O x y \ P z (x \ y) \ P z x \ P z y" +proof - + assume "O x y" + hence "\w. P w (x \ y) \ (P w x \ P w y)" + by (rule product_character) + hence "P z (x \ y) \ (P z x \ P z y)".. + moreover assume "P z (x \ y)" + ultimately show "P z x \ P z y".. +qed + +corollary product_part_in_first_factor: + "O x y \ P z (x \ y) \ P z x" +proof - + assume "O x y" + moreover assume "P z (x \ y)" + ultimately have "P z x \ P z y" + by (rule product_part_in_factors) + thus "P z x".. +qed + +corollary product_part_in_second_factor: + "O x y \ P z (x \ y) \ P z y" +proof - + assume "O x y" + moreover assume "P z (x \ y)" + ultimately have "P z x \ P z y" + by (rule product_part_in_factors) + thus "P z y".. +qed + +lemma part_product_identity: "P x y \ x \ y = x" +proof - + assume "P x y" + with part_reflexivity have "P x x \ P x y".. + hence "P x (x \ y)" by (rule common_part_in_product) + have "O x y" using `P x y` by (rule part_implies_overlap) + hence "P (x \ y) x" by (rule product_in_first_factor) + thus "x \ y = x" using `P x (x \ y)` by (rule part_antisymmetry) +qed + +lemma product_overlap: "P z x \ O z y \ O z (x \ y)" +proof - + assume "P z x" + assume "O z y" + with overlap_eq have "\v. P v z \ P v y".. + then obtain v where v: "P v z \ P v y".. + hence "P v y".. + from v have "P v z".. + hence "P v x" using `P z x` by (rule part_transitivity) + hence "P v x \ P v y" using `P v y`.. + hence "P v (x \ y)" by (rule common_part_in_product) + with `P v z` have "P v z \ P v (x \ y)".. + hence "\v. P v z \ P v (x \ y)".. + with overlap_eq show "O z (x \ y)".. +qed + +lemma disjoint_from_second_factor: + "P x y \ \ O x (y \ z) \ \ O x z" +proof - + assume antecedent: "P x y \ \ O x (y \ z)" + hence "\ O x (y \ z)".. + show "\ O x z" + proof + from antecedent have "P x y".. + moreover assume "O x z" + ultimately have "O x (y \ z)" + by (rule product_overlap) + with `\ O x (y \ z)` show "False".. + qed +qed + +lemma converse_product_overlap: + "O x y \ O z (x \ y) \ O z y" +proof - + assume "O x y" + hence "P (x \ y) y" by (rule product_in_second_factor) + moreover assume "O z (x \ y)" + ultimately show "O z y" + by (rule overlap_monotonicity) +qed + +lemma part_product_in_whole_product: + "O x y \ P x v \ P y z \ P (x \ y) (v \ z)" +proof - + assume "O x y" + assume "P x v \ P y z" + have "\w. P w (x \ y) \ P w (v \ z)" + proof + fix w + show "P w (x \ y) \ P w (v \ z)" + proof + assume "P w (x \ y)" + with `O x y` have "P w x \ P w y" + by (rule product_part_in_factors) + have "P w v \ P w z" + proof + from `P w x \ P w y` have "P w x".. + moreover from `P x v \ P y z` have "P x v".. + ultimately show "P w v" by (rule part_transitivity) + next + from `P w x \ P w y` have "P w y".. + moreover from `P x v \ P y z` have "P y z".. + ultimately show "P w z" by (rule part_transitivity) + qed + thus "P w (v \ z)" by (rule common_part_in_product) + qed + qed + hence "P (x \ y) (x \ y) \ P (x \ y) (v \ z)".. + moreover have "P (x \ y) (x \ y)" by (rule part_reflexivity) + ultimately show "P (x \ y) (v \ z)".. +qed + +lemma right_associated_product: "(\w. P w x \ P w y \ P w z) \ + (\w. P w (x \ (y \ z)) \ P w x \ (P w y \ P w z))" +proof - + assume antecedent: "(\w. P w x \ P w y \ P w z)" + then obtain w where w: "P w x \ P w y \ P w z".. + hence "P w x".. + from w have "P w y \ P w z".. + hence "\w. P w y \ P w z".. + with overlap_eq have "O y z".. + hence yz: "\w. P w (y \ z) \ (P w y \ P w z)" + by (rule product_character) + hence "P w (y \ z) \ (P w y \ P w z)".. + hence "P w (y \ z)" + using `P w y \ P w z`.. + with `P w x` have "P w x \ P w (y \ z)".. + hence "\w. P w x \ P w (y \ z)".. + with overlap_eq have "O x (y \ z)".. + hence xyz: "\w. P w (x \ (y \ z)) \ P w x \ P w (y \ z)" + by (rule product_character) + show "\w. P w (x \ (y \ z)) \ P w x \ (P w y \ P w z)" + proof + fix w + from yz have wyz: "P w (y \ z) \ (P w y \ P w z)".. + moreover from xyz have + "P w (x \ (y \ z)) \ P w x \ P w (y \ z)".. + ultimately show + "P w (x \ (y \ z)) \ P w x \ (P w y \ P w z)" + by (rule subst) + qed +qed + +lemma left_associated_product: "(\w. P w x \ P w y \ P w z) \ + (\w. P w ((x \ y) \ z) \ (P w x \ P w y) \ P w z)" +proof - + assume antecedent: "(\w. P w x \ P w y \ P w z)" + then obtain w where w: "P w x \ P w y \ P w z".. + hence "P w y \ P w z".. + hence "P w y".. + have "P w z" + using `P w y \ P w z`.. + from w have "P w x".. + hence "P w x \ P w y" + using `P w y`.. + hence "\z. P z x \ P z y".. + with overlap_eq have "O x y".. + hence xy: "\w. P w (x \ y) \ (P w x \ P w y)" + by (rule product_character) + hence "P w (x \ y) \ (P w x \ P w y)".. + hence "P w (x \ y)" + using `P w x \ P w y`.. + hence "P w (x \ y) \ P w z" + using `P w z`.. + hence "\w. P w (x \ y) \ P w z".. + with overlap_eq have "O (x \ y) z".. + hence xyz: "\w. P w ((x \ y) \ z) \ P w (x \ y) \ P w z" + by (rule product_character) + show "\w. P w ((x \ y) \ z) \ (P w x \ P w y) \ P w z" + proof + fix v + from xy have vxy: "P v (x \ y) \ (P v x \ P v y)".. + moreover from xyz have + "P v ((x \ y) \ z) \ P v (x \ y) \ P v z".. + ultimately show "P v ((x \ y) \ z) \ (P v x \ P v y) \ P v z" + by (rule subst) + qed +qed + +theorem product_associativity: + "(\w. P w x \ P w y \ P w z) \ x \ (y \ z) = (x \ y) \ z" +proof - + assume ante:"(\w. P w x \ P w y \ P w z)" + hence "(\w. P w (x \ (y \ z)) \ P w x \ (P w y \ P w z))" + by (rule right_associated_product) + moreover from ante have + "(\w. P w ((x \ y) \ z) \ (P w x \ P w y) \ P w z)" + by (rule left_associated_product) + ultimately have "\w. P w (x \ (y \ z)) \ P w ((x \ y) \ z)" + by simp + with part_extensionality show "x \ (y \ z) = (x \ y) \ z".. +qed + +end + +subsection \ Differences \ + +text \ Some writers also add to closed mereology the axiom of difference closure.\footnote{See, for example, +@{cite "varzi_parts_1996"} p. 263 and @{cite "masolo_atomicity_1999"} p. 238.} \ + +locale CMD = CM + + assumes difference_eq: + "x \ y = (THE z. \w. P w z \ P w x \ \ O w y)" + assumes difference_closure: + "(\w. P w x \ \ O w y) \ (\z. \w. P w z \ P w x \ \ O w y)" +begin + +lemma difference_intro: + "(\w. P w z \ P w x \ \ O w y) \ x \ y = z" +proof - + assume antecedent: "(\w. P w z \ P w x \ \ O w y)" + hence "(THE z. \w. P w z \ P w x \ \ O w y) = z" + proof (rule the_equality) + fix v + assume v: "(\w. P w v \ P w x \ \ O w y)" + have "\w. P w v \ P w z" + proof + fix w + from antecedent have "P w z \ P w x \ \ O w y".. + moreover from v have "P w v \ P w x \ \ O w y".. + ultimately show "P w v \ P w z" by (rule ssubst) + qed + with part_extensionality show "v = z".. + qed + with difference_eq show "x \ y = z" by (rule ssubst) +qed + +lemma difference_idempotence: "\ O x y \ (x \ y) = x" +proof - + assume "\ O x y" + hence "\ O y x" by (rule disjoint_symmetry) + have "\w. P w x \ P w x \ \ O w y" + proof + fix w + show "P w x \ P w x \ \ O w y" + proof + assume "P w x" + hence "\ O y w" using `\ O y x` + by (rule disjoint_demonotonicity) + hence "\ O w y" by (rule disjoint_symmetry) + with `P w x` show "P w x \ \ O w y".. + next + assume "P w x \ \ O w y" + thus "P w x".. + qed + qed + thus "(x \ y) = x" by (rule difference_intro) +qed + +lemma difference_character: "(\w. P w x \ \ O w y) \ + (\w. P w (x \ y) \ P w x \ \ O w y)" +proof - + assume "\w. P w x \ \ O w y" + hence "\z. \w. P w z \ P w x \ \ O w y" by (rule difference_closure) + then obtain z where z: "\w. P w z \ P w x \ \ O w y".. + hence "(x \ y) = z" by (rule difference_intro) + thus "\w. P w (x \ y) \ P w x \ \ O w y" using z by (rule ssubst) +qed + +lemma difference_disjointness: + "(\z. P z x \ \ O z y) \ \ O y (x \ y)" +proof - + assume "\z. P z x \ \ O z y" + hence xmy: "\w. P w (x \ y) \ (P w x \ \ O w y)" + by (rule difference_character) + show "\ O y (x \ y)" + proof + assume "O y (x \ y)" + with overlap_eq have "\v. P v y \ P v (x \ y)".. + then obtain v where v: "P v y \ P v (x \ y)".. + from xmy have "P v (x \ y) \ (P v x \ \ O v y)".. + moreover from v have "P v (x \ y)".. + ultimately have "P v x \ \ O v y".. + hence "\ O v y".. + moreover from v have "P v y".. + hence "O v y" by (rule part_implies_overlap) + ultimately show "False".. + qed +qed + +end + +subsection \ The Universe \ + +text \ Another closure condition sometimes considered is the existence of the universe.\footnote{ +See, for example, @{cite "varzi_parts_1996"} p. 264 and @{cite "casati_parts_1999"} p. 45.} \ + +locale CMU = CM + + assumes universe_eq: "u = (THE z. \w. P w z)" + assumes universe_closure: "\y. \x. P x y" +begin + +lemma universe_intro: "(\w. P w z) \ u = z" +proof - + assume z: "\w. P w z" + hence "(THE z. \w. P w z) = z" + proof (rule the_equality) + fix v + assume v: "\w. P w v" + have "\w. P w v \ P w z" + proof + fix w + show "P w v \ P w z" + proof + assume "P w v" + from z show "P w z".. + next + assume "P w z" + from v show "P w v".. + qed + qed + with part_extensionality show "v = z".. + qed + thus "u = z" using universe_eq by (rule subst) +qed + +lemma universe_character: "P x u" +proof - + from universe_closure obtain y where y: "\x. P x y".. + hence "u = y" by (rule universe_intro) + hence "\x. P x u" using y by (rule ssubst) + thus "P x u".. +qed + +lemma "\ PP u x" +proof + assume "PP u x" + hence "\ P x u" by (rule proper_implies_not_part) + thus "False" using universe_character.. +qed + +lemma product_universe_implies_factor_universe: + "O x y \ x \ y = u \ x = u" +proof - + assume "x \ y = u" + moreover assume "O x y" + hence "P (x \ y) x" + by (rule product_in_first_factor) + ultimately have "P u x" + by (rule subst) + with universe_character show "x = u" + by (rule part_antisymmetry) +qed + +end + +subsection \ Complements \ + +text \ As is a condition ensuring the existence of complements.\footnote{See, for example, + @{cite "varzi_parts_1996"} p. 264 and @{cite "casati_parts_1999"} p. 45.} \ + +locale CMC = CM + + assumes complement_eq: "\x = (THE z. \w. P w z \ \ O w x)" + assumes complement_closure: + "(\w. \ O w x) \ (\z. \w. P w z \ \ O w x)" + assumes difference_eq: + "x \ y = (THE z. \w. P w z \ P w x \ \ O w y)" +begin + +lemma complement_intro: + "(\w. P w z \ \ O w x) \ \x = z" +proof - + assume antecedent: "\w. P w z \ \ O w x" + hence "(THE z. \w. P w z \ \ O w x) = z" + proof (rule the_equality) + fix v + assume v: "\w. P w v \ \ O w x" + have "\w. P w v \ P w z" + proof + fix w + from antecedent have "P w z \ \ O w x".. + moreover from v have "P w v \ \ O w x".. + ultimately show "P w v \ P w z" by (rule ssubst) + qed + with part_extensionality show "v = z".. + qed + with complement_eq show "\x = z" by (rule ssubst) +qed + +lemma complement_character: + "(\w. \ O w x) \ (\w. P w (\x) \ \ O w x)" +proof - + assume "\w. \ O w x" + hence "(\z. \w. P w z \ \ O w x)" by (rule complement_closure) + then obtain z where z: "\w. P w z \ \ O w x".. + hence "\x = z" by (rule complement_intro) + thus "\w. P w (\x) \ \ O w x" + using z by (rule ssubst) +qed + +lemma not_complement_part: "\w. \ O w x \ \ P x (\x)" +proof - + assume "\w. \ O w x" + hence "\w. P w (\x) \ \ O w x" + by (rule complement_character) + hence "P x (\x) \ \ O x x".. + show "\ P x (\x)" + proof + assume "P x (\x)" + with `P x (\x) \ \ O x x` have "\ O x x".. + thus "False" using overlap_reflexivity.. + qed +qed + +lemma complement_part: "\ O x y \ P x (\y)" +proof - + assume "\ O x y" + hence "\z. \ O z y".. + hence "\w. P w (\y) \ \ O w y" + by (rule complement_character) + hence "P x (\y) \ \ O x y".. + thus "P x (\y)" using `\ O x y`.. +qed + +lemma complement_overlap: "\ O x y \ O x (\y)" +proof - + assume "\ O x y" + hence "P x (\y)" + by (rule complement_part) + thus "O x (\y)" + by (rule part_implies_overlap) +qed + +lemma or_complement_overlap: "\y. O y x \ O y (\x)" +proof + fix y + show "O y x \ O y (\x)" + proof cases + assume "O y x" + thus "O y x \ O y (\x)".. + next + assume "\ O y x" + hence "O y (\x)" + by (rule complement_overlap) + thus "O y x \ O y (\x)".. + qed +qed + +lemma complement_disjointness: "\v. \ O v x \ \ O x (\x)" +proof - + assume "\v. \ O v x" + hence w: "\w. P w (\x) \ \ O w x" + by (rule complement_character) + show "\ O x (\x)" + proof + assume "O x (\x)" + with overlap_eq have "\v. P v x \ P v (\x)".. + then obtain v where v: "P v x \ P v (\x)".. + from w have "P v (\x) \ \ O v x".. + moreover from v have "P v (\x)".. + ultimately have "\ O v x".. + moreover from v have "P v x".. + hence "O v x" by (rule part_implies_overlap) + ultimately show "False".. + qed +qed + +lemma part_disjoint_from_complement: + "\v. \ O v x \ P y x \ \ O y (\x)" +proof + assume "\v. \ O v x" + hence "\ O x (\x)" by (rule complement_disjointness) + assume "P y x" + assume "O y (\x)" + with overlap_eq have "\v. P v y \ P v (\x)".. + then obtain v where v: "P v y \ P v (\x)".. + hence "P v y".. + hence "P v x" using `P y x` by (rule part_transitivity) + moreover from v have "P v (\x)".. + ultimately have "P v x \ P v (\x)".. + hence "\v. P v x \ P v (\x)".. + with overlap_eq have "O x (\x)".. + with `\ O x (\x)` show "False".. +qed + +lemma product_complement_character: "(\w. P w x \ \ O w y) \ + (\w. P w (x \ (\y)) \ (P w x \ (\ O w y)))" +proof - + assume antecedent: "\w. P w x \ \ O w y" + then obtain w where w: "P w x \ \ O w y".. + hence "P w x".. + moreover from w have "\ O w y".. + hence "P w (\y)" by (rule complement_part) + ultimately have "P w x \ P w (\y)".. + hence "\w. P w x \ P w (\y)".. + with overlap_eq have "O x (\y)".. + hence prod: "(\w. P w (x \ (\y)) \ (P w x \ P w (\y)))" + by (rule product_character) + show "\w. P w (x \ (\y)) \ (P w x \ (\ O w y))" + proof + fix v + from w have "\ O w y".. + hence "\w. \ O w y".. + hence "\w. P w (\y) \ \ O w y" + by (rule complement_character) + hence "P v (\y) \ \ O v y".. + moreover have "P v (x \ (\y)) \ (P v x \ P v (\y))" + using prod.. + ultimately show "P v (x \ (\y)) \ (P v x \ (\ O v y))" + by (rule subst) + qed +qed + +theorem difference_closure: "(\w. P w x \ \ O w y) \ + (\z. \w. P w z \ P w x \ \ O w y)" +proof - + assume "\w. P w x \ \ O w y" + hence "\w. P w (x \ (\y)) \ P w x \ \ O w y" + by (rule product_complement_character) + thus "(\z. \w. P w z \ P w x \ \ O w y)" by (rule exI) +qed + +end + +sublocale CMC \ CMD +proof + fix x y + show "x \ y = (THE z. \w. P w z = (P w x \ \ O w y))" + using difference_eq. + show "(\w. P w x \ \ O w y) \ + (\z. \w. P w z = (P w x \ \ O w y))" + using difference_closure. +qed + +corollary (in CMC) difference_is_product_of_complement: + "(\w. P w x \ \ O w y) \ (x \ y) = x \ (\y)" +proof - + assume antecedent: "\w. P w x \ \ O w y" + hence "\w. P w (x \ (\y)) \ P w x \ \ O w y" + by (rule product_complement_character) + thus "(x \ y) = x \ (\y)" by (rule difference_intro) +qed + +text \ Universe and difference closure entail complement closure, since the difference of an individual +and the universe is the individual's complement. \ + +locale CMUD = CMU + CMD + + assumes complement_eq: "\x = (THE z. \w. P w z \ \ O w x)" +begin + +lemma universe_difference: + "(\w. \ O w x) \ (\w. P w (u \ x) \ \ O w x)" +proof - + assume "\w. \ O w x" + then obtain w where w: "\ O w x".. + from universe_character have "P w u". + hence "P w u \ \ O w x" using `\ O w x`.. + hence "\z. P z u \ \ O z x".. + hence ux: "\w. P w (u \ x) \ (P w u \ \ O w x)" + by (rule difference_character) + show "\w. P w (u \ x) \ \ O w x" + proof + fix w + from ux have wux: "P w (u \ x) \ (P w u \ \ O w x)".. + show "P w (u \ x) \ \ O w x" + proof + assume "P w (u \ x)" + with wux have "P w u \ \ O w x".. + thus "\ O w x".. + next + assume "\ O w x" + from universe_character have "P w u". + hence "P w u \ \ O w x" using `\ O w x`.. + with wux show "P w (u \ x)".. + qed + qed +qed + +theorem complement_closure: + "(\w. \ O w x) \ (\z. \w. P w z \ \ O w x)" +proof - + assume "\w. \ O w x" + hence "\w. P w (u \ x) \ \ O w x" + by (rule universe_difference) + thus "\z. \w. P w z \ \ O w x".. +qed + +end + +sublocale CMUD \ CMC +proof + fix x y + show "\x = (THE z. \w. P w z \ (\ O w x))" + using complement_eq. + show "\w. \ O w x \ \z. \w. P w z \ (\ O w x)" + using complement_closure. + show "x \ y = (THE z. \w. P w z = (P w x \ \ O w y))" + using difference_eq. +qed + +corollary (in CMUD) complement_universe_difference: + "(\y. \ O y x) \ \x = (u \ x)" +proof - + assume "\w. \ O w x" + hence "\w. P w (u \ x) \ \ O w x" + by (rule universe_difference) + thus " \x = (u \ x)" + by (rule complement_intro) +qed + +(*<*) end (*>*) \ No newline at end of file diff --git a/thys/Mereology/EM.thy b/thys/Mereology/EM.thy new file mode 100644 --- /dev/null +++ b/thys/Mereology/EM.thy @@ -0,0 +1,214 @@ +section \ Extensional Mereology \ + +(*<*) +theory EM + imports MM +begin +(*>*) + +text \ Extensional mereology adds to ground mereology the axiom of strong supplementation.\footnote{ +See @{cite "simons_parts:_1987"} p. 29, @{cite "varzi_parts_1996"} p. 262 and @{cite "casati_parts_1999"} +p. 39-40.} \ + +locale EM = M + + assumes strong_supplementation: + "\ P x y \ (\z. P z x \ \ O z y)" +begin + +text \ Strong supplementation entails weak supplementation.\footnote{See @{cite "simons_parts:_1987"} +p. 29 and @{cite "casati_parts_1999"} p. 40.} \ + +lemma weak_supplementation: "PP x y \ (\z. P z y \ \ O z x)" +proof - + assume "PP x y" + hence "\ P y x" by (rule proper_implies_not_part) + thus "\z. P z y \ \ O z x" by (rule strong_supplementation) +qed + +end + +text \ So minimal mereology is a subtheory of extensional mereology.\footnote{@{cite "casati_parts_1999"} p. 40.} \ + +sublocale EM \ MM +proof + fix y x + show "PP y x \ \z. P z x \ \ O z y" using weak_supplementation. +qed + +text \ Strong supplementation also entails the proper parts principle.\footnote{See @{cite "simons_parts:_1987"} +pp. 28-9 and @{cite "varzi_parts_1996"} p. 263.} \ + +context EM +begin + +lemma proper_parts_principle: +"(\z. PP z x) \ (\z. PP z x \ P z y) \ P x y" +proof - + assume "\z. PP z x" + then obtain v where v: "PP v x".. + hence "P v x" by (rule proper_implies_part) + assume antecedent: "\z. PP z x \ P z y" + hence "PP v x \ P v y".. + hence "P v y" using `PP v x`.. + with `P v x` have "P v x \ P v y".. + hence "\v. P v x \ P v y".. + with overlap_eq have "O x y".. + show "P x y" + proof (rule ccontr) + assume "\ P x y" + hence "\z. P z x \ \ O z y" + by (rule strong_supplementation) + then obtain z where z: "P z x \ \ O z y".. + hence "P z x".. + moreover have "z \ x" + proof + assume "z = x" + moreover from z have "\ O z y".. + ultimately have "\ O x y" by (rule subst) + thus "False" using `O x y`.. + qed + ultimately have "P z x \ z \ x".. + with nip_eq have "PP z x".. + from antecedent have "PP z x \ P z y".. + hence "P z y" using `PP z x`.. + hence "O z y" by (rule part_implies_overlap) + from z have "\ O z y".. + thus "False" using `O z y`.. + qed +qed + +text \ Which with antisymmetry entails the extensionality of proper parthood.\footnote{See +@{cite "simons_parts:_1987"} p. 28, @{cite "varzi_parts_1996"} p. 263 and @{cite "casati_parts_1999"} +p. 40.} \ + +theorem proper_part_extensionality: +"(\z. PP z x \ PP z y) \ x = y \ (\z. PP z x \ PP z y)" +proof - + assume antecedent: "\z. PP z x \ PP z y" + show "x = y \ (\z. PP z x \ PP z y)" + proof + assume "x = y" + moreover have "\z. PP z x \ PP z x" by simp + ultimately show "\z. PP z x \ PP z y" by (rule subst) + next + assume right: "\z. PP z x \ PP z y" + have "\z. PP z x \ P z y" + proof + fix z + show "PP z x \ P z y" + proof + assume "PP z x" + from right have "PP z x \ PP z y".. + hence "PP z y" using `PP z x`.. + thus "P z y" by (rule proper_implies_part) + qed + qed + have "\z. PP z y \ P z x" + proof + fix z + show "PP z y \ P z x" + proof + assume "PP z y" + from right have "PP z x \ PP z y".. + hence "PP z x" using `PP z y`.. + thus "P z x" by (rule proper_implies_part) + qed + qed + from antecedent obtain z where z: "PP z x \ PP z y".. + thus "x = y" + proof (rule disjE) + assume "PP z x" + hence "\z. PP z x".. + hence "P x y" using `\z. PP z x \ P z y` + by (rule proper_parts_principle) + from right have "PP z x \ PP z y".. + hence "PP z y" using `PP z x`.. + hence "\z. PP z y".. + hence "P y x" using `\z. PP z y \ P z x` + by (rule proper_parts_principle) + with `P x y` show "x = y" + by (rule part_antisymmetry) + next + assume "PP z y" + hence "\z. PP z y".. + hence "P y x" using `\z. PP z y \ P z x` + by (rule proper_parts_principle) + from right have "PP z x \ PP z y".. + hence "PP z x" using `PP z y`.. + hence "\z. PP z x".. + hence "P x y" using `\z. PP z x \ P z y` + by (rule proper_parts_principle) + thus "x = y" + using `P y x` by (rule part_antisymmetry) + qed + qed +qed + +text \ It also follows from strong supplementation that parthood is definable in terms of overlap.\footnote{ +See @{cite "parsons_many_2014"} p. 4.} \ + +lemma part_overlap_eq: "P x y \ (\z. O z x \ O z y)" +proof + assume "P x y" + show "(\z. O z x \ O z y)" + proof + fix z + show "O z x \ O z y" + proof + assume "O z x" + with `P x y` show "O z y" + by (rule overlap_monotonicity) + qed + qed +next + assume right: "\z. O z x \ O z y" + show "P x y" + proof (rule ccontr) + assume "\ P x y" + hence "\z. P z x \ \ O z y" + by (rule strong_supplementation) + then obtain z where z: "P z x \ \ O z y".. + hence "\ O z y".. + from right have "O z x \ O z y".. + moreover from z have "P z x".. + hence "O z x" by (rule part_implies_overlap) + ultimately have "O z y".. + with `\ O z y` show "False".. + qed +qed + +text \ Which entails the extensionality of overlap. \ + +theorem overlap_extensionality: "x = y \ (\z. O z x \ O z y)" +proof + assume "x = y" + moreover have "\z. O z x \ O z x" + proof + fix z + show "O z x \ O z x".. + qed + ultimately show "\z. O z x \ O z y" + by (rule subst) +next + assume right: "\z. O z x \ O z y" + have "\z. O z y \ O z x" + proof + fix z + from right have "O z x \ O z y".. + thus "O z y \ O z x".. + qed + with part_overlap_eq have "P y x".. + have "\z. O z x \ O z y" + proof + fix z + from right have "O z x \ O z y".. + thus "O z x \ O z y".. + qed + with part_overlap_eq have "P x y".. + thus "x = y" + using `P y x` by (rule part_antisymmetry) +qed + +end + +(*<*) end (*>*) \ No newline at end of file diff --git a/thys/Mereology/GEM.thy b/thys/Mereology/GEM.thy new file mode 100644 --- /dev/null +++ b/thys/Mereology/GEM.thy @@ -0,0 +1,1365 @@ +section \ General Extensional Mereology \ + +(*<*) +theory GEM + imports GMM CEM +begin (*>*) + +text \ The theory of \emph{general extensional mereology}, also known as \emph{classical extensional +mereology} adds general mereology to extensional mereology.\footnote{For this axiomatization see +@{cite "varzi_parts_1996"} p. 265 and @{cite "casati_parts_1999"} p. 46.} \ + +locale GEM = GM + EM + + assumes sum_eq: "x \ y = (THE z. \v. O v z \ O v x \ O v y)" + assumes product_eq: + "x \ y = (THE z. \v. P v z \ P v x \ P v y)" + assumes difference_eq: + "x \ y = (THE z. \w. P w z = (P w x \ \ O w y))" + assumes complement_eq: "\ x = (THE z. \w. P w z \ \ O w x)" + assumes universe_eq: "u = (THE x. \y. P y x)" + assumes fusion_eq: "\x. F x \ + (\ x. F x) = (THE x. \y. O y x \ (\z. F z \ O y z))" + assumes general_product_eq: "(\ x. F x) = (\ x. \y. F y \ P x y)" + +sublocale GEM \ GMM +proof +qed + +subsection \ General Sums \ + +context GEM +begin + +lemma fusion_intro: +"(\y. O y z \ (\x. F x \ O y x)) \ (\ x. F x) = z" +proof - + assume antecedent: "(\y. O y z \ (\x. F x \ O y x))" + hence "(THE x. \y. O y x \ (\z. F z \ O y z)) = z" + proof (rule the_equality) + fix a + assume a: "(\y. O y a \ (\x. F x \ O y x))" + have "\x. O x a \ O x z" + proof + fix b + from antecedent have "O b z \ (\x. F x \ O b x)".. + moreover from a have "O b a \ (\x. F x \ O b x)".. + ultimately show "O b a \ O b z" by (rule ssubst) + qed + with overlap_extensionality show "a = z".. + qed + moreover from antecedent have "O z z \ (\x. F x \ O z x)".. + hence "\x. F x \ O z x" using overlap_reflexivity.. + hence "\x. F x" by auto + hence "(\ x. F x) = (THE x. \y. O y x \ (\z. F z \ O y z))" + by (rule fusion_eq) + ultimately show "(\ v. F v) = z" by (rule subst) +qed + +lemma fusion_idempotence: "(\ x. z = x) = z" +proof - + have "\y. O y z \ (\x. z = x \ O y x)" + proof + fix y + show "O y z \ (\x. z = x \ O y x)" + proof + assume "O y z" + with refl have "z = z \ O y z".. + thus "\x. z = x \ O y x".. + next + assume "\x. z = x \ O y x" + then obtain x where x: "z = x \ O y x".. + hence "z = x".. + moreover from x have "O y x".. + ultimately show "O y z" by (rule ssubst) + qed + qed + thus "(\ x. z = x) = z" + by (rule fusion_intro) +qed + +text \ The whole is the sum of its parts. \ + +lemma fusion_absorption: "(\ x. P x z) = z" +proof - + have "(\y. O y z \ (\x. P x z \ O y x))" + proof + fix y + show "O y z \ (\x. P x z \ O y x)" + proof + assume "O y z" + with part_reflexivity have "P z z \ O y z".. + thus "\x. P x z \ O y x".. + next + assume "\x. P x z \ O y x" + then obtain x where x: "P x z \ O y x".. + hence "P x z".. + moreover from x have "O y x".. + ultimately show "O y z" by (rule overlap_monotonicity) + qed + qed + thus "(\ x. P x z) = z" + by (rule fusion_intro) +qed + +lemma part_fusion: "P w (\ v. P v x) \ P w x" +proof - + assume "P w (\ v. P v x)" + with fusion_absorption show "P w x" by (rule subst) +qed + +lemma fusion_character: + "\x. F x \ (\y. O y (\ v. F v) \ (\x. F x \ O y x))" +proof - + assume "\x. F x" + hence "\z. \y. O y z \ (\x. F x \ O y x)" + by (rule fusion) + then obtain z where z: "\y. O y z \ (\x. F x \ O y x)".. + hence "(\ v. F v) = z " by (rule fusion_intro) + thus "\y. O y (\ v. F v) \ (\x. F x \ O y x)" using z by (rule ssubst) +qed + +text \ The next lemma characterises fusions in terms of parthood.\footnote{See @{cite "pontow_note_2004"} pp. 202-9.} \ + +lemma fusion_part_character: "\x. F x \ + (\y. P y (\ v. F v) \ (\w. P w y \ (\v. F v \ O w v)))" +proof - + assume "(\x. F x)" + hence F: "\y. O y (\ v. F v) \ (\x. F x \ O y x)" + by (rule fusion_character) + show "\y. P y (\ v. F v) \ (\w. P w y \ (\v. F v \ O w v))" + proof + fix y + show "P y (\ v. F v) \ (\w. P w y \ (\v. F v \ O w v))" + proof + assume "P y (\ v. F v)" + show "\w. P w y \ (\v. F v \ O w v)" + proof + fix w + from F have w: "O w (\ v. F v) \ (\x. F x \ O w x)".. + show "P w y \ (\v. F v \ O w v)" + proof + assume "P w y" + hence "P w (\ v. F v)" using `P y (\ v. F v)` + by (rule part_transitivity) + hence "O w (\ v. F v)" by (rule part_implies_overlap) + with w show "\x. F x \ O w x".. + qed + qed + next + assume right: "\w. P w y \ (\v. F v \ O w v)" + show "P y (\ v. F v)" + proof (rule ccontr) + assume "\ P y (\ v. F v)" + hence "\v. P v y \ \ O v (\ v. F v)" + by (rule strong_supplementation) + then obtain v where v: "P v y \ \ O v (\ v. F v)".. + hence "\ O v (\ v. F v)".. + from right have "P v y \ (\w. F w \ O v w)".. + moreover from v have "P v y".. + ultimately have "\w. F w \ O v w".. + from F have "O v (\ v. F v) \ (\x. F x \ O v x)".. + hence "O v (\ v. F v)" using `\w. F w \ O v w`.. + with `\ O v (\ v. F v)` show "False".. + qed + qed + qed +qed + +lemma fusion_part: "F x \ P x (\ x. F x)" +proof - + assume "F x" + hence "\x. F x".. + hence "\y. P y (\ v. F v) \ (\w. P w y \ (\v. F v \ O w v))" + by (rule fusion_part_character) + hence "P x (\ v. F v) \ (\w. P w x \ (\v. F v \ O w v))".. + moreover have "\w. P w x \ (\v. F v \ O w v)" + proof + fix w + show "P w x \ (\v. F v \ O w v)" + proof + assume "P w x" + hence "O w x" by (rule part_implies_overlap) + with `F x` have "F x \ O w x".. + thus "\v. F v \ O w v".. + qed + qed + ultimately show "P x (\ v. F v)".. +qed + +lemma common_part_fusion: + "O x y \ (\w. P w (\ v. (P v x \ P v y)) \ (P w x \ P w y))" +proof - + assume "O x y" + with overlap_eq have "\z. (P z x \ P z y)".. + hence sum: "(\w. P w (\ v. (P v x \ P v y)) \ + (\z. P z w \ (\v. (P v x \ P v y) \ O z v)))" + by (rule fusion_part_character) + show "\w. P w (\ v. (P v x \ P v y)) \ (P w x \ P w y)" + proof + fix w + from sum have w: "P w (\ v. (P v x \ P v y)) + \ (\z. P z w \ (\v. (P v x \ P v y) \ O z v))".. + show "P w (\ v. (P v x \ P v y)) \ (P w x \ P w y)" + proof + assume "P w (\ v. (P v x \ P v y))" + with w have bla: + "(\z. P z w \ (\v. (P v x \ P v y) \ O z v))".. + show "P w x \ P w y" + proof + show "P w x" + proof (rule ccontr) + assume "\ P w x" + hence "\z. P z w \ \ O z x" + by (rule strong_supplementation) + then obtain z where z: "P z w \ \ O z x".. + hence "\ O z x".. + from bla have "P z w \ (\v. (P v x \ P v y) \ O z v)".. + moreover from z have "P z w".. + ultimately have "\v. (P v x \ P v y) \ O z v".. + then obtain v where v: "(P v x \ P v y) \ O z v".. + hence "P v x \ P v y".. + hence "P v x".. + moreover from v have "O z v".. + ultimately have "O z x" + by (rule overlap_monotonicity) + with `\ O z x` show "False".. + qed + show "P w y" + proof (rule ccontr) + assume "\ P w y" + hence "\z. P z w \ \ O z y" + by (rule strong_supplementation) + then obtain z where z: "P z w \ \ O z y".. + hence "\ O z y".. + from bla have "P z w \ (\v. (P v x \ P v y) \ O z v)".. + moreover from z have "P z w".. + ultimately have "\v. (P v x \ P v y) \ O z v".. + then obtain v where v: "(P v x \ P v y) \ O z v".. + hence "P v x \ P v y".. + hence "P v y".. + moreover from v have "O z v".. + ultimately have "O z y" + by (rule overlap_monotonicity) + with `\ O z y` show "False".. + qed + qed + next + assume "P w x \ P w y" + thus "P w (\ v. (P v x \ P v y))" + by (rule fusion_part) + qed + qed +qed + +theorem product_closure: + "O x y \ (\z. \w. P w z \ (P w x \ P w y))" +proof - + assume "O x y" + hence "(\w. P w (\ v. (P v x \ P v y)) \ (P w x \ P w y))" + by (rule common_part_fusion) + thus "\z. \w. P w z \ (P w x \ P w y)".. +qed + +end + +sublocale GEM \ CEM +proof + fix x y + show "\z. \w. O w z = (O w x \ O w y)" + using sum_closure. + show "x \ y = (THE z. \v. O v z \ O v x \ O v y)" + using sum_eq. + show "x \ y = (THE z. \v. P v z \ P v x \ P v y)" + using product_eq. + show "O x y \ (\z. \w. P w z = (P w x \ P w y))" + using product_closure. +qed + +context GEM +begin + +corollary "O x y \ x \ y = (\ v. P v x \ P v y)" +proof - + assume "O x y" + hence "(\w. P w (\ v. (P v x \ P v y)) \ (P w x \ P w y))" + by (rule common_part_fusion) + thus "x \ y = (\ v. P v x \ P v y)" by (rule product_intro) +qed + +lemma disjoint_fusion: + "\w. \ O w x \ (\w. P w (\ z. \ O z x) \ \ O w x)" +proof - + assume antecedent: "\w. \ O w x" + hence "\y. O y (\ v. \ O v x) \ (\v. \ O v x \ O y v)" + by (rule fusion_character) + hence x: "O x (\ v. \ O v x) \ (\v. \ O v x \ O x v)".. + show "\w. P w (\ z. \ O z x) \ \ O w x" + proof + fix y + show "P y (\ z. \ O z x) \ \ O y x" + proof + assume "P y (\ z. \ O z x)" + moreover have "\ O x (\ z. \ O z x)" + proof + assume "O x (\ z. \ O z x)" + with x have "(\v. \ O v x \ O x v)".. + then obtain v where v: "\ O v x \ O x v".. + hence "\ O v x".. + from v have "O x v".. + hence "O v x" by (rule overlap_symmetry) + with `\ O v x` show "False".. + qed + ultimately have "\ O x y" + by (rule disjoint_demonotonicity) + thus "\ O y x" by (rule disjoint_symmetry) + next + assume "\ O y x" + thus "P y (\ v. \ O v x)" + by (rule fusion_part) + qed + qed +qed + +theorem complement_closure: + "\w. \ O w x \ (\z. \w. P w z \ \ O w x)" +proof - + assume "(\w. \ O w x)" + hence "\w. P w (\ z. \ O z x) \ \ O w x" + by (rule disjoint_fusion) + thus "\z. \w. P w z \ \ O w x".. +qed + +end + +sublocale GEM \ CEMC +proof + fix x y + show "\ x = (THE z. \w. P w z \ \ O w x)" + using complement_eq. + show "(\w. \ O w x) \ (\z. \w. P w z = (\ O w x))" + using complement_closure. + show "x \ y = (THE z. \w. P w z = (P w x \ \ O w y))" + using difference_eq. + show "u = (THE x. \y. P y x)" + using universe_eq. +qed + +context GEM +begin + +corollary complement_is_disjoint_fusion: + "\w. \ O w x \ \ x = (\ z. \ O z x)" +proof - + assume "\w. \ O w x" + hence "\w. P w (\ z. \ O z x) \ \ O w x" + by (rule disjoint_fusion) + thus "\ x = (\ z. \ O z x)" + by (rule complement_intro) +qed + +theorem strong_fusion: "\x. F x \ + \x. (\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z))" +proof - + assume "\x. F x" + have "(\y. F y \ P y (\ v. F v)) \ + (\y. P y (\ v. F v) \ (\z. F z \ O y z))" + proof + show "\y. F y \ P y (\ v. F v)" + proof + fix y + show "F y \ P y (\ v. F v)" + proof + assume "F y" + thus "P y (\ v. F v)" + by (rule fusion_part) + qed + qed + next + have "(\y. P y (\ v. F v) \ + (\w. P w y \ (\v. F v \ O w v)))" + using `\x. F x` by (rule fusion_part_character) + hence "P (\ v. F v) (\ v. F v) \ (\w. P w (\ v. F v) \ + (\v. F v \ O w v))".. + thus "\w. P w (\ v. F v) \ (\v. F v \ O w v)" using part_reflexivity.. + qed + thus ?thesis.. +qed + +theorem strong_fusion_eq: "\x. F x \ (\ x. F x) = + (THE x. (\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z)))" +proof - + assume "\x. F x" + have "(THE x. (\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z))) = (\ x. F x)" + proof (rule the_equality) + show "(\y. F y \ P y (\ x. F x)) \ (\y. P y (\ x. F x) \ (\z. F z \ O y z))" + proof + show "\y. F y \ P y (\ x. F x)" + proof + fix y + show "F y \ P y (\ x. F x)" + proof + assume "F y" + thus "P y (\ x. F x)" + by (rule fusion_part) + qed + qed + next + show "(\y. P y (\ x. F x) \ (\z. F z \ O y z))" + proof + fix y + show "P y (\ x. F x) \ (\z. F z \ O y z)" + proof + have "\y. P y (\ v. F v) \ (\w. P w y \ (\v. F v \ O w v))" + using `\x. F x` by (rule fusion_part_character) + hence "P y (\ v. F v) \ (\w. P w y \ (\v. F v \ O w v))".. + moreover assume "P y (\ x. F x)" + ultimately have "\w. P w y \ (\v. F v \ O w v)".. + hence "P y y \ (\v. F v \ O y v)".. + thus "\v. F v \ O y v" using part_reflexivity.. + qed + qed + qed + next + fix x + assume x: "(\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z))" + have "\y. O y x \ (\z. F z \ O y z)" + proof + fix y + show "O y x \ (\z. F z \ O y z)" + proof + assume "O y x" + with overlap_eq have "\v. P v y \ P v x".. + then obtain v where v: "P v y \ P v x".. + from x have "\y. P y x \ (\z. F z \ O y z)".. + hence "P v x \ (\z. F z \ O v z)".. + moreover from v have "P v x".. + ultimately have "\z. F z \ O v z".. + then obtain z where z: "F z \ O v z".. + hence "F z".. + from v have "P v y".. + moreover from z have "O v z".. + hence "O z v" by (rule overlap_symmetry) + ultimately have "O z y" by (rule overlap_monotonicity) + hence "O y z" by (rule overlap_symmetry) + with `F z` have "F z \ O y z".. + thus "\z. F z \ O y z".. + next + assume "\z. F z \ O y z" + then obtain z where z: "F z \ O y z".. + from x have "\y. F y \ P y x".. + hence "F z \ P z x".. + moreover from z have "F z".. + ultimately have "P z x".. + moreover from z have "O y z".. + ultimately show "O y x" + by (rule overlap_monotonicity) + qed + qed + hence "(\ x. F x) = x" + by (rule fusion_intro) + thus "x = (\ x. F x)".. + qed + thus ?thesis.. +qed + +lemma strong_sum_eq: "x \ y = (THE z. (P x z \ P y z) \ (\w. P w z \ O w x \ O w y))" +proof - + have "(THE z. (P x z \ P y z) \ (\w. P w z \ O w x \ O w y)) = x \ y" + proof (rule the_equality) + show "(P x (x \ y) \ P y (x \ y)) \ (\w. P w (x \ y) \ O w x \ O w y)" + proof + show "P x (x \ y) \ P y (x \ y)" + proof + show "P x (x \ y)" using first_summand_in_sum. + show "P y (x \ y)" using second_summand_in_sum. + qed + show "\w. P w (x \ y) \ O w x \ O w y" + proof + fix w + show "P w (x \ y) \ O w x \ O w y" + proof + assume "P w (x \ y)" + hence "O w (x \ y)" by (rule part_implies_overlap) + with sum_overlap show "O w x \ O w y".. + qed + qed + qed + fix z + assume z: "(P x z \ P y z) \ (\w. P w z \ O w x \ O w y)" + hence "P x z \ P y z".. + have "\w. O w z \ (O w x \ O w y)" + proof + fix w + show "O w z \ (O w x \ O w y)" + proof + assume "O w z" + with overlap_eq have "\v. P v w \ P v z".. + then obtain v where v: "P v w \ P v z".. + hence "P v w".. + from z have "\w. P w z \ O w x \ O w y".. + hence "P v z \ O v x \ O v y".. + moreover from v have "P v z".. + ultimately have "O v x \ O v y".. + thus "O w x \ O w y" + proof + assume "O v x" + hence "O x v" by (rule overlap_symmetry) + with `P v w` have "O x w" by (rule overlap_monotonicity) + hence "O w x" by (rule overlap_symmetry) + thus "O w x \ O w y".. + next + assume "O v y" + hence "O y v" by (rule overlap_symmetry) + with `P v w` have "O y w" by (rule overlap_monotonicity) + hence "O w y" by (rule overlap_symmetry) + thus "O w x \ O w y".. + qed + next + assume "O w x \ O w y" + thus "O w z" + proof + from `P x z \ P y z` have "P x z".. + moreover assume "O w x" + ultimately show "O w z" + by (rule overlap_monotonicity) + next + from `P x z \ P y z` have "P y z".. + moreover assume "O w y" + ultimately show "O w z" + by (rule overlap_monotonicity) + qed + qed + qed + hence "x \ y = z" by (rule sum_intro) + thus "z = x \ y".. + qed + thus ?thesis.. +qed + +subsection \ General Products \ + +lemma general_product_intro: "(\y. O y x \ (\z. (\y. F y \ P z y) \ O y z)) \ (\ x. F x) = x" +proof - + assume "\y. O y x \ (\z. (\y. F y \ P z y) \ O y z)" + hence "(\ x. \y. F y \ P x y) = x" by (rule fusion_intro) + with general_product_eq show "(\ x. F x) = x" by (rule ssubst) +qed + +lemma general_product_idempotence: "(\ z. z = x) = x" +proof - + have "\y. O y x \ (\z. (\y. y = x \ P z y) \ O y z)" + by (meson overlap_eq part_reflexivity part_transitivity) + thus "(\ z. z = x) = x" by (rule general_product_intro) +qed + +lemma general_product_absorption: "(\ z. P x z) = x" +proof - + have "\y. O y x \ (\z. (\y. P x y \ P z y) \ O y z)" + by (meson overlap_eq part_reflexivity part_transitivity) + thus "(\ z. P x z) = x" by (rule general_product_intro) +qed + +lemma general_product_character: "\z. \y. F y \ P z y \ + \y. O y (\ x. F x) \ (\z. (\y. F y \ P z y) \ O y z)" +proof - + assume "(\z. \y. F y \ P z y)" + hence "(\x. \y. O y x \ (\z. (\y. F y \ P z y) \ O y z))" + by (rule fusion) + then obtain x where x: + "\y. O y x \ (\z. (\y. F y \ P z y) \ O y z)".. + hence "(\ x. F x) = x" by (rule general_product_intro) + thus "(\y. O y (\ x. F x) \ (\z. (\y. F y \ P z y) \ O y z))" + using x by (rule ssubst) +qed + +corollary "\ (\x. F x) \ u = (\ x. F x)" +proof - + assume antecedent: "\ (\x. F x)" + have "\y. P y (\ x. F x)" + proof + fix y + show "P y (\ x. F x)" + proof (rule ccontr) + assume "\ P y (\ x. F x)" + hence "\z. P z y \ \ O z (\ x. F x)" by (rule strong_supplementation) + then obtain z where z: "P z y \ \ O z (\ x. F x)".. + hence "\ O z (\ x. F x)".. + from antecedent have bla: "\ y. F y \ P z y" by simp + hence "\ v. \ y. F y \ P v y".. + hence "(\y. O y (\ x. F x) \ (\z. (\y. F y \ P z y) \ O y z))" by (rule general_product_character) + hence "O z (\ x. F x) \ (\v. (\y. F y \ P v y) \ O z v)".. + moreover from bla have "(\ y. F y \ P z y) \ O z z" + using overlap_reflexivity.. + hence "\ v. (\ y. F y \ P v y) \ O z v".. + ultimately have "O z (\ x. F x)".. + with `\ O z (\ x. F x)` show "False".. + qed + qed + thus "u = (\ x. F x)" + by (rule universe_intro) +qed + +end + +subsection \ Strong Fusion \ + +text \ An alternative axiomatization of general extensional mereology adds a stronger version of the +fusion axiom to minimal mereology, with correspondingly stronger definitions of sums and general +sums.\footnote{See @{cite "tarski_foundations_1983"} p. 25. The proofs in this section are adapted +from @{cite "hovda_what_2009"}.} \ + +locale GEM1 = MM + + assumes strong_fusion: "\x. F x \ \x. (\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z))" + assumes strong_sum_eq: "x \ y = (THE z. (P x z \ P y z) \ (\w. P w z \ O w x \ O w y))" + assumes product_eq: + "x \ y = (THE z. \v. P v z \ P v x \ P v y)" + assumes difference_eq: + "x \ y = (THE z. \w. P w z = (P w x \ \ O w y))" + assumes complement_eq: "\ x = (THE z. \w. P w z \ \ O w x)" + assumes universe_eq: "u = (THE x. \y. P y x)" + assumes strong_fusion_eq: "\x. F x \ (\ x. F x) = (THE x. (\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z)))" + assumes general_product_eq: "(\ x. F x) = (\ x. \y. F y \ P x y)" +begin + +theorem fusion: + "\x. \ x \ (\z. \y. O y z \ (\x. \ x \ O y x))" +proof - + assume "\x. \ x" + hence "\x. (\y. \ y \ P y x) \ (\y. P y x \ (\z. \ z \ O y z))" by (rule strong_fusion) + then obtain x where x: + "(\y. \ y \ P y x) \ (\y. P y x \ (\z. \ z \ O y z))".. + have "\y. O y x \ (\v. \ v \ O y v)" + proof + fix y + show "O y x \ (\v. \ v \ O y v)" + proof + assume "O y x" + with overlap_eq have "\z. P z y \ P z x".. + then obtain z where z: "P z y \ P z x".. + hence "P z x".. + from x have "\y. P y x \ (\v. \ v \ O y v)".. + hence "P z x \ (\v. \ v \ O z v)".. + hence "\v. \ v \ O z v" using `P z x`.. + then obtain v where v: "\ v \ O z v".. + hence "O z v".. + with overlap_eq have "\w. P w z \ P w v".. + then obtain w where w: "P w z \ P w v".. + hence "P w z".. + moreover from z have "P z y".. + ultimately have "P w y" + by (rule part_transitivity) + moreover from w have "P w v".. + ultimately have "P w y \ P w v".. + hence "\w. P w y \ P w v".. + with overlap_eq have "O y v".. + from v have "\ v".. + hence "\ v \ O y v" using `O y v`.. + thus "\v. \ v \ O y v".. + next + assume "\v. \ v \ O y v" + then obtain v where v: "\ v \ O y v".. + hence "O y v".. + with overlap_eq have "\z. P z y \ P z v".. + then obtain z where z: "P z y \ P z v".. + hence "P z v".. + from x have "\y. \ y \ P y x".. + hence "\ v \ P v x".. + moreover from v have "\ v".. + ultimately have "P v x".. + with `P z v` have "P z x" + by (rule part_transitivity) + from z have "P z y".. + thus "O y x" using `P z x` + by (rule overlap_intro) + qed + qed + thus "(\z. \y. O y z \ (\x. \ x \ O y x))".. +qed + +lemma pair: "\v. (\w. (w = x \ w = y) \ P w v) \ (\w. P w v \ (\z. (z = x \ z = y) \ O w z))" +proof - + have "x = x".. + hence "x = x \ x = y".. + hence "\v. v = x \ v = y".. + thus ?thesis + by (rule strong_fusion) +qed + +lemma or_id: "(v = x \ v = y) \ O w v \ O w x \ O w y" +proof - + assume v: "(v = x \ v = y) \ O w v" + hence "O w v".. + from v have "v = x \ v = y".. + thus "O w x \ O w y" + proof + assume "v = x" + hence "O w x" using `O w v` by (rule subst) + thus "O w x \ O w y".. + next + assume "v = y" + hence "O w y" using `O w v` by (rule subst) + thus "O w x \ O w y".. + qed +qed + +lemma strong_sum_closure: + "\z. (P x z \ P y z) \ (\w. P w z \ O w x \ O w y)" +proof - + from pair obtain z where z: "(\w. (w = x \ w = y) \ P w z) \ (\w. P w z \ (\v. (v = x \ v = y) \ O w v))".. + have "(P x z \ P y z) \ (\w. P w z \ O w x \ O w y)" + proof + from z have allw: "\w. (w = x \ w = y) \ P w z".. + hence "x = x \ x = y \ P x z".. + moreover have "x = x \ x = y" using refl.. + ultimately have "P x z".. + from allw have "y = x \ y = y \ P y z".. + moreover have "y = x \ y = y" using refl.. + ultimately have "P y z".. + with `P x z` show "P x z \ P y z".. + next + show "\w. P w z \ O w x \ O w y" + proof + fix w + show "P w z \ O w x \ O w y" + proof + assume "P w z" + from z have "\w. P w z \ (\v. (v = x \ v = y) \ O w v)".. + hence "P w z \ (\v. (v = x \ v = y) \ O w v)".. + hence "\v. (v = x \ v = y) \ O w v" using `P w z`.. + then obtain v where v: "(v = x \ v = y) \ O w v".. + thus "O w x \ O w y" by (rule or_id) + qed + qed + qed + thus ?thesis.. +qed + +end + +sublocale GEM1 \ GMM +proof + fix x y \ + show "(\x. \ x) \ (\z. \y. O y z \ (\x. \ x \ O y x))" using fusion. +qed + +context GEM1 +begin + +lemma least_upper_bound: + assumes sf: + "((\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z)))" + shows lub: + "(\y. F y \ P y x) \ (\z. (\y. F y \ P y z) \ P x z)" +proof + from sf show "\y. F y \ P y x".. +next + show "(\z. (\y. F y \ P y z) \ P x z)" + proof + fix z + show "(\y. F y \ P y z) \ P x z" + proof + assume z: "\y. F y \ P y z" + from pair obtain v where v: "(\w. (w = x \ w = z) \ P w v) \ (\w. P w v \ (\y. (y = x \ y = z) \ O w y))".. + hence left: "(\w. (w = x \ w = z) \ P w v)".. + hence "(x = x \ x = z) \ P x v".. + moreover have "x = x \ x = z" using refl.. + ultimately have "P x v".. + have "z = v" + proof (rule ccontr) + assume "z \ v" + from left have "z = x \ z = z \ P z v".. + moreover have "z = x \ z = z" using refl.. + ultimately have "P z v".. + hence "P z v \ z \ v" using `z \ v`.. + with nip_eq have "PP z v".. + hence "\w. P w v \ \ O w z" by (rule weak_supplementation) + then obtain w where w: "P w v \ \ O w z".. + hence "P w v".. + from v have right: + "\w. P w v \ (\y. (y = x \ y = z) \ O w y)".. + hence "P w v \ (\y. (y = x \ y = z) \ O w y)".. + hence "\y. (y = x \ y = z) \ O w y" using `P w v`.. + then obtain s where s: "(s = x \ s = z) \ O w s".. + hence "s = x \ s = z".. + thus "False" + proof + assume "s = x" + moreover from s have "O w s".. + ultimately have "O w x" by (rule subst) + with overlap_eq have "\t. P t w \ P t x".. + then obtain t where t: "P t w \ P t x".. + hence "P t x".. + from sf have "(\y. P y x \ (\z. F z \ O y z))".. + hence "P t x \ (\z. F z \ O t z)".. + hence "\z. F z \ O t z" using `P t x`.. + then obtain a where a: "F a \ O t a".. + hence "F a".. + from sf have ub: "\y. F y \ P y x".. + hence "F a \ P a x".. + hence "P a x" using `F a`.. + moreover from a have "O t a".. + ultimately have "O t x" + by (rule overlap_monotonicity) + from t have "P t w".. + moreover have "O z t" + proof - + from z have "F a \ P a z".. + moreover from a have "F a".. + ultimately have "P a z".. + moreover from a have "O t a".. + ultimately have "O t z" + by (rule overlap_monotonicity) + thus "O z t" by (rule overlap_symmetry) + qed + ultimately have "O z w" + by (rule overlap_monotonicity) + hence "O w z" by (rule overlap_symmetry) + from w have "\ O w z".. + thus "False" using `O w z`.. + next + assume "s = z" + moreover from s have "O w s".. + ultimately have "O w z" by (rule subst) + from w have "\ O w z".. + thus "False" using `O w z`.. + qed + qed + thus "P x z" using `P x v` by (rule ssubst) + qed + qed +qed + +corollary strong_fusion_intro: "(\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z)) \ (\ x. F x) = x" +proof - + assume antecedent: "(\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z))" + with least_upper_bound have lubx: + "(\y. F y \ P y x) \ (\z. (\y. F y \ P y z) \ P x z)". + from antecedent have "\y. P y x \ (\z. F z \ O y z)".. + hence "P x x \ (\z. F z \ O x z)".. + hence "\z. F z \ O x z" using part_reflexivity.. + then obtain z where z: "F z \ O x z".. + hence "F z".. + hence "\z. F z".. + hence "(\ x. F x) = (THE x. (\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z)))" by (rule strong_fusion_eq) + moreover have "(THE x. (\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z))) = x" + proof (rule the_equality) + show "(\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z))" + using antecedent. + next + fix w + assume w: + "(\y. F y \ P y w) \ (\y. P y w \ (\z. F z \ O y z))" + with least_upper_bound have lubw: + "(\y. F y \ P y w) \ (\z. (\y. F y \ P y z) \ P w z)". + hence "(\z. (\y. F y \ P y z) \ P w z)".. + hence "(\y. F y \ P y x) \ P w x".. + moreover from antecedent have "\y. F y \ P y x".. + ultimately have "P w x".. + from lubx have "(\z. (\y. F y \ P y z) \ P x z)".. + hence "(\y. F y \ P y w) \ P x w".. + moreover from lubw have "(\y. F y \ P y w)".. + ultimately have "P x w".. + with `P w x` show "w = x" + by (rule part_antisymmetry) + qed + ultimately show "(\ x. F x) = x" by (rule ssubst) +qed + +lemma strong_fusion_character: "\x. F x \ ((\y. F y \ P y (\ x. F x)) \ (\y. P y (\ x. F x) \ (\z. F z \ O y z)))" +proof - + assume "\x. F x" + hence "(\x. (\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z)))" by (rule strong_fusion) + then obtain x where x: + "(\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z))".. + hence "(\ x. F x) = x" by (rule strong_fusion_intro) + thus ?thesis using x by (rule ssubst) +qed + +lemma F_in: "\x. F x \ (\y. F y \ P y (\ x. F x))" +proof - + assume "\x. F x" + hence "((\y. F y \ P y (\ x. F x)) \ (\y. P y (\ x. F x) \ (\z. F z \ O y z)))" by (rule strong_fusion_character) + thus "\y. F y \ P y (\ x. F x)".. +qed + +lemma parts_overlap_Fs: + "\x. F x \ (\y. P y (\ x. F x) \ (\z. F z \ O y z))" +proof - + assume "\x. F x" + hence "((\y. F y \ P y (\ x. F x)) \ (\y. P y (\ x. F x) \ (\z. F z \ O y z)))" by (rule strong_fusion_character) + thus "(\y. P y (\ x. F x) \ (\z. F z \ O y z))".. +qed + +lemma in_strong_fusion: "P z (\ x. z = x)" +proof - + have "\y. z = y" using refl.. + hence "\y. z = y \ P y (\ x. z = x)" + by (rule F_in) + hence "z = z \ P z (\ x. z = x)".. + thus "P z (\ x. z = x)" using refl.. +qed + +lemma strong_fusion_in: "P (\ x. z = x) z" +proof - + have "\y. z = y" using refl.. + hence sf: + "(\y. z = y \ P y (\ x. z = x)) \ (\y. P y (\ x. z = x) \ (\v. z = v \ O y v))" + by (rule strong_fusion_character) + with least_upper_bound have lub: "(\y. z = y \ P y (\ x. z = x)) \ (\v. (\y. z = y \ P y v) \ P (\ x. z = x) v)". + hence "(\v. (\y. z = y \ P y v) \ P (\ x. z = x) v)".. + hence "(\y. z = y \ P y z) \ P (\ x. z = x) z".. + moreover have "(\y. z = y \ P y z)" + proof + fix y + show "z = y \ P y z" + proof + assume "z = y" + thus "P y z" using part_reflexivity by (rule subst) + qed + qed + ultimately show "P (\ x. z = x) z".. +qed + +lemma strong_fusion_idempotence: "(\ x. z = x) = z" + using strong_fusion_in in_strong_fusion by (rule part_antisymmetry) + +subsection \ Strong Sums \ + +lemma pair_fusion: "(P x z \ P y z) \ (\w. P w z \ O w x \ O w y) \ (\ z. z = x \ z = y) = z" +proof + assume z: "(P x z \ P y z) \ (\w. P w z \ O w x \ O w y)" + have "(\v. v = x \ v = y \ P v z) \ (\v. P v z \ (\z. (z = x \ z = y) \ O v z))" + proof + show "\v. v = x \ v = y \ P v z" + proof + fix w + from z have "P x z \ P y z".. + show "w = x \ w = y \ P w z" + proof + assume "w = x \ w = y" + thus "P w z" + proof + assume "w = x" + moreover from `P x z \ P y z` have "P x z".. + ultimately show "P w z" by (rule ssubst) + next + assume "w = y" + moreover from `P x z \ P y z` have "P y z".. + ultimately show "P w z" by (rule ssubst) + qed + qed + qed + show "\v. P v z \ (\z. (z = x \ z = y) \ O v z)" + proof + fix v + show "P v z \ (\z. (z = x \ z = y) \ O v z)" + proof + assume "P v z" + from z have "\w. P w z \ O w x \ O w y".. + hence "P v z \ O v x \ O v y".. + hence "O v x \ O v y" using `P v z`.. + thus "\z. (z = x \ z = y) \ O v z" + proof + assume "O v x" + have "x = x \ x = y" using refl.. + hence "(x = x \ x = y) \ O v x" using `O v x`.. + thus "\z. (z = x \ z = y) \ O v z".. + next + assume "O v y" + have "y = x \ y = y" using refl.. + hence "(y = x \ y = y) \ O v y" using `O v y`.. + thus "\z. (z = x \ z = y) \ O v z".. + qed + qed + qed + qed + thus "(\ z. z = x \ z = y) = z" + by (rule strong_fusion_intro) +qed + +corollary strong_sum_fusion: "x \ y = (\ z. z = x \ z = y)" +proof - + have "(THE z. (P x z \ P y z) \ + (\w. P w z \ O w x \ O w y)) = (\ z. z = x \ z = y)" + proof (rule the_equality) + have "x = x \ x = y" using refl.. + hence exz: "\z. z = x \ z = y".. + hence allw: "(\w. w = x \ w = y \ P w (\ z. z = x \ z = y))" + by (rule F_in) + show "(P x (\ z. z = x \ z = y) \ P y (\ z. z = x \ z = y)) \ + (\w. P w (\ z. z = x \ z = y) \ O w x \ O w y)" + proof + show "(P x (\ z. z = x \ z = y) \ P y (\ z. z = x \ z = y))" + proof + from allw have "x = x \ x = y \ P x (\ z. z = x \ z = y)".. + thus "P x (\ z. z = x \ z = y)" + using `x = x \ x = y`.. + next + from allw have "y = x \ y = y \ P y (\ z. z = x \ z = y)".. + moreover have "y = x \ y = y" + using refl.. + ultimately show "P y (\ z. z = x \ z = y)".. + qed + next + show "\w. P w (\ z. z = x \ z = y) \ O w x \ O w y" + proof + fix w + show "P w (\ z. z = x \ z = y) \ O w x \ O w y" + proof + have "\v. P v (\ z. z = x \ z = y) \ (\z. (z = x \ z = y) \ O v z)" using exz by (rule parts_overlap_Fs) + hence "P w (\ z. z = x \ z = y) \ (\z. (z = x \ z = y) \ O w z)".. + moreover assume "P w (\ z. z = x \ z = y)" + ultimately have "(\z. (z = x \ z = y) \ O w z)".. + then obtain z where z: "(z = x \ z = y) \ O w z".. + thus "O w x \ O w y" by (rule or_id) + qed + qed + qed + next + fix z + assume z: "(P x z \ P y z) \ (\w. P w z \ O w x \ O w y)" + with pair_fusion have "(\ z. z = x \ z = y) = z".. + thus "z = (\ z. z = x \ z = y)".. + qed + with strong_sum_eq show "x \ y = (\ z. z = x \ z = y)" + by (rule ssubst) +qed + +corollary strong_sum_intro: + "(P x z \ P y z) \ (\w. P w z \ O w x \ O w y) \ x \ y = z" +proof + assume z: "(P x z \ P y z) \ (\w. P w z \ O w x \ O w y)" + with pair_fusion have "(\ z. z = x \ z = y) = z".. + with strong_sum_fusion show "(x \ y) = z" + by (rule ssubst) +qed + +corollary strong_sum_character: "(P x (x \ y) \ P y (x \ y)) \ (\w. P w (x \ y) \ O w x \ O w y)" +proof - + from strong_sum_closure obtain z where z: + "(P x z \ P y z) \ (\w. P w z \ O w x \ O w y)".. + with strong_sum_intro have "x \ y = z".. + thus ?thesis using z by (rule ssubst) +qed + +corollary summands_in: "(P x (x \ y) \ P y (x \ y))" + using strong_sum_character.. + +corollary first_summand_in: "P x (x \ y)" using summands_in.. + +corollary second_summand_in: "P y (x \ y)" using summands_in.. + +corollary sum_part_overlap: "(\w. P w (x \ y) \ O w x \ O w y)" using strong_sum_character.. + +lemma strong_sum_absorption: "y = (x \ y) \ P x y" +proof - + assume "y = (x \ y)" + thus "P x y" using first_summand_in by (rule ssubst) +qed + +theorem strong_supplementation: "\ P x y \ (\z. P z x \ \ O z y)" +proof - + assume "\ P x y" + have "\ (\z. P z x \ O z y)" + proof + assume z: "\z. P z x \ O z y" + have "(\v. y = v \ P v (x \ y)) \ + (\v. P v (x \ y) \ (\z. y = z \ O v z))" + proof + show "\v. y = v \ P v (x \ y)" + proof + fix v + show "y = v \ P v (x \ y)" + proof + assume "y = v" + thus "P v (x \ y)" + using second_summand_in by (rule subst) + qed + qed + show "\v. P v (x \ y) \ (\z. y = z \ O v z)" + proof + fix v + show "P v (x \ y) \ (\z. y = z \ O v z)" + proof + assume "P v (x \ y)" + moreover from sum_part_overlap have + "P v (x \ y) \ O v x \ O v y".. + ultimately have "O v x \ O v y" by (rule rev_mp) + hence "O v y" + proof + assume "O v x" + with overlap_eq have "\w. P w v \ P w x".. + then obtain w where w: "P w v \ P w x".. + from z have "P w x \ O w y".. + moreover from w have "P w x".. + ultimately have "O w y".. + with overlap_eq have "\t. P t w \ P t y".. + then obtain t where t: "P t w \ P t y".. + hence "P t w".. + moreover from w have "P w v".. + ultimately have "P t v" + by (rule part_transitivity) + moreover from t have "P t y".. + ultimately show "O v y" + by (rule overlap_intro) + next + assume "O v y" + thus "O v y". + qed + with refl have "y = y \ O v y".. + thus "\z. y = z \ O v z".. + qed + qed + qed + hence "(\ z. y = z) = (x \ y)" by (rule strong_fusion_intro) + with strong_fusion_idempotence have "y = x \ y" by (rule subst) + hence "P x y" by (rule strong_sum_absorption) + with `\ P x y` show "False".. + qed + thus "\z. P z x \ \ O z y" by simp +qed + +lemma sum_character: "\v. O v (x \ y) \ (O v x \ O v y)" +proof + fix v + show "O v (x \ y) \ (O v x \ O v y)" + proof + assume "O v (x \ y)" + with overlap_eq have "\w. P w v \ P w (x \ y)".. + then obtain w where w: "P w v \ P w (x \ y)".. + hence "P w v".. + have "P w (x \ y) \ O w x \ O w y" using sum_part_overlap.. + moreover from w have "P w (x \ y)".. + ultimately have "O w x \ O w y".. + thus "O v x \ O v y" + proof + assume "O w x" + hence "O x w" + by (rule overlap_symmetry) + with `P w v` have "O x v" + by (rule overlap_monotonicity) + hence "O v x" + by (rule overlap_symmetry) + thus "O v x \ O v y".. + next + assume "O w y" + hence "O y w" + by (rule overlap_symmetry) + with `P w v` have "O y v" + by (rule overlap_monotonicity) + hence "O v y" by (rule overlap_symmetry) + thus "O v x \ O v y".. + qed + next + assume "O v x \ O v y" + thus "O v (x \ y)" + proof + assume "O v x" + with overlap_eq have "\w. P w v \ P w x".. + then obtain w where w: "P w v \ P w x".. + hence "P w v".. + moreover from w have "P w x".. + hence "P w (x \ y)" using first_summand_in + by (rule part_transitivity) + ultimately show "O v (x \ y)" + by (rule overlap_intro) + next + assume "O v y" + with overlap_eq have "\w. P w v \ P w y".. + then obtain w where w: "P w v \ P w y".. + hence "P w v".. + moreover from w have "P w y".. + hence "P w (x \ y)" using second_summand_in + by (rule part_transitivity) + ultimately show "O v (x \ y)" + by (rule overlap_intro) + qed + qed +qed + +lemma sum_eq: "x \ y = (THE z. \v. O v z = (O v x \ O v y))" +proof - + have "(THE z. \v. O v z \ (O v x \ O v y)) = x \ y" + proof (rule the_equality) + show "\v. O v (x \ y) \ (O v x \ O v y)" using sum_character. + next + fix z + assume z: "\v. O v z \ (O v x \ O v y)" + have "(P x z \ P y z) \ (\w. P w z \ O w x \ O w y)" + proof + show "P x z \ P y z" + proof + show "P x z" + proof (rule ccontr) + assume "\ P x z" + hence "\v. P v x \ \ O v z" + by (rule strong_supplementation) + then obtain v where v: "P v x \ \ O v z".. + hence "\ O v z".. + from z have "O v z \ (O v x \ O v y)".. + moreover from v have "P v x".. + hence "O v x" by (rule part_implies_overlap) + hence "O v x \ O v y".. + ultimately have "O v z".. + with `\ O v z` show "False".. + qed + next + show "P y z" + proof (rule ccontr) + assume "\ P y z" + hence "\v. P v y \ \ O v z" + by (rule strong_supplementation) + then obtain v where v: "P v y \ \ O v z".. + hence "\ O v z".. + from z have "O v z \ (O v x \ O v y)".. + moreover from v have "P v y".. + hence "O v y" by (rule part_implies_overlap) + hence "O v x \ O v y".. + ultimately have "O v z".. + with `\ O v z` show "False".. + qed + qed + show "\w. P w z \ (O w x \ O w y)" + proof + fix w + show "P w z \ (O w x \ O w y)" + proof + from z have "O w z \ O w x \ O w y".. + moreover assume "P w z" + hence "O w z" by (rule part_implies_overlap) + ultimately show "O w x \ O w y".. + qed + qed + qed + with strong_sum_intro have "x \ y = z".. + thus "z = x \ y".. + qed + thus ?thesis.. +qed + +theorem fusion_eq: "\x. F x \ + (\ x. F x) = (THE x. \y. O y x \ (\z. F z \ O y z))" +proof - + assume "\x. F x" + hence bla: "\y. P y (\ x. F x) \ (\z. F z \ O y z)" + by (rule parts_overlap_Fs) + have "(THE x. \y. O y x \ (\z. F z \ O y z)) = (\ x. F x)" + proof (rule the_equality) + show "\y. O y (\ x. F x) \ (\z. F z \ O y z)" + proof + fix y + show "O y (\ x. F x) \ (\z. F z \ O y z)" + proof + assume "O y (\ x. F x)" + with overlap_eq have "\v. P v y \ P v (\ x. F x)".. + then obtain v where v: "P v y \ P v (\ x. F x)".. + hence "P v y".. + from bla have "P v (\ x. F x) \ (\z. F z \ O v z)".. + moreover from v have "P v (\ x. F x)".. + ultimately have "(\z. F z \ O v z)".. + then obtain z where z: "F z \ O v z".. + hence "F z".. + moreover from z have "O v z".. + hence "O z v" by (rule overlap_symmetry) + with `P v y` have "O z y" by (rule overlap_monotonicity) + hence "O y z" by (rule overlap_symmetry) + ultimately have "F z \ O y z".. + thus "(\z. F z \ O y z)".. + next + assume "\z. F z \ O y z" + then obtain z where z: "F z \ O y z".. + from`\x. F x` have "(\y. F y \ P y (\ x. F x))" + by (rule F_in) + hence "F z \ P z (\ x. F x)".. + moreover from z have "F z".. + ultimately have "P z (\ x. F x)".. + moreover from z have "O y z".. + ultimately show "O y (\ x. F x)" + by (rule overlap_monotonicity) + qed + qed + next + fix x + assume x: "\y. O y x \ (\v. F v \ O y v)" + have "(\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z))" + proof + show "\y. F y \ P y x" + proof + fix y + show "F y \ P y x" + proof + assume "F y" + show "P y x" + proof (rule ccontr) + assume "\ P y x" + hence "\z. P z y \ \ O z x" + by (rule strong_supplementation) + then obtain z where z: "P z y \ \ O z x".. + hence "\ O z x".. + from x have "O z x \ (\v. F v \ O z v)".. + moreover from z have "P z y".. + hence "O z y" by (rule part_implies_overlap) + with `F y` have "F y \ O z y".. + hence "\y. F y \ O z y".. + ultimately have "O z x".. + with `\ O z x` show "False".. + qed + qed + qed + show "\y. P y x \ (\z. F z \ O y z)" + proof + fix y + show "P y x \ (\z. F z \ O y z)" + proof + from x have "O y x \ (\z. F z \ O y z)".. + moreover assume "P y x" + hence "O y x" by (rule part_implies_overlap) + ultimately show "\z. F z \ O y z".. + qed + qed + qed + hence "(\ x. F x) = x" + by (rule strong_fusion_intro) + thus "x = (\ x. F x)".. + qed + thus "(\ x. F x) = (THE x. \y. O y x \ (\z. F z \ O y z))".. +qed + +end + +sublocale GEM1 \ GEM +proof + fix x y F + show "\ P x y \ \z. P z x \ \ O z y" + using strong_supplementation. + show "x \ y = (THE z. \v. O v z \ (O v x \ O v y))" + using sum_eq. + show "x \ y = (THE z. \v. P v z \ P v x \ P v y)" + using product_eq. + show "x \ y = (THE z. \w. P w z = (P w x \ \ O w y))" + using difference_eq. + show "\ x = (THE z. \w. P w z \ \ O w x)" + using complement_eq. + show "u = (THE x. \y. P y x)" + using universe_eq. + show "\x. F x \ (\ x. F x) = (THE x. \y. O y x \ (\z. F z \ O y z))" using fusion_eq. + show "(\ x. F x) = (\ x. \y. F y \ P x y)" + using general_product_eq. +qed + +sublocale GEM \ GEM1 +proof + fix x y F + show "\x. F x \ (\x. (\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z)))" using strong_fusion. + show "\x. F x \ (\ x. F x) = (THE x. (\y. F y \ P y x) \ (\y. P y x \ (\z. F z \ O y z)))" using strong_fusion_eq. + show "(\ x. F x) = (\ x. \y. F y \ P x y)" using general_product_eq. + show "x \ y = (THE z. (P x z \ P y z) \ (\w. P w z \ O w x \ O w y))" using strong_sum_eq. + show "x \ y = (THE z. \v. P v z \ P v x \ P v y)" + using product_eq. + show "x \ y = (THE z. \w. P w z = (P w x \ \ O w y))" + using difference_eq. + show "\ x = (THE z. \w. P w z \ \ O w x)" using complement_eq. + show "u = (THE x. \y. P y x)" using universe_eq. +qed + +(*<*) end (*>*) \ No newline at end of file diff --git a/thys/Mereology/GM.thy b/thys/Mereology/GM.thy new file mode 100644 --- /dev/null +++ b/thys/Mereology/GM.thy @@ -0,0 +1,70 @@ +section \ General Mereology \ + +(*<*) +theory GM + imports CM +begin (*>*) + +text \ The theory of \emph{general mereology} adds the axiom of fusion to ground mereology.\footnote{ +See @{cite "simons_parts:_1987"} p. 36, @{cite "varzi_parts_1996"} p. 265 and @{cite "casati_parts_1999"} p. 46.} \ + +locale GM = M + + assumes fusion: + "\ x. \ x \ \ z. \ y. O y z \ (\ x. \ x \ O y x)" +begin + +text \ Fusion entails sum closure. \ + +theorem sum_closure: "\ z. \ w. O w z \ (O w a \ O w b)" +proof - + have "a = a".. + hence "a = a \ a = b".. + hence "\ x. x = a \ x = b".. + hence "(\ z. \ y. O y z \ (\ x. (x = a \ x = b) \ O y x))" + by (rule fusion) + then obtain z where z: + "\ y. O y z \ (\ x. (x = a \ x = b) \ O y x)".. + have "\ w. O w z \ (O w a \ O w b)" + proof + fix w + from z have w: "O w z \ (\ x. (x = a \ x = b) \ O w x)".. + show "O w z \ (O w a \ O w b)" + proof + assume "O w z" + with w have "\ x. (x = a \ x = b) \ O w x".. + then obtain x where x: "(x = a \ x = b) \ O w x".. + hence "O w x".. + from x have "x = a \ x = b".. + thus "O w a \ O w b" + proof (rule disjE) + assume "x = a" + hence "O w a" using `O w x` by (rule subst) + thus "O w a \ O w b".. + next + assume "x = b" + hence "O w b" using `O w x` by (rule subst) + thus "O w a \ O w b".. + qed + next + assume "O w a \ O w b" + hence "\ x. (x = a \ x = b) \ O w x" + proof (rule disjE) + assume "O w a" + with `a = a \ a = b` have "(a = a \ a = b) \ O w a".. + thus "\ x. (x = a \ x = b) \ O w x".. + next + have "b = b".. + hence "b = a \ b = b".. + moreover assume "O w b" + ultimately have "(b = a \ b = b) \ O w b".. + thus "\ x. (x = a \ x = b) \ O w x".. + qed + with w show "O w z".. + qed + qed + thus "\ z. \ w. O w z \ (O w a \ O w b)".. +qed + +end + +(*<*) end (*>*) diff --git a/thys/Mereology/GMM.thy b/thys/Mereology/GMM.thy new file mode 100644 --- /dev/null +++ b/thys/Mereology/GMM.thy @@ -0,0 +1,33 @@ +section \ General Minimal Mereology \ + +(*<*) +theory GMM + imports GM MM +begin +(*>*) + +text \ The theory of \emph{general minimal mereology} adds general mereology to minimal mereology.\footnote{ +See @{cite "casati_parts_1999"} p. 46.} \ + +locale GMM = GM + MM +begin + +text \ It is natural to assume that just as closed minimal mereology and closed extensional mereology +are the same theory, so are general minimal mereology and general extensional mereology.\footnote{For +this mistake see @{cite "simons_parts:_1987"} p. 37 and @{cite "casati_parts_1999"} p. 46. The mistake +is corrected in @{cite "pontow_note_2004"} and @{cite "hovda_what_2009"}. For discussion of the significance +of this issue see, for example, @{cite "varzi_universalism_2009"} and @{cite "cotnoir_does_2016"}.} +But this is not the case, since the proof of strong supplementation in closed minimal mereology +required the product closure axiom. However, in general minimal mereology, the fusion axiom does not +entail the product closure axiom. So neither product closure nor strong supplementation are theorems. \ + +lemma product_closure: + "O x y \ (\ z. \ v. P v z \ P v x \ P v y)" + nitpick [expect = genuine] oops + +lemma strong_supplementation: "\ P x y \ (\ z. P z x \ \ O z y)" + nitpick [expect = genuine] oops + +end + +(*<*) end (*>*) \ No newline at end of file diff --git a/thys/Mereology/M.thy b/thys/Mereology/M.thy new file mode 100644 --- /dev/null +++ b/thys/Mereology/M.thy @@ -0,0 +1,397 @@ +section \ Ground Mereology \ + +(*<*) +theory M + imports PM +begin +(*>*) + +text \ The theory of \emph{ground mereology} adds to premereology the antisymmetry of parthood, and +defines proper parthood as nonidentical parthood.\footnote{For this axiomatization of ground mereology see, +for example, @{cite "varzi_parts_1996"} p. 261 and @{cite "casati_parts_1999"} p. 36. For discussion of the +antisymmetry of parthood see, for example, @{cite "cotnoir_antisymmetry_2010"}. For the definition of +proper parthood as nonidentical parthood, see for example, @{cite "leonard_calculus_1940"} p. 47.} +In other words, ground mereology assumes that parthood is a partial order.\ + +locale M = PM + + assumes part_antisymmetry: "P x y \ P y x \ x = y" + assumes nip_eq: "PP x y \ P x y \ x \ y" +begin + +subsection \ Proper Parthood \ + +lemma proper_implies_part: "PP x y \ P x y" +proof - + assume "PP x y" + with nip_eq have "P x y \ x \ y".. + thus "P x y".. +qed + +lemma proper_implies_distinct: "PP x y \ x \ y" +proof - + assume "PP x y" + with nip_eq have "P x y \ x \ y".. + thus "x \ y".. +qed + +lemma proper_implies_not_part: "PP x y \ \ P y x" +proof - + assume "PP x y" + hence "P x y" by (rule proper_implies_part) + show "\ P y x" + proof + from `PP x y` have "x \ y" by (rule proper_implies_distinct) + moreover assume "P y x" + with `P x y` have "x = y" by (rule part_antisymmetry) + ultimately show "False".. + qed +qed + +lemma proper_part_asymmetry: "PP x y \ \ PP y x" +proof - + assume "PP x y" + hence "P x y" by (rule proper_implies_part) + from `PP x y` have "x \ y" by (rule proper_implies_distinct) + show "\ PP y x" + proof + assume "PP y x" + hence "P y x" by (rule proper_implies_part) + with `P x y` have "x = y" by (rule part_antisymmetry) + with `x \ y` show "False".. + qed +qed + +lemma proper_implies_overlap: "PP x y \ O x y" +proof - + assume "PP x y" + hence "P x y" by (rule proper_implies_part) + thus "O x y" by (rule part_implies_overlap) +qed + +end + +text \ The rest of this section compares four alternative axiomatizations of ground mereology, and +verifies their equivalence. \ + +text \ The first alternative axiomatization defines proper parthood as nonmutual instead of nonidentical parthood.\footnote{ +See, for example, @{cite "varzi_parts_1996"} p. 261 and @{cite "casati_parts_1999"} p. 36. For the distinction +between nonmutual and nonidentical parthood, see @{cite "parsons_many_2014"} pp. 6-8.} +In the presence of antisymmetry, the two definitions of proper parthood are equivalent.\footnote{ +See @{cite "cotnoir_antisymmetry_2010"} p. 398, @{cite "donnelly_using_2011"} p. 233, +@{cite "cotnoir_non-wellfounded_2012"} p. 191, @{cite "obojska_remarks_2013"} p. 344, +@{cite "cotnoir_does_2016"} p. 128 and @{cite "cotnoir_is_2018"}.} \ + +locale M1 = PM + + assumes nmp_eq: "PP x y \ P x y \ \ P y x" + assumes part_antisymmetry: "P x y \ P y x \ x = y" + +sublocale M \ M1 +proof + fix x y + show nmp_eq: "PP x y \ P x y \ \ P y x" + proof + assume "PP x y" + with nip_eq have nip: "P x y \ x \ y".. + hence "x \ y".. + from nip have "P x y".. + moreover have "\ P y x" + proof + assume "P y x" + with `P x y` have "x = y" by (rule part_antisymmetry) + with `x \ y` show "False".. + qed + ultimately show "P x y \ \ P y x".. + next + assume nmp: "P x y \ \ P y x" + hence "\ P y x".. + from nmp have "P x y".. + moreover have "x \ y" + proof + assume "x = y" + hence "\ P y y" using `\ P y x` by (rule subst) + thus "False" using part_reflexivity.. + qed + ultimately have "P x y \ x \ y".. + with nip_eq show "PP x y".. + qed + show "P x y \ P y x \ x = y" using part_antisymmetry. +qed + +sublocale M1 \ M +proof + fix x y + show nip_eq: "PP x y \ P x y \ x \ y" + proof + assume "PP x y" + with nmp_eq have nmp: "P x y \ \ P y x".. + hence "\ P y x".. + from nmp have "P x y".. + moreover have "x \ y" + proof + assume "x = y" + hence "\ P y y" using `\ P y x` by (rule subst) + thus "False" using part_reflexivity.. + qed + ultimately show "P x y \ x \ y".. + next + assume nip: "P x y \ x \ y" + hence "x \ y".. + from nip have "P x y".. + moreover have "\ P y x" + proof + assume "P y x" + with `P x y` have "x = y" by (rule part_antisymmetry) + with `x \ y` show "False".. + qed + ultimately have "P x y \ \ P y x".. + with nmp_eq show "PP x y".. + qed + show "P x y \ P y x \ x = y" using part_antisymmetry. +qed + +text \ Conversely, assuming the two definitions of proper parthood are equivalent entails the antisymmetry +of parthood, leading to the second alternative axiomatization, which assumes both equivalencies.\footnote{ +For this point see especially @{cite "parsons_many_2014"} pp. 9-10.} \ + +locale M2 = PM + + assumes nip_eq: "PP x y \ P x y \ x \ y" + assumes nmp_eq: "PP x y \ P x y \ \ P y x" + +sublocale M \ M2 +proof + fix x y + show "PP x y \ P x y \ x \ y" using nip_eq. + show "PP x y \ P x y \ \ P y x" using nmp_eq. +qed + +sublocale M2 \ M +proof + fix x y + show "PP x y \ P x y \ x \ y" using nip_eq. + show "P x y \ P y x \ x = y" + proof - + assume "P x y" + assume "P y x" + show "x = y" + proof (rule ccontr) + assume "x \ y" + with `P x y` have "P x y \ x \ y".. + with nip_eq have "PP x y".. + with nmp_eq have "P x y \ \ P y x".. + hence "\ P y x".. + thus "False" using `P y x`.. + qed + qed +qed + +text \ In the context of the other axioms, antisymmetry is equivalent to the extensionality of parthood, +which gives the third alternative axiomatization.\footnote{For this point see @{cite "cotnoir_antisymmetry_2010"} p. 401 +and @{cite "cotnoir_non-wellfounded_2012"} p. 191-2.} \ + +locale M3 = PM + + assumes nip_eq: "PP x y \ P x y \ x \ y" + assumes part_extensionality: "x = y \ (\ z. P z x \ P z y)" + +sublocale M \ M3 +proof + fix x y + show "PP x y \ P x y \ x \ y" using nip_eq. + show part_extensionality: "x = y \ (\ z. P z x \ P z y)" + proof + assume "x = y" + moreover have "\ z. P z x \ P z x" by simp + ultimately show "\ z. P z x \ P z y" by (rule subst) + next + assume z: "\ z. P z x \ P z y" + show "x = y" + proof (rule part_antisymmetry) + from z have "P y x \ P y y".. + moreover have "P y y" by (rule part_reflexivity) + ultimately show "P y x".. + next + from z have "P x x \ P x y".. + moreover have "P x x" by (rule part_reflexivity) + ultimately show "P x y".. + qed + qed +qed + +sublocale M3 \ M +proof + fix x y + show "PP x y \ P x y \ x \ y" using nip_eq. + show part_antisymmetry: "P x y \ P y x \ x = y" + proof - + assume "P x y" + assume "P y x" + have "\ z. P z x \ P z y" + proof + fix z + show "P z x \ P z y" + proof + assume "P z x" + thus "P z y" using `P x y` by (rule part_transitivity) + next + assume "P z y" + thus "P z x" using `P y x` by (rule part_transitivity) + qed + qed + with part_extensionality show "x = y".. + qed +qed + +text \The fourth axiomatization adopts proper parthood as primitive.\footnote{See, for example, +@{cite "simons_parts:_1987"}, p. 26 and @{cite "casati_parts_1999"} p. 37.} Improper parthood is +defined as proper parthood or identity.\ + +locale M4 = + assumes part_eq: "P x y \ PP x y \ x = y" + assumes overlap_eq: "O x y \ (\ z. P z x \ P z y)" + assumes proper_part_asymmetry: "PP x y \ \ PP y x" + assumes proper_part_transitivity: "PP x y \ PP y z \ PP x z" +begin + +lemma proper_part_irreflexivity: "\ PP x x" +proof + assume "PP x x" + hence "\ PP x x" by (rule proper_part_asymmetry) + thus "False" using `PP x x`.. +qed + +end + +sublocale M \ M4 +proof + fix x y z + show part_eq: "P x y \ (PP x y \ x = y)" + proof + assume "P x y" + show "PP x y \ x = y" + proof cases + assume "x = y" + thus "PP x y \ x = y".. + next + assume "x \ y" + with `P x y` have "P x y \ x \ y".. + with nip_eq have "PP x y".. + thus "PP x y \ x = y".. + qed + next + assume "PP x y \ x = y" + thus "P x y" + proof + assume "PP x y" + thus "P x y" by (rule proper_implies_part) + next + assume "x = y" + thus "P x y" by (rule identity_implies_part) + qed + qed + show "O x y \ (\ z. P z x \ P z y)" using overlap_eq. + show "PP x y \ \ PP y x" using proper_part_asymmetry. + show proper_part_transitivity: "PP x y \ PP y z \ PP x z" + proof - + assume "PP x y" + assume "PP y z" + have "P x z \ x \ z" + proof + from `PP x y` have "P x y" by (rule proper_implies_part) + moreover from `PP y z` have "P y z" by (rule proper_implies_part) + ultimately show "P x z" by (rule part_transitivity) + next + show "x \ z" + proof + assume "x = z" + hence "PP y x" using `PP y z` by (rule ssubst) + hence "\ PP x y" by (rule proper_part_asymmetry) + thus "False" using `PP x y`.. + qed + qed + with nip_eq show "PP x z".. + qed +qed + +sublocale M4 \ M +proof + fix x y z + show proper_part_eq: "PP x y \ P x y \ x \ y" + proof + assume "PP x y" + hence "PP x y \ x = y".. + with part_eq have "P x y".. + moreover have "x \ y" + proof + assume "x = y" + hence "PP y y" using `PP x y` by (rule subst) + with proper_part_irreflexivity show "False".. + qed + ultimately show "P x y \ x \ y".. + next + assume rhs: "P x y \ x \ y" + hence "x \ y".. + from rhs have "P x y".. + with part_eq have "PP x y \ x = y".. + thus "PP x y" + proof + assume "PP x y" + thus "PP x y". + next + assume "x = y" + with `x \ y` show "PP x y".. + qed + qed + show "P x x" + proof - + have "x = x" by (rule refl) + hence "PP x x \ x = x".. + with part_eq show "P x x".. + qed + show "O x y \ (\ z. P z x \ P z y)" using overlap_eq. + show "P x y \ P y x \ x = y" + proof - + assume "P x y" + assume "P y x" + from part_eq have "PP x y \ x = y" using `P x y`.. + thus "x = y" + proof + assume "PP x y" + hence "\ PP y x" by (rule proper_part_asymmetry) + from part_eq have "PP y x \ y = x" using `P y x`.. + thus "x = y" + proof + assume "PP y x" + with `\ PP y x` show "x = y".. + next + assume "y = x" + thus "x = y".. + qed + qed + qed + show "P x y \ P y z \ P x z" + proof - + assume "P x y" + assume "P y z" + with part_eq have "PP y z \ y = z".. + hence "PP x z \ x = z" + proof + assume "PP y z" + from part_eq have "PP x y \ x = y" using `P x y`.. + hence "PP x z" + proof + assume "PP x y" + thus "PP x z" using `PP y z` by (rule proper_part_transitivity) + next + assume "x = y" + thus "PP x z" using `PP y z` by (rule ssubst) + qed + thus "PP x z \ x = z".. + next + assume "y = z" + moreover from part_eq have "PP x y \ x = y" using `P x y`.. + ultimately show "PP x z \ x = z" by (rule subst) + qed + with part_eq show "P x z".. + qed +qed + +(*<*) end (*>*) \ No newline at end of file diff --git a/thys/Mereology/MM.thy b/thys/Mereology/MM.thy new file mode 100644 --- /dev/null +++ b/thys/Mereology/MM.thy @@ -0,0 +1,211 @@ +section \ Minimal Mereology \ + +(*<*) +theory MM + imports M +begin +(*>*) + +text \ Minimal mereology adds to ground mereology the axiom of weak supplementation.\footnote{ +See @{cite "varzi_parts_1996"} and @{cite "casati_parts_1999"} p. 39. The name \emph{minimal mereology} +reflects the, controversial, idea that weak supplementation is analytic. See, for example, @{cite "simons_parts:_1987"} +p. 116, @{cite "varzi_extensionality_2008"} p. 110-1, and @{cite "cotnoir_is_2018"}. For general +discussion of weak supplementation see, for example @{cite "smith_mereology_2009"} pp. 507 and +@{cite "donnelly_using_2011"}.} \ + +locale MM = M + + assumes weak_supplementation: "PP y x \ (\ z. P z x \ \ O z y)" + +text \ The rest of this section considers three alternative axiomatizations of minimal mereology. The +first alternative axiomatization replaces improper with proper parthood in the consequent of weak +supplementation.\footnote{See @{cite "simons_parts:_1987"} p. 28.} \ + +locale MM1 = M + + assumes proper_weak_supplementation: + "PP y x \ (\ z. PP z x \ \ O z y)" + +sublocale MM \ MM1 +proof + fix x y + show "PP y x \ (\ z. PP z x \ \ O z y)" + proof - + assume "PP y x" + hence "\ z. P z x \ \ O z y" by (rule weak_supplementation) + then obtain z where z: "P z x \ \ O z y".. + hence "\ O z y".. + from z have "P z x".. + hence "P z x \ z \ x" + proof + show "z \ x" + proof + assume "z = x" + hence "PP y z" + using `PP y x` by (rule ssubst) + hence "O y z" by (rule proper_implies_overlap) + hence "O z y" by (rule overlap_symmetry) + with `\ O z y` show "False".. + qed + qed + with nip_eq have "PP z x".. + hence "PP z x \ \ O z y" + using `\ O z y`.. + thus "\ z. PP z x \ \ O z y".. + qed +qed + +sublocale MM1 \ MM +proof + fix x y + show weak_supplementation: "PP y x \ (\ z. P z x \ \ O z y)" + proof - + assume "PP y x" + hence "\ z. PP z x \ \ O z y" by (rule proper_weak_supplementation) + then obtain z where z: "PP z x \ \ O z y".. + hence "PP z x".. + hence "P z x" by (rule proper_implies_part) + moreover from z have "\ O z y".. + ultimately have "P z x \ \ O z y".. + thus "\ z. P z x \ \ O z y".. + qed +qed + +text \ The following two corollaries are sometimes found in the literature.\footnote{See @{cite "simons_parts:_1987"} p. 27. For the names \emph{weak company} +and \emph{strong company} see @{cite "cotnoir_non-wellfounded_2012"} p. 192-3 and @{cite "varzi_mereology_2016"}.} \ + +context MM +begin + +corollary weak_company: "PP y x \ (\ z. PP z x \ z \ y)" +proof - + assume "PP y x" + hence "\ z. PP z x \ \ O z y" by (rule proper_weak_supplementation) + then obtain z where z: "PP z x \ \ O z y".. + hence "PP z x".. + from z have "\ O z y".. + hence "z \ y" by (rule disjoint_implies_distinct) + with `PP z x` have "PP z x \ z \ y".. + thus "\ z. PP z x \ z \ y".. +qed + +corollary strong_company: "PP y x \ (\ z. PP z x \ \ P z y)" +proof - + assume "PP y x" + hence "\z. PP z x \ \ O z y" by (rule proper_weak_supplementation) + then obtain z where z: "PP z x \ \ O z y".. + hence "PP z x".. + from z have "\ O z y".. + hence "\ P z y" by (rule disjoint_implies_not_part) + with `PP z x` have "PP z x \ \ P z y".. + thus "\ z. PP z x \ \ P z y".. +qed + +end + +text \ If weak supplementation is formulated in terms of nonidentical parthood, then the antisymmetry +of parthood is redundant, and we have the second alternative axiomatization of minimal mereology.\footnote{ +See @{cite "cotnoir_antisymmetry_2010"} p. 399, @{cite "donnelly_using_2011"} p. 232, +@{cite "cotnoir_non-wellfounded_2012"} p. 193 and @{cite "obojska_remarks_2013"} pp. 235-6.} \ + +locale MM2 = PM + + assumes nip_eq: "PP x y \ P x y \ x \ y" + assumes weak_supplementation: "PP y x \ (\ z. P z x \ \ O z y)" + +sublocale MM2 \ MM +proof + fix x y + show "PP x y \ P x y \ x \ y" using nip_eq. + show part_antisymmetry: "P x y \ P y x \ x = y" + proof - + assume "P x y" + assume "P y x" + show "x = y" + proof (rule ccontr) + assume "x \ y" + with `P x y` have "P x y \ x \ y".. + with nip_eq have "PP x y".. + hence "\ z. P z y \ \ O z x" by (rule weak_supplementation) + then obtain z where z: "P z y \ \ O z x".. + hence "\ O z x".. + hence "\ P z x" by (rule disjoint_implies_not_part) + from z have "P z y".. + hence "P z x" using `P y x` by (rule part_transitivity) + with `\ P z x` show "False".. + qed + qed + show "PP y x \ \z. P z x \ \ O z y" using weak_supplementation. +qed + +sublocale MM \ MM2 +proof + fix x y + show "PP x y \ (P x y \ x \ y)" using nip_eq. + show "PP y x \ \z. P z x \ \ O z y" using weak_supplementation. +qed + +text \ Likewise, if proper parthood is adopted as primitive, then the asymmetry of proper parthood +is redundant in the context of weak supplementation, leading to the third alternative +axiomatization.\footnote{See @{cite "donnelly_using_2011"} p. 232 and @{cite "cotnoir_is_2018"}.} \ + +locale MM3 = + assumes part_eq: "P x y \ PP x y \ x = y" + assumes overlap_eq: "O x y \ (\ z. P z x \ P z y)" + assumes proper_part_transitivity: "PP x y \ PP y z \ PP x z" + assumes weak_supplementation: "PP y x \ (\ z. P z x \ \ O z y)" +begin + +lemma part_reflexivity: "P x x" +proof - + have "x = x".. + hence "PP x x \ x = x".. + with part_eq show "P x x".. +qed + +lemma proper_part_irreflexivity: "\ PP x x" +proof + assume "PP x x" + hence "\ z. P z x \ \ O z x" by (rule weak_supplementation) + then obtain z where z: "P z x \ \ O z x".. + hence "\ O z x".. + from z have "P z x".. + with part_reflexivity have "P z z \ P z x".. + hence "\ v. P v z \ P v x".. + with overlap_eq have "O z x".. + with `\ O z x` show "False".. +qed + +end + +sublocale MM3 \ M4 +proof + fix x y z + show "P x y \ PP x y \ x = y" using part_eq. + show "O x y \ (\ z. P z x \ P z y)" using overlap_eq. + show proper_part_irreflexivity: "PP x y \ \ PP y x" + proof - + assume "PP x y" + show "\ PP y x" + proof + assume "PP y x" + hence "PP y y" using `PP x y` by (rule proper_part_transitivity) + with proper_part_irreflexivity show "False".. + qed + qed + show "PP x y \ PP y z \ PP x z" using proper_part_transitivity. +qed + +sublocale MM3 \ MM +proof + fix x y + show "PP y x \ (\ z. P z x \ \ O z y)" using weak_supplementation. +qed + +sublocale MM \ MM3 +proof + fix x y z + show "P x y \ (PP x y \ x = y)" using part_eq. + show "O x y \ (\z. P z x \ P z y)" using overlap_eq. + show "PP x y \ PP y z \ PP x z" using proper_part_transitivity. + show "PP y x \ \z. P z x \ \ O z y" using weak_supplementation. +qed + +(*<*) end (*>*) \ No newline at end of file diff --git a/thys/Mereology/PM.thy b/thys/Mereology/PM.thy new file mode 100644 --- /dev/null +++ b/thys/Mereology/PM.thy @@ -0,0 +1,177 @@ +section \ Introduction \ + +(*<*) +theory PM + imports Main +begin +(*>*) + +text \ In this paper, we use Isabelle/HOL to verify some elementary theorems and alternative axiomatizations +of classical extensional mereology, as well as some of its weaker subtheories.\footnote{For similar +developments see @{cite "sen_computational_2017"} and @{cite "bittner_formal_2018"}.} We mostly follow the +presentations from @{cite "simons_parts:_1987"}, @{cite "varzi_parts_1996"} and @{cite "casati_parts_1999"}, +with some important corrections from @{cite "pontow_note_2004"} and @{cite "hovda_what_2009"} as well as +some detailed proofs adapted from @{cite "pietruszczak_metamereology_2018"}.\footnote{For help with +this project I am grateful to Zach Barnett, Sam Baron, Bob Beddor, Olivier Danvy, Mark Goh, +Jeremiah Joven Joaquin, Wang-Yen Lee, Kee Wei Loo, Bruno Woltzenlogel Paleo, Michael Pelczar, Hsueh Qu, +Abelard Podgorski, Divyanshu Sharma, Manikaran Singh, Neil Sinhababu, Weng-Hong Tang and Zhang Jiang.} \ + +text \ We will use the following notation throughout.\footnote{See @{cite "simons_parts:_1987"} pp. 99-100 +for a helpful comparison of alternative notations.} \ + +typedecl i +consts part :: "i \ i \ bool" ("P") +consts overlap :: "i \ i \ bool" ("O") +consts proper_part :: "i \ i \ bool" ("PP") +consts sum :: "i \ i \ i" (infix "\" 52) +consts product :: "i \ i \ i" (infix "\" 53) +consts difference :: "i \ i \ i" (infix "\" 51) +consts complement:: "i \ i" ("\") +consts universe :: "i" ("u") +consts general_sum :: "(i \ bool) \ i" (binder "\" 9) +consts general_product :: "(i \ bool) \ i" (binder "\" [8] 9) + +section \ Premereology \ + +text \ The theory of \emph{premereology} assumes parthood is reflexive and transitive.\footnote{ +For discussion of reflexivity see @{cite "kearns_can_2011"}. For transitivity see @{cite "varzi_note_2006"}.} +In other words, parthood is assumed to be a partial ordering relation.\footnote{Hence the name \emph{premereology}, +from @{cite "parsons_many_2014"} p. 6.} Overlap is defined as common parthood.\footnote{See +@{cite "simons_parts:_1987"} p. 28, @{cite "varzi_parts_1996"} p. 261 and @{cite "casati_parts_1999"} p. 36. } \ + +locale PM = + assumes part_reflexivity: "P x x" + assumes part_transitivity : "P x y \ P y z \ P x z" + assumes overlap_eq: "O x y \ (\ z. P z x \ P z y)" +begin + +subsection \ Parthood \ + +lemma identity_implies_part : "x = y \ P x y" +proof - + assume "x = y" + moreover have "P x x" by (rule part_reflexivity) + ultimately show "P x y" by (rule subst) +qed + +subsection \ Overlap \ + +lemma overlap_intro: "P z x \ P z y \ O x y" +proof- + assume "P z x" + moreover assume "P z y" + ultimately have "P z x \ P z y".. + hence "\ z. P z x \ P z y".. + with overlap_eq show "O x y".. +qed + +lemma part_implies_overlap: "P x y \ O x y" +proof - + assume "P x y" + with part_reflexivity have "P x x \ P x y".. + hence "\ z. P z x \ P z y".. + with overlap_eq show "O x y".. +qed + +lemma overlap_reflexivity: "O x x" +proof - + have "P x x \ P x x" using part_reflexivity part_reflexivity.. + hence "\ z. P z x \ P z x".. + with overlap_eq show "O x x".. +qed + +lemma overlap_symmetry: "O x y \ O y x" +proof- + assume "O x y" + with overlap_eq have "\ z. P z x \ P z y".. + hence "\ z. P z y \ P z x" by auto + with overlap_eq show "O y x".. +qed + +lemma overlap_monotonicity: "P x y \ O z x \ O z y" +proof - + assume "P x y" + assume "O z x" + with overlap_eq have "\ v. P v z \ P v x".. + then obtain v where v: "P v z \ P v x".. + hence "P v z".. + moreover from v have "P v x".. + hence "P v y" using `P x y` by (rule part_transitivity) + ultimately have "P v z \ P v y".. + hence "\ v. P v z \ P v y".. + with overlap_eq show "O z y".. +qed + +text \ The next lemma is from @{cite "hovda_what_2009"} p. 66. \ + +lemma overlap_lemma: "\x. (P x y \ O z x) \ O y z" +proof - + fix x + have "P x y \ O z x \ O y z" + proof + assume antecedent: "P x y \ O z x" + hence "O z x".. + with overlap_eq have "\v. P v z \ P v x".. + then obtain v where v: "P v z \ P v x".. + hence "P v x".. + moreover from antecedent have "P x y".. + ultimately have "P v y" by (rule part_transitivity) + moreover from v have "P v z".. + ultimately have "P v y \ P v z".. + hence "\v. P v y \ P v z".. + with overlap_eq show "O y z".. + qed + thus "\x. (P x y \ O z x) \ O y z".. +qed + +subsection \ Disjointness \ + +lemma disjoint_implies_distinct: "\ O x y \ x \ y" +proof - + assume "\ O x y" + show "x \ y" + proof + assume "x = y" + hence "\ O y y" using `\ O x y` by (rule subst) + thus "False" using overlap_reflexivity.. + qed +qed + +lemma disjoint_implies_not_part: "\ O x y \ \ P x y" +proof - + assume "\ O x y" + show "\ P x y" + proof + assume "P x y" + hence "O x y" by (rule part_implies_overlap) + with `\ O x y` show "False".. + qed +qed + +lemma disjoint_symmetry: "\ O x y \ \ O y x" +proof - + assume "\ O x y" + show "\ O y x" + proof + assume "O y x" + hence "O x y" by (rule overlap_symmetry) + with `\ O x y` show "False".. + qed +qed + +lemma disjoint_demonotonicity: "P x y \ \ O z y \ \ O z x" +proof - + assume "P x y" + assume "\ O z y" + show "\ O z x" + proof + assume "O z x" + with `P x y` have "O z y" + by (rule overlap_monotonicity) + with `\ O z y` show "False".. + qed +qed + +end + +(*<*)end(*>*) \ No newline at end of file diff --git a/thys/Mereology/ROOT b/thys/Mereology/ROOT new file mode 100644 --- /dev/null +++ b/thys/Mereology/ROOT @@ -0,0 +1,17 @@ +chapter AFP + +session Mereology (AFP) = HOL + + options [timeout = 300] + theories + PM + M + MM + EM + CM + CEM + GM + GMM + GEM + document_files + "root.bib" + "root.tex" diff --git a/thys/Mereology/document/root.bib b/thys/Mereology/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Mereology/document/root.bib @@ -0,0 +1,406 @@ + +@article{bittner_formal_2018, + title = {Formal Ontology of Space, Time, and Physical Entities in Classical Mechanics}, + author = {Bittner, Thomas}, + year = {2018}, + month = jan, + volume = {13}, + pages = {135--179}, + issn = {1570-5838}, + doi = {10.3233/AO-180195}, + abstract = {Classical (i.e., non-quantum) mechanics is the foundation of many models of dynamical physical phenomena. As such those models inherit the ontological commitments inherent in the underlying physics. Therefore, building an ontology of dynamic phenomen}, + journal = {Applied Ontology}, + language = {en}, + number = {2} +} + +@article{calosi_elegant_2020, + title = {An Elegant Universe}, + author = {Calosi, Claudio}, + year = {2020}, + month = nov, + volume = {197}, + pages = {4767--4782}, + issn = {1573-0964}, + doi = {10.1007/s11229-015-0952-5}, + abstract = {David Lewis famously endorsed Unrestricted Composition. His defense of such a controversial principle builds on the alleged innocence of mereology. This innocence defense has come under different attacks in the last decades. In this paper I pursue another line of defense, that stems from some early remarks by van Inwagen. I argue that Unrestricted Composition leads to a better metaphysics. In particular I provide new arguments for the following claims: Unrestricted Composition entails extensionality of composition, functionality of location and four-dimensionalism in the metaphysics of persistence. Its endorsement yields an impressively coherent and powerful metaphysical picture. This picture shows a universe that might not be innocent but it is certainly elegant.}, + file = {/Users/benblumson/Zotero/storage/A2FFL48W/Calosi - 2020 - An elegant universe.pdf}, + journal = {Synthese}, + language = {en}, + number = {11} +} + +@book{casati_parts_1999, + title = {Parts and {{Places}}. {{The Structures}} of {{Spatial Representation}}}, + author = {Casati, Roberto and Varzi, Achille C.}, + year = {1999}, + publisher = {{MIT Press}}, + address = {{Cambridge, Mass.}}, + abstract = {Thinking about space is thinking about spatial things. The table is on the carpet; hence the carpet is under the table. The vase is in the box; hence the box is not in the vase. But what does it mean for an object to be somewhere? How are objects tied to the space they occupy? This book is concerned with these and other fundamental issues in the philosophy of spatial representation. Our starting point is an analysis of the interplay between mereology (the study of part/whole relations), topology (the study of spatial continuity and compactness), and the theory of spatial location proper. This leads to a unified framework for spatial representation understood quite broadly as a theory of the representation of spatial entities. The framework is then tested against some classical metaphysical questions such as: Are parts essential to their wholes? Is spatial colocation a sufficient criterion of identity? What (if anything) distinguishes material objects from events and other spatial entities? The concluding chapters deal with applications to topics as diverse as the logical analysis of movement and the semantics of maps.} +} + +@article{cotnoir_antisymmetry_2010, + title = {Anti-{{Symmetry}} and {{Non}}-{{Extensional Mereology}}}, + author = {Cotnoir, Aaron J.}, + year = {2010}, + month = apr, + volume = {60}, + pages = {396--405}, + issn = {0031-8094}, + doi = {10.1111/j.1467-9213.2009.649.x}, + file = {/Users/benblumson/Zotero/storage/6JMFXEZP/Cotnoir - 2010 - Anti‐Symmetry and Non‐Extensional Mereology.pdf}, + journal = {The Philosophical Quarterly}, + number = {239} +} + +@article{cotnoir_does_2016, + title = {Does {{Universalism Entail Extensionalism}}?}, + author = {Cotnoir, A. J.}, + year = {2016}, + month = mar, + volume = {50}, + pages = {121--132}, + issn = {1468-0068}, + doi = {10.1111/nous.12063}, + abstract = {Does a commitment to mereological universalism automatically bring along a commitment to the controversial doctrine of mereological extensionalism\textemdash the view that objects with the same proper parts are identical? A recent argument suggests the answer is `yes'. This paper attempts a systematic response to the argument, considering nearly every available line of reply. It argues that only one approach\textemdash the mutual parts view\textemdash can yield a viable mereology where universalism does not entail extensionalism.}, + file = {/Users/benblumson/Zotero/storage/2VD42JSI/Cotnoir - 2016 - Does Universalism Entail Extensionalism.pdf}, + journal = {No\^us}, + language = {en}, + number = {1} +} + +@article{cotnoir_is_2018, + title = {Is {{Weak Supplementation}} Analytic?}, + author = {Cotnoir, Aaron J.}, + year = {2018}, + month = dec, + issn = {1573-0964}, + doi = {10.1007/s11229-018-02066-9}, + abstract = {Mereological principles are often controversial; perhaps the most stark contrast is between those who claim that Weak Supplementation is analytic\textemdash constitutive of our notion of proper parthood\textemdash and those who argue that the principle is simply false, and subject to many counterexamples. The aim of this paper is to diagnose the source of this dispute. I'll suggest that the dispute has arisen by participants failing to be sensitive to two different conceptions of proper parthood: the outstripping conception and the non-identity conception. I'll argue that the outstripping conception (together with a specific set of definitions for other mereological notions), can deliver the analyticity of Weak Supplementation on at least one sense of `analyticity'. I'll also suggest that the non-identity conception cannot do so independently of considerations to do with mereological extensionality.}, + file = {/Users/benblumson/Zotero/storage/KILE578L/Cotnoir - 2018 - Is Weak Supplementation analytic.pdf}, + journal = {Synthese}, + language = {en} +} + +@article{cotnoir_non-wellfounded_2012, + title = {Non-{{Wellfounded Mereology}}}, + author = {Cotnoir, Aaron J. and Bacon, Andrew}, + year = {2012}, + month = jun, + volume = {5}, + pages = {187--204}, + abstract = {{$<$}div class="title"{$>$}NON-WELLFOUNDED MEREOLOGY{$<$}/div{$>$} - Volume 5 Issue 2 - AARON J. COTNOIR, ANDREW BACON}, + file = {/Users/benblumson/Zotero/storage/NJUP2FP7/Cotnoir and Bacon - 2012 - NON-WELLFOUNDED MEREOLOGY.pdf}, + journal = {The Review of Symbolic Logic}, + number = {2} +} + +@article{cotnoir_strange_2013, + title = {Strange {{Parts}}: {{The Metaphysics}} of {{Non}}-Classical {{Mereologies}}}, + shorttitle = {Strange {{Parts}}}, + author = {Cotnoir, A. J.}, + year = {2013}, + month = sep, + volume = {8}, + pages = {834--845}, + issn = {1747-9991}, + doi = {10.1111/phc3.12061}, + abstract = {The dominant theory of parts and wholes \textendash{} classical extensional mereology \textendash{} has faced a number of challenges in the recent literature. This article gives a sampling of some of the alleged counterexamples to some of the more controversial principles involving the connections between parthood and identity. Along the way, some of the main revisionary approaches are reviewed. First, counterexamples to extensionality are reviewed. The `supplementation' axioms that generate extensionality are examined more carefully, and a suggested revision is considered. Second, the paper considers an alternative approach that focuses the blame on antisymmetry but allows us to keep natural supplementation axioms. Third, we look at counterexamples to the idempotency of composition and the associated `parts just once' principle. We explore options for developing weaker mereologies that avoid such commitments.}, + file = {/Users/benblumson/Zotero/storage/Q9S8XSQ4/Cotnoir - 2013 - Strange Parts The Metaphysics of Non-classical Me.pdf}, + journal = {Philosophy Compass}, + language = {en}, + number = {9} +} + +@article{donnelly_using_2011, + title = {Using {{Mereological Principles}} to {{Support Metaphysics}}}, + author = {Donnelly, Maureen}, + year = {2011}, + volume = {61}, + pages = {225--246}, + issn = {1467-9213}, + doi = {10.1111/j.1467-9213.2010.683.x}, + abstract = {Mereological principles are sometimes used to support general claims about the structure and arrangement of objects in the world. I focus initially on one such mereological principle, the weak supplementation principle (WSP). It is not obvious that (WSP) is prescribed by ordinary thinking about parthood. Further, (WSP) is not needed for a fairly strong formal characterization of the part\textendash whole relation. For these reasons, some arguments relying on (WSP) might be countered by simply denying (WSP). I argue more generally that there is no reason to assume that one core mereology functions as a common basis for all plausible metaphysical theories.}, + copyright = {\textcopyright{} 2010 The Author The Philosophical Quarterly\textcopyright{} 2010 The Editors of The Philosophical Quarterly}, + file = {/Users/benblumson/Zotero/storage/UAES4ZEX/Donnelly - 2011 - Using Mereological Principles to Support Metaphysi.pdf}, + journal = {The Philosophical Quarterly}, + language = {en}, + number = {243} +} + +@article{eberle_complete_1967, + title = {Some Complete Calculi of Individuals.}, + author = {Eberle, Rolf A.}, + year = {1967}, + volume = {8}, + pages = {267--278}, + issn = {0029-4527, 1939-0726}, + doi = {10.1305/ndjfl/1094068838}, + abstract = {Project Euclid - mathematics and statistics online}, + file = {/Users/benblumson/Zotero/storage/9GJCET3C/Eberle - 1967 - Some complete calculi of individuals..pdf}, + journal = {Notre Dame Journal of Formal Logic}, + language = {en}, + mrnumber = {MR0234816}, + number = {4}, + zmnumber = {0183.00803} +} + +@article{forrest_nonclassical_2002, + title = {Nonclassical {{Mereology}} and {{Its Application}} to {{Sets}}}, + author = {Forrest, Peter}, + year = {2002}, + month = apr, + volume = {43}, + pages = {79--94}, + publisher = {{University of Notre Dame}}, + issn = {0029-4527, 1939-0726}, + doi = {10.1305/ndjfl/1071509430}, + abstract = {Part One of this paper is a case against classical mereology and for Heyting mereology. This case proceeds by first undermining the appeal of classical mereology and then showing how it fails to cohere with our intuitions about a measure of quantity. Part Two shows how Heyting mereology provides an account of sets and classes without resort to any nonmereological primitive.}, + file = {/Users/benblumson/Zotero/storage/XWYNDZJI/Forrest - 2002 - Nonclassical Mereology and Its Application to Sets.pdf}, + journal = {Notre Dame Journal of Formal Logic}, + keywords = {class,fusion,measure,mereology,set,sum}, + language = {EN}, + mrnumber = {MR2033318}, + number = {2}, + zmnumber = {1049.03003} +} + +@article{hazarika_using_nodate, + title = {Using {{SPASS}} for Proving Theorems within {{Mereotopology}}}, + author = {Hazarika, Shyamanta M. and Cohn, Anthony G.}, + file = {/Users/benblumson/Zotero/storage/KFNLZZQB/Hazarika and Cohn - Using SPASS for proving theorems within Mereotopol.pdf} +} + +@article{hovda_what_2009, + title = {What Is {{Classical Mereology}}?}, + author = {Hovda, Paul}, + year = {2009}, + month = feb, + volume = {38}, + pages = {55--82}, + issn = {0022-3611, 1573-0433}, + doi = {10.1007/s10992-008-9092-4}, + abstract = {Classical mereology is a formal theory of the part-whole relation, essentially involving a notion of mereological fusion, or sum. There are various different definitions of fusion in the literature, a}, + file = {/Users/benblumson/Zotero/storage/AWBEC5S6/Hovda - 2009 - What is Classical Mereology.pdf}, + journal = {Journal of Philosophical Logic}, + language = {en}, + number = {1} +} + +@article{kearns_can_2011, + title = {Can a {{Thing}} Be {{Part}} of {{Itself}}?}, + author = {Kearns, Stephen}, + year = {2011}, + volume = {48}, + pages = {87--93}, + issn = {0003-0481}, + file = {/Users/benblumson/Zotero/storage/HKYDR2EN/Kearns - 2011 - CAN A THING BE PART OF ITSELF.pdf}, + journal = {American Philosophical Quarterly}, + number = {1} +} + +@article{leonard_calculus_1940, + title = {The {{Calculus}} of {{Individuals}} and {{Its Uses}}}, + author = {Leonard, Henry S. and Goodman, Nelson}, + year = {1940}, + volume = {5}, + pages = {45--55}, + issn = {0022-4812}, + doi = {10.2307/2266169}, + file = {/Users/benblumson/Zotero/storage/MGI3VWSF/Leonard and Goodman - 1940 - The Calculus of Individuals and Its Uses.pdf}, + journal = {The Journal of Symbolic Logic}, + number = {2} +} + +@inproceedings{masolo_atomicity_1999, + title = {Atomicity vs. {{Infinite Divisibility}} of {{Space}}}, + booktitle = {Spatial {{Information Theory}}. {{Cognitive}} and {{Computational Foundations}} of {{Geographic Information Science}}}, + author = {Masolo, Claudio and Vieu, Laure}, + year = {1999}, + month = aug, + pages = {235--250}, + publisher = {{Springer}}, + address = {{Berlin}}, + doi = {10.1007/3-540-48384-5_16}, + abstract = {In qualitative spatial reasoning, the last ten years have brought a lot of results on theories of spatial properties and relations taking regions of space as primitive entities. In particular, the axiomatization of mereotopologies has been extensively studied. However, properties of space such as divisibility, density and atomicity haven't attracted much attention in this context. Nevertheless, atomicity is especially important if one seeks to build a bridge between spatial reasoning and spatial databases approaches in areas like vision or GIS. In this paper we will investigate the possibility of characterizing such properties in spaces modeled by mereologies and mereotopologies. In addition, properties of atoms like extension and self-connectedness will be considered.}, + file = {/Users/benblumson/Zotero/storage/N252IVA9/Masolo and Vieu - 1999 - Atomicity vs. Infinite Divisibility of Space.pdf}, + isbn = {978-3-540-66365-2 978-3-540-48384-7}, + series = {Lecture {{Notes}} in {{Computer Science}}} +} + +@article{obojska_remarks_2013, + title = {Some {{Remarks}} on {{Supplementation Principles}} in the {{Absence}} of {{Antisymmetry}}}, + author = {Obojska, Lidia}, + year = {2013}, + month = jun, + volume = {6}, + pages = {343--347}, + issn = {1755-0203, 1755-0211}, + doi = {10.1017/S1755020312000330}, + abstract = {In response to the paper by Cotnoir and Bacon published in RSL 2/2012, we would like to add some remarks regarding supplementation principles. It is known that in a classical mereology, the Strong Supplementation Principle (SSP) together with antisymmetry enforces the Weak Supplementation Principle (WSP). Instead, in the nonwellfounded mereology, the failure of extensionality causes the failure of antisymmetry (Cotnoir, 2010), hence the investigated model is also nonantisymmetric. Cotnoir supposes that the failure of antisymmetry implies the failure of (WSP) when (PP1) is applied, however gives no explicit argument, which we would like to supply in this paper. Additionally, when (PP2) is applied, (SSP) implies (WSP), hence the failure of antisymmetry does not necessarily imply the failure of (WSP).}, + file = {/Users/benblumson/Zotero/storage/YAPW5SW3/Obojska - 2013 - SOME REMARKS ON SUPPLEMENTATION PRINCIPLES IN THE .pdf}, + journal = {The Review of Symbolic Logic}, + language = {en}, + number = {2} +} + +@unpublished{parsons_extensionalists_nodate, + title = {An {{Extensionalist}}'s {{Guide}} to {{Non}}-{{Extensional Mereology}}}, + author = {Parsons, Josh}, + file = {/Users/benblumson/Zotero/storage/ZUJU4SDB/PARAEG.pdf} +} + +@incollection{parsons_many_2014, + title = {The {{Many Primitives}} of {{Mereology}}}, + booktitle = {Mereology and {{Location}}}, + author = {Parsons, Josh}, + year = {2014}, + month = jan, + publisher = {{Oxford University Press}}, + address = {{Oxford}}, + abstract = {Formal mereologies are axiomatized in a variety of different ways, with a variety of different primitives. This chapter distinguishes three such ways, whose primitives are part, overlap, and proper part respectively. Not every mereology can be axiomatized in every way. This chapter contains a description of what formal features a mereology much have in order to be successfully axiomatizable in each way.}, + file = {/Users/benblumson/Zotero/storage/J4Y3XH6E/Shieva Kleinschmidt - Mereology and Location (2014, Oxford University Press).pdf}, + isbn = {978-0-19-175891-1}, + language = {en\_US} +} + +@book{pietruszczak_metamereology_2018, + title = {Metamereology}, + author = {Pietruszczak, Andrzej}, + year = {2018}, + publisher = {{Nicolaus Copernicus University Scientific Publishing House}}, + address = {{Turun}}, + abstract = {Our aim in this book is not simply to provide an introduction to the topic of mereology but also to undertake a thorough analysis of it. Hence its name: \"Metamereology\". Mereology arose as a theory of collective sets. It was formulated by the Polish logician Stanis\l aw Le\'sniewski. Collective sets are certain wholes composed of parts. In general, the concept of a collective set can be defined with the help of the relation \"is a part of\" and mereology may therefore be considered as a theory of the relation of part to the whole\&\#39;\&\#39; (from the Greek: meros, \"part\&\#39;\&\#39;).}, + file = {/Users/benblumson/Zotero/storage/26IRTHGU/PIETRUSZCZAK - 2018 - Metamereology.pdf}, + isbn = {978-83-231-3975-1} +} + +@article{pontow_note_2004, + title = {A Note on the Axiomatics of Theories in Parthood}, + author = {Pontow, Carsten}, + year = {2004}, + month = aug, + volume = {50}, + pages = {195--213}, + issn = {0169-023X}, + doi = {10.1016/j.datak.2003.12.002}, + abstract = {We discuss the axiomatic base of some of the most prominent theories of parthood (mereologies), in particular of General (Classical) Extensional Mereology (GEM). Parthood is axiomatized in GEM as a partial ordering to which a supplementation axiom and a general summing axiom are added. In this paper, we disprove the common assumption that it makes no difference for the strength of the resulting theory whether in the above framework the so-called Strong or the Weak Supplementation Principle is taken as supplementation axiom. We further show some more counterexamples to common assertions from literature concerning the interdependance of some of the axioms of the various mereological theories. It turns out that only the Strong Supplementation Principle is sufficient to fit the theories with a strong kind of extensionality.}, + file = {/Users/benblumson/Zotero/storage/YTGU7QAR/1-s2.0-S0169023X03001915-main.pdf}, + journal = {Data \& Knowledge Engineering}, + number = {2} +} + +@phdthesis{sen_computational_2017, + title = {Computational {{Axiomatic Science}}}, + author = {Sen, Atriya}, + year = {2017}, + file = {/Users/benblumson/Zotero/storage/5IF4GA36/Sen - 2017 - Computational Axiomatic Science.pdf}, + school = {Rensselaer Polytechnic Institute} +} + +@book{simons_parts:_1987, + title = {Parts: {{A Study}} in {{Ontology}}}, + shorttitle = {Parts}, + author = {Simons, Peter}, + year = {1987}, + publisher = {{Oxford University Press}}, + address = {{Oxford}}, + abstract = {Although the relationship of part to whole is one of the most fundamental there is, this is the first full-length study of this key concept. Showing that mereology, or the formal theory of part and whole, is essential to ontology, Simons surveys and critiques previous theories--especially the standard extensional view--and proposes a new account that encompasses both temporal and modal considerations. Simons's revised theory not only allows him to offer fresh solutions to long-standing problems, but also has far-reaching consequences for our understanding of a host of classical philosophical concepts.}, + isbn = {978-0-19-824954-2}, + language = {en} +} + +@article{smith_mereology_2009, + title = {Mereology without {{Weak Supplementation}}}, + author = {Smith, Donald}, + year = {2009}, + month = sep, + volume = {87}, + pages = {505--511}, + issn = {0004-8402}, + doi = {10.1080/00048400802215703}, + abstract = {According to the Weak Supplementation Principle (WSP)\textemdash a widely received principle of mereology\textemdash an object with a proper part, p, has another distinct proper part that doesn't overlap p. In a recent article in this journal, Nikk Effingham and Jon Robson employ WSP in an objection to endurantism. I defend endurantism in a way that bears on mereology in general. First, I argue that denying WSP can be motivated apart from the truth of endurantism. I then go on to offer an explanation of WSP's initial appeal, argue that denying WSP fails to have untoward consequences for the rest of mereology, and show that the falsity of WSP is consistent with a primary guiding thought behind it.}, + file = {/Users/benblumson/Zotero/storage/C85VXCWB/Smith - 2009 - Mereology without Weak Supplementation.pdf}, + journal = {Australasian Journal of Philosophy}, + number = {3} +} + +@incollection{tarski_foundations_1983, + title = {Foundations of the {{Geometry}} of {{Solids}}}, + booktitle = {Logic, {{Semantics}}, {{Metamathematics}}}, + author = {Tarski, Alfred}, + year = {1983}, + edition = {Second}, + pages = {24--29}, + publisher = {{Hackett Publishing}}, + address = {{Indianapolis}} +} + +@article{varzi_extensionality_2008, + title = {The {{Extensionality}} of {{Parthood}} and {{Composition}}}, + author = {Varzi, Achille C.}, + year = {2008}, + month = jan, + volume = {58}, + pages = {108--133}, + issn = {0031-8094}, + doi = {10.1111/j.1467-9213.2007.542.x}, + file = {/Users/benblumson/Zotero/storage/DZZS8PFN/Varzi - 2008 - The Extensionality of Parthood and Composition.pdf}, + journal = {The Philosophical Quarterly}, + number = {230} +} + +@incollection{varzi_mereology_2016, + title = {Mereology}, + booktitle = {The {{Stanford Encyclopedia}} of {{Philosophy}}}, + author = {Varzi, Achille C.}, + editor = {Zalta, Edward N.}, + year = {2016}, + edition = {Winter 2016}, + publisher = {{Metaphysics Research Lab, Stanford University}}, + abstract = {Mereology (from the Greek {$\mu\epsilon\rhoo\varsigma$},`part') is the theory of parthood relations: of therelations of part to whole and the relations of part to part within a whole.[1] Its roots can be traced back to the early days of philosophy,beginning with the Presocratics and continuing throughout the writingsof Plato (especially the Parmenides and theTheaetetus), Aristotle (especially the Metaphysics,but also the Physics, the Topics, and Departibus animalium), and Boethius (especially DeDivisione and In Ciceronis Topica). Mereology occupies aprominent role also in the writings of medieval ontologists andscholastic philosophers such as Garland the Computist, Peter Abelard,Thomas Aquinas, Raymond Lull, John Duns Scotus, Walter Burley, Williamof Ockham, and Jean Buridan, as well as in Jungius's LogicaHamburgensis (1638), Leibniz's Dissertatio de artecombinatoria (1666) and Monadology (1714), and Kant'searly writings (the Gedanken of 1747 and the Monadologiaphysica of 1756). As a formal theory of parthood relations,however, mereology made its way into our times mainly through the workof Franz Brentano and of his pupils, especially Husserl's thirdLogical Investigation (1901). The latter may rightly beconsidered the first attempt at a thorough formulation of a theory,though in a format that makes it difficult to disentangle the analysisof mereological concepts from that of other ontologically relevantnotions (such as the relation of ontological dependence).[2] It is not until Le\'sniewski's Foundations of the GeneralTheory of Sets (1916) and his Foundations of Mathematics(1927\textendash 1931) that a pure theory of part-relations was given anexact formulation.[3] And because Le\'sniewski's work was largely inaccessible tonon-speakers of Polish, it is only with the publication of Leonard andGoodman's The Calculus of Individuals (1940), partly underthe influence of Whitehead, that mereology has become a chapter ofcentral interest for modern ontologists and metaphysicians.[4], In the following we focus mostly on contemporary formulations ofmereology as they grew out of these recenttheories\textemdash Le\'sniewski's and Leonard and Goodman's. Indeed,although such theories come in different logical guises, they aresufficiently similar to be recognized as a common basis for mostsubsequent developments. To properly assess the relative strengths andweaknesses, however, it will be convenient to proceed in steps. Firstwe consider some core mereological notions and principles. Then weproceed to an examination of the stronger theories that can be erectedon that basis.} +} + +@article{varzi_note_2006, + title = {A {{Note}} on the {{Transitivity}} of {{Parthood}}}, + author = {Varzi, Achille C.}, + year = {2006}, + volume = {1}, + pages = {141--146}, + file = {/Users/benblumson/Zotero/storage/24DLQ9ZA/Varzi - A Note on the Transitivity of Parthood.pdf}, + journal = {Applied Ontology}, + number = {2} +} + +@article{varzi_parts_1996, + title = {Parts, Wholes, and Part-Whole Relations: {{The}} Prospects of Mereotopology}, + shorttitle = {Parts, Wholes, and Part-Whole Relations}, + author = {Varzi, Achille C.}, + year = {1996}, + month = nov, + volume = {20}, + pages = {259--286}, + issn = {0169-023X}, + doi = {10.1016/S0169-023X(96)00017-1}, + abstract = {We can see mereology as a theory of parthood and topology as a theory of wholeness. How can the two be combined to obtain a unified theory of parts and wholes'? This paper examines three main ways of answering this question. On the first account, mereology and topology form two independent (though mutually related) domains. The second account grants priority to topology and characterizes mereology derivatively, by defining parthood in terms of wholeness (more specifically: connectedness). The third approach reverses the order, exploiting the idea that wholeness (connectedness) can be explained in terms of parthood along with other predicates or relations. The analysis and comparison of these strategies is mostly formal (and within the confines of standard first-order theories), but their relevance to spatio-temporal reasoning and representation is emphasized. Some more speculative strategies and directions for further research, such as the development of a unified framework based on a single mereotopological primitive of connected parthood, are also briefly considered.}, + file = {/Users/benblumson/Zotero/storage/MDZC3I65/Varzi - 1996 - Parts, wholes, and part-whole relations The prosp.pdf}, + journal = {Data \& Knowledge Engineering}, + number = {3}, + series = {Modeling {{Parts}} and {{Wholes}}} +} + +@article{varzi_universalism_2009, + title = {Universalism Entails {{Extensionalism}}}, + author = {Varzi, Achille C.}, + year = {2009}, + month = oct, + volume = {69}, + pages = {599--604}, + issn = {0003-2638}, + doi = {10.1093/analys/anp102}, + file = {/Users/benblumson/Zotero/storage/RNPCADT2/Varzi - 2009 - Universalism entails Extensionalism.pdf}, + journal = {Analysis}, + number = {4} +} + + diff --git a/thys/Mereology/document/root.tex b/thys/Mereology/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Mereology/document/root.tex @@ -0,0 +1,61 @@ +\documentclass[11pt,a4paper]{article} +\usepackage{isabelle,isabellesym} + +% further packages required for unusual symbols (see also +% isabellesym.sty), use only when needed + +%\usepackage{amssymb} + %for \, \, \, \, \, \, + %\, \, \, \, \, + %\, \, \ + +%\usepackage{eurosym} + %for \ + +%\usepackage[only,bigsqcap]{stmaryrd} + %for \ + +%\usepackage{eufrak} + %for \ ... \, \ ... \ (also included in amssymb) + +%\usepackage{textcomp} + %for \, \, \, \, \, + %\ + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + +% for uniform font size +%\renewcommand{\isastyle}{\isastyleminor} + + +\begin{document} + +\title{Mereology} +\author{Ben Blumson} +\maketitle + +\abstract{We use Isabelle/HOL to verify elementary theorems and alternative axiomatizations of classical extensional mereology.} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +% optional bibliography +\bibliographystyle{apalike} +\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Algorithm.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Algorithm.thy new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Algorithm.thy @@ -0,0 +1,379 @@ + +section \Formalization of an efficient Hermite normal form algorithm\ + +text \We formalize a version of the Hermite normal form algorithm based on reductions modulo +the determinant. This avoids the growth of the intermediate coefficients.\ + +subsection \Implementation of the algorithm using generic modulo operation\ + +text \Exception on generic modulo: currently in Hermite-reduce-above, ordinary div/mod is used, + since that is our choice for the complete set of residues.\ + +theory HNF_Mod_Det_Algorithm + imports + Jordan_Normal_Form.Gauss_Jordan_IArray_Impl + Show.Show_Instances + Jordan_Normal_Form.Determinant_Impl + Jordan_Normal_Form.Show_Matrix + LLL_Basis_Reduction.LLL_Certification + Smith_Normal_Form.SNF_Algorithm_Euclidean_Domain + Smith_Normal_Form.SNF_Missing_Lemmas + Uniqueness_Hermite_JNF + Matrix_Change_Row +begin + +subsubsection \Echelon form algorithm\ + +fun make_first_column_positive :: "int mat \ int mat" where + "make_first_column_positive A = ( + Matrix.mat (dim_row A) (dim_col A) \ \ Create a matrix of the same dimensions \ + (\(i,j). if A $$(i,0) < 0 then - A $$(i,j) else A $$(i,j) + ) + )" + + +locale mod_operation = + fixes generic_mod :: "int \ int \ int" (infixl "gmod" 70) + and generic_div :: "int \ int \ int" (infixl "gdiv" 70) +begin + +text \Version for reducing all elements\ + +fun reduce :: "nat \ nat \ int \ int mat \ int mat" where + "reduce a b D A = (let Aaj = A$$(a,0); Abj = A $$ (b,0) + in + if Aaj = 0 then A else + case euclid_ext2 Aaj Abj of (p,q,u,v,d) \ \ \ p*Aaj + q * Abj = d, u = - Abj/d, v = Aaj/d \ + Matrix.mat (dim_row A) (dim_col A) \ \ Create a matrix of the same dimensions \ + (\(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in + if k = 0 then if D dvd r then D else r else r gmod D \ \ Row a is multiplied by p and added row b multiplied by q, modulo D\ + else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in + if k = 0 then r else r gmod D \ \ Row b is multiplied by v and added row a multiplied by u, modulo D\ + else A$$(i,k) \ \ All the other rows remain unchanged\ + ) + )" + +text \Version for reducing, with abs-checking\ + +fun reduce_abs :: "nat \ nat \ int \ int mat \ int mat" where + "reduce_abs a b D A = (let Aaj = A$$(a,0); Abj = A $$ (b,0) + in + if Aaj = 0 then A else + case euclid_ext2 Aaj Abj of (p,q,u,v,d) \ \ \ p*Aaj + q * Abj = d, u = - Abj/d, v = Aaj/d \ + Matrix.mat (dim_row A) (dim_col A) \ \ Create a matrix of the same dimensions \ + (\(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in + if abs r > D then if k = 0 \ D dvd r then D else r gmod D else r + else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in + if abs r > D then r gmod D else r + else A$$(i,k) \ \ All the other rows remain unchanged\ + ) + )" + +definition reduce_impl :: "nat \ nat \ int \ int mat \ int mat" where + "reduce_impl a b D A = (let + row_a = Matrix.row A a; + Aaj = row_a $v 0 + in + if Aaj = 0 then A else let + row_b = Matrix.row A b; + Abj = row_b $v 0 in + case euclid_ext2 Aaj Abj of (p,q,u,v,d) \ + let row_a' = (\ k ak. let r = (p * ak + q * row_b $v k) in + if k = 0 then if D dvd r then D else r else r gmod D); + row_b' = (\ k bk. let r = u * row_a $v k + v * bk in + if k = 0 then r else r gmod D) + in change_row a row_a' (change_row b row_b' A) + )" + +definition reduce_abs_impl :: "nat \ nat \ int \ int mat \ int mat" where + "reduce_abs_impl a b D A = (let + row_a = Matrix.row A a; + Aaj = row_a $v 0 + in + if Aaj = 0 then A else let + row_b = Matrix.row A b; + Abj = row_b $v 0 in + case euclid_ext2 Aaj Abj of (p,q,u,v,d) \ + let row_a' = (\ k ak. let r = (p * ak + q * row_b $v k) in + if abs r > D then if k = 0 \ D dvd r then D else r gmod D else r); + row_b' = (\ k bk. let r = u * row_a $v k + v * bk in + if abs r > D then r gmod D else r) + in change_row a row_a' (change_row b row_b' A) + )" + +lemma reduce_impl: "a < nr \ b < nr \ 0 < nc \ a \ b \ A \ carrier_mat nr nc + \ reduce_impl a b D A = reduce a b D A" + unfolding reduce_impl_def reduce.simps Let_def + apply (intro if_cong[OF _ refl], force) + apply (intro prod.case_cong refl, force) + apply (intro eq_matI, auto) + done + + +lemma reduce_abs_impl: "a < nr \ b < nr \ 0 < nc \ a \ b \ A \ carrier_mat nr nc + \ reduce_abs_impl a b D A = reduce_abs a b D A" + unfolding reduce_abs_impl_def reduce_abs.simps Let_def + apply (intro if_cong[OF _ refl], force) + apply (intro prod.case_cong refl, force) + apply (intro eq_matI, auto) + done + + +(* This functions reduce the elements below the position (a,0), given a list of positions + of non-zero positions as input*) +fun reduce_below :: "nat \ nat list \ int \ int mat \ int mat" +where "reduce_below a [] D A = A" + | "reduce_below a (x # xs) D A = reduce_below a xs D (reduce a x D A)" + +fun reduce_below_impl :: "nat \ nat list \ int \ int mat \ int mat" +where "reduce_below_impl a [] D A = A" + | "reduce_below_impl a (x # xs) D A = reduce_below_impl a xs D (reduce_impl a x D A)" + +lemma reduce_impl_carrier[simp,intro]: "A \ carrier_mat m n \ reduce_impl a b D A \ carrier_mat m n" + unfolding reduce_impl_def Let_def by (auto split: prod.splits) + +lemma reduce_below_impl: "a < nr \ 0 < nc \ (\ b. b \ set bs \ b < nr) \ a \ set bs + \ A \ carrier_mat nr nc \ reduce_below_impl a bs D A = reduce_below a bs D A" +proof (induct bs arbitrary: A) + case (Cons b bs A) + show ?case by (simp del: reduce.simps, + subst reduce_impl[of _ nr _ nc], + (insert Cons, auto simp del: reduce.simps)[5], + rule Cons(1), insert Cons(2-), auto simp: Let_def split: prod.splits) +qed simp + + + +fun reduce_below_abs :: "nat \ nat list \ int \ int mat \ int mat" +where "reduce_below_abs a [] D A = A" + | "reduce_below_abs a (x # xs) D A = reduce_below_abs a xs D (reduce_abs a x D A)" + +fun reduce_below_abs_impl :: "nat \ nat list \ int \ int mat \ int mat" +where "reduce_below_abs_impl a [] D A = A" + | "reduce_below_abs_impl a (x # xs) D A = reduce_below_abs_impl a xs D (reduce_abs_impl a x D A)" + +lemma reduce_abs_impl_carrier[simp,intro]: "A \ carrier_mat m n \ reduce_abs_impl a b D A \ carrier_mat m n" + unfolding reduce_abs_impl_def Let_def by (auto split: prod.splits) + +lemma reduce_abs_below_impl: "a < nr \ 0 < nc \ (\ b. b \ set bs \ b < nr) \ a \ set bs + \ A \ carrier_mat nr nc \ reduce_below_abs_impl a bs D A = reduce_below_abs a bs D A" +proof (induct bs arbitrary: A) + case (Cons b bs A) + show ?case by (simp del: reduce_abs.simps, + subst reduce_abs_impl[of _ nr _ nc], + (insert Cons, auto simp del: reduce_abs.simps)[5], + rule Cons(1), insert Cons(2-), auto simp: Let_def split: prod.splits) +qed simp + +text \This function outputs a matrix in echelon form via reductions modulo the determinant\ + + +function FindPreHNF :: "bool \ int \ int mat \ int mat" + where "FindPreHNF abs_flag D A = + (let m = dim_row A; n = dim_col A in + if m < 2 \ n = 0 then A else \ \ No operations are carried out if m = 1 \ + let non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. 0 then A + else let i = non_zero_positions ! 0 \ \ Select the first non-zero position below the first element\ + in swaprows 0 i A + ); + Reduce = (if abs_flag then reduce_below_abs else reduce_below) + in + if n < 2 then Reduce 0 non_zero_positions D A' \ \ If n = 1, then we have to reduce the column \ + else + let + (A_UL,A_UR,A_DL,A_DR) = split_block (Reduce 0 non_zero_positions D (make_first_column_positive A')) 1 1; + sub_PreHNF = FindPreHNF abs_flag D A_DR in + four_block_mat A_UL A_UR A_DL sub_PreHNF)" + by auto termination +proof (relation "Wellfounded.measure (\(abs_flag,D,A). dim_col A)") + show "wf (Wellfounded.measure (\(abs_flag,D, A). dim_col A))" by auto + fix abs_flag D A m n nz A' R xd A'_UL y A'_UR ya A'_DL A'_DR + assume m: "m = dim_row A" and n:"n = dim_col A" + and m2: "\ (m < 2 \ n = 0)" and nz_def: "nz = filter (\i. A $$ (i, 0) \ 0) [1.. 0 then A else let i = nz ! 0 in swaprows 0 i A)" + and R_def: "R = (if abs_flag then reduce_below_abs else reduce_below)" + and n2: "\ n < 2" and "xd = split_block (R 0 nz D (make_first_column_positive A')) 1 1" + and "(A'_UL, y) = xd" and "(A'_UR, ya) = y" and "(A'_DL, A'_DR) = ya" + hence A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) + = split_block (R 0 nz D (make_first_column_positive A')) 1 1" by force + have dr_mk1: "dim_row (make_first_column_positive A) = dim_row A" for A by auto + have dr_mk2: "dim_col (make_first_column_positive A) = dim_col A" for A by auto + have r1: "reduce_below a xs D A \ carrier_mat m n" if "A \ carrier_mat m n" for A a xs + using that by (induct a xs D A rule: reduce_below.induct, auto simp add: Let_def euclid_ext2_def) + hence R: "(reduce_below 0 nz D (make_first_column_positive A')) \ carrier_mat m n" + using A'_def m n + by (metis carrier_matI index_mat_swaprows(2,3) dr_mk1 dr_mk2) + have "reduce_below_abs a xs D A \ carrier_mat m n" if "A \ carrier_mat m n" for A a xs + using that by (induct a xs D A rule: reduce_below_abs.induct, auto simp add: Let_def euclid_ext2_def) + hence R2: "(reduce_below_abs 0 nz D (make_first_column_positive A')) \ carrier_mat m n" + using A'_def m n + by (metis carrier_matI index_mat_swaprows(2,3) dr_mk1 dr_mk2) + + have "A'_DR \ carrier_mat (m-1) (n-1)" + by (cases abs_flag; rule split_block(4)[OF A'_split[symmetric]],insert m2 n2 m n R_def R R2, auto) + thus "((abs_flag, D, A'_DR),abs_flag, D, A) \ Wellfounded.measure (\(abs_flag,D, A). dim_col A)" using n2 m2 n m by auto +qed + +lemma FindPreHNF_code: "FindPreHNF abs_flag D A = + (let m = dim_row A; n = dim_col A in + if m < 2 \ n = 0 then A else + let non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. 0 then A + else let i = non_zero_positions ! 0 in swaprows 0 i A + ); + Reduce_impl = (if abs_flag then reduce_below_abs_impl else reduce_below_impl) + in + if n < 2 then Reduce_impl 0 non_zero_positions D A' + else + let + (A_UL,A_UR,A_DL,A_DR) = split_block (Reduce_impl 0 non_zero_positions D (make_first_column_positive A')) 1 1; + sub_PreHNF = FindPreHNF abs_flag D A_DR in + four_block_mat A_UL A_UR A_DL sub_PreHNF)" (is "?lhs = ?rhs") +proof - + let ?f = "\R. (if dim_row A < 2 \ dim_col A = 0 then A else if dim_col A < 2 + then R 0 (filter (\i. A $$ (i, 0) \ 0) [1.. 0 then A else swaprows 0 (filter (\i. A $$ (i, 0) \ 0) [1..i. A $$ (i, 0) \ 0) [1.. 0 then A else + swaprows 0 (filter (\i. A $$ (i, 0) \ 0) [1.. four_block_mat A_UL A_UR A_DL (FindPreHNF abs_flag D A_DR))" + have M_carrier: "make_first_column_positive (if A $$ (0, 0) \ 0 then A + else swaprows 0 (filter (\i. A $$ (i, 0) \ 0) [1.. carrier_mat (dim_row A) (dim_col A)" + by (smt (z3) index_mat_swaprows(2) index_mat_swaprows(3) make_first_column_positive.simps mat_carrier) + have *: "0 \ set (filter (\i. A $$ (i, 0) \ 0) [1.. x. split_block x 1 1"]; + (subst reduce_abs_below_impl[where nr = "dim_row A" and nc = "dim_col A"])), (auto)[9]) + (insert M_carrier *, blast+) + also have "... = ?f (if abs_flag then reduce_below_abs_impl else reduce_below_impl)" + using True by presburger + finally show ?thesis using True unfolding FindPreHNF.simps[of abs_flag D A] Let_def by blast + next + case False + have "?f (if abs_flag then reduce_below_abs else reduce_below) = ?f reduce_below" + using False by presburger + also have "... = ?f reduce_below_impl" + by ((intro if_cong refl prod.case_cong arg_cong[of _ _ "\ x. split_block x 1 1"]; + (subst reduce_below_impl[where nr = "dim_row A" and nc = "dim_col A"])), (auto)[9]) + (insert M_carrier *, blast+) + also have "... = ?f (if abs_flag then reduce_below_abs_impl else reduce_below_impl)" + using False by presburger + finally show ?thesis using False unfolding FindPreHNF.simps[of abs_flag D A] Let_def by blast + qed + finally show ?thesis by blast +qed +end + +declare mod_operation.FindPreHNF_code[code] +declare mod_operation.reduce_below_impl.simps[code] +declare mod_operation.reduce_impl_def[code] +declare mod_operation.reduce_below_abs_impl.simps[code] +declare mod_operation.reduce_abs_impl_def[code] + +subsubsection \From echelon form to Hermite normal form\ + +text \From here on, we define functions to transform a matrix in echelon form into its Hermite +normal form. Essentially, we are defining the functions that are available in the AFP entry Hermite +(which uses HOL Analysis + mod-type) in the JNF matrix representation.\ + +(*Find the first nonzero element of row l (A is upper triangular)*) +definition find_fst_non0_in_row :: "nat \ int mat \ nat option" where + "find_fst_non0_in_row l A = (let is = [l ..< dim_col A]; + Ais = filter (\j. A $$ (l, j) \ 0) is + in case Ais of [] \ None | _ \ Some (Ais!0))" + +primrec Hermite_reduce_above +where "Hermite_reduce_above (A::int mat) 0 i j = A" + | "Hermite_reduce_above A (Suc n) i j = (let + Aij = A $$ (i,j); + Anj = A $$ (n,j) + in + Hermite_reduce_above (addrow (- (Anj div Aij)) n i A) n i j)" + +definition Hermite_of_row_i :: "int mat \ nat \ int mat" + where "Hermite_of_row_i A i = ( + case find_fst_non0_in_row i A of None \ A | Some j \ + let Aij = A $$(i,j) in + if Aij < 0 then Hermite_reduce_above (multrow i (-1) A) i i j + else Hermite_reduce_above A i i j)" + + +primrec Hermite_of_list_of_rows + where + "Hermite_of_list_of_rows A [] = A" | + "Hermite_of_list_of_rows A (a#xs) = Hermite_of_list_of_rows (Hermite_of_row_i A a) xs" + +text \We combine the previous functions to assemble the algorithm\ + +definition (in mod_operation) "Hermite_mod_det abs_flag A = + (let m = dim_row A; n = dim_col A; + D = abs(det_int A); + A' = A @\<^sub>r D \\<^sub>m 1\<^sub>m n; + E = FindPreHNF abs_flag D A'; + H = Hermite_of_list_of_rows E [0..Some examples of execution\ + +declare mod_operation.Hermite_mod_det_def[code] + +value "let B = mat_of_rows_list 4 ([[0,3,1,4],[7,1,0,0],[8,0,19,16],[2,0,0,3::int]]) in + show (mod_operation.Hermite_mod_det (mod) True B)" + +(* +sage: import sage.matrix.matrix_integer_dense_hnf as matrix_integer_dense_hnf +sage: A = matrix(ZZ, [[0,3,1,4],[7,1,0,0],[8,0,19,16],[2,0,0,3]]) +sage: A +[ 0 3 1 4] +[ 7 1 0 0] +[ 8 0 19 16] +[ 2 0 0 3] +sage: H, U = matrix_integer_dense_hnf.hnf_with_transformation(A); H +[ 1 0 0 672] +[ 0 1 0 660] +[ 0 0 1 706] +[ 0 0 0 1341] +sage: +*) + + +value "let B = mat_of_rows_list 7 ([ +[ 1, 17, -41, -1, 1, 0, 0], +[ 0, -1, 2, 0, -6, 2, 1], +[ 9, 2, 1, 1, -2, 2, -5], +[ -1, -3, -1, 0, -9, 0, 0], +[ 9, -1, -9, 0, 0, 0, 1], +[ 1, -1, 1, 0, 1, -8, 0], +[ 1, -1, 0, -2, -1, -1, 0::int]]) in + show (mod_operation.Hermite_mod_det (mod) True B)" + +(* +sage: import sage.matrix.matrix_integer_dense_hnf as matrix_integer_dense_hnf +sage: A = random_matrix(ZZ,7,7); A +[ 1 17 -41 -1 1 0 0] +[ 0 -1 2 0 -6 2 1] +[ 9 2 1 1 -2 2 -5] +[ -1 -3 -1 0 -9 0 0] +[ 9 -1 -9 0 0 0 1] +[ 1 -1 1 0 1 -8 0] +[ 1 -1 0 -2 -1 -1 0] +sage: H, U = matrix_integer_dense_hnf.hnf_with_transformation(A); H +[ 1 0 0 0 0 1 191934] +[ 0 1 0 0 0 0 435767] +[ 0 0 1 0 0 1 331950] +[ 0 0 0 1 0 0 185641] +[ 0 0 0 0 1 0 38022] +[ 0 0 0 0 0 2 477471] +[ 0 0 0 0 0 0 565304] +*) + +end \ No newline at end of file diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Soundness.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Soundness.thy new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/HNF_Mod_Det_Soundness.thy @@ -0,0 +1,11563 @@ + +subsection \Soundness of the algorithm\ + +theory HNF_Mod_Det_Soundness + imports + HNF_Mod_Det_Algorithm + Signed_Modulo +begin + +hide_const(open) Determinants.det Determinants2.upper_triangular + Finite_Cartesian_Product.row Finite_Cartesian_Product.rows + Finite_Cartesian_Product.vec + +subsubsection \Results connecting lattices and Hermite normal form\ + +text \The following results will also be useful for proving the soundness of the certification +approach.\ + +lemma of_int_mat_hom_int_id[simp]: + fixes A::"int mat" + shows "of_int_hom.mat_hom A = A" unfolding map_mat_def by auto + + +definition "is_sound_HNF algorithm associates res + = (\A. let (P,H) = algorithm A; m = dim_row A; n = dim_col A in + P \ carrier_mat m m \ H \ carrier_mat m n \ invertible_mat P \ A = P * H + \ Hermite_JNF associates res H)" + +lemma HNF_A_eq_HNF_PA: + fixes A::"'a::{bezout_ring_div,normalization_euclidean_semiring,unique_euclidean_ring} mat" + assumes A: "A \ carrier_mat n n" and inv_A: "invertible_mat A" + and inv_P: "invertible_mat P" and P: "P \ carrier_mat n n" + and sound_HNF: "is_sound_HNF HNF associates res" + and P1_H1: "(P1,H1) = HNF (P*A)" + and P2_H2: "(P2,H2) = HNF A" + shows "H1 = H2" +proof - + obtain inv_P where P_inv_P: "inverts_mat P inv_P" and inv_P_P: "inverts_mat inv_P P" + and inv_P: "inv_P \ carrier_mat n n" + using P inv_P obtain_inverse_matrix by blast + have P1: "P1 \ carrier_mat n n" + using P1_H1 sound_HNF unfolding is_sound_HNF_def Let_def + by (metis (no_types, lifting) P carrier_matD(1) index_mult_mat(2) old.prod.case) + have H1: "H1 \ carrier_mat n n" using P1_H1 sound_HNF unfolding is_sound_HNF_def Let_def + by (metis (no_types, lifting) A P carrier_matD(1) carrier_matD(2) case_prodD index_mult_mat(2,3)) + have invertible_inv_P: "invertible_mat inv_P" + using P_inv_P inv_P inv_P_P invertible_mat_def square_mat.simps by blast + have P_A_P1_H1: "P * A = P1 * H1" using P1_H1 sound_HNF unfolding is_sound_HNF_def Let_def + by (metis (mono_tags, lifting) case_prod_conv) + hence "A = inv_P * (P1 * H1)" + by (smt A P inv_P_P inv_P assoc_mult_mat carrier_matD(1) inverts_mat_def left_mult_one_mat) + hence A_inv_P_P1_H1: "A = (inv_P * P1) * H1" + by (smt P P1_H1 assoc_mult_mat carrier_matD(1) fst_conv index_mult_mat(2) inv_P + is_sound_HNF_def prod.sel(2) sound_HNF split_beta) + have A_P2_H2: "A = P2 * H2" using P2_H2 sound_HNF unfolding is_sound_HNF_def Let_def + by (metis (mono_tags, lifting) case_prod_conv) + have invertible_inv_P_P1: "invertible_mat (inv_P * P1)" + proof (rule invertible_mult_JNF[OF inv_P P1 invertible_inv_P]) + show "invertible_mat P1" + by (smt P1_H1 is_sound_HNF_def prod.sel(1) sound_HNF split_beta) + qed + show ?thesis + proof (rule Hermite_unique_JNF[OF A _ H1 _ _ A_inv_P_P1_H1 A_P2_H2 inv_A invertible_inv_P_P1]) + show "inv_P * P1 \ carrier_mat n n" + by (metis carrier_matD(1) carrier_matI index_mult_mat(2) inv_P + invertible_inv_P_P1 invertible_mat_def square_mat.simps) + show "P2 \ carrier_mat n n" + by (smt A P2_H2 carrier_matD(1) is_sound_HNF_def prod.sel(1) sound_HNF split_beta) + show "H2 \ carrier_mat n n" + by (smt A P2_H2 carrier_matD(1) carrier_matD(2) is_sound_HNF_def prod.sel(2) sound_HNF split_beta) + show "invertible_mat P2" + by (smt P2_H2 is_sound_HNF_def prod.sel(1) sound_HNF split_beta) + show "Hermite_JNF associates res H1" + by (smt P1_H1 is_sound_HNF_def prod.sel(2) sound_HNF split_beta) + show "Hermite_JNF associates res H2" + by (smt P2_H2 is_sound_HNF_def prod.sel(2) sound_HNF split_beta) + qed +qed + + +context vec_module +begin + +lemma mat_mult_invertible_lattice_eq: + assumes fs: "set fs \ carrier_vec n" + and gs: "set gs \ carrier_vec n" + and P: "P \ carrier_mat m m" and invertible_P: "invertible_mat P" + and length_fs: "length fs = m" and length_gs: "length gs = m" + and prod: "mat_of_rows n fs = (map_mat of_int P) * mat_of_rows n gs" + shows "lattice_of fs = lattice_of gs" +proof thm mat_mult_sub_lattice + show "lattice_of fs \ lattice_of gs" + by (rule mat_mult_sub_lattice[OF fs gs _ prod],simp add: length_fs length_gs P) +next + obtain inv_P where P_inv_P: "inverts_mat P inv_P" and inv_P_P: "inverts_mat inv_P P" + and inv_P: "inv_P \ carrier_mat m m" + using P invertible_P obtain_inverse_matrix by blast + have "of_int_hom.mat_hom (inv_P) * mat_of_rows n fs + = of_int_hom.mat_hom (inv_P) * ((map_mat of_int P) * mat_of_rows n gs)" + using prod by auto + also have "... = of_int_hom.mat_hom (inv_P) * (map_mat of_int P) * mat_of_rows n gs" + by (smt P assoc_mult_mat inv_P length_gs map_carrier_mat mat_of_rows_carrier(1)) + also have "... = of_int_hom.mat_hom (inv_P * P) * mat_of_rows n gs" + by (metis P inv_P of_int_hom.mat_hom_mult) + also have "... = mat_of_rows n gs" + by (metis carrier_matD(1) inv_P inv_P_P inverts_mat_def left_mult_one_mat' + length_gs mat_of_rows_carrier(2) of_int_hom.mat_hom_one) + finally have prod: "mat_of_rows n gs = of_int_hom.mat_hom (inv_P) * mat_of_rows n fs" .. + show "lattice_of gs \ lattice_of fs" + by (rule mat_mult_sub_lattice[OF gs fs _ prod], simp add: length_fs length_gs inv_P) +qed + +end + + +context + fixes n :: nat +begin + +interpretation vec_module "TYPE(int)" . + +lemma lattice_of_HNF: + assumes sound_HNF: "is_sound_HNF HNF associates res" + and P1_H1: "(P,H) = HNF (mat_of_rows n fs)" + and fs: "set fs \ carrier_vec n" and len: "length fs = m" + shows "lattice_of fs = lattice_of (rows H)" +proof (rule mat_mult_invertible_lattice_eq[OF fs]) + have H: "H \ carrier_mat m n" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def + by (metis (mono_tags, lifting) assms(4) mat_of_rows_carrier(2) mat_of_rows_carrier(3) prod.sel(2) split_beta) + have H_rw: "mat_of_rows n (Matrix.rows H) = H" using mat_of_rows_rows H by fast + have PH_fs_init: "mat_of_rows n fs = P * H" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def + by (metis (mono_tags, lifting) case_prodD) + show "mat_of_rows n fs = of_int_hom.mat_hom P * mat_of_rows n (Matrix.rows H)" + unfolding H_rw of_int_mat_hom_int_id using PH_fs_init by simp + show "set (Matrix.rows H) \ carrier_vec n" using H rows_carrier by blast + show "P \ carrier_mat m m" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def + by (metis (no_types, lifting) len case_prodD mat_of_rows_carrier(2)) + show "invertible_mat P" using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def + by (metis (no_types, lifting) case_prodD) + show "length fs = m" using len by simp + show "length (Matrix.rows H) = m" using H by auto +qed +end + + +context LLL_with_assms +begin + +(*For this proof, it seems that is not necessary fs_init to be a list of independent vectors. +The context assumes it, though.*) +lemma certification_via_eq_HNF: + assumes sound_HNF: "is_sound_HNF HNF associates res" + and P1_H1: "(P1,H1) = HNF (mat_of_rows n fs_init)" + and P2_H2: "(P2,H2) = HNF (mat_of_rows n gs)" + and H1_H2: "H1 = H2" (*The HNF are equal*) + and gs: "set gs \ carrier_vec n" and len_gs: "length gs = m" + shows "lattice_of gs = lattice_of fs_init" "LLL_with_assms n m gs \" +proof - + have "lattice_of fs_init = lattice_of (rows H1)" + by (rule lattice_of_HNF[OF sound_HNF P1_H1 fs_init], simp add: len) + also have "... = lattice_of (rows H2)" using H1_H2 by auto + also have "... = lattice_of gs" + by (rule lattice_of_HNF[symmetric, OF sound_HNF P2_H2 gs len_gs]) + finally show "lattice_of gs = lattice_of fs_init" .. + have invertible_P1: "invertible_mat P1" + using sound_HNF P1_H1 unfolding is_sound_HNF_def + by (metis (mono_tags, lifting) case_prodD) + have invertible_P2: "invertible_mat P2" + using sound_HNF P2_H2 unfolding is_sound_HNF_def + by (metis (mono_tags, lifting) case_prodD) + have P2: "P2 \ carrier_mat m m" + using sound_HNF P2_H2 unfolding is_sound_HNF_def + by (metis (no_types, lifting) len_gs case_prodD mat_of_rows_carrier(2)) + obtain inv_P2 where P2_inv_P2: "inverts_mat P2 inv_P2" and inv_P2_P2: "inverts_mat inv_P2 P2" + and inv_P2: "inv_P2 \ carrier_mat m m" + using P2 invertible_P2 obtain_inverse_matrix by blast + have P1: "P1 \ carrier_mat m m" + using sound_HNF P1_H1 unfolding is_sound_HNF_def + by (metis (no_types, lifting) len case_prodD mat_of_rows_carrier(2)) + have H1: "H1 \ carrier_mat m n" + using sound_HNF P1_H1 unfolding is_sound_HNF_def + by (metis (no_types, lifting) case_prodD len mat_of_rows_carrier(2) mat_of_rows_carrier(3)) + have H2: "H2 \ carrier_mat m n" + using sound_HNF P2_H2 unfolding is_sound_HNF_def + by (metis (no_types, lifting) len_gs case_prodD mat_of_rows_carrier(2) mat_of_rows_carrier(3)) + have P2_H2: "P2 * H2 = mat_of_rows n gs" + by (smt P2_H2 sound_HNF case_prodD is_sound_HNF_def) + have P1_H1_fs: "P1 * H1 = mat_of_rows n fs_init" + by (smt P1_H1 sound_HNF case_prodD is_sound_HNF_def) + obtain inv_P1 where P1_inv_P1: "inverts_mat P1 inv_P1" and inv_P1_P1: "inverts_mat inv_P1 P1" + and inv_P1: "inv_P1 \ carrier_mat m m" + using P1 invertible_P1 obtain_inverse_matrix by blast + show "LLL_with_assms n m gs \" + proof (rule LLL_change_basis(2)[OF gs len_gs]) + show "P1 * inv_P2 \ carrier_mat m m" using P1 inv_P2 by auto + have "mat_of_rows n fs_init = P1 * H1" using sound_HNF P2_H2 unfolding is_sound_HNF_def + by (metis (mono_tags, lifting) P1_H1 case_prodD) + also have "... = P1 * inv_P2 * P2 * H1" + by (smt P1 P2 assoc_mult_mat carrier_matD(1) inv_P2 inv_P2_P2 inverts_mat_def right_mult_one_mat) + also have "... = P1 * inv_P2 * P2 * H2" using H1_H2 by blast + also have "... = P1 * inv_P2 * (P2 * H2)" + using H2 P2 \P1 * inv_P2 \ carrier_mat m m\ assoc_mult_mat by blast + also have "... = P1 * (inv_P2 * P2 * H2)" + by (metis H2 \P1 * H1 = P1 * inv_P2 * P2 * H1\ \P1 * inv_P2 * P2 * H2 = P1 * inv_P2 * (P2 * H2)\ + H1_H2 carrier_matD(1) inv_P2 inv_P2_P2 inverts_mat_def left_mult_one_mat) + also have "... = P1 * (inv_P2 * (P2 * H2))" using H2 P2 inv_P2 by auto + also have "... = P1 * inv_P2 * mat_of_rows n gs" + using P2_H2 \P1 * (inv_P2 * P2 * H2) = P1 * (inv_P2 * (P2 * H2))\ + \P1 * inv_P2 * (P2 * H2) = P1 * (inv_P2 * P2 * H2)\ by auto + finally show "mat_of_rows n fs_init = P1 * inv_P2 * mat_of_rows n gs" . + show "P2 * inv_P1 \ carrier_mat m m" + using P2 inv_P1 by auto + have "mat_of_rows n gs = P2 * H2" using sound_HNF P2_H2 unfolding is_sound_HNF_def by metis + also have "... = P2 * inv_P1 * P1 * H2" + by (smt P1 P2 assoc_mult_mat carrier_matD(1) inv_P1 inv_P1_P1 inverts_mat_def right_mult_one_mat) + also have "... = P2 * inv_P1 * P1 * H1" using H1_H2 by blast + also have "... = P2 * inv_P1 * (P1 * H1)" + using H1 P1 \P2 * inv_P1 \ carrier_mat m m\ assoc_mult_mat by blast + also have "... = P2 * (inv_P1 * P1 * H1)" + by (metis H2 \P2 * H2 = P2 * inv_P1 * P1 * H2\ \P2 * inv_P1 * P1 * H1 = P2 * inv_P1 * (P1 * H1)\ + H1_H2 carrier_matD(1) inv_P1 inv_P1_P1 inverts_mat_def left_mult_one_mat) + also have "... = P2 * (inv_P1 * (P1 * H1))" using H1 P1 inv_P1 by auto + also have "... = P2 * inv_P1 * mat_of_rows n fs_init" + using P1_H1_fs \P2 * (inv_P1 * P1 * H1) = P2 * (inv_P1 * (P1 * H1))\ + \P2 * inv_P1 * (P1 * H1) = P2 * (inv_P1 * P1 * H1)\ by auto + finally show "mat_of_rows n gs = P2 * inv_P1 * mat_of_rows n fs_init" . + qed +qed + +end + +text \Now, we need to generalize some lemmas.\ + +context vec_module +begin + +(*Generalized version of thm vec_space.finsum_index, now in vec_module*) +lemma finsum_index: + assumes i: "i < n" + and f: "f \ A \ carrier_vec n" + and A: "A \ carrier_vec n" + shows "finsum V f A $ i = sum (\x. f x $ i) A" + using A f +proof (induct A rule: infinite_finite_induct) + case empty + then show ?case using i by simp next + case (insert x X) + then have Xf: "finite X" + and xX: "x \ X" + and x: "x \ carrier_vec n" + and X: "X \ carrier_vec n" + and fx: "f x \ carrier_vec n" + and f: "f \ X \ carrier_vec n" by auto + have i2: "i < dim_vec (finsum V f X)" + using i finsum_closed[OF f] by auto + have ix: "i < dim_vec x" using x i by auto + show ?case + unfolding finsum_insert[OF Xf xX f fx] + unfolding sum.insert[OF Xf xX] + unfolding index_add_vec(1)[OF i2] + using insert lincomb_def + by auto +qed (insert i, auto) + +(*Generalized version of thm vec_space.mat_of_rows_mult_as_finsum, now in vec_module*) +lemma mat_of_rows_mult_as_finsum: + assumes "v \ carrier_vec (length lst)" "\ i. i < length lst \ lst ! i \ carrier_vec n" + defines "f l \ sum (\ i. if l = lst ! i then v $ i else 0) {0..v v = lincomb f (set lst)" +proof - + from assms have "\ i < length lst. lst ! i \ carrier_vec n" by blast + note an = all_nth_imp_all_set[OF this] hence slc:"set lst \ carrier_vec n" by auto + hence dn [simp]:"\ x. x \ set lst \ dim_vec x = n" by auto + have dl [simp]:"dim_vec (lincomb f (set lst)) = n" using an + by (simp add: slc) + show ?thesis proof + show "dim_vec (mat_of_cols n lst *\<^sub>v v) = dim_vec (lincomb f (set lst))" using assms(1,2) by auto + fix i assume i:"i < dim_vec (lincomb f (set lst))" hence i':"i < n" by auto + with an have fcarr:"(\v. f v \\<^sub>v v) \ set lst \ carrier_vec n" by auto + from i' have "(mat_of_cols n lst *\<^sub>v v) $ i = row (mat_of_cols n lst) i \ v" by auto + also have "\ = (\ia = 0.. = (\ia = 0.. = (\x\set lst. f x * x $ i)" + unfolding f_def sum_distrib_right apply (subst sum.swap) + apply(rule sum.cong[OF refl]) + unfolding if_distrib if_distribR mult_zero_left sum.delta[OF finite_set] by auto + also have "\ = (\x\set lst. (f x \\<^sub>v x) $ i)" + apply(rule sum.cong[OF refl],subst index_smult_vec) using i slc by auto + also have "\ = (\\<^bsub>V\<^esub>v\set lst. f v \\<^sub>v v) $ i" + unfolding finsum_index[OF i' fcarr slc] by auto + finally show "(mat_of_cols n lst *\<^sub>v v) $ i = lincomb f (set lst) $ i" + by (auto simp:lincomb_def) + qed +qed + + +lemma lattice_of_altdef_lincomb: + assumes "set fs \ carrier_vec n" + shows "lattice_of fs = {y. \f. lincomb (of_int \ f) (set fs) = y}" + unfolding lincomb_def lattice_of_altdef[OF assms] image_def by auto + +end + +context vec_module +begin + +(*Generalized version of thm idom_vec.lincomb_as_lincomb_list, now in vec_module*) +lemma lincomb_as_lincomb_list: + fixes ws f + assumes s: "set ws \ carrier_vec n" + shows "lincomb f (set ws) = lincomb_list (\i. if \jv. v \ set ws \ v \ carrier_vec n" using snoc.prems(1) by auto + then have ws: "set ws \ carrier_vec n" by auto + have hyp: "lincomb f (set ws) = lincomb_list ?f ws" + by (intro snoc.hyps ws) + show ?case + proof (cases "a\set ws") + case True + have g_length: "?g (length ws) = 0\<^sub>v n" using True + by (auto, metis in_set_conv_nth nth_append) + have "(map ?g [0..v n]" using g_length by simp + finally have map_rw: "(map ?g [0..v n]" . + have "M.sumlist (map ?g2 [0..v n " + by (metis M.r_zero calculation hyp lincomb_closed lincomb_list_def ws) + also have "... = M.sumlist (map ?g [0..v n])" + by (rule M.sumlist_snoc[symmetric], auto simp add: nth_append) + finally have summlist_rw: "M.sumlist (map ?g2 [0..v n])" . + have "lincomb f (set (ws @ [a])) = lincomb f (set ws)" using True unfolding lincomb_def + by (simp add: insert_absorb) + thus ?thesis + unfolding hyp lincomb_list_def map_rw summlist_rw + by auto + next + case False + have g_length: "?g (length ws) = f a \\<^sub>v a" using False by (auto simp add: nth_append) + have "(map ?g [0..\<^sub>v a)]" using g_length by simp + finally have map_rw: "(map ?g [0..\<^sub>v a)]" . + have summlist_rw: "M.sumlist (map ?g2 [0..\<^bsub>V\<^esub>v\set (a # ws). f v \\<^sub>v v)" unfolding lincomb_def .. + also have "... = (\\<^bsub>V\<^esub>v\ insert a (set ws). f v \\<^sub>v v)" by simp + also have "... = (f a \\<^sub>v a) + (\\<^bsub>V\<^esub>v\ (set ws). f v \\<^sub>v v)" + proof (rule finsum_insert) + show "finite (set ws)" by auto + show "a \ set ws" using False by auto + show "(\v. f v \\<^sub>v v) \ set ws \ carrier_vec n" + using snoc.prems(1) by auto + show "f a \\<^sub>v a \ carrier_vec n" using snoc.prems by auto + qed + also have "... = (f a \\<^sub>v a) + lincomb f (set ws)" unfolding lincomb_def .. + also have "... = (f a \\<^sub>v a) + lincomb_list ?f ws" using hyp by auto + also have "... = lincomb_list ?f ws + (f a \\<^sub>v a)" + using M.add.m_comm lincomb_list_carrier snoc.prems by auto + also have "... = lincomb_list (\i. if \j carrier_vec n" using snoc.prems + by (auto simp add: nth_append) + show "f a \\<^sub>v a \ carrier_vec n" + using snoc.prems by auto + qed + finally show ?thesis . + qed +qed auto +end + +context +begin + +interpretation vec_module "TYPE(int)" . + +lemma lattice_of_cols_as_mat_mult: + assumes A: "A \ carrier_mat n nc" (*Integer matrix*) + shows "lattice_of (cols A) = {y\carrier_vec (dim_row A). \x\carrier_vec (dim_col A). A *\<^sub>v x = y}" +proof - + let ?ws = "cols A" + have set_cols_in: "set (cols A) \ carrier_vec n" using A unfolding cols_def by auto + have "lincomb (of_int \ f)(set ?ws) \ carrier_vec (dim_row A)" for f + using lincomb_closed A + by (metis (full_types) carrier_matD(1) cols_dim lincomb_closed) + moreover have "\x\carrier_vec (dim_col A). A *\<^sub>v x = lincomb (of_int \ f) (set (cols A))" for f + proof - + let ?g = "(\v. of_int (f v))" + let ?g' = "(\i. if \j f) (set (cols A)) = lincomb ?g (set ?ws)" unfolding o_def by auto + also have "... = lincomb_list ?g' ?ws" + by (rule lincomb_as_lincomb_list[OF set_cols_in]) + also have "... = mat_of_cols n ?ws *\<^sub>v vec (length ?ws) ?g'" + by (rule lincomb_list_as_mat_mult, insert set_cols_in A, auto) + also have "... = A *\<^sub>v (vec (length ?ws) ?g')" using mat_of_cols_cols A by auto + finally show ?thesis by auto + qed + moreover have "\f. A *\<^sub>v x = lincomb (of_int \ f) (set (cols A))" + if Ax: "A *\<^sub>v x \ carrier_vec (dim_row A)" and x: "x \ carrier_vec (dim_col A)" for x + proof - + let ?c = "\i. x $ i" + have x_vec: "vec (length ?ws) ?c = x" using x by auto + have "A *\<^sub>v x = mat_of_cols n ?ws *\<^sub>v vec (length ?ws) ?c" using mat_of_cols_cols A x_vec by auto + also have "... = lincomb_list ?c ?ws" + by (rule lincomb_list_as_mat_mult[symmetric], insert set_cols_in A, auto) + also have "... = lincomb (mk_coeff ?ws ?c) (set ?ws)" + by (rule lincomb_list_as_lincomb, insert set_cols_in A, auto) + finally show ?thesis by auto + qed + ultimately show ?thesis unfolding lattice_of_altdef_lincomb[OF set_cols_in] + by (metis (mono_tags, hide_lams)) +qed + + +corollary lattice_of_as_mat_mult: + assumes fs: "set fs \ carrier_vec n" + shows "lattice_of fs = {y\carrier_vec n. \x\carrier_vec (length fs). (mat_of_cols n fs) *\<^sub>v x = y}" +proof - + have cols_eq: "cols (mat_of_cols n fs) = fs" using cols_mat_of_cols[OF fs] by simp + have m: "(mat_of_cols n fs) \ carrier_mat n (length fs)" using mat_of_cols_carrier(1) by auto + show ?thesis using lattice_of_cols_as_mat_mult[OF m] unfolding cols_eq using m by auto +qed +end + +context vec_space +begin + +lemma lin_indpt_cols_imp_det_not_0: + fixes A::"'a mat" + assumes A: "A \ carrier_mat n n" and li: "lin_indpt (set (cols A))" and d: "distinct (cols A)" + shows "det A \ 0" + using A li d det_rank_iff lin_indpt_full_rank by blast + +corollary lin_indpt_rows_imp_det_not_0: + fixes A::"'a mat" + assumes A: "A \ carrier_mat n n" and li: "lin_indpt (set (rows A))" and d: "distinct (rows A)" + shows "det A \ 0" + using A li d det_rank_iff lin_indpt_full_rank + by (metis (full_types) Determinant.det_transpose cols_transpose transpose_carrier_mat) +end + +context LLL +begin + +lemma eq_lattice_imp_mat_mult_invertible_cols: + assumes fs: "set fs \ carrier_vec n" + and gs: "set gs \ carrier_vec n" and ind_fs: "lin_indep fs" (*fs is a basis*) + and length_fs: "length fs = n" and length_gs: "length gs = n" (*For the moment, only valid for square matrices*) + and l: "lattice_of fs = lattice_of gs" +shows "\Q \ carrier_mat n n. invertible_mat Q \ mat_of_cols n fs = mat_of_cols n gs * Q" +proof (cases "n=0") + case True + show ?thesis + by (rule bexI[of _ "1\<^sub>m 0"], insert True assms, auto) +next + case False + hence n: "0 carrier_mat n n" by (simp add: length_fs carrier_matI) + let ?f = "(\i. SOME x. x\carrier_vec (length gs) \ (mat_of_cols n gs) *\<^sub>v x = fs ! i)" + let ?cols_Q = "map ?f [0.. carrier_mat n n" using length_fs by auto + show fs_gs_Q: "mat_of_cols n fs = mat_of_cols n gs * ?Q" + proof (rule mat_col_eqI) + fix j assume j: "j < dim_col (mat_of_cols n gs * ?Q)" + have j2: "j lattice_of gs" using fs l basis_in_latticeI j by auto + have fs_j_carrier_vec: "fs ! j \ carrier_vec n" + using fs_j_in_gs gs lattice_of_as_mat_mult by blast + let ?x = "SOME x. x\carrier_vec (length gs) \ (mat_of_cols n gs) *\<^sub>v x = fs ! j" + have "?x\carrier_vec (length gs) \ (mat_of_cols n gs) *\<^sub>v ?x = fs ! j" + by (rule someI_ex, insert fs_j_in_gs lattice_of_as_mat_mult[OF gs], auto) + hence x: "?x \ carrier_vec (length gs)" + and gs_x: "(mat_of_cols n gs) *\<^sub>v ?x = fs ! j" by blast+ + have "col ?Q j = ?cols_Q ! j" + proof (rule col_mat_of_cols) + show "j < length (map ?f [0.. carrier_vec n" using x length_gs by auto + finally show "map ?f [0.. carrier_vec n" . + qed + also have "... = ?f ([0..v ?x" using gs_x by auto + also have "... = (mat_of_cols n gs) *\<^sub>v (col ?Q j)" unfolding col_Qj_x by simp + also have "... = col (mat_of_cols n gs * ?Q) j" + by (rule col_mult2[symmetric, OF _ Q j2], insert length_gs mat_of_cols_def, auto) + finally show "col (mat_of_cols n fs) j = col (mat_of_cols n gs * ?Q) j" . + qed (insert length_gs gs, auto) + show "invertible_mat ?Q" + (* Sketch of the proof: + 1) fs = gs * Q, proved previously + 2) gs = fs * Q', similar proof as the previous one. + 3) fs = fs * Q' * Q + 4) fs * (?Q' * ?Q - 1\<^sub>m n) = 0\<^sub>m n n and hence (?Q' * ?Q - 1\<^sub>m n) = 0 since fs independent + 5) det ?Q' = det ?Q = det 1 = 1, then det ?Q = \1 and ?Q invertible since the determinant + divides a unit. + *) + proof - + let ?f' = "(\i. SOME x. x\carrier_vec (length fs) \ (mat_of_cols n fs) *\<^sub>v x = gs ! i)" + let ?cols_Q' = "map ?f' [0.. carrier_mat n n" using length_gs by auto + have gs_fs_Q': "mat_of_cols n gs = mat_of_cols n fs * ?Q'" + proof (rule mat_col_eqI) + fix j assume j: "j < dim_col (mat_of_cols n fs * ?Q')" + have j2: "j lattice_of fs" using gs l basis_in_latticeI j by auto + have gs_j_carrier_vec: "gs ! j \ carrier_vec n" + using gs_j_in_fs fs lattice_of_as_mat_mult by blast + let ?x = "SOME x. x\carrier_vec (length fs) \ (mat_of_cols n fs) *\<^sub>v x = gs ! j" + have "?x\carrier_vec (length fs) \ (mat_of_cols n fs) *\<^sub>v ?x = gs ! j" + by (rule someI_ex, insert gs_j_in_fs lattice_of_as_mat_mult[OF fs], auto) + hence x: "?x \ carrier_vec (length fs)" + and fs_x: "(mat_of_cols n fs) *\<^sub>v ?x = gs ! j" by blast+ + have "col ?Q' j = ?cols_Q' ! j" + proof (rule col_mat_of_cols) + show "j < length (map ?f' [0.. carrier_vec n" using x length_fs by auto + finally show "map ?f' [0.. carrier_vec n" . + qed + also have "... = ?f' ([0..v ?x" using fs_x by auto + also have "... = (mat_of_cols n fs) *\<^sub>v (col ?Q' j)" unfolding col_Qj_x by simp + also have "... = col (mat_of_cols n fs * ?Q') j" + by (rule col_mult2[symmetric, OF _ Q' j2], insert length_fs mat_of_cols_def, auto) + finally show "col (mat_of_cols n gs) j = col (mat_of_cols n fs * ?Q') j" . + qed (insert length_fs fs, auto) + + have det_fs_not_zero: "rat_of_int (det (mat_of_cols n fs)) \ 0" + proof - + let ?A = "(of_int_hom.mat_hom (mat_of_cols n fs)):: rat mat" + have "rat_of_int (det (mat_of_cols n fs)) = det ?A" + by simp + moreover have "det ?A \ 0" + proof (rule gs.lin_indpt_cols_imp_det_not_0[of ?A]) + have c_eq: "(set (cols ?A)) = set (RAT fs)" + by (metis assms(3) cof_vec_space.lin_indpt_list_def cols_mat_of_cols fs mat_of_cols_map) + show "?A \ carrier_mat n n" by (simp add: fs_carrier) + show "gs.lin_indpt (set (cols ?A))" using ind_RAT_fs c_eq by auto + show "distinct (cols ?A)" + by (metis ind_fs cof_vec_space.lin_indpt_list_def cols_mat_of_cols fs mat_of_cols_map) + qed + ultimately show ?thesis by auto + qed + have Q'Q: "?Q' * ?Q \ carrier_mat n n" using Q Q' mult_carrier_mat by blast + have fs_fs_Q'Q: "mat_of_cols n fs = mat_of_cols n fs * ?Q' * ?Q" using gs_fs_Q' fs_gs_Q by presburger + hence "0\<^sub>m n n = mat_of_cols n fs * ?Q' * ?Q - mat_of_cols n fs" using length_fs by auto + also have "... = mat_of_cols n fs * ?Q' * ?Q - mat_of_cols n fs * 1\<^sub>m n" + using fs_carrier by auto + also have "... = mat_of_cols n fs * (?Q' * ?Q) - mat_of_cols n fs * 1\<^sub>m n" + using Q Q' fs_carrier by auto + also have "... = mat_of_cols n fs * (?Q' * ?Q - 1\<^sub>m n)" + by (rule mult_minus_distrib_mat[symmetric, OF fs_carrier Q'Q], auto) + finally have "mat_of_cols n fs * (?Q' * ?Q - 1\<^sub>m n) = 0\<^sub>m n n" .. + have "det (?Q' * ?Q) = 1" + by (smt Determinant.det_mult Q Q' Q'Q fs_fs_Q'Q assoc_mult_mat det_fs_not_zero + fs_carrier mult_cancel_left2 of_int_code(2)) + hence det_Q'_Q_1: "det ?Q * det ?Q' = 1" + by (metis (no_types, lifting) Determinant.det_mult Groups.mult_ac(2) Q Q') + hence "det ?Q = 1 \ det ?Q = -1" by (rule pos_zmult_eq_1_iff_lemma) + thus ?thesis using invertible_iff_is_unit_JNF[OF Q] by fastforce + qed + qed +qed + + +corollary eq_lattice_imp_mat_mult_invertible_rows: + assumes fs: "set fs \ carrier_vec n" + and gs: "set gs \ carrier_vec n" and ind_fs: "lin_indep fs" (*fs is a basis*) + and length_fs: "length fs = n" and length_gs: "length gs = n" (*For the moment, only valid for square matrices*) + and l: "lattice_of fs = lattice_of gs" +shows "\P \ carrier_mat n n. invertible_mat P \ mat_of_rows n fs = P * mat_of_rows n gs" +proof - + obtain Q where Q: "Q \ carrier_mat n n" and inv_Q: "invertible_mat Q" + and fs_gs_Q: "mat_of_cols n fs = mat_of_cols n gs * Q" + using eq_lattice_imp_mat_mult_invertible_cols[OF assms] by auto + have "invertible_mat Q\<^sup>T" by (simp add: inv_Q invertible_mat_transpose) + moreover have "mat_of_rows n fs = Q\<^sup>T * mat_of_rows n gs" using fs_gs_Q + by (metis Matrix.transpose_mult Q length_gs mat_of_cols_carrier(1) transpose_mat_of_cols) + moreover have "Q\<^sup>T \ carrier_mat n n" using Q by auto + ultimately show ?thesis by blast +qed +end + +subsubsection \Missing results\ + +text \This is a new definition for upper triangular matrix, valid for rectangular matrices. +This definition will allow us to prove that echelon form implies upper triangular for any matrix.\ + +definition "upper_triangular' A = (\i < dim_row A. \ j A $$ (i,j) = 0)" + +lemma upper_triangular'D[elim] : + "upper_triangular' A \ j j < i \ i < dim_row A \ A $$ (i,j) = 0" +unfolding upper_triangular'_def by auto + +lemma upper_triangular'I[intro] : + "(\i j. j j < i \ i < dim_row A \ A $$ (i,j) = 0) \ upper_triangular' A" + unfolding upper_triangular'_def by auto + +lemma prod_list_abs(*[simp]?*): + fixes xs:: "int list" + shows "prod_list (map abs xs) = abs (prod_list xs)" + by (induct xs, auto simp add: abs_mult) + +lemma euclid_ext2_works: + assumes "euclid_ext2 a b = (p,q,u,v,d)" + shows "p*a+q*b = d" and "d = gcd a b" and "gcd a b * u = -b" and "gcd a b * v = a" + and "u = -b div gcd a b" and "v = a div gcd a b" + using assms unfolding euclid_ext2_def + by (auto simp add: bezout_coefficients_fst_snd) + +lemma res_function_euclidean2: + "res_function (\b n::'a::{unique_euclidean_ring}. n mod b)" +proof- + have "n mod b = n" if "b=0" for n b::"'a :: unique_euclidean_ring" using that by auto + hence "res_function_euclidean = (\b n::'a. n mod b)" + by (unfold fun_eq_iff res_function_euclidean_def, auto) + thus ?thesis using res_function_euclidean by auto +qed + +lemma mult_row_1_id: + fixes A:: "'a::semiring_1^'n^'m" + shows "mult_row A b 1 = A" unfolding mult_row_def by vector + +text \Results about appending rows\ + +lemma row_append_rows1: + assumes A: "A \ carrier_mat m n" + and B: "B \ carrier_mat p n" + assumes i: "i < dim_row A" + shows "Matrix.row (A @\<^sub>r B) i = Matrix.row A i" +proof (rule eq_vecI) + have AB_carrier[simp]: "(A @\<^sub>r B) \ carrier_mat (m+p) n" by (rule carrier_append_rows[OF A B]) + thus "dim_vec (Matrix.row (A @\<^sub>r B) i) = dim_vec (Matrix.row A i)" + using A B by (auto, insert carrier_matD(2), blast) + fix j assume j: "j < dim_vec (Matrix.row A i)" + have "Matrix.row (A @\<^sub>r B) i $v j = (A @\<^sub>r B) $$ (i, j)" + by (metis AB_carrier Matrix.row_def j A carrier_matD(2) index_row(2) index_vec) + also have "... = (if i < dim_row A then A $$ (i, j) else B $$ (i - m, j))" + by (rule append_rows_nth, insert assms j, auto) + also have "... = A$$ (i,j)" using i by simp + finally show "Matrix.row (A @\<^sub>r B) i $v j = Matrix.row A i $v j" using i j by simp +qed + +lemma row_append_rows2: + assumes A: "A \ carrier_mat m n" + and B: "B \ carrier_mat p n" + assumes i: "i \ {m..r B) i = Matrix.row B (i - m)" +proof (rule eq_vecI) + have AB_carrier[simp]: "(A @\<^sub>r B) \ carrier_mat (m+p) n" by (rule carrier_append_rows[OF A B]) + thus "dim_vec (Matrix.row (A @\<^sub>r B) i) = dim_vec (Matrix.row B (i-m))" + using A B by (auto, insert carrier_matD(2), blast) + fix j assume j: "j < dim_vec (Matrix.row B (i-m))" + have "Matrix.row (A @\<^sub>r B) i $v j = (A @\<^sub>r B) $$ (i, j)" + by (metis AB_carrier Matrix.row_def j B carrier_matD(2) index_row(2) index_vec) + also have "... = (if i < dim_row A then A $$ (i, j) else B $$ (i - m, j))" + by (rule append_rows_nth, insert assms j, auto) + also have "... = B $$ (i - m, j)" using i A by simp + finally show "Matrix.row (A @\<^sub>r B) i $v j = Matrix.row B (i-m) $v j" using i j A B by auto +qed + + +lemma rows_append_rows: + assumes A: "A \ carrier_mat m n" + and B: "B \ carrier_mat p n" +shows "Matrix.rows (A @\<^sub>r B) = Matrix.rows A @ Matrix.rows B" +proof - + have AB_carrier: "(A @\<^sub>r B) \ carrier_mat (m+p) n" + by (rule carrier_append_rows, insert A B, auto) + hence 1: "dim_row (A @\<^sub>r B) = dim_row A + dim_row B" using A B by blast + moreover have "Matrix.row (A @\<^sub>r B) i = (Matrix.rows A @ Matrix.rows B) ! i" + if i: "i < dim_row (A @\<^sub>r B)" for i + proof (cases "ir B) i = Matrix.row A i" using A True B row_append_rows1 by blast + also have "... = Matrix.rows A ! i" unfolding Matrix.rows_def using True by auto + also have "... = (Matrix.rows A @ Matrix.rows B) ! i" using True by (simp add: nth_append) + finally show ?thesis . + next + case False + have i_mp: "i < m + p" using AB_carrier A B i by fastforce + have "Matrix.row (A @\<^sub>r B) i = Matrix.row B (i-m)" using A False B i row_append_rows2 i_mp + by (smt AB_carrier atLeastLessThan_iff carrier_matD(1) le_add1 + linordered_semidom_class.add_diff_inverse row_append_rows2) + also have "... = Matrix.rows B ! (i-m)" unfolding Matrix.rows_def using False i A 1 by auto + also have "... = (Matrix.rows A @ Matrix.rows B) ! (i-m+m)" + by (metis add_diff_cancel_right' A carrier_matD(1) length_rows not_add_less2 nth_append) + also have "... = (Matrix.rows A @ Matrix.rows B) ! i" using False A by auto + finally show ?thesis . + qed + ultimately show ?thesis unfolding list_eq_iff_nth_eq by auto +qed + + + +lemma append_rows_nth2: + assumes A': "A' \ carrier_mat m n" + and B: "B \ carrier_mat p n" + and A_def: "A = (A' @\<^sub>r B)" + and a: "a carrier_mat m n" + and B: "B \ carrier_mat p n" + and A_def: "A = (A' @\<^sub>r B)" + and a: "a\m" and ap: "a < m + p" and j: "jResults about submatrices\ + +lemma pick_first_id: assumes i: "i {0.. carrier_mat m n" and i: "im" and k2: "k2\n" + shows "(submatrix H {0..m" and kn: "k2\n" using k1 k2 by simp+ + have card_mk: "card {i. i < m \ i < k1} = k1" using km + by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff) + have card_nk: "card {i. i < n \ i < k2} = k2" using kn + by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff) + show ?thesis + proof- + have pick_j: "pick ?J j = j" by (rule pick_first_id[OF j]) + have pick_i: "pick ?I i = i" by (rule pick_first_id[OF i]) + have "submatrix H ?I ?J $$ (i, j) = H $$ (pick ?I i, pick ?J j)" + by (rule submatrix_index, insert H i j card_mk card_nk, auto) + also have "... = H $$ (i,j)" using pick_i pick_j by simp + finally show ?thesis . + qed +qed + +lemma submatrix_carrier_first: + assumes H: "H \ carrier_mat m n" + and k1: "k1 \ m" and k2: "k2 \ n" + shows"submatrix H {0.. carrier_mat k1 k2" +proof - + have km: "k1\m" and kn: "k2\n" using k1 k2 by simp+ + have card_mk: "card {i. i < m \ i < k1} = k1" using km + by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff) + have card_nk: "card {i. i < n \ i < k2} = k2" using kn + by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff) + show ?thesis + by (smt Collect_cong H atLeastLessThan_iff card_mk card_nk carrier_matD + carrier_matI dim_submatrix zero_order(1)) +qed + + + +lemma Units_eq_invertible_mat: + assumes "A \ carrier_mat n n" + shows "A \ Group.Units (ring_mat TYPE('a::comm_ring_1) n b) = invertible_mat A" (is "?lhs = ?rhs") +proof - + interpret m: ring "ring_mat TYPE('a) n b" by (rule ring_mat) + show ?thesis + proof + assume "?lhs" thus "?rhs" + unfolding Group.Units_def + by (insert assms, auto simp add: ring_mat_def invertible_mat_def inverts_mat_def) + next + assume "?rhs" + from this obtain B where AB: "A * B = 1\<^sub>m n" and BA: "B * A = 1\<^sub>m n" and B: "B \ carrier_mat n n" + by (metis assms carrier_matD(1) inverts_mat_def obtain_inverse_matrix) + hence "\x\carrier (ring_mat TYPE('a) n b). x \\<^bsub>ring_mat TYPE('a) n b\<^esub> A = \\<^bsub>ring_mat TYPE('a) n b\<^esub> + \ A \\<^bsub>ring_mat TYPE('a) n b\<^esub> x = \\<^bsub>ring_mat TYPE('a) n b\<^esub>" + unfolding ring_mat_def by auto + thus "?lhs" unfolding Group.Units_def using assms unfolding ring_mat_def by auto + qed +qed + +lemma map_first_rows_index: + assumes "A \ carrier_mat M n" and "m \ M" and "i carrier_mat (m+p) n" and B: "B \ carrier_mat p n" + and eq: "\i\{m..j [0..r B" (is "_ = ?A' @\<^sub>r _") +proof (rule eq_matI) + have A': "?A' \ carrier_mat m n" by (simp add: mat_of_rows_def) + hence A'B: "?A' @\<^sub>r B \ carrier_mat (m+p) n" using B by blast + show "dim_row A = dim_row (?A' @\<^sub>r B)" and "dim_col A = dim_col (?A' @\<^sub>r B)" using A'B A by auto + fix i j assume i: "i < dim_row (?A' @\<^sub>r B)" + and j: "j < dim_col (?A' @\<^sub>r B)" + have jn: "jr B) $$ (i, j)" + proof (cases "ir B) $$ (i, j) = ?A' $$ (i,j)" + by (metis (no_types, lifting) Nat.add_0_right True append_rows_def diff_zero i + index_mat_four_block index_zero_mat(3) j length_map length_upt mat_of_rows_carrier(2)) + also have "... = ?xs ! i $v j" + by (rule mat_of_rows_index, insert i True j, auto simp add: append_rows_def) + also have "... = A $$ (i,j)" + by (rule map_first_rows_index, insert assms A True i jn, auto) + finally show ?thesis .. + next + case False + have "(?A' @\<^sub>r B) $$ (i, j) = B $$ (i-m,j)" + by (smt (z3) A' carrier_matD(1) False append_rows_def i index_mat_four_block j jn length_map + length_upt mat_of_rows_carrier(2,3)) + also have "... = A $$ (i,j)" + by (metis False append_rows_def B eq atLeastLessThan_iff carrier_matD(1) diff_zero i + index_mat_four_block(2) index_zero_mat(2) jn le_add1 length_map length_upt + linordered_semidom_class.add_diff_inverse mat_of_rows_carrier(2)) + finally show ?thesis .. + qed +qed + +lemma invertible_mat_first_column_not0: + fixes A::"'a :: comm_ring_1 mat" + assumes A: "A \ carrier_mat n n" and inv_A: "invertible_mat A" and n0: "0 (0\<^sub>v n)" +proof (rule ccontr) + assume " \ col A 0 \ 0\<^sub>v n" hence col_A0: "col A 0 = 0\<^sub>v n" by simp + have "(det A dvd 1)" using inv_A invertible_iff_is_unit_JNF[OF A] by auto + hence 1: "det A \ 0" by auto + have "det A = (\i carrier_mat n n" + and "B \ carrier_mat n n" + and "invertible_mat P" + and "invertible_mat (map_mat rat_of_int B)" + shows "invertible_mat (map_mat rat_of_int A)" + by (metis (no_types, hide_lams) assms dvd_field_iff + invertible_iff_is_unit_JNF invertible_mult_JNF map_carrier_mat not_is_unit_0 + of_int_hom.hom_0 of_int_hom.hom_det of_int_hom.mat_hom_mult) + + +lemma echelon_form_JNF_intro: + assumes "(\i \ (\j. j < dim_row A \ j>i \ \ is_zero_row_JNF j A))" + and "(\i j. i j \ (is_zero_row_JNF i A) \ \ (is_zero_row_JNF j A) + \ ((LEAST n. A $$ (i, n) \ 0) < (LEAST n. A $$ (j, n) \ 0)))" + shows "echelon_form_JNF A" using assms unfolding echelon_form_JNF_def by simp + + +lemma echelon_form_submatrix: + assumes ef_H: "echelon_form_JNF H" and H: "H \ carrier_mat m n" + and k: "k \ min m n" +shows "echelon_form_JNF (submatrix H {0..m" and kn: "k\n" using k by simp+ + have card_mk: "card {i. i < m \ i < k} = k" using km + by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff) + have card_nk: "card {i. i < n \ i < k} = k" using kn + by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff) + have H_ij: "H $$ (i,j) = (submatrix H ?I ?I) $$ (i,j)" if i: "i carrier_mat k k" + using H dim_submatrix[of H "{0.. is_zero_row_JNF j ?H" + define a where "a = (LEAST n. ?H $$ (j,n) \ 0)" + have H'_ja: "?H $$ (j,a) \ 0" + by (metis (mono_tags) LeastI j_not0_H' a_def is_zero_row_JNF_def) + have a: "a < dim_col ?H" + by (smt j_not0_H' a_def is_zero_row_JNF_def linorder_neqE_nat not_less_Least order_trans_rules(19)) + have j_not0_H: "\ is_zero_row_JNF j H" + by (metis H' H'_ja H_ij a assms(2) basic_trans_rules(19) carrier_matD is_zero_row_JNF_def j kn le_eq_less_or_eq) + hence i_not0_H: "\ is_zero_row_JNF i H" using ef_H j ij unfolding echelon_form_JNF_def + by (metis H' \\ is_zero_row_JNF j H\ assms(2) carrier_matD(1) ij j km + not_less_iff_gr_or_eq order.strict_trans order_trans_rules(21)) + hence least_ab: "(LEAST n. H $$ (i, n) \ 0) < (LEAST n. H $$ (j, n) \ 0)" using jm + using j_not0_H assms(2) echelon_form_JNF_def ef_H ij by blast + define b where "b = (LEAST n. H $$ (i, n) \ 0)" + have H_ib: "H $$ (i, b) \ 0" + by (metis (mono_tags, lifting) LeastI b_def i_not0_H is_zero_row_JNF_def) + have b: "b < dim_col ?H" using least_ab a unfolding a_def b_def + by (metis (mono_tags, lifting) H' H'_ja H_ij a_def carrier_matD dual_order.strict_trans j nat_neq_iff not_less_Least) + have H'_ib: "?H $$ (i,b) \ 0" using H_ib b H_ij H' ij j + by (metis H' carrier_matD dual_order.strict_trans ij j) + hence "\ is_zero_row_JNF i ?H" using b is_zero_row_JNF_def by blast + thus False using iH'_0 by contradiction + qed + next + fix i j assume ij: "i < j" and j: "j < dim_row ?H" + have jm: "j is_zero_row_JNF i ?H" + and not0_jH': "\ is_zero_row_JNF j ?H" + define a where "a = (LEAST n. ?H $$ (i, n) \ 0)" + define b where "b = (LEAST n. ?H $$ (j, n) \ 0)" + have H'_ia: "?H $$ (i,a) \ 0" + by (metis (mono_tags) LeastI_ex a_def is_zero_row_JNF_def not0_iH') + have H'_jb: "?H $$ (j,b) \ 0" + by (metis (mono_tags) LeastI_ex b_def is_zero_row_JNF_def not0_jH') + have a: "a < dim_row ?H" + by (smt H' a_def carrier_matD is_zero_row_JNF_def less_trans linorder_neqE_nat not0_iH' not_less_Least) + have b: "b < dim_row ?H" + by (smt H' b_def carrier_matD is_zero_row_JNF_def less_trans linorder_neqE_nat not0_jH' not_less_Least) + have a_eq: "a = (LEAST n. H $$ (i, n) \ 0)" + by (smt H' H'_ia H_ij LeastI_ex a a_def carrier_matD(1) ij j linorder_neqE_nat not_less_Least order_trans_rules(19)) + have b_eq: "b = (LEAST n. H $$ (j, n) \ 0)" + by (smt H' H'_jb H_ij LeastI_ex b b_def carrier_matD(1) ij j linorder_neqE_nat not_less_Least order_trans_rules(19)) + have not0_iH: "\ is_zero_row_JNF i H" + by (metis H' H'_ia H_ij a H carrier_matD ij is_zero_row_JNF_def j kn le_eq_less_or_eq order.strict_trans) + have not0_jH: "\ is_zero_row_JNF j H" + by (metis H' H'_jb H_ij b H carrier_matD is_zero_row_JNF_def j kn le_eq_less_or_eq order.strict_trans) + show "(LEAST n. ?H $$ (i, n) \ 0) < (LEAST n. ?H $$ (j, n) \ 0)" + unfolding a_def[symmetric] b_def[symmetric] a_eq b_eq using not0_iH not0_jH ef_H ij jm H + unfolding echelon_form_JNF_def by auto + qed +qed + + +lemma HNF_submatrix: + assumes HNF_H: "Hermite_JNF associates res H" and H: "H \ carrier_mat m n" + and k: "k \ min m n" + shows "Hermite_JNF associates res (submatrix H {0..m" and kn: "k\n" using k by simp+ + have card_mk: "card {i. i < m \ i < k} = k" using km + by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff) + have card_nk: "card {i. i < n \ i < k} = k" using kn + by (smt Collect_cong card_Collect_less_nat le_eq_less_or_eq nat_less_induct nat_neq_iff) + have H_ij: "H $$ (i,j) = (submatrix H ?I ?I) $$ (i,j)" if i: "i carrier_mat k k" + using H dim_submatrix[of H "{0.. 0) \ associates" + and HNF2: "(\j 0) + \ res (?H $$ (i, LEAST n. ?H $$ (i, n) \ 0)))" + if i: "i is_zero_row_JNF i ?H" for i + proof - + define a where "a = (LEAST n. ?H $$ (i, n) \ 0)" + have im: "i 0" + by (metis (mono_tags) LeastI_ex a_def is_zero_row_JNF_def not0_iH') + have a: "a < dim_row ?H" + by (smt H' a_def carrier_matD is_zero_row_JNF_def less_trans linorder_neqE_nat not0_iH' not_less_Least) + have a_eq: "a = (LEAST n. H $$ (i, n) \ 0)" + by (smt H' H'_ia H_ij LeastI_ex a a_def carrier_matD(1) i linorder_neqE_nat not_less_Least order_trans_rules(19)) + have H'_ia_H_ia: "?H $$ (i, a) = H $$ (i, a)" by (metis H' H_ij a carrier_matD(1) i) + have not'_iH: "\ is_zero_row_JNF i H" + by (metis H' H'_ia H'_ia_H_ia a assms(2) carrier_matD(1) carrier_matD(2) is_zero_row_JNF_def kn order.strict_trans2) + thus "?H $$ (i, LEAST n. ?H $$ (i, n) \ 0) \ associates" using im + by (metis H'_ia_H_ia Hermite_JNF_def a_def a_eq HNF_H H carrier_matD(1)) + show "(\j 0) + \ res (?H $$ (i, LEAST n. ?H $$ (i, n) \ 0)))" + proof - + { fix nn :: nat + have ff1: "\n. ?H $$ (n, a) = H $$ (n, a) \ \ n < k" + by (metis (no_types) H' H_ij a carrier_matD(1)) + have ff2: "i < k" + by (metis H' carrier_matD(1) that(1)) + then have "H $$ (nn, a) \ res (H $$ (i, a)) \ H $$ (nn, a) \ res (?H $$ (i, a))" + using ff1 by (metis (no_types)) + moreover + { assume "H $$ (nn, a) \ res (?H $$ (i, a))" + then have "?H $$ (nn, a) = H $$ (nn, a) \ ?H $$ (nn, a) \ res (?H $$ (i, a))" + by presburger + then have "\ nn < i \ ?H $$ (nn, LEAST n. ?H $$ (i, n) \ 0) \ res (?H $$ (i, LEAST n. ?H $$ (i, n) \ 0))" + using ff2 ff1 a_def order.strict_trans by blast } + ultimately have "\ nn < i \ ?H $$ (nn, LEAST n. ?H $$ (i, n) \ 0) \ res (?H $$ (i, LEAST n. ?H $$ (i, n) \ 0))" + using Hermite_JNF_def a_eq assms(1) assms(2) im not'_iH by blast } + then show ?thesis + by meson + qed + qed + show ?thesis using HNF1 HNF2 ef_H' CS_res CS_ass unfolding Hermite_JNF_def by blast +qed + +lemma HNF_of_HNF_id: + fixes H :: "int mat" + assumes HNF_H: "Hermite_JNF associates res H" + and H: "H \ carrier_mat n n" + and H_P1_H1: "H = P1 * H1" + and inv_P1: "invertible_mat P1" + and H1: "H1 \ carrier_mat n n" + and P1: "P1 \ carrier_mat n n" + and HNF_H1: "Hermite_JNF associates res H1" + and inv_H: "invertible_mat (map_mat rat_of_int H)" + shows "H1 = H" +proof (rule HNF_unique_generalized_JNF[OF H P1 H1 _ H H_P1_H1]) + show "H = (1\<^sub>m n) * H" using H by auto +qed (insert assms, auto) + + +(*Some of the following lemmas could be moved outside this context*) + +context + fixes n :: nat +begin + +interpretation vec_module "TYPE(int)" . + +lemma lattice_is_monotone: + fixes S T + assumes S: "set S \ carrier_vec n" + assumes T: "set T \ carrier_vec n" + assumes subs: "set S \ set T" + shows "lattice_of S \ lattice_of T" +proof - + have "\fa. lincomb fa (set T) = lincomb f (set S)" for f + proof - + let ?f = "\i. if i \ set T - set S then 0 else f i" + have set_T_eq: "set T = set S \ (set T - set S)" using subs by blast + have l0: "lincomb ?f (set T - set S) = 0\<^sub>v n" by (rule lincomb_zero, insert T, auto) + have "lincomb ?f (set T) = lincomb ?f (set S \ (set T - set S))" using set_T_eq by simp + also have "... = lincomb ?f (set S) + lincomb ?f (set T - set S)" + by (rule lincomb_union, insert S T subs, auto) + also have "... = lincomb ?f (set S)" using l0 by (auto simp add: S) + also have "... = lincomb f (set S)" using S by fastforce + finally show ?thesis by blast + qed + thus ?thesis unfolding lattice_of_altdef_lincomb[OF S] lattice_of_altdef_lincomb[OF T] + by auto +qed + +lemma lattice_of_append: + assumes fs: "set fs \ carrier_vec n" + assumes gs: "set gs \ carrier_vec n" + shows "lattice_of (fs @ gs) = lattice_of (gs @ fs)" +proof - + have fsgs: "set (fs @ gs) \ carrier_vec n" using fs gs by auto + have gsfs: "set (gs @ fs) \ carrier_vec n" using fs gs by auto + show ?thesis + unfolding lattice_of_altdef_lincomb[OF fsgs] lattice_of_altdef_lincomb[OF gsfs] + by auto (metis Un_commute)+ +qed + +lemma lattice_of_append_cons: + assumes fs: "set fs \ carrier_vec n" and v: "v \ carrier_vec n" + shows "lattice_of (v # fs) = lattice_of (fs @ [v])" +proof - + have v_fs: "set (v # fs) \ carrier_vec n" using fs v by auto + hence fs_v: "set (fs @ [v]) \ carrier_vec n" by simp + show ?thesis + unfolding lattice_of_altdef_lincomb[OF v_fs] lattice_of_altdef_lincomb[OF fs_v] by auto +qed + +lemma already_in_lattice_subset: + assumes fs: "set fs \ carrier_vec n" and inlattice: "v \ lattice_of fs" + and v: "v \ carrier_vec n" + shows "lattice_of (v # fs) \ lattice_of fs" +proof (cases "v\set fs") + case True + then show ?thesis + by (metis fs lattice_is_monotone set_ConsD subset_code(1)) +next + case False note v_notin_fs = False + obtain g where v_g: "lincomb g (set fs) = v" + using lattice_of_altdef_lincomb[OF fs] inlattice by auto + have v_fs: "set (v # fs) \ carrier_vec n" using v fs by auto + have "\fa. lincomb fa (set fs) = lincomb f (insert v (set fs))" for f + proof - + have smult_rw: "f v \\<^sub>v (lincomb g (set fs)) = lincomb (\w. f v * g w) (set fs)" + by (rule lincomb_smult[symmetric, OF fs]) + have "lincomb f (insert v (set fs)) = f v \\<^sub>v v + lincomb f (set fs)" + by (rule lincomb_insert2[OF _ fs _ v_notin_fs v], auto) + also have "... = f v \\<^sub>v (lincomb g (set fs)) + lincomb f (set fs)" using v_g by simp + also have "... = lincomb (\w. f v * g w) (set fs) + lincomb f (set fs)" + unfolding smult_rw by auto + also have "... = lincomb (\w. (\w. f v * g w) w + f w) (set fs)" + by (rule lincomb_sum[symmetric, OF _ fs], simp) + finally show ?thesis by auto + qed + thus ?thesis unfolding lattice_of_altdef_lincomb[OF v_fs] lattice_of_altdef_lincomb[OF fs] by auto +qed + + +lemma already_in_lattice: + assumes fs: "set fs \ carrier_vec n" and inlattice: "v \ lattice_of fs" + and v: "v \ carrier_vec n" + shows "lattice_of fs = lattice_of (v # fs)" +proof - + have dir1: "lattice_of fs \ lattice_of (v # fs)" + by (intro lattice_is_monotone, insert fs v, auto) + moreover have dir2: "lattice_of (v # fs) \ lattice_of fs" + by (rule already_in_lattice_subset[OF assms]) + ultimately show ?thesis by auto +qed + + +lemma already_in_lattice_append: + assumes fs: "set fs \ carrier_vec n" and inlattice: "lattice_of gs \ lattice_of fs" + and gs: "set gs \ carrier_vec n" +shows "lattice_of fs = lattice_of (fs @ gs)" + using assms +proof (induct gs arbitrary: fs) + case Nil + then show ?case by auto +next + case (Cons a gs) + note fs = Cons.prems(1) + note inlattice = Cons.prems(2) + note gs = Cons.prems(3) + have gs_in_fs: "lattice_of gs \ lattice_of fs" + by (meson basic_trans_rules(23) gs lattice_is_monotone local.Cons(3) set_subset_Cons) + have a: "a \ lattice_of (fs @ gs)" + using basis_in_latticeI fs gs gs_in_fs local.Cons(1) local.Cons(3) by auto + have "lattice_of (fs @ a # gs) = lattice_of ((a # gs) @ fs)" + by (rule lattice_of_append, insert fs gs, auto) + also have "... = lattice_of (a # (gs @ fs))" by auto + also have "... = lattice_of (a # (fs @ gs))" + by (rule lattice_of_eq_set, insert gs fs, auto) + also have "... = lattice_of (fs @ gs)" + by (rule already_in_lattice[symmetric, OF _ a], insert fs gs, auto) + also have "... = lattice_of fs" by (rule Cons.hyps[symmetric, OF fs gs_in_fs], insert gs, auto) + finally show ?case .. +qed + +lemma zero_in_lattice: + assumes fs_carrier: "set fs \ carrier_vec n" + shows "0\<^sub>v n \ lattice_of fs" +proof - + have "\f. lincomb (\v. 0 * f v) (set fs) = 0\<^sub>v n" + using fs_carrier lincomb_closed lincomb_smult lmult_0 by presburger + hence "lincomb (\i. 0) (set fs) = 0\<^sub>v n" by fastforce + thus ?thesis unfolding lattice_of_altdef_lincomb[OF fs_carrier] by auto +qed + + +lemma lattice_zero_rows_subset: + assumes H: "H \ carrier_mat a n" + shows "lattice_of (Matrix.rows (0\<^sub>m m n)) \ lattice_of (Matrix.rows H)" +proof + let ?fs = "Matrix.rows (0\<^sub>m m n)" + let ?gs = "Matrix.rows H" + have fs_carrier: "set ?fs \ carrier_vec n" unfolding Matrix.rows_def by auto + have gs_carrier: "set ?gs \ carrier_vec n" using H unfolding Matrix.rows_def by auto + fix x assume x: "x \ lattice_of (Matrix.rows (0\<^sub>m m n))" + obtain f where fx: "lincomb (of_int \ f) (set (Matrix.rows (0\<^sub>m m n))) = x" + using x lattice_of_altdef_lincomb[OF fs_carrier] by blast + have "lincomb (of_int \ f) (set (Matrix.rows (0\<^sub>m m n))) = 0\<^sub>v n" + unfolding lincomb_def by (rule M.finsum_all0, unfold Matrix.rows_def, auto) + hence "x = 0\<^sub>v n" using fx by auto + thus "x \ lattice_of (Matrix.rows H)" using zero_in_lattice[OF gs_carrier] by auto +qed + +(*TODO: move outside this context (the previous lemmas too)*) +lemma lattice_of_append_zero_rows: + assumes H': "H' \ carrier_mat m n" + and H: "H = H' @\<^sub>r (0\<^sub>m m n)" +shows "lattice_of (Matrix.rows H) = lattice_of (Matrix.rows H')" +proof - + have "Matrix.rows H = Matrix.rows H' @ Matrix.rows (0\<^sub>m m n)" + by (unfold H, rule rows_append_rows[OF H'], auto) + also have "lattice_of ... = lattice_of (Matrix.rows H')" + proof (rule already_in_lattice_append[symmetric]) + show "lattice_of (Matrix.rows (0\<^sub>m m n)) \ lattice_of (Matrix.rows H')" + by (rule lattice_zero_rows_subset[OF H']) + qed (insert H', auto simp add: Matrix.rows_def) + finally show ?thesis . +qed +end + +text \Lemmas about echelon form\ + +lemma echelon_form_JNF_1xn: + assumes "A\carrier_mat m n" and "m<2" +shows "echelon_form_JNF A" + using assms unfolding echelon_form_JNF_def is_zero_row_JNF_def by fastforce + + +lemma echelon_form_JNF_mx1: + assumes "A\carrier_mat m n" and "n<2" + and "\i \ {1.. carrier_mat m 0" + shows "echelon_form_JNF A" using assms unfolding echelon_form_JNF_def is_zero_row_JNF_def by auto + +lemma echelon_form_JNF_first_column_0: + assumes eA: "echelon_form_JNF A" and A: "A \ carrier_mat m n" + and i0: "0 0" + hence nz_iA: "\ is_zero_row_JNF i A" using n0 A unfolding is_zero_row_JNF_def by auto + hence nz_0A: "\ is_zero_row_JNF 0 A" using eA A unfolding echelon_form_JNF_def using i0 im by auto + have "(LEAST n. A $$ (0, n) \ 0) < (LEAST n. A $$ (i, n) \ 0)" + using nz_iA nz_0A eA A unfolding echelon_form_JNF_def using i0 im by blast + moreover have "(LEAST n. A $$ (i, n) \ 0) = 0" using Ai0 by simp + ultimately show False by auto +qed + + +lemma is_zero_row_JNF_multrow[simp]: + fixes A::"'a::comm_ring_1 mat" + assumes "ij'ia \ (\j \ is_zero_row_JNF j (multrow i (- 1) A))" + unfolding is_zero_row_JNF_def by simp + have Least_eq: "(LEAST n. multrow i (- 1) A $$ (ia, n) \ 0) = (LEAST n. A $$ (ia, n) \ 0)" + if ia: "ia < dim_row A" and nz_ia_mrA: "\ is_zero_row_JNF ia (multrow i (- 1) A)" for ia + proof (rule Least_equality) + have nz_ia_A: "\ is_zero_row_JNF ia A" using nz_ia_mrA ia by auto + have Least_Aian_n: "(LEAST n. A $$ (ia, n) \ 0) < dim_col A" + by (smt dual_order.strict_trans is_zero_row_JNF_def not_less_Least not_less_iff_gr_or_eq nz_ia_A) + show "multrow i (- 1) A $$ (ia, LEAST n. A $$ (ia, n) \ 0) \ 0" + by (smt LeastI Least_Aian_n class_cring.cring_simprules(22) equation_minus_iff ia + index_mat_multrow(1) is_zero_row_JNF_def mult_minus1 nz_ia_A) + show " \y. multrow i (- 1) A $$ (ia, y) \ 0 \ (LEAST n. A $$ (ia, n) \ 0) \ y" + by (metis (mono_tags, lifting) Least_Aian_n class_cring.cring_simprules(22) ia + index_mat_multrow(1) leI mult_minus1 order.strict_trans wellorder_Least_lemma(2)) + qed + have "(LEAST n. multrow i (- 1) A $$ (ia, n) \ 0) < (LEAST n. multrow i (- 1) A $$ (j, n) \ 0)" + if ia_j: "ia < j" and + j: "j < dim_row A" + and nz_ia_A: "\ is_zero_row_JNF ia A" + and nz_j_A: "\ is_zero_row_JNF j A" + for ia j + proof - + have ia: "ia < dim_row A" using ia_j j by auto + show ?thesis using Least_eq[OF ia] Least_eq[OF j] nz_ia_A nz_j_A + is_zero_row_JNF_multrow[OF ia] is_zero_row_JNF_multrow[OF j] eA ia_j j + unfolding echelon_form_JNF_def by simp + qed + thus "\ia j. + ia < j \ j < dim_row (multrow i (- 1) A) \ \ is_zero_row_JNF ia (multrow i (- 1) A) + \ \ is_zero_row_JNF j (multrow i (- 1) A) \ + (LEAST n. multrow i (- 1) A $$ (ia, n) \ 0) < (LEAST n. multrow i (- 1) A $$ (j, n) \ 0)" + by auto +qed + + +(*The following lemma is already in HOL Analysis (thm echelon_form_imp_upper_triagular), +but only for square matrices. We prove it here for rectangular matrices.*) +thm echelon_form_imp_upper_triagular + +(*First we prove an auxiliary statement*) +lemma echelon_form_JNF_least_position_ge_diagonal: + assumes eA: "echelon_form_JNF A" + and A: "A: carrier_mat m n" + and nz_iA: "\ is_zero_row_JNF i A" + and im: "i(LEAST n. A $$ (i,n) \ 0)" + using nz_iA im +proof (induct i rule: less_induct) + case (less i) + note nz_iA = less.prems(1) + note im = less.prems(2) + show ?case + proof (cases "i=0") + case True show ?thesis using True by blast + next + case False + show ?thesis + proof (rule ccontr) + assume " \ i \ (LEAST n. A $$ (i, n) \ 0)" + hence i_least: "i > (LEAST n. A $$ (i, n) \ 0)" by auto + have nz_i1A: "\ is_zero_row_JNF (i-1) A" + using nz_iA im False A eA unfolding echelon_form_JNF_def + by (metis Num.numeral_nat(7) Suc_pred carrier_matD(1) gr_implies_not0 + lessI linorder_neqE_nat order.strict_trans) + have "i-1\(LEAST n. A $$ (i-1,n) \ 0)" by (rule less.hyps, insert im nz_i1A False, auto) + moreover have "(LEAST n. A $$ (i,n) \ 0) > (LEAST n. A $$ (i-1,n) \ 0)" + using nz_i1A nz_iA im False A eA unfolding echelon_form_JNF_def by auto + ultimately show False using i_least by auto + qed + qed +qed + + +lemma echelon_form_JNF_imp_upper_triangular: + assumes eA: "echelon_form_JNF A" + shows "upper_triangular A" +proof + fix i j assume ji: "j carrier_mat (dim_row A) (dim_col A)" by auto + show "A $$ (i,j) = 0" + proof (cases "is_zero_row_JNF i A") + case False + have "i\ (LEAST n. A $$(i,n) \ 0)" + by (rule echelon_form_JNF_least_position_ge_diagonal[OF eA A False i]) + then show ?thesis + using ji not_less_Least order.strict_trans2 by blast + next + case True + (* +    Problem detected: at this point, we don't know if j < dim_col A. +    That is, upper_triangular definition only works for matrices \ carrier_mat m n with n\m. +    The definition is: +       - upper_triangular A \ \i < dim_row A. \ j < i. A $$ (i,j) = 0 +     But we need here: +       - upper_triangular A \ \i < dim_row A. \ j < dim_col A. j < i  \ A $$ (i,j) = 0 +  +    Anyway, the existing definition makes sense since upper triangular is usually + restricted to square matrices. +  *) + then show ?thesis unfolding is_zero_row_JNF_def oops + + +(*We do the same with the new definition upper_triangular'*) +lemma echelon_form_JNF_imp_upper_triangular: + assumes eA: "echelon_form_JNF A" + shows "upper_triangular' A" +proof + fix i j assume ji: "j carrier_mat (dim_row A) (dim_col A)" by auto + show "A $$ (i,j) = 0" + proof (cases "is_zero_row_JNF i A") + case False + have "i\ (LEAST n. A $$(i,n) \ 0)" + by (rule echelon_form_JNF_least_position_ge_diagonal[OF eA A False i]) + then show ?thesis + using ji not_less_Least order.strict_trans2 by blast + next + case True + then show ?thesis unfolding is_zero_row_JNF_def using j by auto + qed +qed + + +lemma upper_triangular_append_zero: + assumes uH: "upper_triangular' H" + and H: "H \ carrier_mat (m+m) n" and mn: "n\m" + shows "H = mat_of_rows n (map (Matrix.row H) [0..r 0\<^sub>m m n" (is "_ = ?H' @\<^sub>r 0\<^sub>m m n") +proof + have H': "?H' \ carrier_mat m n" using H uH by auto + have H'0: "(?H' @\<^sub>r 0\<^sub>m m n) \ carrier_mat (m+m) n" by (simp add: H') + thus dr: "dim_row H = dim_row (?H' @\<^sub>r 0\<^sub>m m n)" using H H' by (simp add: append_rows_def) + show dc: "dim_col H = dim_col (?H' @\<^sub>r 0\<^sub>m m n)" using H H' by (simp add: append_rows_def) + fix i j assume i: "i < dim_row (?H' @\<^sub>r 0\<^sub>m m n)" and j: "j < dim_col (?H' @\<^sub>r 0\<^sub>m m n)" + show "H $$ (i, j) = (?H' @\<^sub>r 0\<^sub>m m n) $$ (i, j)" + proof (cases "ir 0\<^sub>m m n) $$ (i, j)" + by (smt False H' append_rows_def assms(2) carrier_matD(1) carrier_matD(2) dc imn + index_mat_four_block(1,3) index_zero_mat j less_diff_conv2 linorder_not_less) + finally show ?thesis . + qed +qed + +subsubsection \The algorithm is sound\ + +lemma find_fst_non0_in_row: + assumes A: "A \ carrier_mat m n" + and res: "find_fst_non0_in_row l A = Some j" + shows "A $$ (l,j) \ 0" "l \ j" "j < dim_col A" +proof - + let ?xs = "filter (\j. A $$ (l, j) \ 0) [l ..< dim_col A]" + from res[unfolded find_fst_non0_in_row_def Let_def] + have xs: "?xs \ []" by (cases ?xs, auto) + have j_in_xs: "j \ set ?xs" using res unfolding find_fst_non0_in_row_def Let_def + by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs) + show "A $$ (l,j) \ 0" "l \ j" "j < dim_col A" using j_in_xs by auto+ +qed + + +lemma find_fst_non0_in_row_zero_before: + assumes A: "A \ carrier_mat m n" + and res: "find_fst_non0_in_row l A = Some j" + shows "\j'\{l.. []" by (cases ?xs, auto) + have j_in_xs: "j \ set ?xs" using res unfolding find_fst_non0_in_row_def Let_def + by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs) + have j_xs0: "j = ?xs ! 0" + by (smt res[unfolded find_fst_non0_in_row_def Let_def] list.case(2) list.exhaust option.inject xs) + show "\j'\{l.. 0" + have j'j: "j' set ?xs" + by (metis (mono_tags, lifting) A Set.member_filter j' Alj' res atLeastLessThan_iff filter_set + find_fst_non0_in_row(3) nat_SN.gt_trans set_upt) + have l_rw: "[l..j. A $$ (l, j) \ 0) ([l ..j. A $$ (l, j) \ 0) [l .. carrier_mat m n" + and res: "find_fst_non0_in_row l A = Some j" + and "j' \ {l.. carrier_mat m n" + and ut_A: "upper_triangular' A" + and res: "find_fst_non0_in_row l A = Some j" + and lm: "l 0)" +proof (rule Least_equality[symmetric]) + show " A $$ (l, j) \ 0" using res find_fst_non0_in_row(1) by blast + show "\y. A $$ (l, y) \ 0 \ j \ y" + proof (rule ccontr) + fix y assume Aly: "A $$ (l, y) \ 0" and jy: " \ j \ y " + have yn: "y < n" + by (metis A jy carrier_matD(2) find_fst_non0_in_row(3) leI less_imp_le_nat nat_SN.compat res) + have "A $$(l,y) = 0" + proof (cases "y\{l.. carrier_mat m n" + and lm: "lj\{l..{l.. None" + from this obtain j where r: "find_fst_non0_in_row l A = Some j" by blast + hence "A $$ (l,j) \ 0" and "l\j" and "j carrier_mat m n" + and ut_A: "upper_triangular' A" + and lm: "l {l.. None" + from this obtain j where r: "find_fst_non0_in_row l A = Some j" by blast + hence "A $$ (l,j) \ 0" and "j is_zero_row_JNF l A" unfolding is_zero_row_JNF_def using lm A by auto + thus False using rhs by contradiction + qed +qed + +lemma make_first_column_positive_preserves_dimensions: + shows [simp]: "dim_row (make_first_column_positive A) = dim_row A" + and [simp]: "dim_col (make_first_column_positive A) = dim_col A" + by (auto) + + +lemma make_first_column_positive_works: + assumes "A\carrier_mat m n" and i: "i 0" + and "j A $$ (i,0) < 0 \ (make_first_column_positive A) $$ (i,j) = - A $$ (i,j)" + and "j A $$ (i,0) \ 0 \ (make_first_column_positive A) $$ (i,j) = A $$ (i,j)" + using assms by auto + + +lemma make_first_column_positive_invertible: + shows "\P. invertible_mat P \ P \ carrier_mat (dim_row A) (dim_row A) + \ make_first_column_positive A = P * A" +proof - + let ?P = "Matrix.mat (dim_row A) (dim_row A) + (\(i,j). if i = j then if A $$(i,0) < 0 then - 1 else 1 else 0::int)" + have "invertible_mat ?P" + proof - + have "(map abs (diag_mat ?P)) = replicate (length ((map abs (diag_mat ?P)))) 1" + by (rule replicate_length_same[symmetric], auto simp add: diag_mat_def) + hence m_rw: "(map abs (diag_mat ?P)) = replicate (dim_row A) 1" by (auto simp add: diag_mat_def) + have "Determinant.det ?P = prod_list (diag_mat ?P)" by (rule det_upper_triangular, auto) + also have "abs ... = prod_list (map abs (diag_mat ?P))" unfolding prod_list_abs by blast + also have " ... = prod_list (replicate (dim_row A) 1)" using m_rw by simp + also have "... = 1" by auto + finally have "\Determinant.det ?P\ = 1" by blast + hence "Determinant.det ?P dvd 1" by fastforce + thus ?thesis using invertible_iff_is_unit_JNF mat_carrier by blast (*Thanks to the new bridge*) + qed + moreover have "make_first_column_positive A = ?P * A" (is "?M = _") + proof (rule eq_matI) + show "dim_row ?M = dim_row (?P * A)" and "dim_col ?M = dim_col (?P * A)" by auto + fix i j assume i: "i < dim_row (?P * A)" and j: "j < dim_col (?P * A)" + have set_rw: "{0..ia \ {0.. col A j" using i j by auto + also have "... = (\ia = 0..ia \ insert i ({0..ia \ {0.. carrier_mat (dim_row A) (dim_row A)" by auto + ultimately show ?thesis by blast +qed + +locale proper_mod_operation = mod_operation + + assumes dvd_gdiv_mult_right[simp]: "b > 0 \ b dvd a \ (a gdiv b) * b = a" + and gmod_gdiv: "y > 0 \ x gmod y = x - x gdiv y * y" + and dvd_imp_gmod_0: "0 < a \ a dvd b \ b gmod a = 0" + and gmod_0_imp_dvd: "a gmod b = 0 \ b dvd a" + and gmod_0[simp]: "n gmod 0 = n" "n > 0 \ 0 gmod n = 0" +begin +lemma reduce_alt_def_not0: + assumes "A $$ (a,0) \ 0" and pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A $$ (b,0))" + shows "reduce a b D A = + Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in + if k = 0 then if D dvd r then D else r else r gmod D + else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in + if k = 0 then r else r gmod D + else A$$(i,k))" (is "_ = ?rhs") + and + "reduce_abs a b D A = + Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in + if abs r > D then if k = 0 \ D dvd r then D else r gmod D else r + else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in + if abs r > D then r gmod D else r + else A$$(i,k))" (is "_ = ?rhs_abs") +proof - + have "reduce a b D A = + (case euclid_ext2 (A$$(a,0)) (A $$ (b,0)) of (p,q,u,v,d) \ + Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in + if k = 0 then if D dvd r then D else r else r gmod D + else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in + if k = 0 then r else r gmod D + else A$$(i,k) + ))" using assms by auto + also have "... = ?rhs" unfolding reduce.simps Let_def + by (rule eq_matI, insert pquvd) (metis (no_types, lifting) split_conv)+ + finally show "reduce a b D A = ?rhs" . + have "reduce_abs a b D A = + (case euclid_ext2 (A$$(a,0)) (A $$ (b,0)) of (p,q,u,v,d) \ + Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then let r = (p*A$$(a,k) + q*A$$(b,k)) in + if abs r > D then if k = 0 \ D dvd r then D else r gmod D else r + else if i = b then let r = u * A$$(a,k) + v * A$$(b,k) in + if abs r > D then r gmod D else r + else A$$(i,k) + ))" using assms by auto + also have "... = ?rhs_abs" unfolding reduce.simps Let_def + by (rule eq_matI, insert pquvd) (metis (no_types, lifting) split_conv)+ + finally show "reduce_abs a b D A = ?rhs_abs" . +qed + +lemma reduce_preserves_dimensions: + shows [simp]: "dim_row (reduce a b D A) = dim_row A" + and [simp]: "dim_col (reduce a b D A) = dim_col A" + and [simp]: "dim_row (reduce_abs a b D A) = dim_row A" + and [simp]: "dim_col (reduce_abs a b D A) = dim_col A" + by (auto simp add: Let_def split_beta) + +lemma reduce_carrier: + assumes "A \ carrier_mat m n" + shows "(reduce a b D A) \ carrier_mat m n" + and "(reduce_abs a b D A) \ carrier_mat m n" + by (insert assms, auto simp add: Let_def split_beta) + +lemma reduce_gcd: + assumes A: "A \ carrier_mat m n" and a: "a 0" +shows "(reduce a b D A) $$ (a,0) = (let r = gcd (A$$(a,0)) (A$$(b,0)) in if D dvd r then D else r)" (is "?lhs = ?rhs") + and "(reduce_abs a b D A) $$ (a,0) = (let r = gcd (A$$(a,0)) (A$$(b,0)) in if D < r then + if D dvd r then D else r gmod D else r)" (is "?lhs_abs = ?rhs_abs") +proof - + obtain p q u v d where pquvd: "euclid_ext2 (A$$(a,0)) (A$$(b,0)) = (p,q,u,v,d)" + using prod_cases5 by blast + have "p * A $$ (a, 0) + q * A $$ (b, 0) = d" + using Aaj pquvd is_bezout_ext_euclid_ext2 unfolding is_bezout_ext_def + by (smt Pair_inject bezout_coefficients_fst_snd euclid_ext2_def) + also have " ... = gcd (A$$(a,0)) (A$$(b,0))" by (metis euclid_ext2_def pquvd prod.sel(2)) + finally have pAaj_qAbj_gcd: "p * A $$ (a, 0) + q * A $$ (b, 0) = gcd (A$$(a,0)) (A$$(b,0))" . + let ?f = "(\(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in if k = 0 then if D dvd r then D else r else r gmod D + else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in if k = 0 then r else r gmod D else A $$ (i, k))" + have "(reduce a b D A) $$ (a,0) = Matrix.mat (dim_row A) (dim_col A) ?f $$ (a, 0)" + using Aaj pquvd by auto + also have "... = (let r = p * A $$ (a, 0) + q * A $$ (b, 0) in if (0::nat) = 0 then if D dvd r then D else r else r gmod D)" + using A a j by auto + also have "... = (if D dvd gcd (A$$(a,0)) (A$$(b,0)) then D else + gcd (A$$(a,0)) (A$$(b,0)))" + by (simp add: pAaj_qAbj_gcd) + finally show "?lhs = ?rhs" by auto + let ?g = "(\(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in + if D < \r\ then if k = 0 \ D dvd r then D else r gmod D else r + else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in + if D < \r\ then r gmod D else r else A $$ (i, k))" + have "(reduce_abs a b D A) $$ (a,0) = Matrix.mat (dim_row A) (dim_col A) ?g $$ (a, 0)" + using Aaj pquvd by auto + also have "... = (let r = p * A $$ (a, 0) + q * A $$ (b, 0) in if D < \r\ then + if (0::nat) = 0 \ D dvd r then D else r gmod D else r)" + using A a j by auto + also have "... = (if D < \gcd (A$$(a,0)) (A$$(b,0))\ then if D dvd gcd (A$$(a,0)) (A$$(b,0)) then D else + gcd (A$$(a,0)) (A$$(b,0)) gmod D else gcd (A$$(a,0)) (A$$(b,0)))" + by (simp add: pAaj_qAbj_gcd) + finally show "?lhs_abs = ?rhs_abs" by auto +qed + + + + +lemma reduce_preserves: + assumes A: "A \ carrier_mat m n" and j: "j 0" and ib: "i\b" and ia: "i\a" and im: "i carrier_mat m n" and a: "a b" + and Aaj: "A $$ (a,0) \ 0" + and D: "D \ 0" +shows "(reduce a b D A) $$ (b,0) = 0" (is "?thesis1") +and "(reduce_abs a b D A) $$ (b,0) = 0" (is "?thesis2") +proof - + obtain p q u v d where pquvd: "euclid_ext2 (A$$(a,0)) (A$$(b,0)) = (p,q,u,v,d)" + using prod_cases5 by blast + hence u: "u = - (A$$(b,0)) div gcd (A$$(a,0)) (A$$(b,0))" + using euclid_ext2_works[OF pquvd] by auto + have v: "v = A$$(a,0) div gcd (A$$(a,0)) (A$$(b,0))" using euclid_ext2_works[OF pquvd] by auto + have uv0: "u * A$$(a,0) + v * A$$(b,0) = 0" using u v + proof - + have "\i ia. gcd (ia::int) i * (ia div gcd ia i) = ia" + by (meson dvd_mult_div_cancel gcd_dvd1) + then have "v * - A $$ (b, 0) = u * A $$ (a, 0)" + by (metis (no_types) dvd_minus_iff dvd_mult_div_cancel gcd_dvd2 minus_minus mult.assoc mult.commute u v) + then show ?thesis + by simp + qed + let ?f = "(\(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in + if k = 0 then if D dvd r then D else r else r gmod D + else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in + if k = 0 then r else r gmod D else A $$ (i, k))" + have "(reduce a b D A) $$ (b,0) = Matrix.mat (dim_row A) (dim_col A) ?f $$ (b, 0)" + using Aaj pquvd by auto + also have "... = (let r = u * A$$(a,0) + v * A$$(b,0) in r)" + using A a j ab b by auto + also have "... = 0" using uv0 D + by (smt (z3) gmod_0(1) gmod_0(2)) + finally show ?thesis1 . + let ?g = "(\(i, k). if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in + if D < \r\ then if k = 0 \ D dvd r then D else r gmod D else r + else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in + if D < \r\ then r gmod D else r else A $$ (i, k))" + have "(reduce_abs a b D A) $$ (b,0) = Matrix.mat (dim_row A) (dim_col A) ?g $$ (b, 0)" + using Aaj pquvd by auto + also have "... = (let r = u * A$$(a,0) + v * A$$(b,0) in if D < \r\ then r gmod D else r)" + using A a j ab b by auto + also have "... = 0" using uv0 D by simp + finally show ?thesis2 . +qed +end + + +text \Let us show the key lemma: operations modulo determinant don't modify the (integer) row span.\ + +context LLL_with_assms +begin + +lemma lattice_of_kId_subset_fs_init: + assumes k_det: "k = Determinant.det (mat_of_rows n fs_init)" + and mn: "m=n" + shows "lattice_of (Matrix.rows (k \\<^sub>m (1\<^sub>m m))) \ lattice_of fs_init" +proof - + let ?Z = "(mat_of_rows n fs_init)" + let ?RAT = "of_int_hom.mat_hom :: int mat \ rat mat" + have RAT_fs_init: "?RAT (mat_of_rows n fs_init) \ carrier_mat n n" + using len map_carrier_mat mat_of_rows_carrier(1) mn by blast + have det_RAT_fs_init: "Determinant.det (?RAT ?Z) \ 0" + proof (rule gs.lin_indpt_rows_imp_det_not_0[OF RAT_fs_init]) + have rw: "Matrix.rows (?RAT (mat_of_rows n fs_init)) = RAT fs_init" + by (metis cof_vec_space.lin_indpt_list_def fs_init lin_dep mat_of_rows_map rows_mat_of_rows) + thus "gs.lin_indpt (set (Matrix.rows (?RAT (mat_of_rows n fs_init))))" + by (insert lin_dep, simp add: cof_vec_space.lin_indpt_list_def) + show "distinct (Matrix.rows (?RAT (mat_of_rows n fs_init)))" + using rw cof_vec_space.lin_indpt_list_def lin_dep by auto + qed + obtain inv_Z where inverts_Z: "inverts_mat (?RAT ?Z) inv_Z" and inv_Z: "inv_Z \ carrier_mat m m" + by (metis mn det_RAT_fs_init dvd_field_iff invertible_iff_is_unit_JNF + len map_carrier_mat mat_of_rows_carrier(1) obtain_inverse_matrix) + have det_rat_Z_k: "Determinant.det (?RAT ?Z) = rat_of_int k" + using k_det of_int_hom.hom_det by blast + have "?RAT ?Z * adj_mat (?RAT ?Z) = Determinant.det (?RAT ?Z) \\<^sub>m 1\<^sub>m n" + by (rule adj_mat[OF RAT_fs_init]) + hence "inv_Z * (?RAT ?Z * adj_mat (?RAT ?Z)) = inv_Z * (Determinant.det (?RAT ?Z) \\<^sub>m 1\<^sub>m n)" by simp + hence k_inv_Z_eq_adj: "(rat_of_int k) \\<^sub>m inv_Z = adj_mat (?RAT ?Z)" + by (smt Determinant.mat_mult_left_right_inverse RAT_fs_init adj_mat(1,3) mn + carrier_matD det_RAT_fs_init det_rat_Z_k gs.det_nonzero_congruence inv_Z inverts_Z + inverts_mat_def mult_smult_assoc_mat smult_carrier_mat) + have adj_mat_Z: "adj_mat (?RAT ?Z) $$ (i,j) \ \" if i: "i \" + proof (rule Ints_det) + fix ia ja + assume ia: "ia < dim_row (mat_delete (?RAT ?Z) j i)" + and ja: "ja < dim_col (mat_delete (?RAT ?Z) j i)" + have "(mat_delete (?RAT ?Z) j i) $$ (ia, ja) = (?RAT ?Z) $$ (insert_index j ia, insert_index i ja)" + by (rule mat_delete_index[symmetric], insert i j mn len ia ja RAT_fs_init, auto) + also have "... = rat_of_int (?Z $$ (insert_index j ia, insert_index i ja))" + by (rule index_map_mat, insert i j ia ja, auto simp add: insert_index_def) + also have "... \ \" using Ints_of_int by blast + finally show "(mat_delete (?RAT ?Z) j i) $$ (ia, ja) \ \" . + qed + have "adj_mat (?RAT ?Z) $$ (i,j) = Determinant.cofactor (?RAT ?Z) j i" + unfolding adj_mat_def + by (simp add: len i j) + also have "... = (- 1) ^ (j + i) * Determinant.det (mat_delete (?RAT ?Z) j i)" + unfolding Determinant.cofactor_def by auto + also have "... \ \" using det_mat_delete_Z by auto + finally show ?thesis . + qed + have kinvZ_in_Z: "((rat_of_int k) \\<^sub>m inv_Z) $$ (i,j) \ \" if i: "i\<^sub>m (1\<^sub>m m)) = Determinant.det (?RAT ?Z) \\<^sub>m (inv_Z * ?RAT ?Z)" (is "?lhs = ?rhs") + proof - + have "(inv_Z * ?RAT ?Z) = (1\<^sub>m m)" + by (metis Determinant.mat_mult_left_right_inverse RAT_fs_init mn carrier_matD(1) + inv_Z inverts_Z inverts_mat_def) + from this have "?rhs = rat_of_int k \\<^sub>m (1\<^sub>m m)" using det_rat_Z_k by auto + also have "... = ?lhs" by auto + finally show ?thesis .. + qed + also have "... = (Determinant.det (?RAT ?Z) \\<^sub>m inv_Z) * ?RAT ?Z" + by (metis RAT_fs_init mn inv_Z mult_smult_assoc_mat) + also have "... = ((rat_of_int k) \\<^sub>m inv_Z) * ?RAT ?Z" by (simp add: k_det) + finally have r': "?RAT (k \\<^sub>m (1\<^sub>m m)) = ((rat_of_int k) \\<^sub>m inv_Z) * ?RAT ?Z" . + have r: "(k \\<^sub>m (1\<^sub>m m)) = ((map_mat int_of_rat ((rat_of_int k) \\<^sub>m inv_Z))) * ?Z" + proof - + have "?RAT ((map_mat int_of_rat ((rat_of_int k) \\<^sub>m inv_Z))) = ((rat_of_int k) \\<^sub>m inv_Z)" + proof (rule eq_matI, auto) + fix i j assume i: "i < dim_row inv_Z" and j: "j < dim_col inv_Z" + have "((rat_of_int k) \\<^sub>m inv_Z) $$ (i,j) = (rat_of_int k * inv_Z $$ (i, j))" + using index_smult_mat i j by auto + hence kinvZ_in_Z': "... \ \" using kinvZ_in_Z i j inv_Z mn by simp + show "rat_of_int (int_of_rat (rat_of_int k * inv_Z $$ (i, j))) = rat_of_int k * inv_Z $$ (i, j)" + by (rule int_of_rat, insert kinvZ_in_Z', auto) + qed + hence "?RAT (k \\<^sub>m (1\<^sub>m m)) = ?RAT ((map_mat int_of_rat ((rat_of_int k) \\<^sub>m inv_Z))) * ?RAT ?Z" + using r' by simp + also have "... = ?RAT ((map_mat int_of_rat ((rat_of_int k) \\<^sub>m inv_Z)) * ?Z)" + by (metis RAT_fs_init adj_mat(1) k_inv_Z_eq_adj map_carrier_mat of_int_hom.mat_hom_mult) + finally show ?thesis by (rule of_int_hom.mat_hom_inj) + qed + show ?thesis + proof (rule mat_mult_sub_lattice[OF _ fs_init]) + have rw: "of_int_hom.mat_hom (map_mat int_of_rat ((rat_of_int k) \\<^sub>m inv_Z)) + = map_mat int_of_rat ((rat_of_int k) \\<^sub>m inv_Z)" by auto + have "mat_of_rows n (Matrix.rows (k \\<^sub>m 1\<^sub>m m)) = (k \\<^sub>m (1\<^sub>m m))" + by (metis mn index_one_mat(3) index_smult_mat(3) mat_of_rows_rows) + also have "... = of_int_hom.mat_hom (map_mat int_of_rat ((rat_of_int k) \\<^sub>m inv_Z)) * mat_of_rows n fs_init" + using r rw by auto + finally show "mat_of_rows n (Matrix.rows (k \\<^sub>m 1\<^sub>m m)) + = of_int_hom.mat_hom (map_mat int_of_rat ((rat_of_int k) \\<^sub>m inv_Z)) * mat_of_rows n fs_init" . + show "set (Matrix.rows (k \\<^sub>m 1\<^sub>m m)) \ carrier_vec n"using mn unfolding Matrix.rows_def by auto + show "map_mat int_of_rat (rat_of_int k \\<^sub>m inv_Z) \ carrier_mat (length (Matrix.rows (k \\<^sub>m 1\<^sub>m m))) (length fs_init)" + using len fs_init by (simp add: inv_Z) + qed +qed + +end + +context LLL_with_assms +begin + + +lemma lattice_of_append_det_preserves: + assumes k_det: "k = abs (Determinant.det (mat_of_rows n fs_init))" + and mn: "m = n" + and A: "A = (mat_of_rows n fs_init) @\<^sub>r (k \\<^sub>m (1\<^sub>m m))" +shows "lattice_of (Matrix.rows A) = lattice_of fs_init" +proof - + have "Matrix.rows (mat_of_rows n fs_init @\<^sub>r k \\<^sub>m 1\<^sub>m m) = (Matrix.rows (mat_of_rows n fs_init) @ Matrix.rows (k \\<^sub>m (1\<^sub>m m)))" + by (rule rows_append_rows, insert fs_init len mn, auto) + also have "... = (fs_init @ Matrix.rows (k \\<^sub>m (1\<^sub>m m)))" by (simp add: fs_init) + finally have rw: "Matrix.rows (mat_of_rows n fs_init @\<^sub>r k \\<^sub>m 1\<^sub>m m) + = (fs_init @ Matrix.rows (k \\<^sub>m (1\<^sub>m m)))" . + have "lattice_of (Matrix.rows A) = lattice_of (fs_init @ Matrix.rows (k \\<^sub>m (1\<^sub>m m)))" + by (rule arg_cong[of _ _ lattice_of], auto simp add: A rw) + also have "... = lattice_of fs_init" + proof (cases "k = Determinant.det (mat_of_rows n fs_init)") + case True + then show ?thesis + by (rule already_in_lattice_append[symmetric, OF fs_init + lattice_of_kId_subset_fs_init[OF _ mn]], insert mn, auto simp add: Matrix.rows_def) + next + case False + hence k2: "k = -Determinant.det (mat_of_rows n fs_init)" using k_det by auto + have l: "lattice_of (Matrix.rows (- k \\<^sub>m 1\<^sub>m m)) \ lattice_of fs_init" + by (rule lattice_of_kId_subset_fs_init[OF _ mn], insert k2, auto) + have l2: "lattice_of (Matrix.rows (- k \\<^sub>m 1\<^sub>m m)) = lattice_of (Matrix.rows (k \\<^sub>m 1\<^sub>m m))" + proof (rule mat_mult_invertible_lattice_eq) + let ?P = "(- 1::int) \\<^sub>m 1\<^sub>m m" + show P: "?P \ carrier_mat m m" by simp + have "det ?P = 1 \ det ?P = -1" unfolding det_smult by (auto simp add: minus_1_power_even) + hence "det ?P dvd 1" by (smt minus_dvd_iff one_dvd) + thus " invertible_mat ?P" unfolding invertible_iff_is_unit_JNF[OF P] . + have "(- k \\<^sub>m 1\<^sub>m m) = ?P * (k \\<^sub>m 1\<^sub>m m)" + unfolding mat_diag_smult[symmetric] unfolding mat_diag_diag by auto + thus " mat_of_rows n (Matrix.rows (- k \\<^sub>m 1\<^sub>m m)) = of_int_hom.mat_hom ?P * mat_of_rows n (Matrix.rows (k \\<^sub>m 1\<^sub>m m))" + by (metis mn index_one_mat(3) index_smult_mat(3) mat_of_rows_rows of_int_mat_hom_int_id) + show " set (Matrix.rows (- k \\<^sub>m 1\<^sub>m m)) \ carrier_vec n" + and "set (Matrix.rows (k \\<^sub>m 1\<^sub>m m)) \ carrier_vec n" + using assms(2) one_carrier_mat set_rows_carrier smult_carrier_mat by blast+ + qed (insert mn, auto) + hence l2: "lattice_of (Matrix.rows (k \\<^sub>m 1\<^sub>m m)) \ lattice_of fs_init" using l by auto + show ?thesis by (rule already_in_lattice_append[symmetric, OF fs_init l2], + insert mn one_carrier_mat set_rows_carrier smult_carrier_mat, blast) + qed + finally show ?thesis . +qed + +text \This is another key lemma. +Here, $A$ is the initial matrix @{text "(mat_of_rows n fs_init)"} augmented with $m$ rows +$(k,0,\dots,0),(0,k,0,\dots,0), \dots , (0,\dots,0,k)$ where $k$ is the determinant of +@{text "(mat_of_rows n fs_init)"}. +With the algorithm of the article, we obtain @{text "H = H' @\<^sub>r (0\<^sub>m m n)"} by means of an invertible +matrix $P$ (which is computable). Then, $H$ is the HNF of $A$. +The lemma shows that $H'$ is the HNF of @{text "(mat_of_rows n fs_init)"} +and that there exists an invertible matrix to carry out the transformation.\ + +lemma Hermite_append_det_id: + assumes k_det: "k = abs (Determinant.det (mat_of_rows n fs_init))" + and mn: "m = n" + and A: "A = (mat_of_rows n fs_init) @\<^sub>r (k \\<^sub>m (1\<^sub>m m))" + and H': "H'\ carrier_mat m n" + and H_append: "H = H' @\<^sub>r (0\<^sub>m m n)" + and P: "P \ carrier_mat (m+m) (m+m)" + and inv_P: "invertible_mat P" + and A_PH: "A = P * H" + and HNF_H: "Hermite_JNF associates res H" +shows "Hermite_JNF associates res H'" + and "(\P'. invertible_mat P' \ P' \ carrier_mat m m \ (mat_of_rows n fs_init) = P' * H')" +proof - + have A_carrier: "A \ carrier_mat (m+m) n" using A mn len by auto + let ?A' = "(mat_of_rows n fs_init)" + let ?H' = "submatrix H {0..m" by (simp add: mn) + have H: "H \ carrier_mat (m + m) n" using H_append H' by auto + have submatrix_carrier: "submatrix H {0.. carrier_mat m n" + by (rule submatrix_carrier_first[OF H], auto) + have H'_eq: "H' = ?H'" + proof (rule eq_matI) + fix i j assume i: "i < dim_row ?H'" and j: "j < dim_col ?H'" + have im: "im m n) $$ (i - m, j))" + unfolding H_append by (rule append_rows_nth[OF H'], insert im jn, auto) + also have "... = H' $$ (i,j)" using H' im jn by simp + finally show "H' $$ (i, j) = ?H' $$ (i, j)" .. + qed (insert H' submatrix_carrier, auto) + show HNF_H': "Hermite_JNF associates res H'" + unfolding H'_eq mn by (rule HNF_submatrix[OF HNF_H H], insert nm, simp) + have L_fs_init_A: "lattice_of (fs_init) = lattice_of (Matrix.rows A)" + by (rule lattice_of_append_det_preserves[symmetric, OF k_det mn A]) + have L_H'_H: "lattice_of (Matrix.rows H') = lattice_of (Matrix.rows H)" + using H_append H' lattice_of_append_zero_rows by blast + have L_A_H: "lattice_of (Matrix.rows A) = lattice_of (Matrix.rows H)" + proof (rule mat_mult_invertible_lattice_eq[OF _ _ P inv_P]) + show "set (Matrix.rows A) \ carrier_vec n" using A_carrier set_rows_carrier by blast + show "set (Matrix.rows H) \ carrier_vec n" using H set_rows_carrier by blast + show "length (Matrix.rows A) = m + m" using A_carrier by auto + show "length (Matrix.rows H) = m + m" using H by auto + show "mat_of_rows n (Matrix.rows A) = of_int_hom.mat_hom P * mat_of_rows n (Matrix.rows H)" + by (metis A_carrier H A_PH carrier_matD(2) mat_of_rows_rows of_int_mat_hom_int_id) + qed + have L_fs_init_H': "lattice_of fs_init = lattice_of (Matrix.rows H')" + using L_fs_init_A L_A_H L_H'_H by auto + have exists_P2: + "\P2. P2 \ carrier_mat n n \ invertible_mat P2 \ mat_of_rows n (Matrix.rows H') = P2 * H'" + by (rule exI[of _ "1\<^sub>m n"], insert H' mn, auto) + have exist_P': "\P'\carrier_mat n n. invertible_mat P' + \ mat_of_rows n fs_init = P' * mat_of_rows n (Matrix.rows H')" + by (rule eq_lattice_imp_mat_mult_invertible_rows[OF fs_init _ lin_dep len[unfolded mn] _ L_fs_init_H'], + insert H' mn set_rows_carrier, auto) + thus "\P'. invertible_mat P' \ P' \ carrier_mat m m \ (mat_of_rows n fs_init) = P' * H'" + by (metis mn H' carrier_matD(2) mat_of_rows_rows) +qed +end + + + +context proper_mod_operation +begin + +(* Perform the modulo D operation to reduce the element A$$(a,j), assuming A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m m))*) +definition "reduce_element_mod_D (A::int mat) a j D m = + (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A + else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" + +definition "reduce_element_mod_D_abs (A::int mat) a j D m = + (if j = 0 \ D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A + else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" + +lemma reduce_element_mod_D_preserves_dimensions: + shows [simp]: "dim_row (reduce_element_mod_D A a j D m) = dim_row A" + and [simp]: "dim_col (reduce_element_mod_D A a j D m) = dim_col A" + and [simp]: "dim_row (reduce_element_mod_D_abs A a j D m) = dim_row A" + and [simp]: "dim_col (reduce_element_mod_D_abs A a j D m) = dim_col A" + by (auto simp add: reduce_element_mod_D_def reduce_element_mod_D_abs_def Let_def split_beta) + +lemma reduce_element_mod_D_carrier: + shows "reduce_element_mod_D A a j D m \ carrier_mat (dim_row A) (dim_col A)" + and "reduce_element_mod_D_abs A a j D m \ carrier_mat (dim_row A) (dim_col A)" by auto + + +lemma reduce_element_mod_D_invertible_mat: + assumes A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" + and A': "A' \ carrier_mat m n" and a: "an" + shows "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_element_mod_D A a j D m = P * A" (is ?thesis1) + and "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_element_mod_D_abs A a j D m = P * A" (is ?thesis2) + unfolding atomize_conj +proof (rule conjI; cases "j = 0 \ D dvd A$$(a,j)") + case True + let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D) + 1) a (j + m)" + have A: "A \ carrier_mat (m + n) n" using A_def A' mn by auto + have "reduce_element_mod_D A a j D m = addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A" + unfolding reduce_element_mod_D_def using True by auto + also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto) + finally have "reduce_element_mod_D A a j D m = ?P * A" . + moreover have P: "?P \ carrier_mat (m+n) (m+n)" by simp + moreover have inv_P: "invertible_mat ?P" + by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right + invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1) + ultimately show ?thesis1 by blast + have "reduce_element_mod_D_abs A a j D m = addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A" + unfolding reduce_element_mod_D_abs_def using True by auto + also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto) + finally have "reduce_element_mod_D_abs A a j D m = ?P * A" . + thus ?thesis2 using P inv_P by blast +next + case False note nc1 = False + let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)" + have A: "A \ carrier_mat (m + n) n" using A_def A' mn by auto + have P: "?P \ carrier_mat (m+n) (m+n)" by simp + have inv_P: "invertible_mat ?P" + by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right + invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1) + show ?thesis1 + proof (cases "j = 0") + case True + have "reduce_element_mod_D A a j D m = A" + unfolding reduce_element_mod_D_def using True nc1 by auto + thus ?thesis1 + by (metis A_def A' carrier_append_rows invertible_mat_one + left_mult_one_mat one_carrier_mat smult_carrier_mat) + next + case False + have "reduce_element_mod_D A a j D m = addrow (- (A $$ (a, j) gdiv D)) a (j + m) A" + unfolding reduce_element_mod_D_def using False by auto + also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto) + finally have "reduce_element_mod_D A a j D m = ?P * A" . + thus ?thesis using P inv_P by blast + qed + have "reduce_element_mod_D_abs A a j D m = addrow (- (A $$ (a, j) gdiv D)) a (j + m) A" + unfolding reduce_element_mod_D_abs_def using False by auto + also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto) + finally have "reduce_element_mod_D_abs A a j D m = ?P * A" . + thus ?thesis2 using P inv_P by blast +qed + + +lemma reduce_element_mod_D_append: + assumes A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" + and A': "A' \ carrier_mat m n" and a: "an" +shows "reduce_element_mod_D A a j D m + = mat_of_rows n [Matrix.row (reduce_element_mod_D A a j D m) i. i \ [0..r (D \\<^sub>m (1\<^sub>m n))" (is "?lhs = ?A' @\<^sub>r ?D") +and "reduce_element_mod_D_abs A a j D m + = mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a j D m) i. i \ [0..r (D \\<^sub>m (1\<^sub>m n))" (is "?lhs_abs = ?A'_abs @\<^sub>r ?D") + unfolding atomize_conj +proof (rule conjI; rule eq_matI) + let ?xs = "(map (Matrix.row (reduce_element_mod_D A a j D m)) [0.. carrier_mat (m+n) n" + and lhs_carrier_abs: "?lhs_abs \ carrier_mat (m+n) n" + by (metis (no_types, lifting) add.comm_neutral append_rows_def A_def A' carrier_matD + carrier_mat_triv index_mat_four_block(2,3) index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) + reduce_element_mod_D_preserves_dimensions)+ + have map_A_carrier[simp]: "?A' \ carrier_mat m n" + and map_A_carrier_abs[simp]: "?A'_abs \ carrier_mat m n" + by (simp add: mat_of_rows_def)+ + have AD_carrier[simp]: "?A' @\<^sub>r ?D \ carrier_mat (m+n) n" + and AD_carrier_abs[simp]: "?A'_abs @\<^sub>r ?D \ carrier_mat (m+n) n" + by (rule carrier_append_rows, insert lhs_carrier mn, auto) + show "dim_row (?lhs) = dim_row (?A' @\<^sub>r ?D)" and "dim_col (?lhs) = dim_col (?A' @\<^sub>r ?D)" + "dim_row (?lhs_abs) = dim_row (?A'_abs @\<^sub>r ?D)" and "dim_col (?lhs_abs) = dim_col (?A'_abs @\<^sub>r ?D)" + using lhs_carrier lhs_carrier_abs AD_carrier AD_carrier_abs unfolding carrier_mat_def by simp+ + show "?lhs $$ (i, ja) = (?A' @\<^sub>r ?D) $$ (i, ja)" if i: "i < dim_row (?A' @\<^sub>r ?D)" and ja: "ja < dim_col (?A' @\<^sub>r ?D)" for i ja + proof (cases "ir ?D) $$ (i, ja) = ?A' $$ (i,ja)" + by (metis (no_types, lifting) Nat.add_0_right True append_rows_def diff_zero i + index_mat_four_block index_zero_mat(3) ja length_map length_upt mat_of_rows_carrier(2)) + also have "... = ?xs ! i $v ja" + by (rule mat_of_rows_index, insert i True ja , auto simp add: append_rows_def) + also have "... = ?lhs $$ (i,ja)" + by (rule map_first_rows_index, insert assms lhs_carrier True i ja_n, auto) + finally show ?thesis .. + next + case False + have ja_n: "ja < n" + by (metis Nat.add_0_right append_rows_def index_mat_four_block(3) index_zero_mat(3) ja mat_of_rows_carrier(3)) + have "(?A' @\<^sub>r ?D) $$ (i, ja) =?D $$ (i-m,ja)" + by (smt False Nat.add_0_right map_A_carrier append_rows_def carrier_matD i + index_mat_four_block index_zero_mat(3) ja_n) + also have "... = ?lhs $$ (i,ja)" + by (metis (no_types, lifting) False Nat.add_0_right map_A_carrier append_rows_def A_def A' a + carrier_matD i index_mat_addrow(1) index_mat_four_block(1,2) index_zero_mat(3) ja_n + lhs_carrier reduce_element_mod_D_def reduce_element_mod_D_preserves_dimensions) + finally show ?thesis .. + qed + fix i ja assume i: "i < dim_row (?A'_abs @\<^sub>r ?D)" and ja: "ja < dim_col (?A'_abs @\<^sub>r ?D)" + have ja_n: "ja < n" + by (metis Nat.add_0_right append_rows_def index_mat_four_block(3) index_zero_mat(3) ja mat_of_rows_carrier(3)) + show "?lhs_abs $$ (i, ja) = (?A'_abs @\<^sub>r ?D) $$ (i, ja)" + proof (cases "ir ?D) $$ (i, ja) = ?A'_abs $$ (i,ja)" + by (metis (no_types, lifting) Nat.add_0_right True append_rows_def diff_zero i + index_mat_four_block index_zero_mat(3) ja length_map length_upt mat_of_rows_carrier(2)) + also have "... = ?xs_abs ! i $v ja" + by (rule mat_of_rows_index, insert i True ja , auto simp add: append_rows_def) + also have "... = ?lhs_abs $$ (i,ja)" + by (rule map_first_rows_index, insert assms lhs_carrier_abs True i ja_n, auto) + finally show ?thesis .. + next + case False + have "(?A'_abs @\<^sub>r ?D) $$ (i, ja) = ?D $$ (i-m,ja)" + by (smt False Nat.add_0_right map_A_carrier_abs append_rows_def carrier_matD i + index_mat_four_block index_zero_mat(3) ja_n) + also have "... = ?lhs_abs $$ (i,ja)" + by (metis (no_types, lifting) False Nat.add_0_right map_A_carrier_abs append_rows_def A_def A' a + carrier_matD i index_mat_addrow(1) index_mat_four_block(1,2) index_zero_mat(3) ja_n + lhs_carrier_abs reduce_element_mod_D_abs_def reduce_element_mod_D_preserves_dimensions) + finally show ?thesis .. + qed +qed + + +lemma reduce_append_rows_eq: + assumes A': "A' \ carrier_mat m n" + and A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" and a: "a 0" + shows "reduce a x D A + = mat_of_rows n [Matrix.row ((reduce a x D A)) i. i \ [0..r D \\<^sub>m 1\<^sub>m n" (is ?thesis1) + and "reduce_abs a x D A + = mat_of_rows n [Matrix.row ((reduce_abs a x D A)) i. i \ [0..r D \\<^sub>m 1\<^sub>m n" (is ?thesis2) + unfolding atomize_conj +proof (rule conjI; rule matrix_append_rows_eq_if_preserves) + let ?reduce_ax = "reduce a x D A" + let ?reduce_abs = "reduce_abs a x D A" + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + have A: "A: carrier_mat (m+n) n" by (simp add: A_def A') + show D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" and "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by simp+ + show "?reduce_ax \ carrier_mat (m + n) n" "?reduce_abs \ carrier_mat (m + n) n" + by (metis Nat.add_0_right append_rows_def A' A_def carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2) index_zero_mat(3) reduce_preserves_dimensions)+ + show "\i\{m..ja\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" + and "\i\{m..ja\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" + unfolding atomize_conj + proof (rule conjI; rule+) + fix i ja assume i: "i \ {m.. a" using i a by auto + have i_not_x: "i \ x" using i xm by auto + have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto + also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \\<^sub>m (1\<^sub>m n))$$(i-m,ja))" + by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp) + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto + finally show "?reduce_ax $$ (i,ja) = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" . + have "?reduce_abs $$ (i,ja) = A $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto + also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \\<^sub>m (1\<^sub>m n))$$(i-m,ja))" + by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp) + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto + finally show "?reduce_abs $$ (i,ja) = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" . + qed +qed + +fun reduce_row_mod_D + where "reduce_row_mod_D A a [] D m = A" | + "reduce_row_mod_D A a (x # xs) D m = reduce_row_mod_D (reduce_element_mod_D A a x D m) a xs D m" + +fun reduce_row_mod_D_abs + where "reduce_row_mod_D_abs A a [] D m = A" | + "reduce_row_mod_D_abs A a (x # xs) D m = reduce_row_mod_D_abs (reduce_element_mod_D_abs A a x D m) a xs D m" + + +lemma reduce_row_mod_D_preserves_dimensions: + shows [simp]: "dim_row (reduce_row_mod_D A a xs D m) = dim_row A" + and [simp]: "dim_col (reduce_row_mod_D A a xs D m) = dim_col A" + by (induct A a xs D m rule: reduce_row_mod_D.induct, auto) + +lemma reduce_row_mod_D_preserves_dimensions_abs: + shows [simp]: "dim_row (reduce_row_mod_D_abs A a xs D m) = dim_row A" + and [simp]: "dim_col (reduce_row_mod_D_abs A a xs D m) = dim_col A" + by (induct A a xs D m rule: reduce_row_mod_D_abs.induct, auto) + +lemma reduce_row_mod_D_invertible_mat: + assumes A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" + and A': "A' \ carrier_mat m n" and a: "aj\set xs. jn" + shows "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_row_mod_D A a xs D m = P * A" + using assms +proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D.induct) + case (1 A a D m) + show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def) +next + case (2 A a x xs D m) + let ?reduce_xs = "(reduce_element_mod_D A a x D m)" + have 1: "reduce_row_mod_D A a (x # xs) D m + = reduce_row_mod_D ?reduce_xs a xs D m" by simp + have "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_element_mod_D A a x D m = P * A" + by (rule reduce_element_mod_D_invertible_mat, insert "2.prems", auto) + from this obtain P where P: "P \ carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P" + and R_P: "reduce_element_mod_D A a x D m = P * A" by auto + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ reduce_row_mod_D ?reduce_xs a xs D m = P * ?reduce_xs" + proof (rule "2.hyps") + let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \ [0..r (D \\<^sub>m (1\<^sub>m n))" + by (rule reduce_element_mod_D_append, insert "2.prems", auto) + qed (insert "2.prems", auto) + from this obtain P2 where P2: "P2 \ carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2" + and R_P2: "reduce_row_mod_D ?reduce_xs a xs D m = P2 * ?reduce_xs" + by auto + have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast + moreover have "(P2 * P) \ carrier_mat (m+n) (m+n)" using P2 P by auto + moreover have "reduce_row_mod_D A a (x # xs) D m = (P2 * P) * A" + by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv + index_mult_mat reduce_row_mod_D_preserves_dimensions) + ultimately show ?case by blast +qed + + +lemma reduce_row_mod_D_abs_invertible_mat: + assumes A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" + and A': "A' \ carrier_mat m n" and a: "aj\set xs. jn" + shows "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_row_mod_D_abs A a xs D m = P * A" + using assms +proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D_abs.induct) + case (1 A a D m) + show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def) +next + case (2 A a x xs D m) + let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)" + have 1: "reduce_row_mod_D_abs A a (x # xs) D m + = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp + have "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_element_mod_D_abs A a x D m = P * A" + by (rule reduce_element_mod_D_invertible_mat, insert "2.prems", auto) + from this obtain P where P: "P \ carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P" + and R_P: "reduce_element_mod_D_abs A a x D m = P * A" by auto + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ reduce_row_mod_D_abs ?reduce_xs a xs D m = P * ?reduce_xs" + proof (rule "2.hyps") + let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \ [0..r (D \\<^sub>m (1\<^sub>m n))" + by (rule reduce_element_mod_D_append, insert "2.prems", auto) + qed (insert "2.prems", auto) + from this obtain P2 where P2: "P2 \ carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2" + and R_P2: "reduce_row_mod_D_abs ?reduce_xs a xs D m = P2 * ?reduce_xs" + by auto + have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast + moreover have "(P2 * P) \ carrier_mat (m+n) (m+n)" using P2 P by auto + moreover have "reduce_row_mod_D_abs A a (x # xs) D m = (P2 * P) * A" + by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv + index_mult_mat reduce_row_mod_D_preserves_dimensions_abs) + ultimately show ?case by blast +qed +end + +context proper_mod_operation +begin +lemma dvd_gdiv_mult_left[simp]: assumes "b > 0" "b dvd a" shows "b * (a gdiv b) = a" + using dvd_gdiv_mult_right[OF assms] by (auto simp: ac_simps) + + +lemma reduce_element_mod_D: + assumes A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" + and A': "A' \ carrier_mat m n" and a: "a\m" and j: "jn" + and D: "D > 0" + shows "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k = j then if j = 0 then if D dvd A$$(i,k) + then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A") + and "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k = j then if j = 0 \ D dvd A$$(i,k) then D else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A_abs") +unfolding atomize_conj +proof (rule conjI; rule eq_matI) + have A: "A \ carrier_mat (m+n) n" using A_def A' by simp + have dr: "dim_row ?A = dim_row ?A_abs" and dc: "dim_col ?A = dim_col ?A_abs" by auto + have 1: "reduce_element_mod_D A a j D m $$ (i, ja) = ?A $$ (i, ja)" (is ?thesis1) + and 2: "reduce_element_mod_D_abs A a j D m $$ (i, ja) = ?A_abs $$ (i, ja)" (is ?thesis2) + if i: "i < dim_row ?A" and ja: "ja < dim_col ?A" for i ja + unfolding atomize_conj + proof (rule conjI; cases "i=a") + case False + have "reduce_element_mod_D A a j D m = (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A + else A + else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" + unfolding reduce_element_mod_D_def by simp + also have "... $$ (i,ja) = A $$ (i, ja)" unfolding mat_addrow_def using False ja i by auto + also have "... = ?A $$ (i,ja)" using False using i ja by auto + finally show ?thesis1 . + have "reduce_element_mod_D_abs A a j D m $$ (i,ja) = A $$ (i, ja)" + unfolding reduce_element_mod_D_abs_def mat_addrow_def using False ja i by auto + also have "... = ?A_abs $$ (i,ja)" using False using i ja by auto + finally show ?thesis2 . + next + case True note ia = True + have "reduce_element_mod_D A a j D m + = (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A + else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" + unfolding reduce_element_mod_D_def by simp + also have "... $$ (i,ja) = ?A $$ (i,ja)" + proof (cases "ja = j") + case True note ja_j = True + have "A $$ (j + m, ja) = (D \\<^sub>m (1\<^sub>m n)) $$ (j,ja)" + by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A mn, auto) + also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto) + also have "... = D" by (simp add: True j mn) + finally have A_ja_jaD: "A $$ (j + m, ja) = D" . + show ?thesis + proof (cases "j=0 \ D dvd A$$(a,j)") + case True + have 1: "reduce_element_mod_D A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A " + using True ia ja_j unfolding reduce_element_mod_D_def by auto + also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)" + unfolding mat_addrow_def using True ja_j ia + using A i j by auto + also have "... = D" + proof - + have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0" + using True ia ja_j D by force + then show ?thesis + by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2) + ja_j more_arith_simps(3) mult.commute mult_cancel_right1) + qed + also have "... = ?A $$ (i,ja)" using True ia A i j ja_j by auto + finally show ?thesis + using True 1 by auto + next + case False + show ?thesis + proof (cases "ja=0") + case True + then show ?thesis + using False i ja ja_j by force + next + case False + have "?A $$ (i,ja) = A $$ (i, ja) gmod D" using True ia A i j False by auto + also have "... = A $$ (i, ja) - ((A $$ (i, ja) gdiv D) * D)" + by (subst gmod_gdiv[OF D], auto) + also have "... = - (A $$ (a, j) gdiv D) * A $$ (j + m, ja) + A $$ (i, ja)" + unfolding A_ja_jaD by (simp add: True ia) + finally show ?thesis + using A False True i ia j by auto + qed + qed + next + case False + have "A $$ (j + m, ja) = (D \\<^sub>m (1\<^sub>m n)) $$ (j,ja)" + by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A, auto) + also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto) + also have "... = 0" using False using A a mn ja j by force + finally have A_am_ja0: "A $$ (j + m, ja) = 0" . + then show ?thesis using False i ja by fastforce + qed + finally show ?thesis1 . + have "reduce_element_mod_D_abs A a j D m + = (if j = 0 \ D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A + else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" + unfolding reduce_element_mod_D_abs_def by simp + also have "... $$ (i,ja) = ?A_abs $$ (i,ja)" + proof (cases "ja = j") + case True note ja_j = True + have "A $$ (j + m, ja) = (D \\<^sub>m (1\<^sub>m n)) $$ (j,ja)" + by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A mn, auto) + also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto) + also have "... = D" by (simp add: True j mn) + finally have A_ja_jaD: "A $$ (j + m, ja) = D" . + show ?thesis + proof (cases "j=0 \ D dvd A$$(a,j)") + case True + have 1: "reduce_element_mod_D_abs A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A " + using True ia ja_j unfolding reduce_element_mod_D_abs_def by auto + also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)" + unfolding mat_addrow_def using True ja_j ia + using A i j by auto + also have "... = D" + proof - + have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0" + using True ia ja_j D by force + then show ?thesis + by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2) + ja_j more_arith_simps(3) mult.commute mult_cancel_right1) + qed + also have "... = ?A_abs $$ (i,ja)" using True ia A i j ja_j by auto + finally show ?thesis + using True 1 by auto + next + case False + have i: "i\<^sub>m (1\<^sub>m n)) $$ (j,ja)" + by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A, auto) + also have "... = D * (1\<^sub>m n) $$ (j,ja)" by (rule index_smult_mat, insert ja j A mn, auto) + also have "... = 0" using False using A a mn ja j by force + finally have A_am_ja0: "A $$ (j + m, ja) = 0" . + then show ?thesis using False i ja by fastforce + qed + finally show ?thesis2 . + qed + from this + show "\i ja. i ja < dim_col ?A \ reduce_element_mod_D A a j D m $$ (i, ja) = ?A $$ (i, ja)" + and "\i ja. i ja < dim_col ?A_abs \ reduce_element_mod_D_abs A a j D m $$ (i, ja) = ?A_abs $$ (i, ja)" + using dr dc by auto +next + show "dim_row (reduce_element_mod_D A a j D m) = dim_row ?A" + and "dim_col (reduce_element_mod_D A a j D m) = dim_col ?A" + "dim_row (reduce_element_mod_D_abs A a j D m) = dim_row ?A_abs" + and "dim_col (reduce_element_mod_D_abs A a j D m) = dim_col ?A_abs" + by auto +qed + + +lemma reduce_row_mod_D: + assumes A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" + and A': "A' \ carrier_mat m n" and a: "aj\set xs. jn" + and "D > 0" + shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k \ set xs then if k = 0 then if D dvd A$$(i,k) + then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" + using assms +proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D.induct) + case (1 A a D m) + then show ?case by force +next + case (2 A a x xs D m) + let ?reduce_xs = "(reduce_element_mod_D A a x D m)" + have 1: "reduce_row_mod_D A a (x # xs) D m + = reduce_row_mod_D ?reduce_xs a xs D m" by simp + have 2: "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k = j then if j = 0 then if D dvd A$$(i,k) + then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" if "j(i,k). if i = a \ k \ set xs then + if k=0 then if D dvd ?reduce_xs $$ (i, k) then D else ?reduce_xs $$ (i, k) + else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))" + proof (rule "2.hyps") + let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \ [0..r (D \\<^sub>m (1\<^sub>m n))" + by (rule reduce_element_mod_D_append, insert "2.prems", auto) + qed (insert "2.prems", auto) + also have "... = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k \ set (x # xs) then if k = 0 then if D dvd A$$(i,k) + then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs") + proof (rule eq_matI) + show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto + fix i j assume i: "i j \ set xs") + case True note ia_jxs = True + have j_not_x: "j\x" + using "2.prems"(5) True by auto + show ?thesis + proof (cases "j=0 \ D dvd ?reduce_xs $$(i,j)") + case True + have "?lhs $$ (i,j) = D" + using True i j ia_jxs by auto + also have "... = ?rhs $$ (i,j)" using i j j_not_x + by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn) + finally show ?thesis . + next + case False note nc1 = False + show ?thesis + proof (cases "j=0") + case True + then show ?thesis + by (smt (z3) "2" False case_prod_conv dim_col_mat(1) dim_row_mat(1) i index_mat(1) j j_not_x xn) + next + case False + have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D" + using True False i j by auto + also have "... = A $$ (i,j) gmod D" using 2[OF xn] j_not_x i j by auto + also have "... = ?rhs $$ (i,j)" using i j j_not_x \D > 0\ + using False True dim_col_mat(1) dim_row_mat(1) index_mat(1) list.set_intros(2) old.prod.case + by auto + finally show ?thesis . + qed + qed + next + case False + show ?thesis using 2 i j xn + by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2)) + qed + qed + finally show ?case using 1 by simp +qed + + + + +lemma reduce_row_mod_D_abs: + assumes A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" + and A': "A' \ carrier_mat m n" and a: "aj\set xs. jn" + and "D > 0" + shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k \ set xs then if k = 0 \ D dvd A$$(i,k) + then D else A$$(i,k) gmod D else A$$(i,k))" + using assms +proof (induct A a xs D m arbitrary: A' rule: reduce_row_mod_D_abs.induct) + case (1 A a D m) + then show ?case by force +next + case (2 A a x xs D m) + let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)" + have 1: "reduce_row_mod_D_abs A a (x # xs) D m + = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp + have 2: "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k = j then if j = 0 \ D dvd A$$(i,k) then D + else A$$(i,k) gmod D else A$$(i,k))" if "j(i,k). if i = a \ k \ set xs then + if k=0 \ D dvd ?reduce_xs $$ (i, k) then D + else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))" + proof (rule "2.hyps") + let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \ [0..r (D \\<^sub>m (1\<^sub>m n))" + by (rule reduce_element_mod_D_append, insert "2.prems", auto) + qed (insert "2.prems", auto) + also have "... = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k \ set (x # xs) then if k = 0 \ D dvd A$$(i,k) + then D else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs") + proof (rule eq_matI) + show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto + fix i j assume i: "i j \ set xs") + case True note ia_jxs = True + have j_not_x: "j\x" + using "2.prems"(5) True by auto + show ?thesis + proof (cases "j=0 \ D dvd ?reduce_xs $$(i,j)") + case True + have "?lhs $$ (i,j) = D" + using True i j ia_jxs by auto + also have "... = ?rhs $$ (i,j)" using i j j_not_x + by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn) + finally show ?thesis . + next + case False + have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D" + using True False i j by auto + also have "... = A $$ (i,j) gmod D" using 2[OF xn] j_not_x i j by auto + also have "... = ?rhs $$ (i,j)" using i j j_not_x \D > 0\ + using "2" False True dim_col_mat(1) dim_row_mat(1) index_mat(1) list.set_intros(2) + old.prod.case xn by auto + finally show ?thesis . + qed + next + case False + show ?thesis using 2 i j xn + by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2)) + qed + qed + finally show ?case using 1 by simp +qed +end + + +text \Now, we prove some transfer rules to connect B\'ezout matrices in HOL Analysis and JNF\ +(*Connecting Bezout Matrix in HOL Analysis (thm bezout_matrix_def) and JNF (thm bezout_matrix_JNF_def)*) +lemma HMA_bezout_matrix[transfer_rule]: + shows "((Mod_Type_Connect.HMA_M :: _ \ 'a :: {bezout_ring} ^ 'n :: mod_type ^ 'm :: mod_type \ _) + ===> (Mod_Type_Connect.HMA_I :: _ \ 'm \ _) ===> (Mod_Type_Connect.HMA_I :: _ \ 'm \ _) + ===> (Mod_Type_Connect.HMA_I :: _ \ 'n \ _) ===> (=) ===> (Mod_Type_Connect.HMA_M)) + (bezout_matrix_JNF) (bezout_matrix)" +proof (intro rel_funI, goal_cases) + case (1 A A' a a' b b' j j' bezout bezout') + note HMA_AA'[transfer_rule] = "1"(1) + note HMI_aa'[transfer_rule] = "1"(2) + note HMI_bb'[transfer_rule] = "1"(3) + note HMI_jj'[transfer_rule] = "1"(4) + note eq_bezout'[transfer_rule] = "1"(5) + show ?case unfolding Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma\<^sub>m_def + proof (rule eq_matI) + let ?A = "Matrix.mat CARD('m) CARD('m) (\(i, j). bezout_matrix A' a' b' j' bezout' + $h mod_type_class.from_nat i $h mod_type_class.from_nat j)" + show "dim_row (bezout_matrix_JNF A a b j bezout) = dim_row ?A" + and "dim_col (bezout_matrix_JNF A a b j bezout) = dim_col ?A" + using Mod_Type_Connect.dim_row_transfer_rule[OF HMA_AA'] + unfolding bezout_matrix_JNF_def by auto + fix i ja assume i: "i < dim_row ?A" and ja: "ja < dim_col ?A" + let ?i = "mod_type_class.from_nat i :: 'm" + let ?ja = "mod_type_class.from_nat ja :: 'm" + have i_A: "i < dim_row A" + using HMA_AA' Mod_Type_Connect.dim_row_transfer_rule i by fastforce + have ja_A: "ja < dim_row A" + using Mod_Type_Connect.dim_row_transfer_rule[OF HMA_AA'] ja by fastforce + have HMA_I_ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i ?i" + unfolding Mod_Type_Connect.HMA_I_def using from_nat_not_eq i by auto + have HMA_I_ja'[transfer_rule]: "Mod_Type_Connect.HMA_I ja ?ja" + unfolding Mod_Type_Connect.HMA_I_def using from_nat_not_eq ja by auto + have Aaj: "A' $h a' $h j' = A $$ (a,j)" unfolding index_hma_def[symmetric] by (transfer, simp) + have Abj: "A' $h b' $h j' = A $$ (b, j)" unfolding index_hma_def[symmetric] by (transfer, simp) + have "?A $$ (i, ja) = bezout_matrix A' a' b' j' bezout' $h ?i $h ?ja" using i ja by auto + also have "... = (let (p, q, u, v, d) = bezout' (A' $h a' $h j') (A' $h b' $h j') + in if ?i = a' \ ?ja = a' then p else if ?i = a' \ ?ja = b' then q else if ?i = b' \ ?ja = a' + then u else if ?i = b' \ ?ja = b' then v else if ?i = ?ja then 1 else 0)" + unfolding bezout_matrix_def by auto + also have "... = (let + (p, q, u, v, d) = bezout (A $$ (a, j)) (A $$ (b, j)) + in + if i = a \ ja = a then p else + if i = a \ ja = b then q else + if i = b \ ja = a then u else + if i = b \ ja = b then v else + if i = ja then 1 else 0)" unfolding eq_bezout' Aaj Abj by (transfer, simp) + also have "... = bezout_matrix_JNF A a b j bezout $$ (i,ja)" + unfolding bezout_matrix_JNF_def using i_A ja_A by auto + finally show "bezout_matrix_JNF A a b j bezout $$ (i, ja) = ?A $$ (i, ja)" .. + qed +qed + +(*thm invertible_bezout_matrix must be transferred from HOL Analysis to JNF*) + +context +begin + +private lemma invertible_bezout_matrix_JNF_mod_type: + fixes A::"'a::{bezout_ring_div} mat" + assumes "A \ carrier_mat CARD('m::mod_type) CARD('n::mod_type)" + assumes ib: "is_bezout_ext bezout" + and a_less_b: "a < b" and b: "b 0" +shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" +proof - + define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: 'a ^'n :: mod_type ^'m :: mod_type)" + define a' where "a' = (Mod_Type.from_nat a :: 'm)" + define b' where "b' = (Mod_Type.from_nat b :: 'm)" + define j' where "j' = (Mod_Type.from_nat j :: 'n)" + have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" + unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto + have aa'[transfer_rule]: "Mod_Type_Connect.HMA_I a a'" + unfolding Mod_Type_Connect.HMA_I_def a'_def using assms + using from_nat_not_eq order.strict_trans by blast + have bb'[transfer_rule]: "Mod_Type_Connect.HMA_I b b'" + unfolding Mod_Type_Connect.HMA_I_def b'_def using assms + using from_nat_not_eq order.strict_trans by blast + have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I j j'" + unfolding Mod_Type_Connect.HMA_I_def j'_def using assms + using from_nat_not_eq order.strict_trans by blast + have [transfer_rule]: "bezout = bezout" .. + have [transfer_rule]: "Mod_Type_Connect.HMA_M (bezout_matrix_JNF A a b j bezout) + (bezout_matrix A' a' b' j' bezout)" + by transfer_prover + have "invertible (bezout_matrix A' a' b' j' bezout)" + proof (rule invertible_bezout_matrix[OF ib]) + show "a' < b'" using a_less_b by (simp add: a'_def b b'_def from_nat_mono) + show "A' $h a' $h j' \ 0" unfolding index_hma_def[symmetric] using aj by (transfer, simp) + qed + thus ?thesis by (transfer, simp) +qed + +private lemma invertible_bezout_matrix_JNF_nontriv_mod_ring: + fixes A::"'a::{bezout_ring_div} mat" + assumes "A \ carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)" + assumes ib: "is_bezout_ext bezout" + and a_less_b: "a < b" and b: "b 0" +shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" + using assms invertible_bezout_matrix_JNF_mod_type by (smt CARD_mod_ring) + + +(*We internalize both sort constraints in one step*) +lemmas invertible_bezout_matrix_JNF_internalized = + invertible_bezout_matrix_JNF_nontriv_mod_ring[unfolded CARD_mod_ring, + internalize_sort "'m::nontriv", internalize_sort "'c::nontriv"] + +context + fixes m::nat and n::nat + assumes local_typedef1: "\(Rep :: ('b \ int)) Abs. type_definition Rep Abs {0..(Rep :: ('c \ int)) Abs. type_definition Rep Abs {0..1" + and n: "n>1" +begin + +lemma type_to_set1: + shows "class.nontriv TYPE('b)" (is ?a) and "m=CARD('b)" (is ?b) +proof - + from local_typedef1 obtain Rep::"('b \ int)" and Abs + where t: "type_definition Rep Abs {0.. int)" and Abs + where t: "type_definition Rep Abs {0.. carrier_mat m n" + assumes ib: "is_bezout_ext bezout" + and a_less_b: "a < b" and b: "b 0" +shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" + using invertible_bezout_matrix_JNF_internalized[OF type_to_set2(1) type_to_set(1), where ?'aa = 'b] + using assms + using type_to_set1(2) type_to_set2(2) local_typedef1 m by blast +end + + +(*Canceling the first local type definitions*) +context +begin + +(*Canceling the first*) +private lemma invertible_bezout_matrix_JNF_cancelled_first: +"\Rep Abs. type_definition Rep Abs {0.. {0.. {} \ +1 < m \ 1 < n \ +(A::'a::bezout_ring_div mat) \ carrier_mat m n \ is_bezout_ext bezout +\ a < b \ b < m \ j < n \ A $$ (a, j) \ 0 \ invertible_mat (bezout_matrix_JNF A a b j bezout)" + using invertible_bezout_matrix_JNF_nontriv_mod_ring_aux[cancel_type_definition] by blast + +(*Canceling the second*) +private lemma invertible_bezout_matrix_JNF_cancelled_both: +"{0.. {} \ {0.. {} \ 1 < m \ 1 < n \ +1 < m \ 1 < n \ +(A::'a::bezout_ring_div mat) \ carrier_mat m n \ is_bezout_ext bezout +\ a < b \ b < m \ j < n \ A $$ (a, j) \ 0 \ invertible_mat (bezout_matrix_JNF A a b j bezout)" + using invertible_bezout_matrix_JNF_cancelled_first[cancel_type_definition] by blast + +(*The final result in JNF*) +lemma invertible_bezout_matrix_JNF': + fixes A::"'a::{bezout_ring_div} mat" + assumes "A \ carrier_mat m n" + assumes ib: "is_bezout_ext bezout" + and a_less_b: "a < b" and b: "b1" (* Required from the mod_type restrictions*) + and aj: "A $$ (a, j) \ 0" +shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" + using invertible_bezout_matrix_JNF_cancelled_both assms by auto + +(*Trick: we want to get rid out the "n>1" assumption, which has appeared since CARD('m::mod_type)>1. +Given an mx1 matrix, we just append another column and the bezout_matrix is the same, so it will +also be invertible by the previous transfered theorem +*) +lemma invertible_bezout_matrix_JNF_n1: + fixes A::"'a::{bezout_ring_div} mat" + assumes A: "A \ carrier_mat m n" + assumes ib: "is_bezout_ext bezout" + and a_less_b: "a < b" and b: "b 0" +shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" +proof - + let ?A = "A @\<^sub>c (0\<^sub>m m n)" + have "(A @\<^sub>c 0\<^sub>m m n) $$ (a, j) = (if j < dim_col A then A $$ (a, j) else (0\<^sub>m m n) $$ (a, j - n))" + by (rule append_cols_nth[OF A], insert assms, auto) + also have "... = A $$ (a,j)" using assms by auto + finally have Aaj: "(A @\<^sub>c 0\<^sub>m m n) $$ (a, j) = A $$ (a,j)" . + have "(A @\<^sub>c 0\<^sub>m m n) $$ (b, j) = (if j < dim_col A then A $$ (b, j) else (0\<^sub>m m n) $$ (b, j - n))" + by (rule append_cols_nth[OF A], insert assms, auto) + also have "... = A $$ (b,j)" using assms by auto + finally have Abj: "(A @\<^sub>c 0\<^sub>m m n) $$ (b, j) = A $$ (b, j)" . + have dr: "dim_row A = dim_row ?A" by (simp add: append_cols_def) + have dc: "dim_col ?A = 2" + by (metis Suc_1 append_cols_def A n1 carrier_matD(2) index_mat_four_block(3) + index_zero_mat(3) plus_1_eq_Suc) + have bz_eq: "bezout_matrix_JNF A a b j bezout = bezout_matrix_JNF ?A a b j bezout" + unfolding bezout_matrix_JNF_def Aaj Abj dr by auto + have "invertible_mat (bezout_matrix_JNF ?A a b j bezout)" + by (rule invertible_bezout_matrix_JNF', insert assms Aaj Abj dr dc, auto) + thus ?thesis using bz_eq by simp +qed + +(*The final result in JNF without requiring n>1*) +corollary invertible_bezout_matrix_JNF: + fixes A::"'a::{bezout_ring_div} mat" + assumes "A \ carrier_mat m n" + assumes ib: "is_bezout_ext bezout" + and a_less_b: "a < b" and b: "b 0" +shows "invertible_mat (bezout_matrix_JNF A a b j bezout)" + using invertible_bezout_matrix_JNF_n1 invertible_bezout_matrix_JNF' assms + by (metis One_nat_def gr_implies_not0 less_Suc0 not_less_iff_gr_or_eq) + +end +end + +text \We continue with the soundness of the algorithm\ + +lemma bezout_matrix_JNF_mult_eq: + assumes A': "A' \ carrier_mat m n" and a: "a\m" and b: "b\m" and ab: "a \ b" + and A_def: "A = A' @\<^sub>r B" and B: "B \ carrier_mat n n" + assumes pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,j)) (A$$(b,j))" + shows "Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k)) + else if i = b then u * A$$(a,k) + v * A$$(b,k) + else A$$(i,k) + ) = (bezout_matrix_JNF A a b j euclid_ext2) * A" (is "?A = ?BM * A") +proof (rule eq_matI) + have A: "A \ carrier_mat (m+n) n" using A_def A' B by simp + hence A_carrier: "?A \ carrier_mat (m+n) n" by auto + show dr: "dim_row ?A = dim_row (?BM * A)" and dc: "dim_col ?A = dim_col (?BM * A)" + unfolding bezout_matrix_JNF_def by auto + fix i ja assume i: "i < dim_row (?BM * A)" and ja: "ja < dim_col (?BM * A)" + let ?f = "\ia. (bezout_matrix_JNF A a b j euclid_ext2) $$ (i,ia) * A $$ (ia,ja)" + have dv: "dim_vec (col A ja) = m+n" using A by auto + have i_dr: "i col A ja" + by (rule index_mult_mat, insert i ja, auto) + also have "... = (\ia = 0..ia = 0..ia \ ({a,b} \ ({0.. {0.. i" using True x by blast + have x_dr: "x < dim_row A" using x A by auto + have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0" + unfolding bezout_matrix_JNF_def + unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto + thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto + qed + have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = p" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True pquvd + by (auto, metis split_conv) + have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = q" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True pquvd ab + by (auto, metis split_conv) + have "sum ?f {a,b} + sum ?f ({0.. {0.. i" using True x by blast + have x_dr: "x < dim_row A" using x A by auto + have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0" + unfolding bezout_matrix_JNF_def + unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto + thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto + qed + have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = u" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True i_not_a pquvd + by (auto, metis split_conv) + have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = v" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True i_not_a pquvd ab + by (auto, metis split_conv) + have "sum ?f {a,b} + sum ?f ({0.. {0.. i" using x by blast + have x_dr: "x < dim_row A" using x A by auto + have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0" + unfolding bezout_matrix_JNF_def + unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto + thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto + qed + have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = 0" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using False i_not_a pquvd + by auto + have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = 0" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using False i_not_a pquvd + by auto + have "sum ?f ({0.. carrier_mat m n" and a: "a b" + and A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and a_less_b: "a < b" + and mn: "m\n" + and D_ge0: "D > 0" +shows "\P. invertible_mat P \ P \ carrier_mat (m+n) (m+n) \ (reduce a b D A) = P * A" (is ?thesis1) +proof - + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))" + by (metis prod_cases5) + let ?A = "Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k)) + else if i = b then u * A$$(a,k) + v * A$$(b,k) + else A$$(i,k) + )" + have D: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by auto + have A: "A \ carrier_mat (m+n) n" using A_def A' by simp + hence A_carrier: "?A \ carrier_mat (m+n) n" by auto + + let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2" + have A'_BZ_A: "?A = ?BM * A" + by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def D pquvd], insert a b, auto) + have invertible_bezout: "invertible_mat ?BM" + by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a_less_b _ j Aaj], + insert a_less_b b, auto) + have BM: "?BM \ carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto + + define xs where "xs = [0..r D \\<^sub>m 1\<^sub>m n" + proof (rule matrix_append_rows_eq_if_preserves[OF A_carrier D], rule+) + fix i j assume i: "i \ {m..\<^sub>m (1\<^sub>m n))$$(i-m,j))" + by (unfold A_def, rule append_rows_nth[OF A' D _ j], insert i, auto) + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, j)" using i A' by auto + finally show "?A $$ (i,j) = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, j)" . + qed + have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) + (\(i, k). if i = a \ k \ set xs then if k = 0 then if D dvd ?A$$(i,k) then D + else ?A $$ (i, k) else ?A $$ (i, k) gmod D else ?A $$ (i, k))" + by (rule reduce_row_mod_D[OF A_A'_D _ a _], insert xs_def mn D_ge0, auto) + have reduce_a: "?reduce_a \ carrier_mat (m+n) n" using reduce_a_eq A by auto + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ ?reduce_a = P * ?A" + by (rule reduce_row_mod_D_invertible_mat[OF A_A'_D _ a], insert xs_def mn, auto) + from this obtain P where P: "P \ carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" + and reduce_a_PA: "?reduce_a = P * ?A" by blast + define ys where "ys = [1..r D \\<^sub>m 1\<^sub>m n" + proof (rule matrix_append_rows_eq_if_preserves[OF reduce_a D], rule+) + fix i ja assume i: "i \ {m..a" and i_not_b: "i\b" using i a b by auto + have "?reduce_a $$ (i,ja) = ?A $$ (i, ja)" + unfolding reduce_a_eq using i i_not_a i_not_b ja A by auto + also have "... = A $$ (i,ja)" using i i_not_a i_not_b ja A by auto + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" + by (smt D append_rows_nth A' A_def atLeastLessThan_iff + carrier_matD(1) i ja less_irrefl_nat nat_SN.compat) + finally show "?reduce_a $$ (i,ja) = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" . + qed + have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a) + (\(i, k). if i = b \ k \ set ys then if k = 0 then if D dvd ?reduce_a$$(i,k) then D else ?reduce_a $$ (i, k) + else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))" + by (rule reduce_row_mod_D[OF reduce_a_B'_D _ b _ _ mn], unfold ys_def, insert D_ge0, auto) + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ ?reduce_b = P * ?reduce_a" + by (rule reduce_row_mod_D_invertible_mat[OF reduce_a_B'_D _ b _ mn], insert ys_def, auto) + from this obtain Q where Q: "Q \ carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" + and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast + have reduce_b_eq_reduce: "?reduce_b = (reduce a b D A)" + proof (rule eq_matI) + show dr_eq: "dim_row ?reduce_b = dim_row (reduce a b D A)" + and dc_eq: "dim_col ?reduce_b = dim_col (reduce a b D A)" + using reduce_preserves_dimensions by auto + fix i ja assume i: "ia \ i\b)") + case True + have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions) + also have "... = ?A $$ (i,ja)" + by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n + reduce_a_eq reduce_preserves_dimensions(1) split_conv) + also have "... = A $$ (i,ja)" using A True im ja_n by auto + also have "... = (reduce a b D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd] + using im ja_n A True by auto + finally show ?thesis . + next + case False note a_or_b = False + show ?thesis + proof (cases "i=a") + case True note ia = True + hence i_not_b: "i\b" using ab by auto + show ?thesis + proof - + have ja_in_xs: "ja \ set xs" + unfolding xs_def using True ja_n im a A unfolding set_filter by auto + have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2) + reduce_b_eq reduce_row_mod_D_preserves_dimensions(2)) + show ?thesis + proof (cases "ja = 0 \ D dvd p*A$$(a,ja) + q*A$$(b,ja)") + case True + have "?reduce_a $$ (i,ja) = D" + unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto + also have "... = (reduce a b D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] + using True a_or_b i_not_b ja_n im A False + by auto + finally show ?thesis using 1 by simp + next + case False note nc1 = False + show ?thesis + proof (cases "ja=0") + case True + then show ?thesis + by (smt (z3) "1" A assms(3) assms(7) dim_col_mat(1) dim_row_mat(1) euclid_ext2_works i ia im index_mat(1) + ja ja_in_xs old.prod.case pquvd reduce_gcd reduce_preserves_dimensions reduce_a_eq) + next + case False + have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D" + unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto + also have "... = (reduce a b D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto + finally show ?thesis using 1 by simp + qed + qed + qed + next + case False note i_not_a = False + have i_drb: "i set ys") + case True note ja_in_ys = True + hence ja_not0: "ja \ 0" unfolding ys_def by auto + have "?reduce_b $$ (i,ja) = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D + else ?reduce_a $$ (i, ja) else ?reduce_a $$ (i, ja) gmod D)" + unfolding reduce_b_eq using i_not_a True ja ja_in_ys + by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2)) + also have "... = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D else ?A $$ (i, ja) else ?A $$ (i, ja) gmod D)" + unfolding reduce_a_eq using True ab a_or_b ib False ja_n im a A ja_in_ys by auto + also have "... = (reduce a b D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using True ja_not0 False a_or_b ib ja_n im A + using i_not_a by auto + finally show ?thesis . + next + case False + hence ja0:"ja = 0" using ja_n unfolding ys_def by auto + have rw0: "u * A $$ (a, ja) + v * A $$ (b, ja) = 0" + unfolding euclid_ext2_works[OF pquvd[symmetric]] ja0 + by (smt euclid_ext2_works[OF pquvd[symmetric]] more_arith_simps(11) mult.commute mult_minus_left) + have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt False a_or_b dc_eq dim_row_mat(1) dr_eq i index_mat(1) ja + prod.simps(2) reduce_b_eq reduce_row_mod_D_preserves_dimensions(2)) + also have "... = ?A $$ (i, ja)" + unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A by auto + also have "... = u * A $$ (a, ja) + v * A $$ (b, ja)" + by (smt (verit, ccfv_SIG) A \ja = 0\ assms(3) assms(5) carrier_matD(2) i ib index_mat(1) + old.prod.case reduce_preserves_dimensions(1)) + also have "... = (reduce a b D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] + using False a_or_b i_not_a ja_n im A ja0 by auto + finally show ?thesis . + qed + qed + qed + qed + have inv_QPBM: "invertible_mat (Q * P * ?BM)" + by (meson BM P Q inv_P inv_Q invertible_bezout invertible_mult_JNF mult_carrier_mat) + moreover have "(Q*P*?BM) \ carrier_mat (m + n) (m + n)" using BM P Q by auto + moreover have "(reduce a b D A) = (Q*P*?BM) * A" + proof - + have "?BM * A = ?A" using A'_BZ_A by auto + hence "P * (?BM * A) = ?reduce_a" using reduce_a_PA by auto + hence "Q * (P * (?BM * A)) = ?reduce_b" using reduce_b_Q_reduce by auto + thus ?thesis using reduce_b_eq_reduce + by (smt A A'_BZ_A A_carrier BM P Q assoc_mult_mat mn mult_carrier_mat reduce_a_PA) + qed + ultimately show ?thesis by blast +qed + + +lemma reduce_abs_invertible_mat: + assumes A': "A' \ carrier_mat m n" and a: "a b" + and A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and a_less_b: "a < b" + and mn: "m\n" + and D_ge0: "D > 0" +shows "\P. invertible_mat P \ P \ carrier_mat (m+n) (m+n) \ (reduce_abs a b D A) = P * A" (is ?thesis1) +proof - + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))" + by (metis prod_cases5) + let ?A = "Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k)) + else if i = b then u * A$$(a,k) + v * A$$(b,k) + else A$$(i,k) + )" + have D: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by auto + have A: "A \ carrier_mat (m+n) n" using A_def A' by simp + hence A_carrier: "?A \ carrier_mat (m+n) n" by auto + + let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2" + have A'_BZ_A: "?A = ?BM * A" + by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def D pquvd], insert a b, auto) + have invertible_bezout: "invertible_mat ?BM" + by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a_less_b _ j Aaj], + insert a_less_b b, auto) + have BM: "?BM \ carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto + + define xs where "xs = filter (\i. abs (?A $$ (a,i)) > D) [0..r D \\<^sub>m 1\<^sub>m n" + proof (rule matrix_append_rows_eq_if_preserves[OF A_carrier D], rule+) + fix i j assume i: "i \ {m..\<^sub>m (1\<^sub>m n))$$(i-m,j))" + by (unfold A_def, rule append_rows_nth[OF A' D _ j], insert i, auto) + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, j)" using i A' by auto + finally show "?A $$ (i,j) = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, j)" . + qed + have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) + (\(i, k). if i = a \ k \ set xs then + if k = 0 \ D dvd ?A$$(i,k) then D else ?A $$ (i, k) gmod D else ?A $$ (i, k))" + by (rule reduce_row_mod_D_abs[OF A_A'_D _ a _], insert xs_def mn D_ge0, auto) + have reduce_a: "?reduce_a \ carrier_mat (m+n) n" using reduce_a_eq A by auto + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ ?reduce_a = P * ?A" + by (rule reduce_row_mod_D_abs_invertible_mat[OF A_A'_D _ a], insert xs_def mn, auto) + from this obtain P where P: "P \ carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" + and reduce_a_PA: "?reduce_a = P * ?A" by blast + define ys where "ys = filter (\i. abs (?A $$ (b,i)) > D) [0..r D \\<^sub>m 1\<^sub>m n" + proof (rule matrix_append_rows_eq_if_preserves[OF reduce_a D], rule+) + fix i ja assume i: "i \ {m..a" and i_not_b: "i\b" using i a b by auto + have "?reduce_a $$ (i,ja) = ?A $$ (i, ja)" + unfolding reduce_a_eq using i i_not_a i_not_b ja A by auto + also have "... = A $$ (i,ja)" using i i_not_a i_not_b ja A by auto + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" + by (smt D append_rows_nth A' A_def atLeastLessThan_iff + carrier_matD(1) i ja less_irrefl_nat nat_SN.compat) + finally show "?reduce_a $$ (i,ja) = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" . + qed + have reduce_b_eq: "?reduce_b = Matrix.mat (dim_row ?reduce_a) (dim_col ?reduce_a) + (\(i, k). if i = b \ k \ set ys then if k = 0 \ D dvd ?reduce_a$$(i,k) then D + else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))" + by (rule reduce_row_mod_D_abs[OF reduce_a_B'_D _ b _ _ mn], unfold ys_def, insert D_ge0, auto) + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ ?reduce_b = P * ?reduce_a" + by (rule reduce_row_mod_D_abs_invertible_mat[OF reduce_a_B'_D _ b _ mn], insert ys_def, auto) + from this obtain Q where Q: "Q \ carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" + and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast + have reduce_b_eq_reduce: "?reduce_b = (reduce_abs a b D A)" + proof (rule eq_matI) + show dr_eq: "dim_row ?reduce_b = dim_row (reduce_abs a b D A)" + and dc_eq: "dim_col ?reduce_b = dim_col (reduce_abs a b D A)" + using reduce_preserves_dimensions by auto + fix i ja assume i: "ia \ i\b)") + case True + have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions_abs) + also have "... = ?A $$ (i,ja)" + by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n + reduce_a_eq reduce_preserves_dimensions(3) split_conv) + also have "... = A $$ (i,ja)" using A True im ja_n by auto + also have "... = (reduce_abs a b D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd] + using im ja_n A True by auto + finally show ?thesis . + next + case False note a_or_b = False + show ?thesis + proof (cases "i=a") + case True note ia = True + hence i_not_b: "i\b" using ab by auto + show ?thesis + proof (cases "abs((p*A$$(a,ja) + q*A$$(b,ja))) > D") + case True note ge_D = True + have ja_in_xs: "ja \ set xs" + unfolding xs_def using True ja_n im a A unfolding set_filter by auto + have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2) + reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2)) + show ?thesis + proof (cases "ja = 0 \ D dvd p*A$$(a,ja) + q*A$$(b,ja)") + case True + have "?reduce_a $$ (i,ja) = D" + unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto + also have "... = (reduce_abs a b D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] + using True a_or_b i_not_b ja_n im A False ge_D + by auto + finally show ?thesis using 1 by simp + next + case False + have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D" + unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto + also have "... = (reduce_abs a b D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto + finally show ?thesis using 1 by simp + qed + next + case False + have ja_in_xs: "ja \ set xs" + unfolding xs_def using False ja_n im a A unfolding set_filter by auto + have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2) + reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2)) + also have "... = ?A $$ (i, ja)" + unfolding reduce_a_eq using False ab a_or_b i_not_b ja_n im a A ja_in_xs by auto + also have "... = (reduce_abs a b D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using False a_or_b i_not_b ja_n im A by auto + finally show ?thesis . + qed + next + case False note i_not_a = False + have i_drb: "i D") + case True note ge_D = True + have ja_in_ys: "ja \ set ys" + unfolding ys_def using True False ib ja_n im a b A unfolding set_filter by auto + have "?reduce_b $$ (i,ja) = (if ja = 0 \ D dvd ?reduce_a$$(i,ja) then D else ?reduce_a $$ (i, ja) gmod D)" + unfolding reduce_b_eq using i_not_a True ja ja_in_ys + by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2)) + also have "... = (if ja = 0 \ D dvd ?reduce_a$$(i,ja) then D else ?A $$ (i, ja) gmod D)" + unfolding reduce_a_eq using True ab a_or_b ib False ja_n im a A ja_in_ys by auto + also have "... = (reduce_abs a b D A) $$ (i,ja)" + proof (cases "ja = 0 \ D dvd ?reduce_a$$(i,ja)") + case True + have ja0: "ja=0" using True by auto + have "u * A $$ (a, ja) + v * A $$ (b, ja) = 0" + unfolding euclid_ext2_works[OF pquvd[symmetric]] ja0 + by (smt euclid_ext2_works[OF pquvd[symmetric]] more_arith_simps(11) mult.commute mult_minus_left) + hence abs_0: "abs((u*A$$(a,ja) + v * A$$(b,ja))) = 0" by auto + show ?thesis using abs_0 D_ge0 ge_D by linarith + next + case False + then show ?thesis + unfolding reduce_alt_def_not0[OF Aaj pquvd] using True ge_D False a_or_b ib ja_n im A + using i_not_a by auto + qed + finally show ?thesis . + next + case False + have ja_in_ys: "ja \ set ys" + unfolding ys_def using i_not_a False ib ja_n im a b A unfolding set_filter by auto + have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + using i_dra ja_dra ja_in_ys by auto + also have "... = ?A $$ (i, ja)" + unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A by auto + also have "... = u * A $$ (a, ja) + v * A $$ (b, ja)" + unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A ja_in_ys by auto + also have "... = (reduce_abs a b D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] + using False a_or_b i_not_a ja_n im A by auto + finally show ?thesis . + qed + qed + qed + qed + have inv_QPBM: "invertible_mat (Q * P * ?BM)" + by (meson BM P Q inv_P inv_Q invertible_bezout invertible_mult_JNF mult_carrier_mat) + moreover have "(Q*P*?BM) \ carrier_mat (m + n) (m + n)" using BM P Q by auto + moreover have "(reduce_abs a b D A) = (Q*P*?BM) * A" + proof - + have "?BM * A = ?A" using A'_BZ_A by auto + hence "P * (?BM * A) = ?reduce_a" using reduce_a_PA by auto + hence "Q * (P * (?BM * A)) = ?reduce_b" using reduce_b_Q_reduce by auto + thus ?thesis using reduce_b_eq_reduce + by (smt A A'_BZ_A A_carrier BM P Q assoc_mult_mat mn mult_carrier_mat reduce_a_PA) + qed + ultimately show ?thesis by blast +qed + + + + +lemma reduce_element_mod_D_case_m': + assumes A_def: "A = A' @\<^sub>r B" and B: "B\carrier_mat n n" + and A': "A' \ carrier_mat m n" and a: "a\m" and j: "j=n" and B1: "B $$ (j, j) = D" and B2: "(\j'\{0.. 0" + shows "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k = j then if j = 0 then if D dvd A$$(i,k) then D + else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A") +proof (rule eq_matI) + have jm: "j carrier_mat (m+n) n" using A_def A' B mn by simp + fix i ja assume i: "i < dim_row ?A" and ja: "ja < dim_col ?A" + show "reduce_element_mod_D A a j D m $$ (i, ja) = ?A $$ (i, ja)" + proof (cases "i=a") + case False + have "reduce_element_mod_D A a j D m = (if j = 0 then if D dvd A$$(a,j) + then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A + else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" + unfolding reduce_element_mod_D_def by simp + also have "... $$ (i,ja) = A $$ (i, ja)" unfolding mat_addrow_def using False ja i by auto + also have "... = ?A $$ (i,ja)" using False using i ja by auto + finally show ?thesis . + next + case True note ia = True + have "reduce_element_mod_D A a j D m + = (if j = 0 then if D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A else A + else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" + unfolding reduce_element_mod_D_def by simp + also have "... $$ (i,ja) = ?A $$ (i,ja)" + proof (cases "ja = j") + case True note ja_j = True + have "A $$ (j + m, ja) = B $$ (j,ja)" + by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A B mn, auto) + also have "... = D" using True j mn B1 B2 B by auto + finally have A_ja_jaD: "A $$ (j + m, ja) = D" . + + show ?thesis + proof (cases "j=0 \ D dvd A$$(a,j)") + case True + have 1: "reduce_element_mod_D A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A " + using True ia ja_j unfolding reduce_element_mod_D_def by auto + also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)" + unfolding mat_addrow_def using True ja_j ia + using A i j by auto + also have "... = D" + proof - + have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0" + using True ia ja_j using D0 by force + then show ?thesis + by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2) + ja_j more_arith_simps(3) mult.commute mult_cancel_right1) + qed + also have "... = ?A $$ (i,ja)" using True ia A i j ja_j by auto + finally show ?thesis + using True 1 by auto + next + case False + show ?thesis + proof (cases "j=0") + case True + then show ?thesis + using False i ja by auto + next + case False + have "?A $$ (i,ja) = A $$ (i, ja) gmod D" using True ia A i j False by auto + also have "... = A $$ (i, ja) - ((A $$ (i, ja) gdiv D) * D)" + by (subst gmod_gdiv[OF D0], auto) + also have "... = - (A $$ (a, j) gdiv D) * A $$ (j + m, ja) + A $$ (i, ja)" + unfolding A_ja_jaD by (simp add: True ia) + finally show ?thesis + using A False True i ia j by auto + qed + qed + next + case False + have "A $$ (j + m, ja) = B $$ (j,ja)" + by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A B, auto) + also have "... = 0" using False using A a mn ja j B2 by force + finally have A_am_ja0: "A $$ (j + m, ja) = 0" . + then show ?thesis using False i ja by fastforce + qed + finally show ?thesis . + qed +next + show "dim_row (reduce_element_mod_D A a j D m) = dim_row ?A" + and "dim_col (reduce_element_mod_D A a j D m) = dim_col ?A" + using reduce_element_mod_D_def by auto +qed + + + + +lemma reduce_element_mod_D_abs_case_m': + assumes A_def: "A = A' @\<^sub>r B" and B: "B\carrier_mat n n" + and A': "A' \ carrier_mat m n" and a: "a\m" and j: "j=n" and B1: "B $$ (j, j) = D" and B2: "(\j'\{0.. 0" + shows "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k = j then if j = 0 \ D dvd A$$(i,k) then D else A$$(i,k) gmod D else A$$(i,k))" (is "_ = ?A") +proof (rule eq_matI) + have jm: "j carrier_mat (m+n) n" using A_def A' B mn by simp + fix i ja assume i: "i < dim_row ?A" and ja: "ja < dim_col ?A" + show "reduce_element_mod_D_abs A a j D m $$ (i, ja) = ?A $$ (i, ja)" + proof (cases "i=a") + case False + have "reduce_element_mod_D_abs A a j D m = (if j = 0 \ D dvd A$$(a,j) + then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A + else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" + unfolding reduce_element_mod_D_abs_def by simp + also have "... $$ (i,ja) = A $$ (i, ja)" unfolding mat_addrow_def using False ja i by auto + also have "... = ?A $$ (i,ja)" using False using i ja by auto + finally show ?thesis . + next + case True note ia = True + have "reduce_element_mod_D_abs A a j D m + = (if j = 0 \ D dvd A$$(a,j) then addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A + else addrow (-((A$$(a,j) gdiv D))) a (j + m) A)" + unfolding reduce_element_mod_D_abs_def by simp + also have "... $$ (i,ja) = ?A $$ (i,ja)" + proof (cases "ja = j") + case True note ja_j = True + have "A $$ (j + m, ja) = B $$ (j,ja)" + by (rule append_rows_nth2[OF A' _ A_def ], insert j ja A B mn, auto) + also have "... = D" using True j mn B1 B2 B by auto + finally have A_ja_jaD: "A $$ (j + m, ja) = D" . + + show ?thesis + proof (cases "j=0 \ D dvd A$$(a,j)") + case True + have 1: "reduce_element_mod_D_abs A a j D m = addrow (-((A$$(a,j) gdiv D)) + 1) a (j + m) A " + using True ia ja_j unfolding reduce_element_mod_D_abs_def by auto + also have "... $$(i,ja) = (- (A $$ (a, j) gdiv D) + 1) * A $$ (j + m, ja) + A $$ (i, ja)" + unfolding mat_addrow_def using True ja_j ia + using A i j by auto + also have "... = D" + proof - + have "A $$ (i, ja) + D * - (A $$ (i, ja) gdiv D) = 0" + using True ia ja_j using D0 by force + then show ?thesis + by (metis A_ja_jaD ab_semigroup_add_class.add_ac(1) add.commute add_right_imp_eq ia int_distrib(2) + ja_j more_arith_simps(3) mult.commute mult_cancel_right1) + qed + also have "... = ?A $$ (i,ja)" using True ia A i j ja_j by auto + finally show ?thesis + using True 1 by auto + next + case False + have "?A $$ (i,ja) = A $$ (i, ja) gmod D" using True ia A i j False by auto + also have "... = A $$ (i, ja) - ((A $$ (i, ja) gdiv D) * D)" + by (subst gmod_gdiv[OF D0], auto) + also have "... = - (A $$ (a, j) gdiv D) * A $$ (j + m, ja) + A $$ (i, ja)" + unfolding A_ja_jaD by (simp add: True ia) + finally show ?thesis + using A False True i ia j by auto + qed + next + case False + have "A $$ (j + m, ja) = B $$ (j,ja)" + by (rule append_rows_nth2[OF A' _ A_def ], insert j mn ja A B, auto) + also have "... = 0" using False using A a mn ja j B2 by force + finally have A_am_ja0: "A $$ (j + m, ja) = 0" . + then show ?thesis using False i ja by fastforce + qed + finally show ?thesis . + qed +next + show "dim_row (reduce_element_mod_D_abs A a j D m) = dim_row ?A" + and "dim_col (reduce_element_mod_D_abs A a j D m) = dim_col ?A" + using reduce_element_mod_D_abs_def by auto +qed + + +lemma reduce_row_mod_D_case_m': + assumes A_def: "A = A' @\<^sub>r B" and "B \ carrier_mat n n" + and A': "A' \ carrier_mat m n" and "a < m" + and j: "\j\set xs. j (B $$ (j, j) = D) \ (\j'\{0..n" + and D: "D > 0" + shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k \ set xs then if k = 0 then if D dvd A$$(i,k) then D + else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" + using assms +proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct) + case (1 A a D m) + then show ?case by force +next + case (2 A a x xs D m) + note A_A'B = "2.prems"(1) + note B = "2.prems"(2) + note A' = "2.prems"(3) + note a = "2.prems"(4) + note j = "2.prems"(5) + note mn = "2.prems"(7) + note d = "2.prems"(6) + let ?reduce_xs = "(reduce_element_mod_D A a x D m)" + have reduce_xs_carrier: "?reduce_xs \ carrier_mat (m + n) n" + by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3) + reduce_element_mod_D_preserves_dimensions) + have 1: "reduce_row_mod_D A a (x # xs) D m + = reduce_row_mod_D ?reduce_xs a xs D m" by simp + have 2: "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k = j then if j = 0 then if D dvd A$$(i,k) + then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" if "j\set (x#xs)" for j + by (rule reduce_element_mod_D_case_m'[OF A_A'B B A'], insert "2.prems" that, auto) + have "reduce_row_mod_D ?reduce_xs a xs D m = + Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\(i,k). if i = a \ k \ set xs + then if k = 0 then if D dvd ?reduce_xs $$ (i, k) then D else ?reduce_xs $$ (i, k) else + ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))" + proof (rule "2.hyps"[OF _ B _ a _ _ mn]) + let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \ [0..r B" + proof (rule matrix_append_rows_eq_if_preserves[OF reduce_xs_carrier B]) + show " \i\{m..j(i,k). if i = a \ k \ set (x # xs) then if k = 0 then if D dvd A$$(i,k) + then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs") + proof (rule eq_matI) + show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto + fix i j assume i: "i j \ set xs") + case True note ia_jxs = True + have j_not_x: "j\x" using d True by auto + show ?thesis + proof (cases "j=0 \ D dvd ?reduce_xs $$(i,j)") + case True + have "?lhs $$ (i,j) = D" + using True i j ia_jxs by auto + also have "... = ?rhs $$ (i,j)" using i j j_not_x + by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn) + finally show ?thesis . + next + case False + show ?thesis + proof (cases "j=0") + case True + then show ?thesis + by (smt (z3) "2" dim_col_mat(1) dim_row_mat(1) i index_mat(1) insert_iff j list.set(2) old.prod.case) + next + case False + have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D" + using True False i j by auto + also have "... = A $$ (i,j) gmod D" using 2[OF ] j_not_x i j by auto + also have "... = ?rhs $$ (i,j)" using i j j_not_x + using False True dim_col_mat(1) dim_row_mat(1) index_mat(1) + list.set_intros(2) old.prod.case by auto + finally show ?thesis . + qed + qed + next + case False + show ?thesis using 2 i j xn + by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2)) + qed + qed + finally show ?case using 1 by simp +qed + + + + +lemma reduce_row_mod_D_abs_case_m': + assumes A_def: "A = A' @\<^sub>r B" and "B \ carrier_mat n n" + and A': "A' \ carrier_mat m n" and "a < m" + and j: "\j\set xs. j (B $$ (j, j) = D) \ (\j'\{0..n" + and D: "D > 0" + shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k \ set xs then if k = 0 \ D dvd A$$(i,k) then D + else A$$(i,k) gmod D else A$$(i,k))" + using assms +proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct) + case (1 A a D m) + then show ?case by force +next + case (2 A a x xs D m) + note A_A'B = "2.prems"(1) + note B = "2.prems"(2) + note A' = "2.prems"(3) + note a = "2.prems"(4) + note j = "2.prems"(5) + note mn = "2.prems"(7) + note d = "2.prems"(6) + let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)" + have reduce_xs_carrier: "?reduce_xs \ carrier_mat (m + n) n" + by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3) + reduce_element_mod_D_preserves_dimensions) + have 1: "reduce_row_mod_D_abs A a (x # xs) D m + = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp + have 2: "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k = j then if j = 0 \ D dvd A$$(i,k) + then D else A$$(i,k) gmod D else A$$(i,k))" if "j\set (x#xs)" for j + by (rule reduce_element_mod_D_abs_case_m'[OF A_A'B B A'], insert "2.prems" that, auto) + have "reduce_row_mod_D_abs ?reduce_xs a xs D m = + Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\(i,k). if i = a \ k \ set xs + then if k = 0 \ D dvd ?reduce_xs $$ (i, k) then D else + ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))" + proof (rule "2.hyps"[OF _ B _ a _ _ mn]) + let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \ [0..r B" + proof (rule matrix_append_rows_eq_if_preserves[OF reduce_xs_carrier B]) + show " \i\{m..j(i,k). if i = a \ k \ set (x # xs) then if k = 0 \ D dvd A$$(i,k) + then D else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs") + proof (rule eq_matI) + show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto + fix i j assume i: "i j \ set xs") + case True note ia_jxs = True + have j_not_x: "j\x" using d True by auto + show ?thesis + proof (cases "j=0 \ D dvd ?reduce_xs $$(i,j)") + case True + have "?lhs $$ (i,j) = D" + using True i j ia_jxs by auto + also have "... = ?rhs $$ (i,j)" using i j j_not_x + by (smt "2" calculation dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2) xn) + finally show ?thesis . + next + case False + have "?lhs $$ (i,j) = ?reduce_xs $$ (i, j) gmod D" + using True False i j by auto + also have "... = A $$ (i,j) gmod D" using 2[OF ] j_not_x i j by auto + also have "... = ?rhs $$ (i,j)" using i j j_not_x + by (smt False True \Matrix.mat (dim_row ?reduce_xs) + (dim_col ?reduce_xs) (\(i, k). if i = a \ k \ set xs + then if k = 0 \ D dvd ?reduce_xs $$ (i, k) + then D else ?reduce_xs $$ (i, k) gmod D + else ?reduce_xs $$ (i, k)) $$ (i, j) = ?reduce_xs $$ (i, j) gmod D\ + calculation dim_col_mat(1) dim_row_mat(1) dvd_imp_gmod_0[OF \D > 0\] index_mat(1) + insert_iff list.set(2) gmod_0_imp_dvd prod.simps(2)) + finally show ?thesis . + qed + next + case False + show ?thesis using 2 i j xn + by (smt False dim_col_mat(1) dim_row_mat(1) index_mat(1) insert_iff list.set(2) prod.simps(2)) + qed + qed + finally show ?case using 1 by simp +qed + + + +lemma + assumes A_def: "A = A' @\<^sub>r B" and B: "B \ carrier_mat n n" + and A': "A' \ carrier_mat m n" and a: "an" +shows reduce_element_mod_D_invertible_mat_case_m: + "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ reduce_element_mod_D A a j D m = P * A" (is ?thesis1) + and reduce_element_mod_D_abs_invertible_mat_case_m: + "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_element_mod_D_abs A a j D m = P * A" (is ?thesis2) + unfolding atomize_conj +proof (rule conjI; cases "j = 0 \ D dvd A$$(a,j)") + case True + let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D) + 1) a (j + m)" + have A: "A \ carrier_mat (m + n) n" using A_def A' B mn by auto + have "reduce_element_mod_D_abs A a j D m = addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A" + unfolding reduce_element_mod_D_abs_def using True by auto + also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto) + finally have rw: "reduce_element_mod_D_abs A a j D m = ?P * A" . + have "reduce_element_mod_D A a j D m = addrow (- (A $$ (a, j) gdiv D) + 1) a (j + m) A" + unfolding reduce_element_mod_D_def using True by auto + also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto) + finally have "reduce_element_mod_D A a j D m = ?P * A" . + moreover have "?P \ carrier_mat (m+n) (m+n)" by simp + moreover have "invertible_mat ?P" + by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right + invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1) + ultimately show ?thesis1 and ?thesis2 using rw by blast+ +next + case False + show ?thesis1 + proof (cases "j=0") + case True + have "reduce_element_mod_D A a j D m = A" unfolding reduce_element_mod_D_def using False True by auto + then show ?thesis + by (metis A_def assms(2) assms(3) carrier_append_rows invertible_mat_one left_mult_one_mat one_carrier_mat) + next + case False + let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)" + have A: "A \ carrier_mat (m + n) n" using A_def B A' mn by auto + have "reduce_element_mod_D A a j D m = addrow (- (A $$ (a, j) gdiv D)) a (j + m) A" + unfolding reduce_element_mod_D_def using False by auto + also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto) + finally have "reduce_element_mod_D A a j D m = ?P * A" . + moreover have "?P \ carrier_mat (m+n) (m+n)" by simp + moreover have "invertible_mat ?P" + by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right + invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1) + ultimately show ?thesis by blast + qed + show ?thesis2 + proof - + let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)" + have A: "A \ carrier_mat (m + n) n" using A_def B A' mn by auto + have "reduce_element_mod_D_abs A a j D m = addrow (- (A $$ (a, j) gdiv D)) a (j + m) A" + unfolding reduce_element_mod_D_abs_def using False by auto + also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto) + finally have "reduce_element_mod_D_abs A a j D m = ?P * A" . + moreover have "?P \ carrier_mat (m+n) (m+n)" by simp + moreover have "invertible_mat ?P" + by (metis addrow_mat_carrier a det_addrow_mat dvd_mult_right + invertible_iff_is_unit_JNF mult.right_neutral not_add_less2 semiring_gcd_class.gcd_dvd1) + ultimately show ?thesis by blast + qed +qed + + +lemma reduce_row_mod_D_invertible_mat_case_m: + assumes A_def: "A = A' @\<^sub>r B" and "B \ carrier_mat n n" + and A': "A' \ carrier_mat m n" and a: "a < m" + and j: "\j\set xs. j (B $$ (j, j) = D) \ (\j'\{0..n" + shows "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_row_mod_D A a xs D m = P * A" + using assms +proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct) + case (1 A a D m) + show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def) +next + case (2 A a x xs D m) + note A_def = "2.prems"(1) + note B = "2.prems"(2) + note A' = "2.prems"(3) + note a = "2.prems"(4) + note j = "2.prems"(5) + note mn = "2.prems"(6) + let ?reduce_xs = "(reduce_element_mod_D A a x D m)" + have 1: "reduce_row_mod_D A a (x # xs) D m + = reduce_row_mod_D ?reduce_xs a xs D m" by simp + have "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_element_mod_D A a x D m = P * A" + by (rule reduce_element_mod_D_invertible_mat_case_m, insert "2.prems", auto) + from this obtain P where P: "P \ carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P" + and R_P: "reduce_element_mod_D A a x D m = P * A" by auto + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P + \ reduce_row_mod_D ?reduce_xs a xs D m = P * ?reduce_xs" + proof (rule "2.hyps") + let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \ [0..r ?B'" + by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD + index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(2)) + show "\j\set xs. j < n \ ?B' $$ (j, j) = D \ (\j'\{0.. set xs" + have jn: "jj'\{0..{0.. ?B' $$ (j, j) = D \ (\j'\{0..m" using "2.prems" by auto + qed + from this obtain P2 where P2: "P2 \ carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2" + and R_P2: "reduce_row_mod_D ?reduce_xs a xs D m = P2 * ?reduce_xs" + by auto + have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast + moreover have "(P2 * P) \ carrier_mat (m+n) (m+n)" using P2 P by auto + moreover have "reduce_row_mod_D A a (x # xs) D m = (P2 * P) * A" + by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv + index_mult_mat reduce_row_mod_D_preserves_dimensions) + ultimately show ?case by blast +qed + + + + +lemma reduce_row_mod_D_abs_invertible_mat_case_m: + assumes A_def: "A = A' @\<^sub>r B" and "B \ carrier_mat n n" + and A': "A' \ carrier_mat m n" and a: "a < m" + and j: "\j\set xs. j (B $$ (j, j) = D) \ (\j'\{0..n" + shows "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_row_mod_D_abs A a xs D m = P * A" + using assms +proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct) + case (1 A a D m) + show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def) +next + case (2 A a x xs D m) + note A_def = "2.prems"(1) + note B = "2.prems"(2) + note A' = "2.prems"(3) + note a = "2.prems"(4) + note j = "2.prems"(5) + note mn = "2.prems"(6) + let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)" + have 1: "reduce_row_mod_D_abs A a (x # xs) D m + = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp + have "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_element_mod_D_abs A a x D m = P * A" + by (rule reduce_element_mod_D_abs_invertible_mat_case_m, insert "2.prems", auto) + from this obtain P where P: "P \ carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P" + and R_P: "reduce_element_mod_D_abs A a x D m = P * A" by auto + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P + \ reduce_row_mod_D_abs ?reduce_xs a xs D m = P * ?reduce_xs" + proof (rule "2.hyps") + let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \ [0..r ?B'" + by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD + index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(4)) + show "\j\set xs. j < n \ ?B' $$ (j, j) = D \ (\j'\{0.. set xs" + have jn: "jj'\{0..{0.. ?B' $$ (j, j) = D \ (\j'\{0..m" using "2.prems" by auto + qed + from this obtain P2 where P2: "P2 \ carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2" + and R_P2: "reduce_row_mod_D_abs ?reduce_xs a xs D m = P2 * ?reduce_xs" + by auto + have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast + moreover have "(P2 * P) \ carrier_mat (m+n) (m+n)" using P2 P by auto + moreover have "reduce_row_mod_D_abs A a (x # xs) D m = (P2 * P) * A" + by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv + index_mult_mat reduce_row_mod_D_preserves_dimensions_abs) + ultimately show ?case by blast +qed + + + + +(*Similar to thm reduce_row_mod_D_case_m' but including the case a = m. +This could substitute the previous version.*) +lemma reduce_row_mod_D_case_m'': + assumes A_def: "A = A' @\<^sub>r B" and "B \ carrier_mat n n" + and A': "A' \ carrier_mat m n" and "a \ m" + and j: "\j\set xs. j (B $$ (j, j) = D) \ (\j'\{0..n" and "0 \ set xs" + and "D > 0" + shows "reduce_row_mod_D A a xs D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k \ set xs then if k = 0 then if D dvd A$$(i,k) then D + else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" + using assms +proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct) + case (1 A a D m) + then show ?case by force +next + case (2 A a x xs D m) + note A_A'B = "2.prems"(1) + note B = "2.prems"(2) + note A' = "2.prems"(3) + note a = "2.prems"(4) + note j = "2.prems"(5) + note mn = "2.prems"(7) + note d = "2.prems"(6) + note zero_not_xs = "2.prems"(8) + let ?reduce_xs = "(reduce_element_mod_D A a x D m)" + have reduce_xs_carrier: "?reduce_xs \ carrier_mat (m + n) n" + by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3) + reduce_element_mod_D_preserves_dimensions) + have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast + have 1: "reduce_row_mod_D A a (x # xs) D m + = reduce_row_mod_D ?reduce_xs a xs D m" by simp + have 2: "reduce_element_mod_D A a j D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k = j then if j = 0 then if D dvd A$$(i,k) + then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" if "j\set (x#xs)" for j + by (rule reduce_element_mod_D_case_m'[OF A_A'B B A'], insert "2.prems" that, auto) + have "reduce_row_mod_D ?reduce_xs a xs D m = + Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\(i,k). if i = a \ k \ set xs + then if k=0 then if D dvd ?reduce_xs $$ (i, k) then D else ?reduce_xs $$ (i, k) + else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))" + proof (rule "2.hyps"[OF _ _ _ a _ _ mn]) + let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D A a x D m) i. i \ [0.. [m..r B'" + by (metis B'_def append_rows_split carrier_matD + reduce_element_mod_D_preserves_dimensions(1) reduce_xs_carrier le_add1) + show "\j\set xs. j (B' $$ (j, j) = D) \ (\j'\{0..set xs" + have "B $$ (j,j') = B' $$ (j,j')" if j': "j' B' $$ (j, j) = D \ (\j'\{0..(i,k). if i = a \ k \ set (x # xs) then if k = 0 then if D dvd A$$(i,k) + then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs") + proof (rule eq_matI) + show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto + fix i j assume i: "i j \ set xs") + case True note ia_jxs = True + have j_not_x: "j\x" using d True by auto + show ?thesis + proof (cases "j=0 \ D dvd ?reduce_xs $$(i,j)") + case True + have "?lhs $$ (i,j) = D" + using True i j ia_jxs by auto + also have "... = ?rhs $$ (i,j)" using i j j_not_x + by (metis "2.prems"(8) True ia_jxs list.set_intros(2)) + finally show ?thesis . + next + case False + show ?thesis + by (smt (z3) "2" "2.prems"(8) dim_col_mat(1) dim_row_mat(1) i index_mat(1) insert_iff j j_not_x list.set(2) old.prod.case) + qed + next + case False + show ?thesis using 2 i j xn + by (smt (z3) "2.prems"(8) False carrier_matD(2) dim_row_mat(1) index_mat(1) + insert_iff jn list.set(2) old.prod.case reduce_element_mod_D_preserves_dimensions(2) reduce_xs_carrier) + qed + qed + finally show ?case using 1 by simp +qed + + + + +(*Similar to thm reduce_row_mod_D_abs_case_m' but including the case a = m. +This could substitute the previous version.*) +lemma reduce_row_mod_D_abs_case_m'': + assumes A_def: "A = A' @\<^sub>r B" and "B \ carrier_mat n n" + and A': "A' \ carrier_mat m n" and "a \ m" + and j: "\j\set xs. j (B $$ (j, j) = D) \ (\j'\{0..n" and "0 \ set xs" + and "D > 0" + shows "reduce_row_mod_D_abs A a xs D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k \ set xs then if k = 0 \ D dvd A$$(i,k) then D + else A$$(i,k) gmod D else A$$(i,k))" + using assms +proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct) + case (1 A a D m) + then show ?case by force +next + case (2 A a x xs D m) + note A_A'B = "2.prems"(1) + note B = "2.prems"(2) + note A' = "2.prems"(3) + note a = "2.prems"(4) + note j = "2.prems"(5) + note mn = "2.prems"(7) + note d = "2.prems"(6) + note zero_not_xs = "2.prems"(8) + let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)" + have reduce_xs_carrier: "?reduce_xs \ carrier_mat (m + n) n" + by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3) + reduce_element_mod_D_preserves_dimensions) + have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast + have 1: "reduce_row_mod_D_abs A a (x # xs) D m + = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp + have 2: "reduce_element_mod_D_abs A a j D m = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a \ k = j then if j = 0 \ D dvd A$$(i,k) + then D else A$$(i,k) gmod D else A$$(i,k))" if "j\set (x#xs)" for j + by (rule reduce_element_mod_D_abs_case_m'[OF A_A'B B A'], insert "2.prems" that, auto) + have "reduce_row_mod_D_abs ?reduce_xs a xs D m = + Matrix.mat (dim_row ?reduce_xs) (dim_col ?reduce_xs) (\(i,k). if i = a \ k \ set xs + then if k=0 \ D dvd ?reduce_xs $$ (i, k) then D + else ?reduce_xs $$ (i, k) gmod D else ?reduce_xs $$ (i, k))" + proof (rule "2.hyps"[OF _ _ _ a _ _ mn]) + let ?A' = "mat_of_rows n [Matrix.row (reduce_element_mod_D_abs A a x D m) i. i \ [0.. [m..r B'" + by (metis B'_def append_rows_split carrier_matD + reduce_element_mod_D_preserves_dimensions(3) reduce_xs_carrier le_add1) + show "\j\set xs. j (B' $$ (j, j) = D) \ (\j'\{0..set xs" + have "B $$ (j,j') = B' $$ (j,j')" if j': "j' B' $$ (j, j) = D \ (\j'\{0..(i,k). if i = a \ k \ set (x # xs) then if k = 0 then if D dvd A$$(i,k) + then D else A$$(i,k) else A$$(i,k) gmod D else A$$(i,k))" (is "?lhs = ?rhs") + proof (rule eq_matI) + show "dim_row ?lhs = dim_row ?rhs" and "dim_col ?lhs = dim_col ?rhs" by auto + fix i j assume i: "i j \ set xs") + case True note ia_jxs = True + have j_not_x: "j\x" using d True by auto + show ?thesis + proof (cases "j=0 \ D dvd ?reduce_xs $$(i,j)") + case True + have "?lhs $$ (i,j) = D" + using True i j ia_jxs by auto + also have "... = ?rhs $$ (i,j)" using i j j_not_x + by (metis "2.prems"(8) True ia_jxs list.set_intros(2)) + finally show ?thesis . + next + case False + show ?thesis + by (smt (z3) "2" "2.prems"(8) dim_col_mat(1) dim_row_mat(1) i index_mat(1) insert_iff j j_not_x list.set(2) old.prod.case) + qed + next + case False + show ?thesis using 2 i j xn + by (smt (z3) "2.prems"(8) False carrier_matD(2) dim_row_mat(1) index_mat(1) + insert_iff jn list.set(2) old.prod.case reduce_element_mod_D_preserves_dimensions(4) reduce_xs_carrier) + qed + qed + finally show ?case using 1 + by (smt (verit, ccfv_SIG) "2.prems"(8) cong_mat split_conv) +qed + + + +lemma + assumes A_def: "A = A' @\<^sub>r B" and B: "B \ carrier_mat n n" + and A': "A' \ carrier_mat m n" and a: "a\m" and j: "jn" and j0: "j\0" +shows reduce_element_mod_D_invertible_mat_case_m': + "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ reduce_element_mod_D A a j D m = P * A" (is ?thesis1) + and reduce_element_mod_D_abs_invertible_mat_case_m': + "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ reduce_element_mod_D_abs A a j D m = P * A" (is ?thesis2) +proof - + let ?P = "addrow_mat (m+n) (- (A $$ (a, j) gdiv D)) a (j + m)" + have jm: "j+m \a" using j0 a by auto + have A: "A \ carrier_mat (m + n) n" using A_def A' B mn by auto + have rw: "reduce_element_mod_D A a j D m = reduce_element_mod_D_abs A a j D m" + unfolding reduce_element_mod_D_def reduce_element_mod_D_abs_def using j0 by auto + have "reduce_element_mod_D A a j D m = addrow (- (A $$ (a, j) gdiv D)) a (j + m) A" + unfolding reduce_element_mod_D_def using j0 by auto + also have "... = ?P * A" by (rule addrow_mat[OF A], insert j mn, auto) + finally have "reduce_element_mod_D A a j D m = ?P * A" . + moreover have "?P \ carrier_mat (m+n) (m+n)" by simp + moreover have "invertible_mat ?P" + by (metis addrow_mat_carrier det_addrow_mat dvd_mult_right jm + invertible_iff_is_unit_JNF mult.right_neutral semiring_gcd_class.gcd_dvd1) + ultimately show ?thesis1 and ?thesis2 using rw by metis+ +qed + +(*Similar to reduce_row_mod_D_invertible_mat_case_m but including the case a = m, and then +adding the assumption 0 not in set xs.*) +lemma reduce_row_mod_D_invertible_mat_case_m': + assumes A_def: "A = A' @\<^sub>r B" and "B \ carrier_mat n n" + and A': "A' \ carrier_mat m n" and a: "a \ m" + and j: "\j\set xs. j (B $$ (j, j) = D) \ (\j'\{0..n" and "0\ set xs" + shows "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_row_mod_D A a xs D m = P * A" + using assms +proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D.induct) + case (1 A a D m) + show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def) +next + case (2 A a x xs D m) + note A_A'B = "2.prems"(1) + note B = "2.prems"(2) + note A' = "2.prems"(3) + note a = "2.prems"(4) + note j = "2.prems"(5) + note mn = "2.prems"(7) + note d = "2.prems"(6) + note zero_not_xs = "2.prems"(8) + let ?reduce_xs = "(reduce_element_mod_D A a x D m)" + have reduce_xs_carrier: "?reduce_xs \ carrier_mat (m + n) n" + by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3) + reduce_element_mod_D_preserves_dimensions) + have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast + let ?reduce_xs = "(reduce_element_mod_D A a x D m)" + have 1: "reduce_row_mod_D A a (x # xs) D m + = reduce_row_mod_D ?reduce_xs a xs D m" by simp + have "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_element_mod_D A a x D m = P * A" + by (rule reduce_element_mod_D_invertible_mat_case_m'[OF A_A'B B A' a _ mn], + insert zero_not_xs j, auto) + from this obtain P where P: "P \ carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P" + and R_P: "reduce_element_mod_D A a x D m = P * A" by auto + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P + \ reduce_row_mod_D ?reduce_xs a xs D m = P * ?reduce_xs" + proof (rule "2.hyps") + let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \ [0.. carrier_mat n n" by auto + show A'': "?A' : carrier_mat m n" by auto + show reduce_split: "?reduce_xs = ?A' @\<^sub>r ?B'" + by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD + index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(2)) + show "\j\set xs. j < n \ ?B' $$ (j, j) = D \ (\j'\{0..set xs" + have "B $$ (j,j') = ?B' $$ (j,j')" if j': "j' ?B' $$ (j, j) = D \ (\j'\{0.. carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2" + and R_P2: "reduce_row_mod_D ?reduce_xs a xs D m = P2 * ?reduce_xs" + by auto + have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast + moreover have "(P2 * P) \ carrier_mat (m+n) (m+n)" using P2 P by auto + moreover have "reduce_row_mod_D A a (x # xs) D m = (P2 * P) * A" + by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv + index_mult_mat reduce_row_mod_D_preserves_dimensions) + ultimately show ?case by blast +qed + + + +lemma reduce_row_mod_D_abs_invertible_mat_case_m': + assumes A_def: "A = A' @\<^sub>r B" and "B \ carrier_mat n n" + and A': "A' \ carrier_mat m n" and a: "a \ m" + and j: "\j\set xs. j (B $$ (j, j) = D) \ (\j'\{0..n" and "0\ set xs" + shows "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_row_mod_D_abs A a xs D m = P * A" + using assms +proof (induct A a xs D m arbitrary: A' B rule: reduce_row_mod_D_abs.induct) + case (1 A a D m) + show ?case by (rule exI[of _ "1\<^sub>m (m+n)"], insert "1.prems", auto simp add: append_rows_def) +next + case (2 A a x xs D m) + note A_A'B = "2.prems"(1) + note B = "2.prems"(2) + note A' = "2.prems"(3) + note a = "2.prems"(4) + note j = "2.prems"(5) + note mn = "2.prems"(7) + note d = "2.prems"(6) + note zero_not_xs = "2.prems"(8) + let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)" + have reduce_xs_carrier: "?reduce_xs \ carrier_mat (m + n) n" + by (metis "2.prems"(1) "2.prems"(2) "2.prems"(3) add.right_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) index_zero_mat(2,3) + reduce_element_mod_D_preserves_dimensions) + have A: "A:carrier_mat (m+n) n" using A' B A_A'B by blast + let ?reduce_xs = "(reduce_element_mod_D_abs A a x D m)" + have 1: "reduce_row_mod_D_abs A a (x # xs) D m + = reduce_row_mod_D_abs ?reduce_xs a xs D m" by simp + have "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ + reduce_element_mod_D_abs A a x D m = P * A" + by (rule reduce_element_mod_D_abs_invertible_mat_case_m'[OF A_A'B B A' a _ mn], + insert zero_not_xs j, auto) + from this obtain P where P: "P \ carrier_mat (m+n) (m+n)" and inv_P: "invertible_mat P" + and R_P: "reduce_element_mod_D_abs A a x D m = P * A" by auto + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P + \ reduce_row_mod_D_abs ?reduce_xs a xs D m = P * ?reduce_xs" + proof (rule "2.hyps") + let ?A' = "mat_of_rows n [Matrix.row ?reduce_xs i. i \ [0.. carrier_mat n n" by auto + show A'': "?A' : carrier_mat m n" by auto + show reduce_split: "?reduce_xs = ?A' @\<^sub>r ?B'" + by (smt "2"(2) "2"(4) P R_P add.comm_neutral append_rows_def append_rows_split carrier_matD + index_mat_four_block(3) index_mult_mat(2) index_zero_mat(3) le_add1 reduce_element_mod_D_preserves_dimensions(4)) + show "\j\set xs. j < n \ ?B' $$ (j, j) = D \ (\j'\{0..set xs" + have "B $$ (j,j') = ?B' $$ (j,j')" if j': "j' ?B' $$ (j, j) = D \ (\j'\{0.. carrier_mat (m + n) (m + n)" and inv_P2: "invertible_mat P2" + and R_P2: "reduce_row_mod_D_abs ?reduce_xs a xs D m = P2 * ?reduce_xs" + by auto + have "invertible_mat (P2 * P)" using P P2 inv_P inv_P2 invertible_mult_JNF by blast + moreover have "(P2 * P) \ carrier_mat (m+n) (m+n)" using P2 P by auto + moreover have "reduce_row_mod_D_abs A a (x # xs) D m = (P2 * P) * A" + by (smt P P2 R_P R_P2 1 assoc_mult_mat carrier_matD carrier_mat_triv + index_mult_mat reduce_row_mod_D_preserves_dimensions_abs) + ultimately show ?case by blast +qed + + +lemma reduce_invertible_mat_case_m: + assumes A': "A' \ carrier_mat m n" and B: "B \ carrier_mat n n" + and a: "a m" + and A_def: "A = A' @\<^sub>r B" + and j: "\j\set xs. j (B $$ (j, j) = D) \ (\j'\{0.. 0" + and mn: "m\n" + and n0: "0(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k)) + else if i = m then u * A$$(a,k) + v * A$$(m,k) + else A$$(i,k) + )" + and xs_def: "xs = [1..j\set ys. j (B $$ (j, j) = D) \ (\j'\{0.. 0" + and Am0_D: "A $$ (m, 0) \ {0,D}" + and Am0_D2: "A $$ (m, 0) = 0 \ A $$ (a, 0) = D" +shows "\P. invertible_mat P \ P \ carrier_mat (m+n) (m+n) \ (reduce a m D A) = P * A" +proof - + let ?A = "Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k)) + else if i = m then u * A$$(a,k) + v * A$$(m,k) + else A$$(i,k) + )" + have D: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" using mn by auto + have A: "A \ carrier_mat (m+n) n" using A_def A' B mn by simp + hence A_carrier: "?A \ carrier_mat (m+n) n" by auto + + let ?BM = "bezout_matrix_JNF A a m 0 euclid_ext2" + + have A'_BZ_A: "?A = ?BM * A" + by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def B pquvd], insert a, auto) + have invertible_bezout: "invertible_mat ?BM" + by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a _ _ Aaj], insert a n0, auto) + have BM: "?BM \ carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto + let ?reduce_a = "reduce_row_mod_D ?A a xs D m" + define A'1 where "A'1 = mat_of_rows n [Matrix.row ?A i. i \ [0.. [m..r A'2" using append_rows_split A + by (metis (no_types, lifting) A'1_def A'2_def A_carrier carrier_matD le_add1) + have j_A'1_A'2: "\j\set xs. j < n \ A'2 $$ (j, j) = D \ (\j'\{0..set xs" + have ja_n: "ja < n" using ja unfolding xs_def by auto + have ja2: "ja < dim_row A - m" using A mn ja_n by auto + have ja_m: "ja < m" using ja_n mn by auto + have ja_not_0: "ja \ 0" using ja unfolding xs_def by auto + show "ja < n \ A'2 $$ (ja, ja) = D \ (\j'\{0.. [m..r B) $$ (m + ja, ja)" unfolding A_def .. + also have "... = B $$ (ja, ja)" + by (metis B Groups.add_ac(2) append_rows_nth2 assms(1) ja_n mn nat_SN.compat) + also have "... = D" using j ja by blast + finally have A2_D: "A'2 $$ (ja, ja) = D" . + + moreover have "(\j'\{0.. [m..r B) $$ (ja + m, j')" unfolding A_def + by (simp add: add.commute) + also have "... = B $$ (ja, j')" + by (rule append_rows_nth2[OF A' B _ ja_m ja_n], insert j', auto) + also have "... = 0" using mn j' ja_n j ja by auto + finally show "A'2 $$ (ja, j') = 0" . + qed + ultimately show ?thesis using ja_n by simp + qed + qed + have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) + (\(i, k). if i = a \ k \ set xs then if k = 0 then if D dvd ?A $$ (i, k) then D + else ?A $$ (i, k) else ?A $$ (i, k) gmod D else ?A $$ (i, k))" + proof (rule reduce_row_mod_D_case_m'[OF A_A'_D _ _ a j_A'1_A'2 _ mn D0]) + show "A'2 \ carrier_mat n n" using A A'2_def by auto + show "A'1 \ carrier_mat m n" by (simp add: A'1_def mat_of_rows_def) + show "distinct xs" using distinct_filter distinct_upt xs_def by blast + qed + have reduce_a: "?reduce_a \ carrier_mat (m+n) n" using reduce_a_eq A by auto + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ ?reduce_a = P * ?A" + by (rule reduce_row_mod_D_invertible_mat_case_m[OF A_A'_D _ _ _ j_A'1_A'2 mn], + insert a A A'2_def A'1_def, auto) + from this obtain P where P: "P \ carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" + and reduce_a_PA: "?reduce_a = P * ?A" by blast + let ?reduce_b = "reduce_row_mod_D ?reduce_a m ys D m" + let ?B' = "mat_of_rows n [Matrix.row ?reduce_a i. i \ [0.. [0.. [m..r reduce_a2" + by (unfold reduce_a1_def reduce_a2_def, rule append_rows_split, insert mn A, auto) + have zero_notin_ys: "0 \ set ys" + proof - + have m: "m carrier_mat n n" unfolding reduce_a2_def using A by auto + have reduce_a1: "reduce_a1 \ carrier_mat m n" unfolding reduce_a1_def using A by auto + have j2: "\j\set ys. j < n \ reduce_a2 $$ (j, j) = D \ (\j'\{0.. set ys" + have a_jm: "a \ j+m" using a by auto + have m_not_jm: "m \ j + m" using zero_notin_ys j_in_ys by fastforce + have jm: "j+m < dim_row ?A" using A_carrier j_in_ys unfolding ys_def by auto + have jn: "j < dim_col ?A" using A_carrier j_in_ys unfolding ys_def by auto + have jm': "j+m < dim_row A" using A_carrier j_in_ys unfolding ys_def by auto + have jn': "j < dim_col A" using A_carrier j_in_ys unfolding ys_def by auto + have "reduce_a2 $$ (j, j') = B $$ (j,j')" if j': "j' reduce_a2 $$ (j, j) = D \ (\j'\{0..(i, k). if i = m \ k \ set ys then if k = 0 then if D dvd ?reduce_a $$ (i, k) then D + else ?reduce_a $$ (i, k) else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))" + by (rule reduce_row_mod_D_case_m''[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys], + insert D0, auto simp add: ys_def) + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ ?reduce_b = P * ?reduce_a" + by (rule reduce_row_mod_D_invertible_mat_case_m'[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys], + auto simp add: ys_def) + from this obtain Q where Q: "Q \ carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" + and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast + have reduce_b_eq_reduce: "?reduce_b = (reduce a m D A)" + proof (rule eq_matI) + show dr_eq: "dim_row ?reduce_b = dim_row (reduce a m D A)" + and dc_eq: "dim_col ?reduce_b = dim_col (reduce a m D A)" + using reduce_preserves_dimensions by auto + fix i ja assume i: "ia \ i\m)") + case True + have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions) + also have "... = ?A $$ (i,ja)" + by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n + reduce_a_eq reduce_preserves_dimensions(1) split_conv) + also have "... = A $$ (i,ja)" using A True im ja_n by auto + also have "... = (reduce a m D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd] + using im ja_n A True by auto + finally show ?thesis . + next + case False note a_or_b = False + have gcd_pq: "p * A $$ (a, 0) + q * A $$ (m, 0) = gcd (A $$ (a, 0)) (A $$ (m, 0))" + by (metis assms(10) euclid_ext2_works(1) euclid_ext2_works(2)) + have gcd_le_D: "gcd (A $$ (a, 0)) (A $$ (m, 0)) \ D" + by (metis Am0_D D0 assms(17) empty_iff gcd_le1_int gcd_le2_int insert_iff) + show ?thesis + proof (cases "i=a") + case True note ia = True + hence i_not_b: "i\m" using ab by auto + have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2) + reduce_b_eq reduce_row_mod_D_preserves_dimensions(2)) + show ?thesis + proof (cases "ja=0") + case True note ja0 = True + hence ja_notin_xs: "ja \ set xs" unfolding xs_def by auto + have "?reduce_a $$ (i,ja) = p * A $$ (a, 0) + q * A $$ (m, 0)" + unfolding reduce_a_eq using True ja0 ab a_or_b i_not_b ja_n im a A False ja_notin_xs + by auto + also have "... = (reduce a m D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] + using True a_or_b i_not_b ja_n im A False + using gcd_le_D gcd_pq Am0_D Am0_D2 by auto + finally show ?thesis using 1 by auto + next + case False + hence ja_in_xs: "ja \ set xs" + unfolding xs_def using True ja_n im a A unfolding set_filter by auto + have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D" + unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto + also have "... = (reduce a m D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto + finally show ?thesis using 1 by simp + qed + next + case False note i_not_a = False + have i_drb: "i set ys" + unfolding ys_def using False ib ja_n im a A unfolding set_filter by auto + have "?reduce_b $$ (i,ja) = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D + else ?reduce_a $$ (i, ja) else ?reduce_a $$ (i, ja) gmod D)" + unfolding reduce_b_eq using i_not_a ja ja_in_ys + by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2)) + also have "... = (if ja = 0 then if D dvd ?reduce_a$$(i,ja) then D + else ?A $$ (i, ja) else ?A $$ (i, ja) gmod D)" + unfolding reduce_a_eq using ab a_or_b ib False ja_n im a A ja_in_ys by auto + also have "... = (reduce a m D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using False a_or_b ib ja_n im A + using i_not_a by auto + finally show ?thesis . + qed + qed + qed + qed + have r: "?reduce_a = (P*?BM) * A" using A A'_BZ_A BM P reduce_a_PA by auto + have "Q * P * ?BM : carrier_mat (m+n) (m+n)" using P BM Q by auto + moreover have "invertible_mat (Q * P*?BM)" + using inv_P invertible_bezout BM P invertible_mult_JNF inv_Q Q by (metis mult_carrier_mat) + moreover have "(reduce a m D A) = (Q * P * ?BM) * A" using reduce_a_eq r reduce_b_eq_reduce + by (smt BM P Q assoc_mult_mat carrier_matD carrier_mat_triv + dim_row_mat(1) index_mult_mat(2,3) reduce_b_Q_reduce) + ultimately show ?thesis by auto +qed + + + +lemma reduce_abs_invertible_mat_case_m: + assumes A': "A' \ carrier_mat m n" and B: "B \ carrier_mat n n" + and a: "a m" + and A_def: "A = A' @\<^sub>r B" + and j: "\j\set xs. j (B $$ (j, j) = D) \ (\j'\{0.. 0" + and mn: "m\n" + and n0: "0(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k)) + else if i = m then u * A$$(a,k) + v * A$$(m,k) + else A$$(i,k) + )" + and xs_def: "xs = filter (\i. abs (A2 $$ (a,i)) > D) [0..i. abs (A2 $$ (m,i)) > D) [0..j\set ys. j (B $$ (j, j) = D) \ (\j'\{0.. 0" +shows "\P. invertible_mat P \ P \ carrier_mat (m+n) (m+n) \ (reduce_abs a m D A) = P * A" +proof - + let ?A = "Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then (p*A$$(a,k) + q*A$$(m,k)) + else if i = m then u * A$$(a,k) + v * A$$(m,k) + else A$$(i,k) + )" + note xs_def = xs_def[unfolded A2_def] + note ys_def = ys_def[unfolded A2_def] + have D: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" using mn by auto + have A: "A \ carrier_mat (m+n) n" using A_def A' B mn by simp + hence A_carrier: "?A \ carrier_mat (m+n) n" by auto + + let ?BM = "bezout_matrix_JNF A a m 0 euclid_ext2" + + have A'_BZ_A: "?A = ?BM * A" + by (rule bezout_matrix_JNF_mult_eq[OF A' _ _ ab A_def B pquvd], insert a, auto) + have invertible_bezout: "invertible_mat ?BM" + by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a _ _ Aaj], insert a n0, auto) + have BM: "?BM \ carrier_mat (m+n) (m+n)" unfolding bezout_matrix_JNF_def using A by auto + let ?reduce_a = "reduce_row_mod_D_abs ?A a xs D m" + define A'1 where "A'1 = mat_of_rows n [Matrix.row ?A i. i \ [0.. [m..r A'2" using append_rows_split A + by (metis (no_types, lifting) A'1_def A'2_def A_carrier carrier_matD le_add1) + have j_A'1_A'2: "\j\set xs. j < n \ A'2 $$ (j, j) = D \ (\j'\{0..set xs" + have ja_n: "ja < n" using ja unfolding xs_def by auto + have ja2: "ja < dim_row A - m" using A mn ja_n by auto + have ja_m: "ja < m" using ja_n mn by auto + have abs_A_a_ja_D: "\(?A $$ (a,ja))\ > D" using ja unfolding xs_def by auto + have ja_not_0: "ja \ 0" + proof (rule ccontr, simp) + assume ja_a: "ja = 0" + have A_mja_D: "A$$(m,ja) = D" + proof - + have "A$$(m,ja) = (A' @\<^sub>r B) $$ (m, ja)" unfolding A_def .. + also have "... = B $$ (m-m,ja)" + by (metis B append_rows_nth A' assms(9) carrier_matD(1) ja_a less_add_same_cancel1 less_irrefl_nat) + also have "... = B $$ (0,0)" unfolding ja_a by auto + also have "... = D" using mn unfolding ja_a using ja_n ja j ja_a by auto + finally show ?thesis . + qed + have "?A $$ (a, ja) = p*A$$(a,ja) + q*A$$(m,ja)" using A_carrier ja_n a A by auto + also have "... = d" using pquvd A assms(2) ja_n ja_a + by (simp add: bezout_coefficients_fst_snd euclid_ext2_def) + also have "... = gcd (A$$(a,ja)) (A$$(m,ja))" + by (metis euclid_ext2_works(2) ja_a pquvd) + also have "abs(...) \ D" using A_mja_D by (simp add: D0) + finally have "abs (?A $$ (a, ja)) \ D" . + thus False using abs_A_a_ja_D by auto + qed + show "ja < n \ A'2 $$ (ja, ja) = D \ (\j'\{0.. [m..r B) $$ (m + ja, ja)" unfolding A_def .. + also have "... = B $$ (ja, ja)" + by (metis B Groups.add_ac(2) append_rows_nth2 assms(1) ja_n mn nat_SN.compat) + also have "... = D" using j ja by blast + finally have A2_D: "A'2 $$ (ja, ja) = D" . + + moreover have "(\j'\{0.. [m..r B) $$ (ja + m, j')" unfolding A_def + by (simp add: add.commute) + also have "... = B $$ (ja, j')" + by (rule append_rows_nth2[OF A' B _ ja_m ja_n], insert j', auto) + also have "... = 0" using mn j' ja_n j ja by auto + finally show "A'2 $$ (ja, j') = 0" . + qed + ultimately show ?thesis using ja_n by simp + qed + qed + have reduce_a_eq: "?reduce_a = Matrix.mat (dim_row ?A) (dim_col ?A) + (\(i, k). if i = a \ k \ set xs then if k = 0 \ D dvd ?A $$ (i, k) then D else ?A $$ (i, k) gmod D else ?A $$ (i, k))" + proof (rule reduce_row_mod_D_abs_case_m'[OF A_A'_D _ _ a j_A'1_A'2 _ mn D0]) + show "A'2 \ carrier_mat n n" using A A'2_def by auto + show "A'1 \ carrier_mat m n" by (simp add: A'1_def mat_of_rows_def) + show "distinct xs" using distinct_filter distinct_upt xs_def by blast + qed + have reduce_a: "?reduce_a \ carrier_mat (m+n) n" using reduce_a_eq A by auto + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ ?reduce_a = P * ?A" + by (rule reduce_row_mod_D_abs_invertible_mat_case_m[OF A_A'_D _ _ _ j_A'1_A'2 mn], + insert a A A'2_def A'1_def, auto) + from this obtain P where P: "P \ carrier_mat (m + n) (m + n)" and inv_P: "invertible_mat P" + and reduce_a_PA: "?reduce_a = P * ?A" by blast + let ?reduce_b = "reduce_row_mod_D_abs ?reduce_a m ys D m" + let ?B' = "mat_of_rows n [Matrix.row ?reduce_a i. i \ [0.. [0.. [m..r reduce_a2" + by (unfold reduce_a1_def reduce_a2_def, rule append_rows_split, insert mn A, auto) + have zero_notin_ys: "0 \ set ys" + proof - + have m: "m carrier_mat n n" unfolding reduce_a2_def using A by auto + have reduce_a1: "reduce_a1 \ carrier_mat m n" unfolding reduce_a1_def using A by auto + have j2: "\j\set ys. j < n \ reduce_a2 $$ (j, j) = D \ (\j'\{0.. set ys" + have a_jm: "a \ j+m" using a by auto + have m_not_jm: "m \ j + m" using zero_notin_ys j_in_ys by fastforce + have jm: "j+m < dim_row ?A" using A_carrier j_in_ys unfolding ys_def by auto + have jn: "j < dim_col ?A" using A_carrier j_in_ys unfolding ys_def by auto + have jm': "j+m < dim_row A" using A_carrier j_in_ys unfolding ys_def by auto + have jn': "j < dim_col A" using A_carrier j_in_ys unfolding ys_def by auto + have "reduce_a2 $$ (j, j') = B $$ (j,j')" if j': "j' reduce_a2 $$ (j, j) = D \ (\j'\{0..(i, k). if i = m \ k \ set ys then if k = 0 \ D dvd ?reduce_a $$ (i, k) then D else ?reduce_a $$ (i, k) gmod D else ?reduce_a $$ (i, k))" + by (rule reduce_row_mod_D_abs_case_m''[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys], + insert D0, auto simp add: ys_def) + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ ?reduce_b = P * ?reduce_a" + by (rule reduce_row_mod_D_abs_invertible_mat_case_m'[OF reduce_a_split reduce_a2 reduce_a1 _ j2 _ mn zero_notin_ys], + auto simp add: ys_def) + from this obtain Q where Q: "Q \ carrier_mat (m + n) (m + n)" and inv_Q: "invertible_mat Q" + and reduce_b_Q_reduce: "?reduce_b = Q * ?reduce_a" by blast + have reduce_b_eq_reduce: "?reduce_b = (reduce_abs a m D A)" + proof (rule eq_matI) + show dr_eq: "dim_row ?reduce_b = dim_row (reduce_abs a m D A)" + and dc_eq: "dim_col ?reduce_b = dim_col (reduce_abs a m D A)" + using reduce_preserves_dimensions by auto + fix i ja assume i: "ia \ i\m)") + case True + have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt True dr_eq dc_eq i index_mat(1) ja prod.simps(2) reduce_row_mod_D_preserves_dimensions_abs) + also have "... = ?A $$ (i,ja)" + by (smt A True carrier_matD(2) dim_col_mat(1) dim_row_mat(1) i index_mat(1) ja_n + reduce_a_eq reduce_preserves_dimensions(3) split_conv) + also have "... = A $$ (i,ja)" using A True im ja_n by auto + also have "... = (reduce_abs a m D A) $$ (i,ja)" unfolding reduce_alt_def_not0[OF Aaj pquvd] + using im ja_n A True by auto + finally show ?thesis . + next + case False note a_or_b = False + show ?thesis + proof (cases "i=a") + case True note ia = True + hence i_not_b: "i\m" using ab by auto + show ?thesis + proof (cases "abs((p*A$$(a,ja) + q*A$$(m,ja))) > D") + case True note ge_D = True + have ja_in_xs: "ja \ set xs" + unfolding xs_def using True ja_n im a A unfolding set_filter by auto + have 1: "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2) + reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2)) + show ?thesis + proof (cases "ja = 0 \ D dvd p*A$$(a,ja) + q*A$$(m,ja)") + case True + have "?reduce_a $$ (i,ja) = D" + unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto + also have "... = (reduce_abs a m D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] + using True a_or_b i_not_b ja_n im A False ge_D + by auto + finally show ?thesis using 1 by simp + next + case False + have "?reduce_a $$ (i,ja) = ?A $$ (i, ja) gmod D" + unfolding reduce_a_eq using True ab a_or_b i_not_b ja_n im a A ja_in_xs False by auto + also have "... = (reduce_abs a m D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using True a_or_b i_not_b ja_n im A False by auto + finally show ?thesis using 1 by simp + qed + next + case False + have ja_in_xs: "ja \ set xs" + unfolding xs_def using False ja_n im a A unfolding set_filter by auto + have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt ab dc_eq dim_row_mat(1) dr_eq i ia index_mat(1) ja prod.simps(2) + reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2)) + also have "... = ?A $$ (i, ja)" + unfolding reduce_a_eq using False ab a_or_b i_not_b ja_n im a A ja_in_xs by auto + also have "... = (reduce_abs a m D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using False a_or_b i_not_b ja_n im A by auto + finally show ?thesis . + qed + next + case False note i_not_a = False + have i_drb: "i D") + case True note ge_D = True + have ja_in_ys: "ja \ set ys" + unfolding ys_def using True False ib ja_n im a A unfolding set_filter by auto + have "?reduce_b $$ (i,ja) = (if ja = 0 \ D dvd ?reduce_a$$(i,ja) then D else ?reduce_a $$ (i, ja) gmod D)" + unfolding reduce_b_eq using i_not_a True ja ja_in_ys + by (smt i_dra ja_dra a_or_b index_mat(1) prod.simps(2)) + also have "... = (if ja = 0 \ D dvd ?reduce_a$$(i,ja) then D else ?A $$ (i, ja) gmod D)" + unfolding reduce_a_eq using True ab a_or_b ib False ja_n im a A ja_in_ys by auto + also have "... = (reduce_abs a m D A) $$ (i,ja)" + proof (cases "ja = 0 \ D dvd ?reduce_a$$(i,ja)") + case True + have ja0: "ja=0" using True by auto + have "u * A $$ (a, ja) + v * A $$ (m, ja) = 0" + unfolding euclid_ext2_works[OF pquvd[symmetric]] ja0 + by (smt euclid_ext2_works[OF pquvd[symmetric]] more_arith_simps(11) mult.commute mult_minus_left) + hence abs_0: "abs((u*A$$(a,ja) + v * A$$(m,ja))) = 0" by auto + show ?thesis using abs_0 D0 ge_D by linarith + next + case False + then show ?thesis + unfolding reduce_alt_def_not0[OF Aaj pquvd] using True ge_D False a_or_b ib ja_n im A + using i_not_a by auto + qed + finally show ?thesis . + next + case False + have ja_in_ys: "ja \ set ys" + unfolding ys_def using i_not_a False ib ja_n im a A unfolding set_filter by auto + have "?reduce_b $$ (i,ja) = ?reduce_a $$ (i,ja)" unfolding reduce_b_eq + by (smt False a_or_b dc_eq dim_row_mat(1) dr_eq i index_mat(1) ja ja_in_ys + prod.simps(2) reduce_b_eq reduce_row_mod_D_preserves_dimensions_abs(2)) + also have "... = ?A $$ (i, ja)" + unfolding reduce_a_eq using False ab a_or_b i_not_a ja_n im a A ja_in_ys by auto + also have "... = (reduce_abs a m D A) $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using False a_or_b i_not_a ja_n im A by auto + finally show ?thesis . + qed + qed + qed + qed + have r: "?reduce_a = (P*?BM) * A" using A A'_BZ_A BM P reduce_a_PA by auto + have "Q * P * ?BM : carrier_mat (m+n) (m+n)" using P BM Q by auto + moreover have "invertible_mat (Q * P*?BM)" + using inv_P invertible_bezout BM P invertible_mult_JNF inv_Q Q by (metis mult_carrier_mat) + moreover have "(reduce_abs a m D A) = (Q * P * ?BM) * A" using reduce_a_eq r reduce_b_eq_reduce + by (smt BM P Q assoc_mult_mat carrier_matD carrier_mat_triv + dim_row_mat(1) index_mult_mat(2,3) reduce_b_Q_reduce) + ultimately show ?thesis by auto +qed + + + + +lemma reduce_not0: + assumes A: "A \ carrier_mat m n" and a: "a 0" and D0: "D \ 0" + shows "reduce a b D A $$ (a, 0) \ 0" (is "?reduce $$ (a,0) \ _") + and "reduce_abs a b D A $$ (a, 0) \ 0" (is "?reduce_abs $$ (a,0) \ _") +proof - + have "?reduce $$ (a,0) = (let r = gcd (A $$ (a, 0)) (A $$ (b, 0)) in if D dvd r then D else r)" + by (rule reduce_gcd[OF A _ j Aaj], insert a, simp) + also have "... \ 0" unfolding Let_def using D0 + by (smt Aaj gcd_eq_0_iff gmod_0_imp_dvd) + finally show "reduce a b D A $$ (a, 0) \ 0" . + have "?reduce_abs $$ (a,0) = (let r = gcd (A $$ (a, 0)) (A $$ (b, 0)) in + if D < r then if D dvd r then D else r gmod D else r)" + by (rule reduce_gcd[OF A _ j Aaj], insert a, simp) + also have "... \ 0" unfolding Let_def using D0 + by (smt Aaj gcd_eq_0_iff gmod_0_imp_dvd) + finally show "reduce_abs a b D A $$ (a, 0) \ 0" . +qed + +lemma reduce_below_not0: + assumes A: "A \ carrier_mat m n" and a: "a 0" +and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "D\ 0" + shows "reduce_below a xs D A $$ (a, 0) \ 0" (is "?R $$ (a,0) \ _") + using assms +proof (induct a xs D A arbitrary: A rule: reduce_below.induct) + case (1 a D A) + then show ?case by auto +next + case (2 a x xs D A) + note A = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note Aaj = "2.prems"(4) + note d = "2.prems"(5) + note D0 = "2.prems"(7) + note x_less_xxs = "2.prems"(6) + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by simp + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat m n" + by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions) + have h: "reduce_below a xs D (reduce a x D A) $$ (a,0) \ 0" + proof (rule "2.hyps") + show "reduce a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A a _ j xm Aaj D0], insert x_less_xxs, simp) + qed (insert A a j Aaj d x_less_xxs xm reduce_ax D0, auto) + thus ?case by auto +qed + + + +lemma reduce_below_abs_not0: + assumes A: "A \ carrier_mat m n" and a: "a 0" +and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "D\ 0" + shows "reduce_below_abs a xs D A $$ (a, 0) \ 0" (is "?R $$ (a,0) \ _") + using assms +proof (induct a xs D A arbitrary: A rule: reduce_below_abs.induct) + case (1 a D A) + then show ?case by auto +next + case (2 a x xs D A) + note A = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note Aaj = "2.prems"(4) + note d = "2.prems"(5) + note D0 = "2.prems"(7) + note x_less_xxs = "2.prems"(6) + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by simp + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce_abs a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat m n" + by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions) + have h: "reduce_below_abs a xs D (reduce_abs a x D A) $$ (a,0) \ 0" + proof (rule "2.hyps") + show "reduce_abs a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A a _ j xm Aaj D0], insert x_less_xxs, simp) + qed (insert A a j Aaj d x_less_xxs xm reduce_ax D0, auto) + thus ?case by auto +qed + + + +lemma reduce_below_not0_case_m: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + and "\x \ set xs. x < m \ a < x" + and "D \ 0" + shows "reduce_below a (xs@[m]) D A $$ (a, 0) \ 0" (is "?R $$ (a,0) \ _") + using assms +proof (induct a xs D A arbitrary: A A' rule: reduce_below.induct) + case (1 a D A) + note A' = "1.prems"(1) + note a = "1.prems"(2) + note n = "1.prems"(3) + note A_def = "1.prems"(4) + note Aaj = "1.prems"(5) + note mn = "1.prems"(6) + note all_less_xxs = "1.prems"(7) + note D0 = "1.prems"(8) + have A: "A \ carrier_mat (m+n) n" using A' A_def by auto + have "reduce_below a ([] @ [m]) D A $$ (a, 0) = reduce_below a [m] D A $$ (a, 0)" by auto + also have "... = reduce a m D A $$ (a, 0)" by auto + also have "... \ 0" + by (rule reduce_not0[OF A _ a n _ Aaj D0], insert a n, auto) + finally show ?case . +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note n = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note x_less_xxs = "2.prems"(7) + note D0= "2.prems"(8) + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by simp + have A: "A \ carrier_mat (m+n) n" using A' A_def by auto + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat (m+n) n" + by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions) + have h: "reduce_below a (xs@[m]) D (reduce a x D A) $$ (a,0) \ 0" + proof (rule "2.hyps") + show "reduce a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ _ _ _ D0], insert x_less_xxs j Aaj, auto) + let ?reduce_ax' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" by (rule reduce_append_rows_eq[OF A' A_def a xm n Aaj]) + qed (insert A a j Aaj x_less_xxs xm reduce_ax mn D0, auto) + thus ?case by auto +qed + +lemma reduce_below_abs_not0_case_m: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + and "\x \ set xs. x < m \ a < x" + and "D \ 0" + shows "reduce_below_abs a (xs@[m]) D A $$ (a, 0) \ 0" (is "?R $$ (a,0) \ _") + using assms +proof (induct a xs D A arbitrary: A A' rule: reduce_below_abs.induct) + case (1 a D A) + note A' = "1.prems"(1) + note a = "1.prems"(2) + note n = "1.prems"(3) + note A_def = "1.prems"(4) + note Aaj = "1.prems"(5) + note mn = "1.prems"(6) + note all_less_xxs = "1.prems"(7) + note D0 = "1.prems"(8) + have A: "A \ carrier_mat (m+n) n" using A' A_def by auto + have "reduce_below_abs a ([] @ [m]) D A $$ (a, 0) = reduce_below_abs a [m] D A $$ (a, 0)" by auto + also have "... = reduce_abs a m D A $$ (a, 0)" by auto + also have "... \ 0" + by (rule reduce_not0[OF A _ a n _ Aaj D0], insert a n, auto) + finally show ?case . +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note n = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note x_less_xxs = "2.prems"(7) + note D0= "2.prems"(8) + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by simp + have A: "A \ carrier_mat (m+n) n" using A' A_def by auto + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce_abs a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat (m+n) n" + by (metis (no_types, lifting) A carrier_matD carrier_mat_triv reduce_preserves_dimensions) + have h: "reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (a,0) \ 0" + proof (rule "2.hyps") + show "reduce_abs a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ _ _ _ D0], insert x_less_xxs j Aaj, auto) + let ?reduce_ax' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" by (rule reduce_append_rows_eq[OF A' A_def a xm n Aaj]) + qed (insert A a j Aaj x_less_xxs xm reduce_ax mn D0, auto) + thus ?case by auto +qed + + + + + +lemma reduce_below_invertible_mat: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "m\n" + and "D>0" + shows "(\P. invertible_mat P \ P \ carrier_mat (m+n) (m+n) \ reduce_below a xs D A = P * A)" + using assms +proof (induct a xs D A arbitrary: A' rule: reduce_below.induct) + case (1 a D A) + then show ?case + by (metis append_rows_def carrier_matD(1) index_mat_four_block(2) reduce_below.simps(1) + index_smult_mat(2) index_zero_mat(2) invertible_mat_one left_mult_one_mat' one_carrier_mat) +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note d = "2.prems"(6) + note x_less_xxs = "2.prems"(7) + note mn = "2.prems"(8) + note D_ge0 = "2.prems"(9) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by simp + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have h: "(\P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) + \ reduce_below a xs D (reduce a x D A) = P * reduce a x D A)" + proof (rule "2.hyps"[OF _ a j _ _ ]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj]) + show "reduce a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto) + qed (insert mn d x_less_xxs D_ge0, auto) + from this obtain P where inv_P: "invertible_mat P" and P: "P \ carrier_mat (m + n) (m + n)" + and rb_Pr: "reduce_below a xs D (reduce a x D A) = P * reduce a x D A" by blast + have *: "reduce_below a (x # xs) D A = reduce_below a xs D (reduce a x D A)" by simp + have "\Q. invertible_mat Q \ Q \ carrier_mat (m+n) (m+n) \ (reduce a x D A) = Q * A" + by (rule reduce_invertible_mat[OF A' a j xm _ A_def Aaj ], insert "2.prems", auto) + from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \ carrier_mat (m + n) (m + n)" + and r_QA: "reduce a x D A = Q * A" by blast + have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast + moreover have "P * Q \ carrier_mat (m+n) (m+n)" using P Q by auto + moreover have "reduce_below a (x # xs) D A = (P*Q) * A" + by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) + r_QA rb_Pr reduce_preserves_dimensions(1)) + ultimately show ?case by blast +qed + + +lemma reduce_below_abs_invertible_mat: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "m\n" + and "D>0" + shows "(\P. invertible_mat P \ P \ carrier_mat (m+n) (m+n) \ reduce_below_abs a xs D A = P * A)" + using assms +proof (induct a xs D A arbitrary: A' rule: reduce_below_abs.induct) + case (1 a D A) + then show ?case + by (metis carrier_append_rows invertible_mat_one left_mult_one_mat one_carrier_mat + reduce_below_abs.simps(1) smult_carrier_mat) +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note d = "2.prems"(6) + note x_less_xxs = "2.prems"(7) + note mn = "2.prems"(8) + note D_ge0 = "2.prems"(9) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by simp + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce_abs a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have h: "(\P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) + \ reduce_below_abs a xs D (reduce_abs a x D A) = P * reduce_abs a x D A)" + proof (rule "2.hyps"[OF _ a j _ _ ]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj]) + show "reduce_abs a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto) + qed (insert mn d x_less_xxs D_ge0, auto) + from this obtain P where inv_P: "invertible_mat P" and P: "P \ carrier_mat (m + n) (m + n)" + and rb_Pr: "reduce_below_abs a xs D (reduce_abs a x D A) = P * reduce_abs a x D A" by blast + have *: "reduce_below_abs a (x # xs) D A = reduce_below_abs a xs D (reduce_abs a x D A)" by simp + have "\Q. invertible_mat Q \ Q \ carrier_mat (m+n) (m+n) \ (reduce_abs a x D A) = Q * A" + by (rule reduce_abs_invertible_mat[OF A' a j xm _ A_def Aaj ], insert "2.prems", auto) + from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \ carrier_mat (m + n) (m + n)" + and r_QA: "reduce_abs a x D A = Q * A" by blast + have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast + moreover have "P * Q \ carrier_mat (m+n) (m+n)" using P Q by auto + moreover have "reduce_below_abs a (x # xs) D A = (P*Q) * A" + by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) + r_QA rb_Pr reduce_preserves_dimensions(3)) + ultimately show ?case by blast +qed + + + +lemma reduce_below_preserves: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "i \ set xs" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "i\a" and "i0" + shows "reduce_below a xs D A $$ (i,j) = A $$ (i,j)" + using assms +proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct) + case (1 a D A) + then show ?case by auto +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note i_set_xxs = "2.prems"(7) + note d = "2.prems"(8) + note xxs_less_m = "2.prems"(9) + note ia = "2.prems"(10) + note imm = "2.prems"(11) + note D_ge0 = "2.prems"(12) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "(reduce a x D A)" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) 2 add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have "reduce_below a (x # xs) D A $$ (i, j) = reduce_below a xs D (reduce a x D A) $$ (i, j)" + by auto + also have "... = reduce a x D A $$ (i, j)" + proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto) + show "i \ set xs" using i_set_xxs by auto + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + qed + also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto) + finally show ?case . +qed + + + + +lemma reduce_below_abs_preserves: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "i \ set xs" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "i\a" and "i0" + shows "reduce_below_abs a xs D A $$ (i,j) = A $$ (i,j)" + using assms +proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct) + case (1 a D A) + then show ?case by auto +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note i_set_xxs = "2.prems"(7) + note d = "2.prems"(8) + note xxs_less_m = "2.prems"(9) + note ia = "2.prems"(10) + note imm = "2.prems"(11) + note D_ge0 = "2.prems"(12) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "(reduce_abs a x D A)" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) 2 add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have "reduce_below_abs a (x # xs) D A $$ (i, j) = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, j)" + by auto + also have "... = reduce_abs a x D A $$ (i, j)" + proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto) + show "i \ set xs" using i_set_xxs by auto + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce_abs a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + qed + also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto) + finally show ?case . +qed + + + +lemma reduce_below_0: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "i \ set xs" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "D>0" + shows "reduce_below a xs D A $$ (i,0) = 0" + using assms +proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct) + case (1 a D A) + then show ?case by auto +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note i_set_xxs = "2.prems"(7) + note d = "2.prems"(8) + note xxs_less_m = "2.prems"(9) + note D_ge0 = "2.prems"(10) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + show ?case + proof (cases "i=x") + case True + have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)" + by auto + also have "... = (reduce a x D A) $$ (i, 0)" + proof (rule reduce_below_preserves[OF _ a j _ _ mn ]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj]) + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + show "i \ set xs" using True d by auto + show "i \ a" using "2.prems" by blast + show "i < m + n" + by (simp add: True trans_less_add1 xm) + qed (insert D_ge0) + also have "... = 0" unfolding True by (rule reduce_0[OF A _ j _ _ Aaj], insert "2.prems", auto) + finally show ?thesis . + next + case False note i_not_x = False + have h: "reduce_below a xs D (reduce a x D A) $$ (i, 0) = 0 " + proof (rule "2.hyps"[OF _ a j _ _ mn]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1]) + show "\i\{m..ja\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" + proof (rule+) + fix i ja assume i: "i \ {m.. a" using i a by auto + have i_not_x: "i \ x" using i xm by auto + have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto + also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \\<^sub>m (1\<^sub>m n))$$(i-m,ja))" + by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp) + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto + finally show "?reduce_ax $$ (i,ja) = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" . + qed + qed + show "i \ set xs" using i_set_xxs i_not_x by auto + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + qed (insert D_ge0) + have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)" + by auto + also have "... = 0" using h . + finally show ?thesis . + qed +qed + +lemma reduce_below_abs_0: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "i \ set xs" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "D>0" + shows "reduce_below_abs a xs D A $$ (i,0) = 0" + using assms +proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct) + case (1 a D A) + then show ?case by auto +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note i_set_xxs = "2.prems"(7) + note d = "2.prems"(8) + note xxs_less_m = "2.prems"(9) + note D_ge0 = "2.prems"(10) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce_abs a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + show ?case + proof (cases "i=x") + case True + have "reduce_below_abs a (x # xs) D A $$ (i, 0) = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0)" + by auto + also have "... = (reduce_abs a x D A) $$ (i, 0)" + proof (rule reduce_below_abs_preserves[OF _ a j _ _ mn ]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj]) + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce_abs a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + show "i \ set xs" using True d by auto + show "i \ a" using "2.prems" by blast + show "i < m + n" + by (simp add: True trans_less_add1 xm) + qed (insert D_ge0) + also have "... = 0" unfolding True by (rule reduce_0[OF A _ j _ _ Aaj], insert "2.prems", auto) + finally show ?thesis . + next + case False note i_not_x = False + have h: "reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0) = 0 " + proof (rule "2.hyps"[OF _ a j _ _ mn]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1]) + show "\i\{m..ja\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" + proof (rule+) + fix i ja assume i: "i \ {m.. a" using i a by auto + have i_not_x: "i \ x" using i xm by auto + have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto + also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \\<^sub>m (1\<^sub>m n))$$(i-m,ja))" + by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp) + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto + finally show "?reduce_ax $$ (i,ja) = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" . + qed + qed + show "i \ set xs" using i_set_xxs i_not_x by auto + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce_abs a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + qed (insert D_ge0) + have "reduce_below_abs a (x # xs) D A $$ (i, 0) = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0)" + by auto + also have "... = 0" using h . + finally show ?thesis . + qed +qed + + + + +lemma reduce_below_preserves_case_m: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "i \ set xs" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "i\a" and "i m" + and "D>0" + shows "reduce_below a (xs @ [m]) D A $$ (i,j) = A $$ (i,j)" + using assms +proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct) + case (1 a D A) + have "reduce_below a ([] @ [m]) D A $$ (i, j) = reduce_below a [m] D A $$ (i, j)" by auto + also have "... = reduce a m D A $$ (i,j)" by auto + also have "... = A $$ (i,j)" + by (rule reduce_preserves, insert "1", auto) + finally show ?case . +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note i_set_xxs = "2.prems"(7) + note d = "2.prems"(8) + note xxs_less_m = "2.prems"(9) + note ia = "2.prems"(10) + note imm = "2.prems"(11) + note D_ge0 = "2.prems"(13) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "(reduce a x D A)" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) A' A_def add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have "reduce_below a ((x # xs) @ [m]) D A $$ (i, j) + = reduce_below a (xs@[m]) D (reduce a x D A) $$ (i, j)" + by auto + also have "... = reduce a x D A $$ (i, j)" + proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm _ D_ge0]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto) + show "i \ set xs" using i_set_xxs by auto + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + show "i\m" using "2.prems" by auto + qed + also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto) + finally show ?case . +qed + + +lemma reduce_below_abs_preserves_case_m: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "i \ set xs" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "i\a" and "i m" + and "D>0" + shows "reduce_below_abs a (xs @ [m]) D A $$ (i,j) = A $$ (i,j)" + using assms +proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct) + case (1 a D A) + have "reduce_below_abs a ([] @ [m]) D A $$ (i, j) = reduce_below_abs a [m] D A $$ (i, j)" by auto + also have "... = reduce_abs a m D A $$ (i,j)" by auto + also have "... = A $$ (i,j)" + by (rule reduce_preserves, insert "1", auto) + finally show ?case . +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note i_set_xxs = "2.prems"(7) + note d = "2.prems"(8) + note xxs_less_m = "2.prems"(9) + note ia = "2.prems"(10) + note imm = "2.prems"(11) + note D_ge0 = "2.prems"(13) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "(reduce_abs a x D A)" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) A' A_def add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (i, j) + = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (i, j)" + by auto + also have "... = reduce_abs a x D A $$ (i, j)" + proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm _ D_ge0]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm _ Aaj], insert j, auto) + show "i \ set xs" using i_set_xxs by auto + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce_abs a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + show "i\m" using "2.prems" by auto + qed + also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto) + finally show ?case . +qed + + + +lemma reduce_below_0_case_m1: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "distinct xs" and "\x \ set xs. x < m \ a < x" + and "m\a" + and "D>0" + shows "reduce_below a (xs @ [m]) D A $$ (m,0) = 0" + using assms +proof (induct a xs D A arbitrary: A' rule: reduce_below.induct) + case (1 a D A) + have A: "A \ carrier_mat (m+n) n" using "1" by auto + have " reduce_below a ([] @ [m]) D A $$ (m, 0) = reduce_below a [m] D A $$ (m, 0)" by auto + also have "... = reduce a m D A $$ (m,0)" by auto + also have "... = 0" by (rule reduce_0[OF A], insert "1.prems", auto) + finally show ?case . +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note d = "2.prems"(7) + note xxs_less_m = "2.prems"(8) + note ma = "2.prems"(9) + note D_ge0 = "2.prems"(10) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "(reduce a x D A)" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have "reduce_below a ((x # xs) @ [m]) D A $$ (m, 0) = reduce_below a (xs@[m]) D (reduce a x D A) $$ (m, 0)" + by auto + also have "... = 0" + proof (rule "2.hyps"[OF ]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj]) + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + qed (insert "2.prems", auto) + finally show ?case . +qed + +lemma reduce_below_abs_0_case_m1: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "distinct xs" and "\x \ set xs. x < m \ a < x" + and "m\a" + and "D>0" + shows "reduce_below_abs a (xs @ [m]) D A $$ (m,0) = 0" + using assms +proof (induct a xs D A arbitrary: A' rule: reduce_below_abs.induct) + case (1 a D A) + have A: "A \ carrier_mat (m+n) n" using "1" by auto + have " reduce_below_abs a ([] @ [m]) D A $$ (m, 0) = reduce_below_abs a [m] D A $$ (m, 0)" by auto + also have "... = reduce_abs a m D A $$ (m,0)" by auto + also have "... = 0" by (rule reduce_0[OF A], insert "1.prems", auto) + finally show ?case . +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note d = "2.prems"(7) + note xxs_less_m = "2.prems"(8) + note ma = "2.prems"(9) + note D_ge0 = "2.prems"(10) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "(reduce_abs a x D A)" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (m, 0) = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (m, 0)" + by auto + also have "... = 0" + proof (rule "2.hyps"[OF ]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj]) + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce_abs a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + qed (insert "2.prems", auto) + finally show ?case . +qed + + + +lemma reduce_below_preserves_case_m2: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "i \ set xs" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "i\a" and "i0" + shows "reduce_below a (xs @ [m]) D A $$ (i,0) = reduce_below a xs D A $$ (i,0)" + using assms +proof (induct a xs D A arbitrary: A' i rule: reduce_below.induct) + case (1 a D A) + then show ?case by auto +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note i_set_xxs = "2.prems"(7) + note d = "2.prems"(8) + note xxs_less_m = "2.prems"(9) + note ia = "2.prems"(10) + note imm = "2.prems"(11) + note D_ge0 = "2.prems"(12) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "(reduce a x D A)" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) A_def A' add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + show ?case + proof (cases "i=x") + case True + have "reduce_below a ((x # xs) @ [m]) D A $$ (i, 0) + = reduce_below a (xs @ [m]) D (reduce a x D A) $$ (i, 0)" + by auto + also have "... = (reduce a x D A) $$ (i, 0)" + proof (rule reduce_below_preserves_case_m[OF _ a j _ _ mn _ _ _ _ _ _ D_ge0]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1]) + show "\i\{m..ja\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" + proof (rule+) + fix i ja assume i: "i \ {m.. a" using i a by auto + have i_not_x: "i \ x" using i xm by auto + have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto + also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \\<^sub>m (1\<^sub>m n))$$(i-m,ja))" + by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp) + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto + finally show "?reduce_ax $$ (i,ja) = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" . + qed + qed + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + show "i \ set xs" using True d by auto + show "i \ a" using "2.prems" by blast + show "i < m + n" + by (simp add: True trans_less_add1 xm) + show "i \ m" by (simp add: True less_not_refl3 xm) + qed + also have "... = 0" unfolding True by (rule reduce_0[OF A _ _ _ _ Aaj], insert "2.prems", auto) + also have "... = reduce_below a (x # xs) D A $$ (i, 0) " + unfolding True by (rule reduce_below_0[symmetric], insert "2.prems", auto) + finally show ?thesis . + next + case False + have "reduce_below a ((x # xs) @ [m]) D A $$ (i, 0) + = reduce_below a (xs@[m]) D (reduce a x D A) $$ (i, 0)" + by auto + also have "... = reduce_below a xs D (reduce a x D A) $$ (i, 0)" + proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj]) + show "i \ set xs" using i_set_xxs False by auto + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + qed + also have "... = reduce_below a (x # xs) D A $$ (i, 0)" by auto + finally show ?thesis . + qed +qed + + +lemma reduce_below_abs_preserves_case_m2: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "i \ set xs" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "i\a" and "i0" + shows "reduce_below_abs a (xs @ [m]) D A $$ (i,0) = reduce_below_abs a xs D A $$ (i,0)" + using assms +proof (induct a xs D A arbitrary: A' i rule: reduce_below_abs.induct) + case (1 a D A) + then show ?case by auto +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note i_set_xxs = "2.prems"(7) + note d = "2.prems"(8) + note xxs_less_m = "2.prems"(9) + note ia = "2.prems"(10) + note imm = "2.prems"(11) + note D_ge0 = "2.prems"(12) + have D0: "D\0" using D_ge0 by simp + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "(reduce_abs a x D A)" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) A_def A' add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + show ?case + proof (cases "i=x") + case True + have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (i, 0) + = reduce_below_abs a (xs @ [m]) D (reduce_abs a x D A) $$ (i, 0)" + by auto + also have "... = (reduce_abs a x D A) $$ (i, 0)" + proof (rule reduce_below_abs_preserves_case_m[OF _ a j _ _ mn _ _ _ _ _ _ D_ge0]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + proof (rule matrix_append_rows_eq_if_preserves[OF reduce_ax D1]) + show "\i\{m..ja\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" + proof (rule+) + fix i ja assume i: "i \ {m.. a" using i a by auto + have i_not_x: "i \ x" using i xm by auto + have "?reduce_ax $$ (i,ja) = A $$ (i,ja)" + unfolding reduce_alt_def_not0[OF Aaj pquvd] using ja_dc i_dr i_not_a i_not_x by auto + also have "... = (if i < dim_row A' then A' $$(i,ja) else (D \\<^sub>m (1\<^sub>m n))$$(i-m,ja))" + by (unfold A_def, rule append_rows_nth[OF A' D1 _ ja], insert A i_dr, simp) + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" using i A' by auto + finally show "?reduce_ax $$ (i,ja) = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, ja)" . + qed + qed + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce_abs a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ _ _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + show "i \ set xs" using True d by auto + show "i \ a" using "2.prems" by blast + show "i < m + n" + by (simp add: True trans_less_add1 xm) + show "i \ m" by (simp add: True less_not_refl3 xm) + qed + also have "... = 0" unfolding True by (rule reduce_0[OF A _ _ _ _ Aaj], insert "2.prems", auto) + also have "... = reduce_below_abs a (x # xs) D A $$ (i, 0) " + unfolding True by (rule reduce_below_abs_0[symmetric], insert "2.prems", auto) + finally show ?thesis . + next + case False + have "reduce_below_abs a ((x # xs) @ [m]) D A $$ (i, 0) + = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) $$ (i, 0)" + by auto + also have "... = reduce_below_abs a xs D (reduce_abs a x D A) $$ (i, 0)" + proof (rule "2.hyps"[OF _ a j _ _ mn _ _ _ ia imm D_ge0]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm j Aaj]) + show "i \ set xs" using i_set_xxs False by auto + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce_abs a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ j _ Aaj], insert "2.prems", auto) + show "?A' \ carrier_mat m n" by auto + qed + also have "... = reduce_below_abs a (x # xs) D A $$ (i, 0)" by auto + finally show ?thesis . + qed +qed + + +lemma reduce_below_0_case_m: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "i \ set (xs @ [m])" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "D>0" + shows "reduce_below a (xs @ [m]) D A $$ (i,0) = 0" +proof (cases "i=m") + case True + show ?thesis by (unfold True, rule reduce_below_0_case_m1, insert assms, auto) +next + case False + have "reduce_below a (xs @ [m]) D A $$ (i,0) = reduce_below a (xs) D A $$ (i,0)" + by (rule reduce_below_preserves_case_m2[OF A' a j A_def Aaj mn], insert assms False, auto) + also have "... = 0" by (rule reduce_below_0, insert assms False, auto) + finally show ?thesis . +qed + + +lemma reduce_below_abs_0_case_m: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" + assumes "i \ set (xs @ [m])" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "D>0" + shows "reduce_below_abs a (xs @ [m]) D A $$ (i,0) = 0" +proof (cases "i=m") + case True + show ?thesis by (unfold True, rule reduce_below_abs_0_case_m1, insert assms, auto) +next + case False + have "reduce_below_abs a (xs @ [m]) D A $$ (i,0) = reduce_below_abs a (xs) D A $$ (i,0)" + by (rule reduce_below_abs_preserves_case_m2[OF A' a j A_def Aaj mn], insert assms False, auto) + also have "... = 0" by (rule reduce_below_abs_0, insert assms False, auto) + finally show ?thesis . +qed + + +lemma reduce_below_0_case_m_complete: + assumes A': "A' \ carrier_mat m n" and a: "0r (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (0,0) \ 0" + and mn: "m\n" + assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\x \ set xs. x < m \ 0 < x" + and ia: "i\0" + and xs_def: "xs = filter (\i. A $$ (i,0) \ 0) [1..0" + shows "reduce_below 0 (xs @ [m]) D A $$ (i,0) = 0" +proof (cases "i \ set (xs @ [m])") + case True + show ?thesis by (rule reduce_below_0_case_m[OF A' a j A_def Aaj mn True d_xs xs D]) +next + case False + have A: "A \ carrier_mat (m+n) n" using A' A_def by simp + have "reduce_below 0 (xs @ [m]) D A $$ (i,0) = A $$ (i,0)" + by (rule reduce_below_preserves_case_m[OF A' a j A_def Aaj mn _ _ _ _ _ _ D], + insert i_mn d_xs xs ia False, auto) + also have "... = 0" using False ia i_mn A unfolding xs_def by auto + finally show ?thesis . +qed + + + +lemma reduce_below_abs_0_case_m_complete: + assumes A': "A' \ carrier_mat m n" and a: "0r (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (0,0) \ 0" + and mn: "m\n" + assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\x \ set xs. x < m \ 0 < x" + and ia: "i\0" + and xs_def: "xs = filter (\i. A $$ (i,0) \ 0) [1..0" + shows "reduce_below_abs 0 (xs @ [m]) D A $$ (i,0) = 0" +proof (cases "i \ set (xs @ [m])") + case True + show ?thesis by (rule reduce_below_abs_0_case_m[OF A' a j A_def Aaj mn True d_xs xs D]) +next + case False + have A: "A \ carrier_mat (m+n) n" using A' A_def by simp + have "reduce_below_abs 0 (xs @ [m]) D A $$ (i,0) = A $$ (i,0)" + by (rule reduce_below_abs_preserves_case_m[OF A' a j A_def Aaj mn _ _ _ _ _ _ D], + insert i_mn d_xs xs ia False, auto) + also have "... = 0" using False ia i_mn A unfolding xs_def by auto + finally show ?thesis . +qed + + +(*Now we take care of the mth row of A*) +lemma reduce_below_invertible_mat_case_m: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and D0: "D>0" + shows "(\P. invertible_mat P \ P \ carrier_mat (m+n) (m+n) \ reduce_below a (xs@[m]) D A = P * A)" + using assms +proof (induct a xs D A arbitrary: A' rule: reduce_below.induct) + case (1 a D A) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(m,0))" + by (metis prod_cases5) + have D: "D \\<^sub>m (1\<^sub>m n) : carrier_mat n n" by auto + note A' = "1.prems"(1) + note a = "1.prems"(2) + note j = "1.prems"(3) + note A_def = "1.prems"(4) + note Aaj = "1.prems"(5) + note mn = "1.prems"(6) + note D0 = "1.prems"(9) + have Am0_D: "A $$ (m, 0) = D" + proof - + have "A $$ (m, 0) = (D \\<^sub>m (1\<^sub>m n)) $$ (m-m,0)" + by (smt (z3) "1"(1) "1"(3) "1"(4) D append_rows_nth3 diff_is_0_eq diff_self_eq_0 less_add_same_cancel1) + also have "... = D" by (simp add: n0) + finally show ?thesis . + qed + have "reduce_below a ([]@[m]) D A = reduce a m D A" by auto + let ?A = "Matrix.mat (dim_row A) (dim_col A) + (\(i, k). if i = a then p * A $$ (a, k) + q * A $$ (m, k) else + if i = m then u * A $$ (a, k) + v * A $$ (m, k) else A $$ (i, k))" + let ?xs = "[1..P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) \ reduce a m D A = P * A" + by (rule reduce_invertible_mat_case_m[OF A' D a _ A_def _ Aaj mn n0 pquvd, of ?xs _ _ ?ys], + insert a D0 Am0_D, auto) + then show ?case by auto +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note n0 = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note d = "2.prems"(7) + note xxs_less_m = "2.prems"(8) + note D0 = "2.prems"(9) + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + have Am0_D: "A $$ (m, 0) = D" + proof - + have "A $$ (m, 0) = (D \\<^sub>m (1\<^sub>m n)) $$ (m-m,0)" + by (smt (z3) "2"(2) "2"(4) "2"(5) D1 append_rows_nth3 + cancel_comm_monoid_add_class.diff_cancel diff_is_0_eq less_add_same_cancel1) + also have "... = D" by (simp add: n0) + finally show ?thesis . + qed + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have h: "(\P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) + \ reduce_below a (xs@[m]) D (reduce a x D A) = P * reduce a x D A)" + proof (rule "2.hyps"[OF _ a n0 _ _ ]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm n0 Aaj]) + show "reduce a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ n0 _ Aaj], insert "2.prems", auto) + qed (insert d xxs_less_m mn n0 D0, auto) + from this obtain P where inv_P: "invertible_mat P" and P: "P \ carrier_mat (m + n) (m + n)" + and rb_Pr: "reduce_below a (xs@[m]) D (reduce a x D A) = P * reduce a x D A" by blast + have *: "reduce_below a ((x # xs)@[m]) D A = reduce_below a (xs@[m]) D (reduce a x D A)" by simp + have "\Q. invertible_mat Q \ Q \ carrier_mat (m+n) (m+n) \ (reduce a x D A) = Q * A" + by (rule reduce_invertible_mat[OF A' a n0 xm _ A_def Aaj _ mn D0], insert xxs_less_m, auto) + from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \ carrier_mat (m + n) (m + n)" + and r_QA: "reduce a x D A = Q * A" by blast + have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast + moreover have "P * Q \ carrier_mat (m+n) (m+n)" using P Q by auto + moreover have "reduce_below a ((x # xs)@[m]) D A = (P*Q) * A" + by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) + r_QA rb_Pr reduce_preserves_dimensions(1)) + ultimately show ?case by blast +qed + + + + +(*Now we take care of the mth row of A*) +lemma reduce_below_abs_invertible_mat_case_m: + assumes A': "A' \ carrier_mat m n" and a: "ar (D \\<^sub>m (1\<^sub>m n))" + and Aaj: "A $$ (a,0) \ 0" + and mn: "m\n" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and D0: "D>0" + shows "(\P. invertible_mat P \ P \ carrier_mat (m+n) (m+n) \ reduce_below_abs a (xs@[m]) D A = P * A)" + using assms +proof (induct a xs D A arbitrary: A' rule: reduce_below_abs.induct) + case (1 a D A) + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(m,0))" + by (metis prod_cases5) + have D: "D \\<^sub>m (1\<^sub>m n) : carrier_mat n n" by auto + note A' = "1.prems"(1) + note a = "1.prems"(2) + note j = "1.prems"(3) + note A_def = "1.prems"(4) + note Aaj = "1.prems"(5) + note mn = "1.prems"(6) + note D0 = "1.prems"(9) + have Am0_D: "A $$ (m, 0) = D" + proof - + have "A $$ (m, 0) = (D \\<^sub>m (1\<^sub>m n)) $$ (m-m,0)" + by (smt (z3) "1"(1) "1"(3) "1"(4) D append_rows_nth3 diff_is_0_eq diff_self_eq_0 less_add_same_cancel1) + also have "... = D" by (simp add: n0) + finally show ?thesis . + qed + have "reduce_below_abs a ([]@[m]) D A = reduce_abs a m D A" by auto + let ?A = "Matrix.mat (dim_row A) (dim_col A) + (\(i, k). if i = a then p * A $$ (a, k) + q * A $$ (m, k) else + if i = m then u * A $$ (a, k) + v * A $$ (m, k) else A $$ (i, k))" + let ?xs = "filter (\i. D < \?A $$ (a, i)\) [0..P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) \ reduce_abs a m D A = P * A" + by (rule reduce_abs_invertible_mat_case_m[OF A' D a _ A_def _ Aaj mn n0 pquvd, of ?xs _ _ ?ys], + insert a D0 Am0_D, auto) + then show ?case by auto +next + case (2 a x xs D A) + note A' = "2.prems"(1) + note a = "2.prems"(2) + note n0 = "2.prems"(3) + note A_def = "2.prems"(4) + note Aaj = "2.prems"(5) + note mn = "2.prems"(6) + note d = "2.prems"(7) + note xxs_less_m = "2.prems"(8) + note D0 = "2.prems"(9) + have A: "A \ carrier_mat (m+n) n" using A' mn A_def by auto + have xm: "x < m" using "2.prems" by auto + have D1: "D \\<^sub>m 1\<^sub>m n \ carrier_mat n n" by (simp add: mn) + have Am0_D: "A $$ (m, 0) = D" + proof - + have "A $$ (m, 0) = (D \\<^sub>m (1\<^sub>m n)) $$ (m-m,0)" + by (smt (z3) "2"(2) "2"(4) "2"(5) D1 append_rows_nth3 + cancel_comm_monoid_add_class.diff_cancel diff_is_0_eq less_add_same_cancel1) + also have "... = D" by (simp add: n0) + finally show ?thesis . + qed + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce_abs a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat (m + n) n" + by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have h: "(\P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) + \ reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) = P * reduce_abs a x D A)" + proof (rule "2.hyps"[OF _ a n0 _ _ ]) + let ?A' = "mat_of_rows n (map (Matrix.row ?reduce_ax) [0..r D \\<^sub>m 1\<^sub>m n" + by (rule reduce_append_rows_eq[OF A' A_def a xm n0 Aaj]) + show "reduce_abs a x D A $$ (a, 0) \ 0" + by (rule reduce_not0[OF A _ _ n0 _ Aaj], insert "2.prems", auto) + qed (insert d xxs_less_m mn n0 D0, auto) + from this obtain P where inv_P: "invertible_mat P" and P: "P \ carrier_mat (m + n) (m + n)" + and rb_Pr: "reduce_below_abs a (xs@[m]) D (reduce_abs a x D A) = P * reduce_abs a x D A" by blast + have *: "reduce_below_abs a ((x # xs)@[m]) D A = reduce_below_abs a (xs@[m]) D (reduce_abs a x D A)" by simp + have "\Q. invertible_mat Q \ Q \ carrier_mat (m+n) (m+n) \ (reduce_abs a x D A) = Q * A" + by (rule reduce_abs_invertible_mat[OF A' a n0 xm _ A_def Aaj _ mn D0], insert xxs_less_m, auto) + from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \ carrier_mat (m + n) (m + n)" + and r_QA: "reduce_abs a x D A = Q * A" by blast + have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast + moreover have "P * Q \ carrier_mat (m+n) (m+n)" using P Q by auto + moreover have "reduce_below_abs a ((x # xs)@[m]) D A = (P*Q) * A" + by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) + r_QA rb_Pr reduce_preserves_dimensions(3)) + ultimately show ?case by blast +qed + +end + +hide_const (open) C + +text \This lemma will be very important, since it will allow us to prove that the output +matrix is in echelon form.\ + +lemma echelon_form_four_block_mat: + assumes A: "A \ carrier_mat 1 1" + and B: "B \ carrier_mat 1 (n-1)" + and D: "D \ carrier_mat (m-1) (n-1)" + and H_def: "H = four_block_mat A B (0\<^sub>m (m-1) 1) D" + and A00: "A $$ (0,0) \ 0" + and e_D: "echelon_form_JNF D" + and m: "m>0" and n: "n>0" +shows "echelon_form_JNF H" +proof (rule echelon_form_JNF_intro) + have H: "H \ carrier_mat m n" + by (metis H_def Num.numeral_nat(7) A D m n carrier_matD carrier_mat_triv + index_mat_four_block(2,3) linordered_semidom_class.add_diff_inverse not_less_eq) + have Hij_Dij: "H $$ (i+1,j+1) = D $$ (i,j)" if i: "im (m-1) 1) $$ ((i+1) - dim_row A, (j+1)) else D $$ ((i+1) - dim_row A, (j+1) - dim_col A))" + unfolding H_def by (rule index_mat_four_block, insert A D i j, auto) + also have "... = D $$ ((i+1) - dim_row A, (j+1) - dim_col A)" using A D i j B m n by auto + also have "... = D $$ (i,j)" using A by auto + finally show ?thesis . + qed + have Hij_Dij': "H $$ (i,j) = D $$ (i-1,j-1)" + if i: "i0" and j0: "j>0" for i j + by (metis (no_types, lifting) H H_def Num.numeral_nat(7) A carrier_matD + index_mat_four_block less_Suc0 less_not_refl3 i j i0 j0) + have Hi0: "H$$(i,0) = 0" if i: "i\{1..m (m-1) 1) $$ (i - dim_row A, 0) else D $$ (i - dim_row A, 0 - dim_col A))" + unfolding H_def by (rule index_mat_four_block, insert A D i, auto) + also have "... = (0\<^sub>m (m-1) 1) $$ (i - dim_row A, 0)" using A D i m n by auto + also have "... = 0" using i A n by auto + finally show ?thesis . + qed + have A00_H00: "A $$ (0,0) = H $$ (0,0)" unfolding H_def using A by auto + have "is_zero_row_JNF j H" if zero_iH: "is_zero_row_JNF i H" and ij: "i < j" and j: "j < dim_row H" + for i j + proof - + have "\ is_zero_row_JNF 0 H" unfolding is_zero_row_JNF_def using m n H A00 A00_H00 by auto + hence i_not0: "i\0" using zero_iH by meson + have "is_zero_row_JNF (i-1) D" using zero_iH i_not0 Hij_Dij m n D H unfolding is_zero_row_JNF_def + by (auto, smt (z3) Suc_leI carrier_matD(1) le_add_diff_inverse2 Hij_Dij One_nat_def Suc_pred carrier_matD(1) j le_add_diff_inverse2 + less_diff_conv less_imp_add_positive plus_1_eq_Suc that(2) trans_less_add1) + hence "is_zero_row_JNF (j-1) D" using ij e_D D j m i_not0 unfolding echelon_form_JNF_def + by (auto, smt H Nat.lessE Suc_pred carrier_matD(1) diff_Suc_1 diff_Suc_less order.strict_trans) + thus ?thesis + by (smt A H H_def Hi0 D atLeastLessThan_iff carrier_matD index_mat_four_block(1) + is_zero_row_JNF_def le_add1 less_one linordered_semidom_class.add_diff_inverse not_less_eq + plus_1_eq_Suc ij j zero_order(3)) + qed + thus "\i \ (\j \ is_zero_row_JNF j H)" + by blast + have "(LEAST n. H $$ (i, n) \ 0) < (LEAST n. H $$ (j, n) \ 0)" + if ij: "i < j" and j: "j < dim_row H" and not_zero_iH: "\ is_zero_row_JNF i H" + and not_zero_jH: "\ is_zero_row_JNF j H" for i j + proof (cases "i = 0") + case True + have "(LEAST n. H $$ (i, n) \ 0) = 0" unfolding True using A00_H00 A00 by auto + then show ?thesis + by (metis (mono_tags) H Hi0 LeastI True atLeastLessThan_iff carrier_matD(1) + is_zero_row_JNF_def leI less_one not_gr0 ij j not_zero_jH) + next + case False note i_not0 = False + let ?least_H = "(LEAST n. H $$ (i, n) \ 0)" + let ?least_Hj = "(LEAST n. H $$ (j, n) \ 0)" + + have least_not0: "(LEAST n. H $$ (i, n) \ 0) \ 0" + proof - + have "\n. H $$ (i, n) \ 0 \ H $$ (i, 0) = 0" + by (metis (no_types) False H Hi0 Num.numeral_nat(7) atLeastLessThan_iff carrier_matD(1) + is_zero_row_JNF_def j nat_LEAST_True nat_neq_iff not_less_Least not_less_eq order.strict_trans + ij not_zero_iH wellorder_Least_lemma(1) wellorder_Least_lemma(2)) + then show ?thesis + by (metis (mono_tags, lifting) LeastI_ex) + qed + have least_not0j: "(LEAST n. H $$ (j, n) \ 0) \ 0" + proof - + have "\n. H $$ (j, 0) = 0 \ H $$ (j, n) \ 0" + by (metis (no_types) H Hi0 LeastI_ex Num.numeral_nat(7) atLeastLessThan_iff carrier_matD(1) + is_zero_row_JNF_def linorder_neqE_nat not_gr0 not_less_Least not_less_eq order_trans_rules(19) + ij j not_zero_jH wellorder_Least_lemma(2)) + then show ?thesis + by (metis (mono_tags, lifting) LeastI_ex) + qed + have least_n: "?least_H 0" and ln':"(\n'. (H $$ (i, n') \ 0) \ ?least_H \ n')" + by (metis (mono_tags, lifting) is_zero_row_JNF_def that(3) wellorder_Least_lemma)+ + have Hil_Dil: "H $$ (i,?least_H) = D $$ (i-1,?least_H - 1)" + proof - + have "H $$ (i,?least_H) = (if i < dim_row A then if ?least_H < dim_col A then A $$ (i, ?least_H) + else B $$ (i, ?least_H - dim_col A) else if ?least_H < dim_col A then + (0\<^sub>m (m-1) 1) $$ (i - dim_row A, ?least_H) else D $$ (i - dim_row A, ?least_H - dim_col A))" + unfolding H_def + by (rule index_mat_four_block, insert False j ij H A D n least_n, auto simp add: H_def) + also have "... = D $$ (i - 1, ?least_H - 1)" + using False j ij H A D n least_n B Hi0 Hil by auto + finally show ?thesis . + qed + have not_zero_iD: "\ is_zero_row_JNF (i-1) D" + by (metis (no_types, lifting) Hil Hil_Dil D carrier_matD(2) is_zero_row_JNF_def le_add1 + le_add_diff_inverse2 least_n least_not0 less_diff_conv less_one + linordered_semidom_class.add_diff_inverse) + have not_zero_jD: "\ is_zero_row_JNF (j-1) D" + by (smt H Hij_Dij' One_nat_def Suc_pred D m carrier_matD diff_Suc_1 ij is_zero_row_JNF_def j + least_not0j less_Suc0 less_Suc_eq_0_disj less_one neq0_conv not_less_Least not_less_eq + plus_1_eq_Suc not_zero_jH zero_order(3)) + have "?least_H - 1 = (LEAST n. D $$ (i-1, n) \ 0 \ n 0" using Hil Hil_Dil by auto + show "(LEAST n. H $$ (i, n) \ 0) - 1 < dim_col D" using least_n least_not0 H D n by auto + fix n' assume "D $$ (i - 1, n') \ 0 \ n' < dim_col D" + hence Di1n'1: "D $$ (i - 1, n') \ 0" and n': "n' < dim_col D" by auto + have "(LEAST n. H $$ (i, n) \ 0) \ n' + 1" + proof (rule Least_le) + have "H $$ (i, n'+1) = D $$ (i -1, (n'+1)-1)" + by (rule Hij_Dij', insert i_not0 False H A ij j n' D, auto) + thus Hin': "H $$ (i, n'+1) \ 0" using False Di1n'1 Hij_Dij' by auto + qed + thus "(LEAST n. H $$ (i, n) \ 0) -1 \ n'" using least_not0 by auto + qed + also have "... = (LEAST n. D $$ (i-1, n) \ 0)" + proof (rule Least_equality) + have "D $$ (i - 1, LEAST n. D $$ (i - 1, n) \ 0) \ 0" + by (metis (mono_tags, lifting) Hil Hil_Dil LeastI_ex) + moreover have leastD: "(LEAST n. D $$ (i - 1, n) \ 0) < dim_col D" + by (smt dual_order.strict_trans is_zero_row_JNF_def linorder_neqE_nat + not_less_Least not_zero_iD) + ultimately show "D $$ (i - 1, LEAST n. D $$ (i - 1, n) \ 0) \ 0 + \ (LEAST n. D $$ (i - 1, n) \ 0) < dim_col D" by simp + fix y assume "D $$ (i - 1, y) \ 0 \ y < dim_col D" + thus "(LEAST n. D $$ (i - 1, n) \ 0) \ y" by (meson wellorder_Least_lemma(2)) + qed + finally have leastHi_eq: "?least_H - 1 = (LEAST n. D $$ (i-1, n) \ 0)" . + have least_nj: "?least_Hj 0" and ln':"(\n'. (H $$ (j, n') \ 0) \ ?least_Hj \ n')" + by (metis (mono_tags, lifting) is_zero_row_JNF_def not_zero_jH wellorder_Least_lemma)+ + have Hjl_Djl: "H $$ (j,?least_Hj) = D $$ (j-1,?least_Hj - 1)" + proof - + have "H $$ (j,?least_Hj) = (if j < dim_row A then if ?least_Hj < dim_col A then A $$ (j, ?least_Hj) + else B $$ (j, ?least_Hj - dim_col A) else if ?least_Hj < dim_col A then + (0\<^sub>m (m-1) 1) $$ (j - dim_row A, ?least_Hj) else D $$ (j - dim_row A, ?least_Hj - dim_col A))" + unfolding H_def + by (rule index_mat_four_block, insert False j ij H A D n least_nj, auto simp add: H_def) + also have "... = D $$ (j - 1, ?least_Hj - 1)" + using False j ij H A D n least_n B Hi0 Hjl by auto + finally show ?thesis . + qed + have "(LEAST n. H $$ (j, n) \ 0) - 1 = (LEAST n. D $$ (j-1, n) \ 0 \ n 0" using Hil Hil_Dil + by (smt H Hij_Dij' LeastI_ex carrier_matD is_zero_row_JNF_def j least_not0j + linorder_neqE_nat not_gr0 not_less_Least order.strict_trans ij not_zero_jH) + show "(LEAST n. H $$ (j, n) \ 0) - 1 < dim_col D" using least_nj least_not0j H D n by auto + fix n' assume "D $$ (j - 1, n') \ 0 \ n' < dim_col D" + hence Di1n'1: "D $$ (j - 1, n') \ 0" and n': "n' < dim_col D" by auto + have "(LEAST n. H $$ (j, n) \ 0) \ n' + 1" + proof (rule Least_le) + have "H $$ (j, n'+1) = D $$ (j -1, (n'+1)-1)" + by (rule Hij_Dij', insert i_not0 False H A ij j n' D, auto) + thus Hin': "H $$ (j, n'+1) \ 0" using False Di1n'1 Hij_Dij' by auto + qed + thus "(LEAST n. H $$ (j, n) \ 0) -1 \ n'" using least_not0 by auto + qed + also have "... = (LEAST n. D $$ (j-1, n) \ 0)" + proof (rule Least_equality) + have "D $$ (j - 1, LEAST n. D $$ (j - 1, n) \ 0) \ 0" + by (metis (mono_tags, lifting) Hjl Hjl_Djl LeastI_ex) + moreover have leastD: "(LEAST n. D $$ (j - 1, n) \ 0) < dim_col D" + by (smt dual_order.strict_trans is_zero_row_JNF_def linorder_neqE_nat + not_less_Least not_zero_jD) + ultimately show "D $$ (j - 1, LEAST n. D $$ (j - 1, n) \ 0) \ 0 + \ (LEAST n. D $$ (j - 1, n) \ 0) < dim_col D" by simp + fix y assume "D $$ (j - 1, y) \ 0 \ y < dim_col D" + thus "(LEAST n. D $$ (j - 1, n) \ 0) \ y" by (meson wellorder_Least_lemma(2)) + qed + finally have leastHj_eq: "(LEAST n. H $$ (j, n) \ 0) - 1 = (LEAST n. D $$ (j-1, n) \ 0)" . + have ij': "i-1 < j-1" using ij False by auto + have "j-1 < dim_row D " using D H ij j by auto + hence "(LEAST n. D $$ (i-1, n) \ 0) < (LEAST n. D $$ (j-1, n) \ 0)" + using e_D echelon_form_JNF_def ij' not_zero_jD order.strict_trans by blast + thus ?thesis using leastHj_eq leastHi_eq by auto + qed + thus "\i j. i < j \ j < dim_row H \ \ is_zero_row_JNF i H \ \ is_zero_row_JNF j H + \ (LEAST n. H $$ (i, n) \ 0) < (LEAST n. H $$ (j, n) \ 0)" by blast +qed + +context mod_operation +begin + + +lemma reduce_below: + assumes "A \ carrier_mat m n" + shows "reduce_below a xs D A \ carrier_mat m n" + using assms + by (induct a xs D A rule: reduce_below.induct, auto simp add: Let_def euclid_ext2_def) + +lemma reduce_below_preserves_dimensions: + shows [simp]: "dim_row (reduce_below a xs D A) = dim_row A" + and [simp]: "dim_col (reduce_below a xs D A) = dim_col A" + using reduce_below[of A "dim_row A" "dim_col A"] by auto + + +lemma reduce_below_abs: + assumes "A \ carrier_mat m n" + shows "reduce_below_abs a xs D A \ carrier_mat m n" + using assms + by (induct a xs D A rule: reduce_below_abs.induct, auto simp add: Let_def euclid_ext2_def) + +lemma reduce_below_abs_preserves_dimensions: + shows [simp]: "dim_row (reduce_below_abs a xs D A) = dim_row A" + and [simp]: "dim_col (reduce_below_abs a xs D A) = dim_col A" + using reduce_below_abs[of A "dim_row A" "dim_col A"] by auto + + +lemma FindPreHNF_1xn: + assumes A: "A \ carrier_mat m n" and "m<2 \ n = 0" + shows "FindPreHNF abs_flag D A \ carrier_mat m n" using assms by auto + +lemma FindPreHNF_mx1: + assumes A: "A \ carrier_mat m n" and "m\2" and "n \ 0" "n<2" + shows "FindPreHNF abs_flag D A \ carrier_mat m n" +proof (cases "abs_flag") + case True + let ?nz = "(filter (\i. A $$ (i, 0) \ 0) [1..i. A $$ (i, 0) \ 0) [Suc 0.. 0 then A else + let i = non_zero_positions ! 0 in swaprows 0 i A))" + using assms True by auto + also have "... = reduce_below_abs 0 ?nz D (if A $$ (0, 0) \ 0 then A + else let i = ?nz ! 0 in swaprows 0 i A)" unfolding Let_def by auto + also have "... \ carrier_mat m n" using A by auto + finally show ?thesis . +next + case False + let ?nz = "(filter (\i. A $$ (i, 0) \ 0) [1..i. A $$ (i, 0) \ 0) [Suc 0.. 0 then A else + let i = non_zero_positions ! 0 in swaprows 0 i A))" + using assms False by auto + also have "... = reduce_below 0 ?nz D (if A $$ (0, 0) \ 0 then A + else let i = ?nz ! 0 in swaprows 0 i A)" unfolding Let_def by auto + also have "... \ carrier_mat m n" using A by auto + finally show ?thesis . +qed + + +lemma FindPreHNF_mxn2: + assumes A: "A \ carrier_mat m n" and m: "m\2" and n: "n\2" + shows "FindPreHNF abs_flag D A \ carrier_mat m n" +using assms +proof (induct abs_flag D A arbitrary: m n rule: FindPreHNF.induct) + case (1 abs_flag D A) + note A = "1.prems"(1) + note m = "1.prems"(2) + note n = "1.prems"(3) + define non_zero_positions where "non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)" + define Reduce where [simp]: "Reduce = (if abs_flag then reduce_below_abs else reduce_below)" + obtain A'_UL A'_UR A'_DL A'_DR where A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) + = split_block (Reduce 0 non_zero_positions D (make_first_column_positive A')) 1 1" + by (metis prod_cases4) + define sub_PreHNF where "sub_PreHNF = FindPreHNF abs_flag D A'_DR" + have A': "A' \ carrier_mat m n" unfolding A'_def using A by auto + have A'_DR: "A'_DR \ carrier_mat (m -1) (n-1)" + by (cases abs_flag; rule split_block(4)[OF A'_split[symmetric]], insert Reduce_def A A' m n, auto) + have sub_PreHNF: "sub_PreHNF \ carrier_mat (m - 1) (n-1)" + proof (cases "m-1<2") + case True + show ?thesis using A'_DR True unfolding sub_PreHNF_def by auto + next + case False note m' = False + show ?thesis + proof (cases "n-1<2") + case True + show ?thesis + unfolding sub_PreHNF_def by (rule FindPreHNF_mx1[OF A'_DR _ _ True], insert n m', auto) + next + case False + show ?thesis + by (unfold sub_PreHNF_def, rule "1.hyps" + [of m n, OF _ _ _ non_zero_positions_def A'_def Reduce_def _ A'_split _ _ _ A'_DR], + insert A False n m' Reduce_def, auto) + qed + qed + have A'_UL: "A'_UL \ carrier_mat 1 1" + by (cases abs_flag; rule split_block(1)[OF A'_split[symmetric], of "m-1" "n-1"], insert n m A', auto) + have A'_UR: "A'_UR \ carrier_mat 1 (n-1)" + by (cases abs_flag; rule split_block(2)[OF A'_split[symmetric], of "m-1"], insert n m A', auto) + have A'_DL: "A'_DL \ carrier_mat (m - 1) 1" + by (cases abs_flag; rule split_block(3)[OF A'_split[symmetric], of _ "n-1"], insert n m A', auto) + have *: "(dim_col A = 0) = False" using 1(2-) by auto + have FindPreHNF_as_fbm: "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF" + unfolding FindPreHNF.simps[of abs_flag D A] using A'_split m n A + unfolding Let_def sub_PreHNF_def A'_def non_zero_positions_def * + apply (cases abs_flag) + by (smt (z3) Reduce_def carrier_matD(1) carrier_matD(2) linorder_not_less prod.simps(2))+ + also have "... \ carrier_mat m n" + by (smt m A'_UL One_nat_def add.commute carrier_matD carrier_mat_triv index_mat_four_block(2,3) + le_add_diff_inverse2 le_eq_less_or_eq lessI n nat_SN.compat numerals(2) sub_PreHNF) + finally show ?case . +qed + + +lemma FindPreHNF: + assumes A: "A \ carrier_mat m n" + shows "FindPreHNF abs_flag D A \ carrier_mat m n" + using assms FindPreHNF_mxn2[OF A] FindPreHNF_mx1[OF A] FindPreHNF_1xn[OF A] + using linorder_not_less by blast +end + +lemma make_first_column_positive_append_id: + assumes A': "A' \ carrier_mat m n" + and A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" + and D0: "D>0" + and n0: "0r (D \\<^sub>m (1\<^sub>m n))" +proof (rule matrix_append_rows_eq_if_preserves) + have A: "A \ carrier_mat (m+n) n" using A' A_def by auto + thus "make_first_column_positive A \ carrier_mat (m + n) n" by auto + have "make_first_column_positive A $$ (i, j) = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, j)" + if j: "j {m..\<^sub>m 1\<^sub>m n) $$ (i - m, 0)" unfolding A_def + by (smt A append_rows_def assms(1) assms(2) atLeastLessThan_iff carrier_matD + index_mat_four_block less_irrefl_nat nat_SN.compat j i n0) + also have "... \ 0" using D0 mult_not_zero that(2) by auto + finally have Ai0: "A$$(i,0)\0" . + have "make_first_column_positive A $$ (i, j) = A$$(i,j)" + using make_first_column_positive_works[OF A i_mn n0] j Ai0 by auto + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i - m, j)" unfolding A_def + by (smt A append_rows_def A' A_def atLeastLessThan_iff carrier_matD + index_mat_four_block less_irrefl_nat nat_SN.compat i j) + finally show ?thesis . + qed + thus "\i\{m..j\<^sub>m 1\<^sub>m n) $$ (i - m, j)" + by simp +qed (auto) + + +lemma A'_swaprows_invertible_mat: + fixes A::"int mat" + assumes A: "A\carrier_mat m n" + assumes A'_def: "A' = (if A $$ (0, 0) \ 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)" + and nz_def: "non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. non_zero_positions \ []" + and m0: "0P. P \ carrier_mat m m \ invertible_mat P \ A' = P * A" +proof (cases "A$$(0,0) \ 0") + case True + then show ?thesis + by (metis A A'_def invertible_mat_one left_mult_one_mat one_carrier_mat) +next + case False + have nz_empty: "non_zero_positions \ []" using nz_empty False by simp + let ?i = "non_zero_positions ! 0" + let ?M = "(swaprows_mat m 0 ?i) :: int mat" + have i_set_nz: "?i \ set (non_zero_positions)" using nz_empty by auto + have im: "?i < m" using A nz_def i_set_nz by auto + have i_not0: "?i \ 0" using A nz_def i_set_nz by auto + have "A' = swaprows 0 ?i A" using False A'_def by simp + also have "... = ?M * A" + by (rule swaprows_mat[OF A], insert nz_def nz_empty False A m0 im, auto) + finally have 1: "A' = ?M * A" . + have 2: "?M \ carrier_mat m m" by auto + have "Determinant.det ?M = - 1" + by (rule det_swaprows_mat[OF m0 im i_not0[symmetric]]) + hence 3: "invertible_mat ?M" using invertible_iff_is_unit_JNF[OF 2] by auto + show ?thesis using 1 2 3 by blast +qed + +lemma swaprows_append_id: + assumes A': "A' \ carrier_mat m n" + and A_def: "A = A' @\<^sub>r (D \\<^sub>m (1\<^sub>m n))" + and i:"ir (D \\<^sub>m (1\<^sub>m n))" +proof (rule matrix_append_rows_eq_if_preserves) + have A: "A \ carrier_mat (m+n) n" using A' A_def by auto + show swap: "swaprows 0 i A \ carrier_mat (m + n) n" by (simp add: A) + have "swaprows 0 i A $$ (ia, j) = (D \\<^sub>m 1\<^sub>m n) $$ (ia - m, j)" + if ia: "ia \ {m..\<^sub>m 1\<^sub>m n) $$ (ia - m, j)" + by (smt A append_rows_def A' A_def atLeastLessThan_iff carrier_matD + index_mat_four_block less_irrefl_nat nat_SN.compat ia j) + finally show "swaprows 0 i A $$ (ia, j) = (D \\<^sub>m 1\<^sub>m n) $$ (ia - m, j)" . + qed + thus "\ia\{m..j\<^sub>m 1\<^sub>m n) $$ (ia - m, j)" by simp +qed (simp) + + + +lemma non_zero_positions_xs_m: + fixes A::"'a::comm_ring_1 mat" + assumes A_def: "A = A' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + and A': "A' \ carrier_mat m n" + and nz_def: "non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. 0" +shows "\xs. non_zero_positions = xs @ [m] \ distinct xs \ (\x\set xs. x < m \ 0 < x)" +proof - + have A: "A \ carrier_mat (m+n) n" using A' A_def by auto + let ?xs = "filter (\i. A $$ (i,0) \ 0) [1..i. A $$ (i,0) \ 0) ([m+1..set [m + 1..\<^sub>m 1\<^sub>m n) $$ (i-m,0)" + by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert i A, auto) + also have "... = 0" using i A by auto + finally show ?thesis . + qed + thus "\x\set [m + 1.. A $$ (x, 0) \ 0" by blast + qed + have fm: "filter (\i. A $$ (i,0) \ 0) [m] = [m]" + proof - + have "A $$ (m, 0) = (D \\<^sub>m 1\<^sub>m n) $$ (m-m,0)" + by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert n0, auto) + also have "... = D" using m0 n0 by auto + finally show ?thesis using D0 by auto + qed + have "non_zero_positions = filter (\i. A $$ (i,0) \ 0) ([1..i. A $$ (i,0) \ 0) [1..i. A $$ (i,0) \ 0) ([m+1..i. A $$ (i,0) \ 0) [1..i. A $$ (i,0) \ 0) ([1..i. A $$ (i,0) \ 0) [1..x\set ?xs. x < m \ 0 < x)" by auto + ultimately show ?thesis by blast +qed + + + + +lemma non_zero_positions_xs_m': + fixes A::"'a::comm_ring_1 mat" + assumes A_def: "A = A' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + and A': "A' \ carrier_mat m n" + and nz_def: "non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. 0" +shows "non_zero_positions = (filter (\i. A $$ (i,0) \ 0) [1.. distinct (filter (\i. A $$ (i,0) \ 0) [1.. (\x\set (filter (\i. A $$ (i,0) \ 0) [1.. 0 < x)" +proof - + have A: "A \ carrier_mat (m+n) n" using A' A_def by auto + let ?xs = "filter (\i. A $$ (i,0) \ 0) [1..i. A $$ (i,0) \ 0) ([m+1..set [m + 1..\<^sub>m 1\<^sub>m n) $$ (i-m,0)" + by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert i A, auto) + also have "... = 0" using i A by auto + finally show ?thesis . + qed + thus "\x\set [m + 1.. A $$ (x, 0) \ 0" by blast + qed + have fm: "filter (\i. A $$ (i,0) \ 0) [m] = [m]" + proof - + have "A $$ (m, 0) = (D \\<^sub>m 1\<^sub>m n) $$ (m-m,0)" + by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert n0, auto) + also have "... = D" using m0 n0 by auto + finally show ?thesis using D0 by auto + qed + have "non_zero_positions = filter (\i. A $$ (i,0) \ 0) ([1..i. A $$ (i,0) \ 0) [1..i. A $$ (i,0) \ 0) ([m+1..i. A $$ (i,0) \ 0) [1..i. A $$ (i,0) \ 0) ([1..i. A $$ (i,0) \ 0) [1..x\set ?xs. x < m \ 0 < x)" by auto + ultimately show ?thesis by blast +qed + +lemma A_A'D_eq_first_n_rows: + assumes A_def: "A = A' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + and A': "A' \ carrier_mat m n" + and mn: "m\n" +shows "(mat_of_rows n (map (Matrix.row A') [0..\<^sub>m 1\<^sub>m n : carrier_mat n n" by simp + fix i j assume i: "ir D \\<^sub>m 1\<^sub>m n" + and A': "A' \ carrier_mat m n" + and nz_def: "non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. 0" + and inv_A'': "invertible_mat (map_mat rat_of_int (mat_of_rows n (map (Matrix.row A') [0..n" +shows "length non_zero_positions > 1" +proof - + have A: "A \ carrier_mat (m+n) n" using A' A_def by auto + have D: "D \\<^sub>m 1\<^sub>m n : carrier_mat n n" by auto + let ?RAT = "map_mat rat_of_int" + let ?A'' = "(mat_of_rows n (map (Matrix.row A') [0.. carrier_mat n n" by auto + have RAT_A'': "?RAT ?A'' \ carrier_mat n n" by auto + let ?ys = "filter (\i. A $$ (i,0) \ 0) [1.. []" + proof (rule ccontr) + assume "\ ?xs \ []" hence xs0: "?xs = []" by simp + have A00: "A $$ (0,0) = 0" + proof - + have "A $$ (0,0) = A'$$(0,0)" unfolding A_def using append_rows_nth[OF A' D] m0 n0 A' by auto + thus ?thesis using A'00 by simp + qed + hence "(\i\set [1..iv n" + proof (rule eq_vecI) + show "dim_vec (col ?A'' 0) = dim_vec (0\<^sub>vn)" using A' by auto + fix i assume i: "i < dim_vec (0\<^sub>v n)" + have "col ?A'' 0 $v i = ?A'' $$ (i,0)" by (rule index_col, insert i A' n0, auto) + also have "... = A $$ (i,0)" + unfolding A_def using i A append_rows_nth[OF A' D _ n0] A' mn + by (metis A'' n0 carrier_matD(1) index_zero_vec(2) le_add2 map_first_rows_index + mat_of_rows_carrier(2) mat_of_rows_index nat_SN.compat) + also have "... = 0" using * i by auto + finally show "col ?A'' 0 $v i = 0\<^sub>v n $v i" using i by auto + qed + hence "col (?RAT ?A'') 0 = 0\<^sub>v n" by auto + hence "\ invertible_mat (?RAT ?A'')" + using invertible_mat_first_column_not0[OF RAT_A'' _ n0] by auto + thus False using inv_A'' by contradiction + qed + have l_rw: "[1..i. A $$ (i,0) \ 0) ([m+1..set [m + 1..\<^sub>m 1\<^sub>m n) $$ (i-m,0)" + by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert i A, auto) + also have "... = 0" using i A by auto + finally show ?thesis . + qed + thus "\x\set [m + 1.. A $$ (x, 0) \ 0" by blast + qed + have fm: "filter (\i. A $$ (i,0) \ 0) [m] = [m]" + proof - + have "A $$ (m, 0) = (D \\<^sub>m 1\<^sub>m n) $$ (m-m,0)" + by (rule append_rows_nth3[OF A' _ A_def _ _ n0], insert n0, auto) + also have "... = D" using m0 n0 by auto + finally show ?thesis using D0 by auto + qed + have "non_zero_positions = filter (\i. A $$ (i,0) \ 0) ([1..i. A $$ (i,0) \ 0) [1..i. A $$ (i,0) \ 0) ([m+1..i. A $$ (i,0) \ 0) [1..i. A $$ (i,0) \ 0) ([1..i. A $$ (i,0) \ 0) [1.. []" using xs_not_empty mn + by (metis (no_types, lifting) atLeastLessThan_iff empty_filter_conv nat_SN.compat set_upt) + show ?thesis unfolding nz using ys_not_empty by auto +qed + + + +corollary non_zero_positions_length_xs: + assumes A_def: "A = A' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + and A': "A' \ carrier_mat m n" + and nz_def: "non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. 0" + and inv_A'': "invertible_mat (map_mat rat_of_int (mat_of_rows n (map (Matrix.row A') [0..n" + and nz_xs_m: "non_zero_positions = xs @ [m]" +shows "length xs > 0" +proof - + have "length non_zero_positions > 1" + by (rule non_zero_positions_xs_m_invertible[OF A_def A' nz_def m0 n0 D0 inv_A'' A'00 mn]) + thus ?thesis using nz_xs_m by auto +qed + + + +lemma make_first_column_positive_nz_conv: + assumes "i 0) = (A $$ (i, j) \ 0)" + using assms unfolding make_first_column_positive.simps by auto + + + +lemma make_first_column_positive_00: + assumes A_def: "A = A'' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + and A'': "A'' : carrier_mat m n" + assumes nz_def: "non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)" + and m0: "0 0" and mn: "m\n" + shows "make_first_column_positive A' $$ (0, 0) \ 0" +proof - + have A: "A \ carrier_mat (m+n) n" using A_def A'' by auto + hence A': "A' \ carrier_mat (m+n) n" unfolding A'_def by auto + have "(make_first_column_positive A' $$ (0, 0) \ 0) = (A' $$ (0, 0) \ 0)" + by (rule make_first_column_positive_nz_conv, insert m0 n0 A', auto) + moreover have "A' $$ (0, 0) \ 0" + proof (cases "A $$ (0, 0) \ 0") + case True + then show ?thesis unfolding A'_def by auto + next + case False + have "A $$ (0, 0) = A'' $$ (0, 0)" + by (smt add_gr_0 append_rows_def A_def A'' carrier_matD index_mat_four_block(1) mn n0 nat_SN.compat) + hence A''00: "A''$$(0,0) = 0" using False by auto + let ?i = "non_zero_positions ! 0" + obtain xs where non_zero_positions_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs" + and all_less_m: "\x\set xs. x < m \ 0 < x" + using non_zero_positions_xs_m[OF A_def A'' nz_def m0 n0] using D0 by fast + have Ai0:"A $$ (?i,0) \ 0" + by (smt append.simps(1) append_Cons append_same_eq nz_def in_set_conv_nth length_greater_0_conv + list.simps(3) local.non_zero_positions_xs_m mem_Collect_eq set_filter) + have "A' $$ (0, 0) = swaprows 0 ?i A $$ (0,0)" using False A'_def by auto + also have "... \ 0" using A Ai0 n0 by auto + finally show ?thesis . + qed + ultimately show ?thesis by blast +qed + + +context proper_mod_operation +begin +lemma reduce_below_0_case_m_make_first_column_positive: + assumes A': "A' \ carrier_mat m n" and m0: "0r (D \\<^sub>m (1\<^sub>m n))" + and mn: "m\n" + assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\x \ set xs. x < m \ 0 < x" + and ia: "i\0" + and A''_def: "A'' = (if A $$ (0, 0) \ 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)" + and D0: "D>0" + and nz_def: "non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. carrier_mat (m+n) n" using A' A_def by auto + define xs where "xs = filter (\i. A $$ (i,0) \ 0) [1..x\set xs. x < m \ 0 < x" + using non_zero_positions_xs_m'[OF A_def A' nz_def m0 n0] using D0 A unfolding nz_def xs_def by auto + have A'': "A'' \ carrier_mat (m+n) n" using A' A_def A''_def by auto + have D_not0: "D\0" using D0 by auto + have Ai0: "A $$ (i, 0) = 0" if im: "i>m" and imn: "i\<^sub>m (1\<^sub>m n)) \ carrier_mat n n" by simp + have "A $$ (i, 0) = (D \\<^sub>m (1\<^sub>m n)) $$ (i-m, 0)" + unfolding A_def using append_rows_nth[OF A' D imn n0] im A' by auto + also have "... = 0" using im imn n0 by auto + finally show ?thesis . + qed + let ?M' = "mat_of_rows n (map (Matrix.row (make_first_column_positive A'')) [0.. carrier_mat m n" using A'' by auto + have mk0: "make_first_column_positive A'' $$ (0, 0) \ 0" + by (rule make_first_column_positive_00[OF A_def A' nz_def A''_def m0 n0 D_not0 mn]) + have M_M'D: "make_first_column_positive A'' = ?M' @\<^sub>r D \\<^sub>m 1\<^sub>m n" if xs_empty: "xs \ []" + proof (cases "A$$(0,0) \ 0") + case True + then have *: "make_first_column_positive A'' = make_first_column_positive A" + unfolding A''_def by auto + show ?thesis + by (unfold *, rule make_first_column_positive_append_id[OF A' A_def D0 n0]) + next + case False + then have *: "make_first_column_positive A'' + = make_first_column_positive (swaprows 0 (non_zero_positions ! 0) A)" + unfolding A''_def by auto + show ?thesis + proof (unfold *, rule make_first_column_positive_append_id) + let ?S = "mat_of_rows n (map (Matrix.row (swaprows 0 (non_zero_positions ! 0) A)) [0..r (D \\<^sub>m (1\<^sub>m n))" + proof (rule swaprows_append_id[OF A' A_def]) + have A'00: "A' $$ (0, 0) = 0" + by (metis (no_types, lifting) A False add_pos_pos append_rows_def A' A_def + carrier_matD index_mat_four_block m0 n0) + have length_xs: "length xs > 0" using xs_empty by auto + have "non_zero_positions ! 0 = xs ! 0" unfolding nz_xs_m + by (meson length_xs nth_append) + thus "non_zero_positions ! 0 < m" using all_less_m length_xs by simp + qed + qed (insert n0 D0, auto) + qed + show ?thesis + proof (cases "xs = []") + case True note xs_empty = True + have "reduce_below 0 non_zero_positions D (make_first_column_positive A'') + = reduce 0 m D (make_first_column_positive A'')" + unfolding nz_xs_m True by auto + + also have "... $$ (i, 0) = 0" + proof (cases "i=m") + case True + from D0 have "D \ 1" "D \ 0" by auto + then show ?thesis using D0 True + by (metis A add_sign_intros(2) A''_def carrier_matD(1) carrier_matD(2) carrier_matI + index_mat_swaprows(2) index_mat_swaprows(3) less_add_same_cancel1 m0 + make_first_column_positive_preserves_dimensions mk0 n0 neq0_conv reduce_0) + next + case False note i_not_m = False + have nz_m: "non_zero_positions ! 0 = m" unfolding nz_xs_m True by auto + let ?M = "make_first_column_positive A''" + have M: "?M \ carrier_mat (m+n) n" using A'' by auto + show ?thesis + proof (cases "A$$(0,0) = 0") + case True + have "reduce 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" + by (rule reduce_preserves[OF M n0 mk0 False ia i_mn]) + also have Mi0: "... = abs (A'' $$ (i,0))" + by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps + make_first_column_positive_preserves_dimensions n0 prod.simps(2)) + also have Mi02: "... = abs (A $$ (i,0)) " unfolding A''_def nz_m + using True A False i_mn ia n0 by auto + also have "... = 0" + proof - + have "filter (\n. A $$ (n, 0) \ 0) [1..n. A $$ (n, 0) = 0 \ n \ set [1.. 0" by simp + have "reduce 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" + by (rule reduce_preserves[OF M n0 mk0 i_not_m ia i_mn]) + also have Mi0: "... = abs (A'' $$ (i,0))" + by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps + make_first_column_positive_preserves_dimensions n0 prod.simps(2)) + also have Mi02: "... = abs (swaprows 0 m A $$ (i,0)) " unfolding A''_def nz_m + using A00 A i_not_m i_mn ia n0 by auto + also have "... = abs (A $$ (i,0))" using False ia A00 Mi0 A''_def calculation Mi02 by presburger + also have "... = 0" + proof - + have "filter (\n. A $$ (n, 0) \ 0) [1..n. A $$ (n, 0) = 0 \ n \ set [1.. set (xs @ [m])") + case True + show ?thesis + by (unfold nz_xs_m, rule reduce_below_0_case_m[OF M' m0 n0 M_M'D mk0 mn True d_xs all_less_m D0]) + next + case False note i_notin_xs_m = False + have 1: "reduce_below 0 (xs @ [m]) D (make_first_column_positive A'') $$ (i,0) + = (make_first_column_positive A'') $$ (i,0)" + by (rule reduce_below_preserves_case_m[OF M' m0 n0 M_M'D mk0 mn _ d_xs all_less_m ia i_mn _ D0], + insert False, auto) + have "((make_first_column_positive A'') $$ (i,0) \ 0) = (A'' $$ (i,0) \ 0)" + by (rule make_first_column_positive_nz_conv, insert A'' i_mn n0, auto) + hence 2: "((make_first_column_positive A'') $$ (i,0) = 0) = (A'' $$ (i,0) = 0)" by auto + have 3: "(A'' $$ (i,0) = 0)" + proof (cases "A$$(0,0) \ 0") + case True + then have "A'' $$ (i, 0) = A $$ (i, 0)" unfolding A''_def by auto + also have "... = 0" using False ia i_mn A nz_xs_m Ai0 unfolding nz_def xs_def by auto + finally show ?thesis by auto + next + case False hence A00: "A $$ (0,0) = 0" by simp + let ?i = "non_zero_positions ! 0" + have i_noti: "i\?i" + using i_notin_xs_m unfolding nz_xs_m + by (metis Nil_is_append_conv length_greater_0_conv list.distinct(2) nth_mem) + have "A''$$(i,0) = (swaprows 0 ?i A) $$ (i,0)" using False unfolding A''_def by auto + also have "... = A $$ (i,0)" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def by fastforce + also have "... = 0" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def + by (smt nz_def atLeastLessThan_iff carrier_matD(1) less_one linorder_not_less + mem_Collect_eq nz_xs_m set_filter set_upt xs_def) + finally show ?thesis . + qed + show ?thesis using 1 2 3 nz_xs_m by argo + qed + qed +qed + + +lemma reduce_below_abs_0_case_m_make_first_column_positive: + assumes A': "A' \ carrier_mat m n" and m0: "0r (D \\<^sub>m (1\<^sub>m n))" + and mn: "m\n" + assumes i_mn: "i < m+n" and d_xs: "distinct xs" and xs: "\x \ set xs. x < m \ 0 < x" + and ia: "i\0" + and A''_def: "A'' = (if A $$ (0, 0) \ 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)" + and D0: "D>0" + and nz_def: "non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. carrier_mat (m+n) n" using A' A_def by auto + define xs where "xs = filter (\i. A $$ (i,0) \ 0) [1..x\set xs. x < m \ 0 < x" + using non_zero_positions_xs_m'[OF A_def A' nz_def m0 n0] using D0 A unfolding nz_def xs_def by auto + have A'': "A'' \ carrier_mat (m+n) n" using A' A_def A''_def by auto + have D_not0: "D\0" using D0 by auto + have Ai0: "A $$ (i, 0) = 0" if im: "i>m" and imn: "i\<^sub>m (1\<^sub>m n)) \ carrier_mat n n" by simp + have "A $$ (i, 0) = (D \\<^sub>m (1\<^sub>m n)) $$ (i-m, 0)" + unfolding A_def using append_rows_nth[OF A' D imn n0] im A' by auto + also have "... = 0" using im imn n0 by auto + finally show ?thesis . + qed + let ?M' = "mat_of_rows n (map (Matrix.row (make_first_column_positive A'')) [0.. carrier_mat m n" using A'' by auto + have mk0: "make_first_column_positive A'' $$ (0, 0) \ 0" + by (rule make_first_column_positive_00[OF A_def A' nz_def A''_def m0 n0 D_not0 mn]) + have M_M'D: "make_first_column_positive A'' = ?M' @\<^sub>r D \\<^sub>m 1\<^sub>m n" if xs_empty: "xs \ []" + proof (cases "A$$(0,0) \ 0") + case True + then have *: "make_first_column_positive A'' = make_first_column_positive A" + unfolding A''_def by auto + show ?thesis + by (unfold *, rule make_first_column_positive_append_id[OF A' A_def D0 n0]) + next + case False + then have *: "make_first_column_positive A'' + = make_first_column_positive (swaprows 0 (non_zero_positions ! 0) A)" + unfolding A''_def by auto + show ?thesis + proof (unfold *, rule make_first_column_positive_append_id) + let ?S = "mat_of_rows n (map (Matrix.row (swaprows 0 (non_zero_positions ! 0) A)) [0..r (D \\<^sub>m (1\<^sub>m n))" + proof (rule swaprows_append_id[OF A' A_def]) + have A'00: "A' $$ (0, 0) = 0" + by (metis (no_types, lifting) A False add_pos_pos append_rows_def A' A_def + carrier_matD index_mat_four_block m0 n0) + have length_xs: "length xs > 0" using xs_empty by auto + have "non_zero_positions ! 0 = xs ! 0" unfolding nz_xs_m + by (meson length_xs nth_append) + thus "non_zero_positions ! 0 < m" using all_less_m length_xs by simp + qed + qed (insert n0 D0, auto) + qed + show ?thesis + proof (cases "xs = []") + case True note xs_empty = True + have "reduce_below_abs 0 non_zero_positions D (make_first_column_positive A'') + = reduce_abs 0 m D (make_first_column_positive A'')" + unfolding nz_xs_m True by auto + + also have "... $$ (i, 0) = 0" + proof (cases "i=m") + case True + from D0 have "D \ 1" "D \ 0" by auto + then show ?thesis using D0 True + by (metis A add_sign_intros(2) A''_def carrier_matD(1) carrier_matD(2) carrier_matI + index_mat_swaprows(2) index_mat_swaprows(3) less_add_same_cancel1 m0 + make_first_column_positive_preserves_dimensions mk0 n0 neq0_conv reduce_0) + next + case False note i_not_m = False + have nz_m: "non_zero_positions ! 0 = m" unfolding nz_xs_m True by auto + let ?M = "make_first_column_positive A''" + have M: "?M \ carrier_mat (m+n) n" using A'' by auto + show ?thesis + proof (cases "A$$(0,0) = 0") + case True + have "reduce_abs 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" + by (rule reduce_preserves[OF M n0 mk0 False ia i_mn]) + also have Mi0: "... = abs (A'' $$ (i,0))" + by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps + make_first_column_positive_preserves_dimensions n0 prod.simps(2)) + also have Mi02: "... = abs (A $$ (i,0)) " unfolding A''_def nz_m + using True A False i_mn ia n0 by auto + also have "... = 0" + proof - + have "filter (\n. A $$ (n, 0) \ 0) [1..n. A $$ (n, 0) = 0 \ n \ set [1.. 0" by simp + have "reduce_abs 0 m D ?M $$ (i, 0) = ?M $$ (i,0)" + by (rule reduce_preserves[OF M n0 mk0 i_not_m ia i_mn]) + also have Mi0: "... = abs (A'' $$ (i,0))" + by (smt M carrier_matD(1) carrier_matD(2) i_mn index_mat(1) make_first_column_positive.simps + make_first_column_positive_preserves_dimensions n0 prod.simps(2)) + also have Mi02: "... = abs (swaprows 0 m A $$ (i,0)) " unfolding A''_def nz_m + using A00 A i_not_m i_mn ia n0 by auto + also have "... = abs (A $$ (i,0))" using False ia A00 Mi0 A''_def calculation Mi02 by presburger + also have "... = 0" + proof - + have "filter (\n. A $$ (n, 0) \ 0) [1..n. A $$ (n, 0) = 0 \ n \ set [1.. set (xs @ [m])") + case True + show ?thesis + by (unfold nz_xs_m, rule reduce_below_abs_0_case_m[OF M' m0 n0 M_M'D mk0 mn True d_xs all_less_m D0]) + next + case False note i_notin_xs_m = False + have 1: "reduce_below_abs 0 (xs @ [m]) D (make_first_column_positive A'') $$ (i,0) + = (make_first_column_positive A'') $$ (i,0)" + by (rule reduce_below_abs_preserves_case_m[OF M' m0 n0 M_M'D mk0 mn _ d_xs all_less_m ia i_mn _ D0], + insert False, auto) + have "((make_first_column_positive A'') $$ (i,0) \ 0) = (A'' $$ (i,0) \ 0)" + by (rule make_first_column_positive_nz_conv, insert A'' i_mn n0, auto) + hence 2: "((make_first_column_positive A'') $$ (i,0) = 0) = (A'' $$ (i,0) = 0)" by auto + have 3: "(A'' $$ (i,0) = 0)" + proof (cases "A$$(0,0) \ 0") + case True + then have "A'' $$ (i, 0) = A $$ (i, 0)" unfolding A''_def by auto + also have "... = 0" using False ia i_mn A nz_xs_m Ai0 unfolding nz_def xs_def by auto + finally show ?thesis by auto + next + case False hence A00: "A $$ (0,0) = 0" by simp + let ?i = "non_zero_positions ! 0" + have i_noti: "i\?i" + using i_notin_xs_m unfolding nz_xs_m + by (metis Nil_is_append_conv length_greater_0_conv list.distinct(2) nth_mem) + have "A''$$(i,0) = (swaprows 0 ?i A) $$ (i,0)" using False unfolding A''_def by auto + also have "... = A $$ (i,0)" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def by fastforce + also have "... = 0" using i_notin_xs_m ia i_mn A i_noti n0 unfolding xs_def + by (smt nz_def atLeastLessThan_iff carrier_matD(1) less_one linorder_not_less + mem_Collect_eq nz_xs_m set_filter set_upt xs_def) + finally show ?thesis . + qed + show ?thesis using 1 2 3 nz_xs_m by argo + qed + qed +qed + + +lemma FindPreHNF_invertible_mat_2xn: + assumes A: "A \ carrier_mat m n" and "m<2" + shows "\P. P \ carrier_mat m m \ invertible_mat P \ FindPreHNF abs_flag D A = P * A" + using assms + by (auto, metis invertible_mat_one left_mult_one_mat one_carrier_mat) + + +lemma FindPreHNF_invertible_mat_mx2: + assumes A_def: "A = A'' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + and A'': "A'' \ carrier_mat m n" and n2: "n<2" and n0: "00" and mn: "m\n" +shows "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ FindPreHNF abs_flag D A = P * A" +proof - + have A: "A \ carrier_mat (m+n) n" using A_def A'' by auto + have m0: "m>0" using mn n2 n0 by auto + have D0: "D\0" using D_g0 by auto + show ?thesis + proof (cases "m+n<2") + case True + show ?thesis by (rule FindPreHNF_invertible_mat_2xn[OF A True]) + next + case False note mn_le_2 = False + have dr_A: "dim_row A \2" using False n2 A by auto + have dc_A: "dim_col A < 2" using n2 A by auto + let ?non_zero_positions = "filter (\i. A $$ (i, 0) \ 0) [Suc 0..i. A $$ (i,0) \ 0) [1..x\set xs. x < m \ 0 < x" + using non_zero_positions_xs_m'[OF A_def A'' _ m0 n0 D0] using D0 A unfolding xs_def by auto + have *: "FindPreHNF abs_flag D A = (if abs_flag then reduce_below_abs 0 ?non_zero_positions D ?A' + else reduce_below 0 ?non_zero_positions D ?A')" + using dr_A dc_A by (auto simp add: Let_def) + have l: "length ?non_zero_positions > 1" if "xs\[]" using that unfolding nz_xs_m by auto + have inv: "\P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) + \ reduce_below 0 ?non_zero_positions D ?A' = P * ?A'" + proof (cases "A $$ (0,0) \0") + case True + show ?thesis + by (unfold nz_xs_m, rule reduce_below_invertible_mat_case_m + [OF A'' m0 n0 _ _ mn d_xs all_less_m], insert A_def True D_g0, auto) + next + case False hence A00: "A $$ (0,0) = 0" by auto + let ?S = "swaprows 0 (?non_zero_positions ! 0) A" + have rw: "(if A $$ (0, 0) \ 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A) + = ?S" using False by auto + show ?thesis + proof (cases "xs = []") + case True + have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))" + by (metis prod_cases5) + have Am0: "A $$ (m,0) = D" + proof - + have "A $$ (m,0) = (D \\<^sub>m 1\<^sub>m n) $$ (m-m, 0)" + by (smt (z3) A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block + less_add_same_cancel1 less_diff_conv diff_add nat_less_le) + also have "... = D" by (simp add: n0) + finally show ?thesis . + qed + have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto + have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto + have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))" + using pquvd Sm0 S00 Am0 A00 by auto + have "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D ?A'" unfolding nz_m by auto + also have "... = reduce 0 m D (swaprows 0 m A)" using True False rw nz_m by auto + have " \P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) \ + reduce 0 m D (swaprows 0 m A) = P * (swaprows 0 m A)" + proof (rule reduce_invertible_mat_case_m[OF _ _ m0 _ _ _ _ mn n0]) + show "swaprows 0 m A $$ (0, 0) \ 0" using S00 D0 by auto + define S' where "S' = mat_of_rows n (map (Matrix.row ?S) [0..(i, k). if i = 0 then p * A $$ (m, k) + q * A $$ (0, k) + else if i = m then u * A $$ (m, k) + v * A $$ (0, k) else A $$ (i, k))" + show S_S'_S'': "swaprows 0 m A = S' @\<^sub>r S''" unfolding S'_def S''_def + by (metis A append_rows_split carrier_matD index_mat_swaprows(2,3) le_add1 nth_Cons_0 nz_m) + show S': "S' \ carrier_mat m n" unfolding S'_def by fastforce + show S'': "S'' \ carrier_mat n n" unfolding S''_def by fastforce + show "0 \ m" using m0 by simp + show "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))" + using pquvd by simp + show "A2 = Matrix.mat (dim_row (swaprows 0 m A)) (dim_col (swaprows 0 m A)) + (\(i, k). if i = 0 then p * swaprows 0 m A $$ (0, k) + q * swaprows 0 m A $$ (m, k) + else if i = m then u * swaprows 0 m A $$ (0, k) + v * swaprows 0 m A $$ (m, k) else swaprows 0 m A $$ (i, k))" + (is "_ = ?rhs") using A A2_def by auto + define xs' where "xs' = [1.. (\j'\{0..0" for j + proof - + have "S'' $$ (j, i) = (D \\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i\<^sub>m 1\<^sub>m n) $$ (j,i)" + by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n + carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1) + finally show ?thesis . + qed + thus ?thesis using jn j0 by auto + qed + have "0 \ set xs'" + proof - + have "A2 $$ (0,0) = p * A $$ (m, 0) + q * A $$ (0, 0)" + using A A2_def n0 by auto + also have "... = gcd (A $$ (m, 0)) (A $$ (0, 0))" + by (metis euclid_ext2_works(1) euclid_ext2_works(2) pquvd2) + also have "... = D" using Am0 A00 D_g0 by auto + finally have "A2 $$ (0,0) = D" . + thus ?thesis unfolding xs'_def using D_g0 by auto + qed + thus "\j\set xs'. j (S'' $$ (j, j) = D) \ (\j'\{0.. set ys'" + proof - + have "A2 $$ (m,0) = u * A $$ (m, 0) + v * A $$ (0, 0)" + using A A2_def n0 m0 by auto + also have "... = - A $$ (0, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (m, 0) + + A $$ (m, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (0, 0)" + by (simp add: euclid_ext2_works[OF pquvd2[symmetric]]) + also have "... = 0" using A00 Am0 by auto + finally have "A2 $$ (m,0) = 0" . + thus ?thesis unfolding ys'_def using D_g0 by auto + qed + thus "\j\set ys'. j (S'' $$ (j, j) = D) \ (\j'\{0.. {0, D}" using Sm0 by blast + thus "swaprows 0 m A $$ (m, 0) = 0 \ swaprows 0 m A $$ (0, 0) = D" + using S00 by linarith + qed (insert D_g0) + then show ?thesis by (simp add: False nz_m) + next + case False note xs_not_empty = False + show ?thesis + proof (unfold nz_xs_m, rule reduce_below_invertible_mat_case_m[OF _ m0 n0 _ _ mn d_xs all_less_m D_g0]) + let ?S' = "mat_of_rows n (map (Matrix.row ?S) [0.. carrier_mat m n" by auto + have l: "length ?non_zero_positions > 1" using l False by blast + hence nz0_less_m: "?non_zero_positions ! 0 < m" + by (metis One_nat_def add.commute add.left_neutral all_less_m append_Cons_nth_left + length_append less_add_same_cancel1 list.size(3,4) nth_mem nz_xs_m) + have "?S = ?S' @\<^sub>r D \\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def nz0_less_m]) + thus "(if A $$ (0, 0) \ 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)= ?S' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + using rw nz_xs_m by argo + have "?S $$ (0, 0) \ 0" + by (smt A l add_pos_pos carrier_matD index_mat_swaprows(1) le_eq_less_or_eq length_greater_0_conv + less_one linorder_not_less list.size(3) m0 mem_Collect_eq n0 nth_mem set_filter) + thus "(if A $$ (0, 0) \ 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A) $$ (0, 0) \ 0" + using rw nz_xs_m by algebra + qed + qed + qed + have inv2: "\P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) + \ reduce_below_abs 0 ?non_zero_positions D ?A' = P * ?A'" + proof (cases "A $$ (0,0) \0") + case True + show ?thesis + by (unfold nz_xs_m, rule reduce_below_abs_invertible_mat_case_m + [OF A'' m0 n0 _ _ mn d_xs all_less_m], insert A_def True D_g0, auto) + next + case False hence A00: "A $$ (0,0) = 0" by auto + let ?S = "swaprows 0 (?non_zero_positions ! 0) A" + have rw: "(if A $$ (0, 0) \ 0 then A else let i = ?non_zero_positions ! 0 in swaprows 0 i A) + = ?S" using False by auto + show ?thesis + proof (cases "xs = []") + case True + have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))" + by (metis prod_cases5) + have Am0: "A $$ (m,0) = D" + proof - + have "A $$ (m,0) = (D \\<^sub>m 1\<^sub>m n) $$ (m-m, 0)" + by (smt (z3) A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block + less_add_same_cancel1 less_diff_conv diff_add nat_less_le) + also have "... = D" by (simp add: n0) + finally show ?thesis . + qed + have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto + have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto + have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))" + using pquvd Sm0 S00 Am0 A00 by auto + have "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D ?A'" unfolding nz_m by auto + also have "... = reduce 0 m D (swaprows 0 m A)" using True False rw nz_m by auto + have " \P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) \ + reduce_abs 0 m D (swaprows 0 m A) = P * (swaprows 0 m A)" + proof (rule reduce_abs_invertible_mat_case_m[OF _ _ m0 _ _ _ _ mn n0]) + show "swaprows 0 m A $$ (0, 0) \ 0" using S00 D0 by auto + define S' where "S' = mat_of_rows n (map (Matrix.row ?S) [0..(i, k). if i = 0 then p * A $$ (m, k) + q * A $$ (0, k) + else if i = m then u * A $$ (m, k) + v * A $$ (0, k) else A $$ (i, k))" + show S_S'_S'': "swaprows 0 m A = S' @\<^sub>r S''" unfolding S'_def S''_def + by (metis A append_rows_split carrier_matD index_mat_swaprows(2,3) le_add1 nth_Cons_0 nz_m) + show S': "S' \ carrier_mat m n" unfolding S'_def by fastforce + show S'': "S'' \ carrier_mat n n" unfolding S''_def by fastforce + show "0 \ m" using m0 by simp + show "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))" + using pquvd by simp + show "A2 = Matrix.mat (dim_row (swaprows 0 m A)) (dim_col (swaprows 0 m A)) + (\(i, k). if i = 0 then p * swaprows 0 m A $$ (0, k) + q * swaprows 0 m A $$ (m, k) + else if i = m then u * swaprows 0 m A $$ (0, k) + v * swaprows 0 m A $$ (m, k) else swaprows 0 m A $$ (i, k))" + (is "_ = ?rhs") using A A2_def by auto + define xs' where "xs' = filter (\i. abs (A2 $$ (0,i)) > D) [0..i. abs (A2 $$ (m,i)) > D) [0..i. abs (A2 $$ (0,i)) > D) [0..i. abs (A2 $$ (m,i)) > D) [0.. (\j'\{0..0" for j + proof - + have "S'' $$ (j, i) = (D \\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i\<^sub>m 1\<^sub>m n) $$ (j,i)" + by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n + carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1) + finally show ?thesis . + qed + thus ?thesis using jn j0 by auto + qed + have "0 \ set xs'" + proof - + have "A2 $$ (0,0) = p * A $$ (m, 0) + q * A $$ (0, 0)" + using A A2_def n0 by auto + also have "... = gcd (A $$ (m, 0)) (A $$ (0, 0))" + by (metis euclid_ext2_works(1) euclid_ext2_works(2) pquvd2) + also have "... = D" using Am0 A00 D_g0 by auto + finally have "A2 $$ (0,0) = D" . + thus ?thesis unfolding xs'_def using D_g0 by auto + qed + thus "\j\set xs'. j (S'' $$ (j, j) = D) \ (\j'\{0.. set ys'" + proof - + have "A2 $$ (m,0) = u * A $$ (m, 0) + v * A $$ (0, 0)" + using A A2_def n0 m0 by auto + also have "... = - A $$ (0, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (m, 0) + + A $$ (m, 0) div gcd (A $$ (m, 0)) (A $$ (0, 0)) * A $$ (0, 0)" + by (simp add: euclid_ext2_works[OF pquvd2[symmetric]]) + also have "... = 0" using A00 Am0 by auto + finally have "A2 $$ (m,0) = 0" . + thus ?thesis unfolding ys'_def using D_g0 by auto + qed + thus "\j\set ys'. j (S'' $$ (j, j) = D) \ (\j'\{0.. carrier_mat m n" by auto + have l: "length ?non_zero_positions > 1" using l False by blast + hence nz0_less_m: "?non_zero_positions ! 0 < m" + by (metis One_nat_def add.commute add.left_neutral all_less_m append_Cons_nth_left + length_append less_add_same_cancel1 list.size(3,4) nth_mem nz_xs_m) + have "?S = ?S' @\<^sub>r D \\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def nz0_less_m]) + thus "(if A $$ (0, 0) \ 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)= ?S' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + using rw nz_xs_m by argo + have "?S $$ (0, 0) \ 0" + by (smt A l add_pos_pos carrier_matD index_mat_swaprows(1) le_eq_less_or_eq length_greater_0_conv + less_one linorder_not_less list.size(3) m0 mem_Collect_eq n0 nth_mem set_filter) + thus "(if A $$ (0, 0) \ 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A) $$ (0, 0) \ 0" + using rw nz_xs_m by algebra + qed + qed + qed + show ?thesis + proof (cases abs_flag) + case False + from inv obtain P where inv_P: "invertible_mat P" and P: "P \ carrier_mat (m + n) (m + n)" + and r_PA': "reduce_below 0 ?non_zero_positions D ?A' = P * ?A'" by blast + have Find_rw: "FindPreHNF abs_flag D A = reduce_below 0 ?non_zero_positions D ?A'" + using n0 A dr_A dc_A False * by (auto simp add: Let_def) + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ ?A' = P * A" + by (rule A'_swaprows_invertible_mat[OF A], insert non_zero_positions_xs_m n0 m0 l nz_xs_m, auto) + from this obtain Q where Q: "Q \ carrier_mat (m + n) (m + n)" + and inv_Q: "invertible_mat Q" and A'_QA: "?A' = Q * A" by blast + have "reduce_below 0 ?non_zero_positions D ?A' = (P * Q) * A" using Q A'_QA P r_PA' A by auto + moreover have "invertible_mat (P*Q)" using P Q inv_P inv_Q invertible_mult_JNF by blast + moreover have "(P*Q) \ carrier_mat (m + n) (m + n)" using P Q by auto + ultimately show ?thesis using Find_rw by metis + next + case True + from inv2 obtain P where inv_P: "invertible_mat P" and P: "P \ carrier_mat (m + n) (m + n)" + and r_PA': "reduce_below_abs 0 ?non_zero_positions D ?A' = P * ?A'" by blast + have Find_rw: "FindPreHNF abs_flag D A = reduce_below_abs 0 ?non_zero_positions D ?A'" + using n0 A dr_A dc_A True * by (auto simp add: Let_def) + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ ?A' = P * A" + by (rule A'_swaprows_invertible_mat[OF A], insert non_zero_positions_xs_m n0 m0 l nz_xs_m, auto) + from this obtain Q where Q: "Q \ carrier_mat (m + n) (m + n)" + and inv_Q: "invertible_mat Q" and A'_QA: "?A' = Q * A" by blast + have "reduce_below_abs 0 ?non_zero_positions D ?A' = (P * Q) * A" using Q A'_QA P r_PA' A by auto + moreover have "invertible_mat (P*Q)" using P Q inv_P inv_Q invertible_mult_JNF by blast + moreover have "(P*Q) \ carrier_mat (m + n) (m + n)" using P Q by auto + ultimately show ?thesis using Find_rw by metis + qed + qed +qed + + +corollary FindPreHNF_echelon_form_mx0: + assumes "A \ carrier_mat m 0" + shows "echelon_form_JNF (FindPreHNF abs_flag D A)" + by (rule echelon_form_mx0, rule FindPreHNF[OF assms]) + + +lemma FindPreHNF_echelon_form_mx1: + assumes A_def: "A = A'' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + and A'': "A'' \ carrier_mat m n" and n2: "n<2" and D_g0: "D>0" and mn: "m\n" +shows "echelon_form_JNF (FindPreHNF abs_flag D A)" +proof (cases "n=0") + case True + have A: "A \ carrier_mat m 0" using A_def A'' True + by (metis add.comm_neutral append_rows_def carrier_matD carrier_matI index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3)) + show ?thesis unfolding True by (rule FindPreHNF_echelon_form_mx0, insert A, auto) +next + case False hence n0: "0 carrier_mat (m+n) n" using A_def A'' by auto + have m0: "m>0" using mn n2 n0 by auto + have D0: "D\0" using D_g0 by auto + show ?thesis + proof (cases "m+n<2") + case True + show ?thesis by (rule echelon_form_JNF_1xn[OF _ True], rule FindPreHNF[OF A]) + next + case False note mn_le_2 = False + have dr_A: "dim_row A \2" using False n2 A by auto + have dc_A: "dim_col A < 2" using n2 A by auto + let ?non_zero_positions = "filter (\i. A $$ (i, 0) \ 0) [Suc 0..i. A $$ (i,0) \ 0) [1..x\set xs. x < m \ 0 < x" + using non_zero_positions_xs_m'[OF A_def A'' _ m0 n0 D0] using D0 A unfolding xs_def by auto + have *: "FindPreHNF abs_flag D A = (if abs_flag then reduce_below_abs 0 ?non_zero_positions D ?A' + else reduce_below 0 ?non_zero_positions D ?A')" + using dr_A dc_A by (auto simp add: Let_def) + have l: "length ?non_zero_positions > 1" if "xs\[]" using that unfolding nz_xs_m by auto + have e: "echelon_form_JNF (reduce_below 0 ?non_zero_positions D ?A')" + proof (cases "A $$ (0,0) \0") + case True note A00 = True + have 1: "reduce_below 0 ?non_zero_positions D ?A' = reduce_below 0 ?non_zero_positions D A" + using True by auto + have "echelon_form_JNF (reduce_below 0 ?non_zero_positions D A)" + proof (rule echelon_form_JNF_mx1[OF _ n2]) + show "reduce_below 0 ?non_zero_positions D A \ carrier_mat (m+n) n" using A by auto + show "\i\{1.. {1..set ?non_zero_positions") + case True + show ?thesis unfolding nz_xs_m + by (rule reduce_below_0_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m D_g0], + insert nz_xs_m True, auto) + next + case False note i_notin_set = False + have "reduce_below 0 ?non_zero_positions D A $$ (i, 0) = A $$ (i, 0)" unfolding nz_xs_m + by (rule reduce_below_preserves_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m _ _ _ D_g0], + insert i nz_xs_m i_notin_set, auto) + also have "... = 0" using i_notin_set i A unfolding set_filter by auto + finally show ?thesis . + qed + qed + qed + thus ?thesis using 1 by argo + next + case False hence A00: "A $$ (0,0) = 0" by simp + let ?i = "((xs @ [m]) ! 0)" + let ?S = "swaprows 0 ?i A" + let ?S' = "mat_of_rows n (map (Matrix.row (swaprows 0 ?i A)) [0.. 0 then A else let i = ?non_zero_positions!0 in swaprows 0 i A) = ?S" + using A00 nz_xs_m by auto + have S: "?S \ carrier_mat (m+n) n" using A by auto + have A00_eq_A'00: "A $$ (0, 0) = A'' $$ (0, 0)" + by (metis A'' A_def add_gr_0 append_rows_def n0 carrier_matD index_mat_four_block(1) m0) + show ?thesis + proof (cases "xs=[]") + case True + have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))" + by (metis prod_cases5) + have Am0: "A $$ (m,0) = D" + proof - + have "A $$ (m,0) = (D \\<^sub>m 1\<^sub>m n) $$ (m-m, 0)" + by (smt A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block + less_add_same_cancel1 less_diff_conv ordered_cancel_comm_monoid_diff_class.diff_add + nat_less_le) + also have "... = D" by (simp add: n0) + finally show ?thesis . + qed + have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto + have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto + have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))" + using pquvd Sm0 S00 Am0 A00 by auto + have "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D ?A'" unfolding nz_m by auto + also have "... = reduce 0 m D (swaprows 0 m A)" using True False rw nz_m by auto + finally have *: "reduce_below 0 ?non_zero_positions D ?A' = reduce 0 m D (swaprows 0 m A)" . + have "echelon_form_JNF (reduce 0 m D (swaprows 0 m A))" + proof (rule echelon_form_JNF_mx1[OF _ n2]) + show "reduce 0 m D (swaprows 0 m A) \ carrier_mat (m+n) n" + using A n2 reduce_carrier by (auto simp add: Let_def) + show "\i\{1.. {1.. carrier_mat (m+n) n" using A by auto + qed (insert m0 n0 S00 D_g0, auto) + next + case False + have "reduce 0 m D (swaprows 0 m A) $$ (i, 0) = (swaprows 0 m A) $$ (i, 0)" + proof (rule reduce_preserves[OF _ n0]) + show "swaprows 0 m A \ carrier_mat (m+n) n" using A by auto + qed (insert m0 n0 S00 D_g0 False i, auto) + also have "... = A $$ (i, 0)" using i False A n0 by auto + also have "... = 0" + proof (rule ccontr) + assume "A $$ (i, 0) \ 0" hence "i \ set ?non_zero_positions" using i A by auto + hence "i=m" using nz_xs_m True by auto + thus False using False by contradiction + qed + finally show ?thesis . + qed + qed + qed + then show ?thesis using * by presburger + next + case False + have l: "length ?non_zero_positions > 1" using False nz_xs_m by auto + hence l_xs: "length xs > 0" using nz_xs_m by auto + hence xs_m_less_m: "(xs@[m]) ! 0 < m" by (simp add: all_less_m nth_append) + have S00: "?S $$ (0,0) \ 0" + by (smt A add_pos_pos append_Cons_nth_left n0 carrier_matD index_mat_swaprows(1) + l_xs m0 mem_Collect_eq nth_mem set_filter xs_def) + have S': "?S' \ carrier_mat m n" using A by auto + have S_S'D: "?S = ?S' @\<^sub>r D \\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def xs_m_less_m]) + have 2: "reduce_below 0 ?non_zero_positions D ?A' = reduce_below 0 ?non_zero_positions D ?S" + using A00 nz_xs_m by algebra + have "echelon_form_JNF (reduce_below 0 ?non_zero_positions D ?S)" + proof (rule echelon_form_JNF_mx1[OF _ n2]) + show "reduce_below 0 ?non_zero_positions D ?S \ carrier_mat (m+n) n" using A by auto + show "\i\{1.. {1..set ?non_zero_positions") + case True + show ?thesis unfolding nz_xs_m + by (rule reduce_below_0_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m D_g0], + insert True nz_xs_m, auto) + next + case False note i_notin_set = False + have "reduce_below 0 ?non_zero_positions D ?S $$ (i, 0) = ?S $$ (i, 0)" unfolding nz_xs_m + by (rule reduce_below_preserves_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m _ _ _ D_g0], + insert i nz_xs_m i_notin_set, auto) + also have "... = 0" using i_notin_set i A S00 n0 unfolding set_filter by auto + finally show ?thesis . + qed + qed + qed + thus ?thesis using 2 by argo + qed + qed + have e2: "echelon_form_JNF (reduce_below_abs 0 ?non_zero_positions D ?A')" + proof (cases "A $$ (0,0) \0") + case True note A00 = True + have 1: "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_below_abs 0 ?non_zero_positions D A" + using True by auto + have "echelon_form_JNF (reduce_below_abs 0 ?non_zero_positions D A)" + proof (rule echelon_form_JNF_mx1[OF _ n2]) + show "reduce_below_abs 0 ?non_zero_positions D A \ carrier_mat (m+n) n" using A by auto + show "\i\{1.. {1..set ?non_zero_positions") + case True + show ?thesis unfolding nz_xs_m + by (rule reduce_below_abs_0_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m D_g0], + insert nz_xs_m True, auto) + next + case False note i_notin_set = False + have "reduce_below_abs 0 ?non_zero_positions D A $$ (i, 0) = A $$ (i, 0)" unfolding nz_xs_m + by (rule reduce_below_abs_preserves_case_m[OF A'' m0 n0 A_def A00 mn _ d_xs all_less_m _ _ _ D_g0], + insert i nz_xs_m i_notin_set, auto) + also have "... = 0" using i_notin_set i A unfolding set_filter by auto + finally show ?thesis . + qed + qed + qed + thus ?thesis using 1 by argo + next + case False hence A00: "A $$ (0,0) = 0" by simp + let ?i = "((xs @ [m]) ! 0)" + let ?S = "swaprows 0 ?i A" + let ?S' = "mat_of_rows n (map (Matrix.row (swaprows 0 ?i A)) [0.. 0 then A else let i = ?non_zero_positions!0 in swaprows 0 i A) = ?S" + using A00 nz_xs_m by auto + have S: "?S \ carrier_mat (m+n) n" using A by auto + have A00_eq_A'00: "A $$ (0, 0) = A'' $$ (0, 0)" + by (metis A'' A_def add_gr_0 append_rows_def n0 carrier_matD index_mat_four_block(1) m0) + show ?thesis + proof (cases "xs=[]") + case True + have nz_m: "?non_zero_positions = [m]" using True nz_xs_m by simp + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (swaprows 0 m A $$ (0, 0)) (swaprows 0 m A $$ (m, 0))" + by (metis prod_cases5) + have Am0: "A $$ (m,0) = D" + proof - + have "A $$ (m,0) = (D \\<^sub>m 1\<^sub>m n) $$ (m-m, 0)" + by (smt A append_rows_def A_def A'' n0 carrier_matD diff_self_eq_0 index_mat_four_block + less_add_same_cancel1 less_diff_conv ordered_cancel_comm_monoid_diff_class.diff_add + nat_less_le) + also have "... = D" by (simp add: n0) + finally show ?thesis . + qed + have Sm0: "(swaprows 0 m A) $$ (m,0) = 0" using A False n0 by auto + have S00: "(swaprows 0 m A) $$ (0,0) = D" using A Am0 n0 by auto + have pquvd2: "(p,q,u,v,d) = euclid_ext2 (A $$ (m, 0)) (A $$ (0, 0))" + using pquvd Sm0 S00 Am0 A00 by auto + have "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_abs 0 m D ?A'" unfolding nz_m by auto + also have "... = reduce_abs 0 m D (swaprows 0 m A)" using True False rw nz_m by auto + finally have *: "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_abs 0 m D (swaprows 0 m A)" . + have "echelon_form_JNF (reduce_abs 0 m D (swaprows 0 m A))" + proof (rule echelon_form_JNF_mx1[OF _ n2]) + show "reduce_abs 0 m D (swaprows 0 m A) \ carrier_mat (m+n) n" + using A n2 reduce_carrier by (auto simp add: Let_def) + show "\i\{1.. {1.. carrier_mat (m+n) n" using A by auto + qed (insert m0 n0 S00 D_g0, auto) + next + case False + have "reduce_abs 0 m D (swaprows 0 m A) $$ (i, 0) = (swaprows 0 m A) $$ (i, 0)" + proof (rule reduce_preserves[OF _ n0]) + show "swaprows 0 m A \ carrier_mat (m+n) n" using A by auto + qed (insert m0 n0 S00 D_g0 False i, auto) + also have "... = A $$ (i, 0)" using i False A n0 by auto + also have "... = 0" + proof (rule ccontr) + assume "A $$ (i, 0) \ 0" hence "i \ set ?non_zero_positions" using i A by auto + hence "i=m" using nz_xs_m True by auto + thus False using False by contradiction + qed + finally show ?thesis . + qed + qed + qed + then show ?thesis using * by presburger + next + case False + have l: "length ?non_zero_positions > 1" using False nz_xs_m by auto + hence l_xs: "length xs > 0" using nz_xs_m by auto + hence xs_m_less_m: "(xs@[m]) ! 0 < m" by (simp add: all_less_m nth_append) + have S00: "?S $$ (0,0) \ 0" + by (smt A add_pos_pos append_Cons_nth_left n0 carrier_matD index_mat_swaprows(1) + l_xs m0 mem_Collect_eq nth_mem set_filter xs_def) + have S': "?S' \ carrier_mat m n" using A by auto + have S_S'D: "?S = ?S' @\<^sub>r D \\<^sub>m 1\<^sub>m n" by (rule swaprows_append_id[OF A'' A_def xs_m_less_m]) + have 2: "reduce_below_abs 0 ?non_zero_positions D ?A' = reduce_below_abs 0 ?non_zero_positions D ?S" + using A00 nz_xs_m by algebra + have "echelon_form_JNF (reduce_below_abs 0 ?non_zero_positions D ?S)" + proof (rule echelon_form_JNF_mx1[OF _ n2]) + show "reduce_below_abs 0 ?non_zero_positions D ?S \ carrier_mat (m+n) n" using A by auto + show "\i\{1.. {1..set ?non_zero_positions") + case True + show ?thesis unfolding nz_xs_m + by (rule reduce_below_abs_0_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m D_g0], + insert True nz_xs_m, auto) + next + case False note i_notin_set = False + have "reduce_below_abs 0 ?non_zero_positions D ?S $$ (i, 0) = ?S $$ (i, 0)" unfolding nz_xs_m + by (rule reduce_below_abs_preserves_case_m[OF S' m0 n0 S_S'D S00 mn _ d_xs all_less_m _ _ _ D_g0], + insert i nz_xs_m i_notin_set, auto) + also have "... = 0" using i_notin_set i A S00 n0 unfolding set_filter by auto + finally show ?thesis . + qed + qed + qed + thus ?thesis using 2 by argo + qed + qed + thus ?thesis using * e by presburger + qed +qed + + +lemma FindPreHNF_works_n_ge2: + assumes A_def: "A = A'' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + and A'': "A'' \ carrier_mat m n" and "n\2" and m_le_n: "m\n" and "D>0" +shows "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ FindPreHNF abs_flag D A = P * A \ echelon_form_JNF (FindPreHNF abs_flag D A)" + using assms +proof (induct abs_flag D A arbitrary: A'' m n rule: FindPreHNF.induct) + case (1 abs_flag D A) + note A_def = "1.prems"(1) + note A'' = "1.prems"(2) + note n = "1.prems"(3) + note m_le_n = "1.prems"(4) + note D0 = "1.prems"(5) + let ?RAT = "map_mat rat_of_int" + have A: "A \ carrier_mat (m+n) n" using A_def A'' by auto + have mn: "2\m+n" using n by auto + have m0: "00" using D0 by auto + define non_zero_positions where "non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A)" + let ?Reduce = "(if abs_flag then reduce_below_abs else reduce_below)" + obtain A'_UL A'_UR A'_DL A'_DR where A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) + = split_block (?Reduce 0 non_zero_positions D (make_first_column_positive A')) 1 1" + by (metis prod_cases4) + define sub_PreHNF where "sub_PreHNF = FindPreHNF abs_flag D A'_DR" + obtain xs where non_zero_positions_xs_m: "non_zero_positions = xs @ [m]" and d_xs: "distinct xs" + and all_less_m: "\x\set xs. x < m \ 0 < x" + using non_zero_positions_xs_m[OF A_def A'' non_zero_positions_def m0 n0] using D0 by fast + define M where "M = (make_first_column_positive A')" + have A': "A' \ carrier_mat (m+n) n" unfolding A'_def using A by auto + have mk_A'_not0:"make_first_column_positive A' $$ (0,0) \ 0" + by (rule make_first_column_positive_00[OF A_def A'' non_zero_positions_def + A'_def m0 n0 D_not0 m_le_n]) + have M: "M \ carrier_mat (m+n) n" using A' M_def by auto + let ?M' = "mat_of_rows n (map (Matrix.row (make_first_column_positive A')) [0.. carrier_mat m n" by auto + have M_M'D: "make_first_column_positive A' = ?M' @\<^sub>r D \\<^sub>m 1\<^sub>m n" if xs_empty: "xs \ []" + proof (cases "A$$(0,0) \ 0") + case True + then have *: "make_first_column_positive A' = make_first_column_positive A" + unfolding A'_def by auto + show ?thesis + by (unfold *, rule make_first_column_positive_append_id[OF A'' A_def D0 n0]) + next + case False + then have *: "make_first_column_positive A' + = make_first_column_positive (swaprows 0 (non_zero_positions ! 0) A)" + unfolding A'_def by auto + show ?thesis + proof (unfold *, rule make_first_column_positive_append_id) + let ?S = "mat_of_rows n (map (Matrix.row (swaprows 0 (non_zero_positions ! 0) A)) [0..r (D \\<^sub>m (1\<^sub>m n))" + proof (rule swaprows_append_id[OF A'' A_def]) + have A''00: "A'' $$ (0, 0) = 0" + by (metis (no_types, lifting) A A'' A_def False add_sign_intros(2) append_rows_def + carrier_matD index_mat_four_block m0 n0) + have length_xs: "length xs > 0" using xs_empty by auto + have "non_zero_positions ! 0 = xs ! 0" unfolding non_zero_positions_xs_m + by (meson length_xs nth_append) + thus "non_zero_positions ! 0 < m" using all_less_m length_xs by simp + qed + qed (insert n0 D0, auto) + qed + have A'_DR: "A'_DR \ carrier_mat (m + (n-1)) (n-1)" + by (rule split_block(4)[OF A'_split[symmetric]], insert n M M_def, auto) + have sub_PreHNF: "sub_PreHNF \ carrier_mat (m + (n -1)) (n-1)" + unfolding sub_PreHNF_def by (rule FindPreHNF[OF A'_DR]) + hence sub_PreHNF': "sub_PreHNF \ carrier_mat (m+n - 1) (n-1)" using n by auto + have A'_UL: "A'_UL \ carrier_mat 1 1" + by (rule split_block(1)[OF A'_split[symmetric], of "m+n-1" "n-1"], insert n A', auto) + have A'_UR: "A'_UR \ carrier_mat 1 (n-1)" + by (rule split_block(2)[OF A'_split[symmetric], of "m+n-1"], insert n A', auto) + have A'_DL: "A'_DL \ carrier_mat (m + (n - 1)) 1" + by (rule split_block(3)[OF A'_split[symmetric], of _ "n-1"], insert n A', auto) + + show ?case + proof (cases abs_flag) + case True note abs_flag = True + hence A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) + = split_block (reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')) 1 1" using A'_split by auto + let ?R = "reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')" + have fbm_R: "four_block_mat A'_UL A'_UR A'_DL A'_DR + = reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')" + by (rule split_block(5)[symmetric, OF A'_split[symmetric], of "m+n-1" "n-1"], insert A' n, auto) + have A'_DL0: "A'_DL = (0\<^sub>m (m + (n - 1)) 1)" + proof (rule eq_matI) + show "dim_row A'_DL = dim_row (0\<^sub>m (m + (n - 1)) 1)" + and "dim_col A'_DL = dim_col (0\<^sub>m (m + (n - 1)) 1)" using A'_DL by auto + fix i j assume i: "i < dim_row (0\<^sub>m (m + (n - 1)) 1)" and j: "j < dim_col (0\<^sub>m (m + (n - 1)) 1)" + have j0: "j=0" using j by auto + have "0 = ?R $$ (i+1,j)" + proof (unfold M_def non_zero_positions_xs_m j0, + rule reduce_below_abs_0_case_m_make_first_column_positive[symmetric, + OF A'' m0 n0 A_def m_le_n _ d_xs all_less_m _ _ D0 _ ]) + show "A' = (if A $$ (0, 0) \ 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)" + using A'_def non_zero_positions_def non_zero_positions_xs_m by presburger + show "xs @ [m] = filter (\i. A $$ (i, 0) \ 0) [1..m (m + (n - 1)) 1 $$ (i, j)" using i j by auto + qed + + let ?A'_DR_m = "mat_of_rows (n-1) [Matrix.row A'_DR i. i \ [0.. carrier_mat m (n-1)" by auto + have A'DR_A'DR_m_D: "A'_DR = ?A'_DR_m @\<^sub>r D \\<^sub>m 1\<^sub>m (n - 1)" + proof (rule eq_matI) + show dr: "dim_row A'_DR = dim_row (?A'_DR_m @\<^sub>r D \\<^sub>m 1\<^sub>m (n - 1))" + by (metis A'_DR A'_DR_m append_rows_def carrier_matD(1) index_mat_four_block(2) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2)) + show dc: "dim_col A'_DR = dim_col (?A'_DR_m @\<^sub>r D \\<^sub>m 1\<^sub>m (n - 1))" + by (metis A'_DR A'_DR_m add.comm_neutral append_rows_def + carrier_matD(2) index_mat_four_block(3) index_zero_mat(3)) + fix i j assume i: "i < dim_row(?A'_DR_m @\<^sub>r D \\<^sub>m 1\<^sub>m (n - 1))" + and j: "jr D \\<^sub>m 1\<^sub>m (n - 1))" + have jn1: "jr D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)" + proof (cases "ir D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)" + by (metis (mono_tags, lifting) A'_DR A'_DR_m True append_rows_def + carrier_matD dc i index_mat_four_block j) + finally show ?thesis . + next + case False note i_ge_m = False + let ?reduce_below = "reduce_below_abs 0 non_zero_positions D (make_first_column_positive A')" + have 1: "(?A'_DR_m @\<^sub>r D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j) = (D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" + by (smt A'_DR A'_DR_m False append_rows_nth carrier_matD carrier_mat_triv dc dr i + index_one_mat(2) index_one_mat(3) index_smult_mat(2,3) j) + have "?reduce_below = four_block_mat A'_UL A'_UR A'_DL A'_DR" using fbm_R .. + also have "... $$ (i+1,j+1) = (if i+1 < dim_row A'_UL then if j+1 < dim_col A'_UL + then A'_UL $$ (i+1, j+1) else A'_UR $$ (i+1, j+1 - dim_col A'_UL) + else if j+1 < dim_col A'_UL then A'_DL $$ (i+1 - dim_row A'_UL, j+1) + else A'_DR $$ (i+1 - dim_row A'_UL, j+1 - dim_col A'_UL))" + by (rule index_mat_four_block, insert i j A'_UL A'_DR dr dc, auto) + also have "... = A'_DR $$ (i,j)" using A'_UL by auto + finally have 2: "?reduce_below $$ (i+1,j+1) = A'_DR $$ (i,j)" . + show ?thesis + proof (cases "xs = []") + case True note xs_empty = True + have i1_m: "i + 1 \ m" + using False less_add_one by blast + have j1n: "j+1\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)" + proof (cases "A $$ (0,0) = 0") + case True + let ?S = "(swaprows 0 m A)" + have S: "?S \ carrier_mat (m+n) n" using A by auto + have Si10: "?S $$ (i+1,0) = 0" + proof - + have "?S $$ (i+1,0) = A $$ (i+1,0)" using i1_m n0 i1_mn S by auto + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)" + by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn + index_mat_four_block less_imp_diff_less n0) + also have "... = 0" using i_ge_m n0 i1_mn by auto + finally show ?thesis . + qed + have "M $$ (i+1, j+1) = (make_first_column_positive ?S) $$ (i+1,j+1)" + by (simp add: A'_def M_def True non_zero_positions_xs_m xs_empty) + also have "... = (if ?S $$ (i+1,0) < 0 then - ?S $$ (i+1,j+1) else ?S $$ (i+1,j+1))" + unfolding make_first_column_positive.simps using S i1_mn j1n by auto + also have "... = ?S $$ (i+1,j+1)" using Si10 by auto + also have "... = A $$ (i+1,j+1)" using i1_m n0 i1_mn S jn1 by auto + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)" + by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right') + finally show ?thesis . + next + case False + have Ai10: "A $$ (i+1,0) = 0" + proof - + have "A $$ (i+1,0) = (D \\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)" + by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn + index_mat_four_block less_imp_diff_less n0) + also have "... = 0" using i_ge_m n0 i1_mn by auto + finally show ?thesis . + qed + have "M $$ (i+1, j+1) = (make_first_column_positive A) $$ (i+1,j+1)" + by (simp add: A'_def M_def False True non_zero_positions_xs_m) + also have "... = (if A $$ (i+1,0) < 0 then - A $$ (i+1,j+1) else A $$ (i+1,j+1))" + unfolding make_first_column_positive.simps using A i1_mn j1n by auto + also have "... = A $$ (i+1,j+1)" using Ai10 by auto + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)" + by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right') + finally show ?thesis . + qed + also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)" + by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto) + also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m + by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv + linorder_not_less add_diff_cancel_right' add_diff_cancel_right' add_diff_cancel_left') + also have "... = (D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" + by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto) + finally show ?thesis using 1 2 by auto + next + case False + have "?reduce_below $$ (i+1, j+1) = M $$ (i+1, j+1)" + proof (unfold non_zero_positions_xs_m M_def, + rule reduce_below_abs_preserves_case_m[OF M' m0 _ M_M'D mk_A'_not0 m_le_n _ d_xs all_less_m _ _ _ D0]) + show "j + 1 < n" using jn1 by auto + show "i + 1 \ set xs" using all_less_m i_ge_m non_zero_positions_xs_m by auto + show "i + 1 \ 0" by auto + show " i + 1 < m + n" using i_ge_m i dr A'_DR by auto + show " i + 1 \ m" using i_ge_m by auto + qed (insert False) + also have "... = (?M' @\<^sub>r D \\<^sub>m 1\<^sub>m n) $$ (i+1, j+1)" unfolding M_def using False M_M'D by argo + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)" + proof - + have f1: "1 + j < n" + by (metis Groups.add_ac(2) jn1 less_diff_conv) + have f2: "\n. \ n + i < m" + by (meson i_ge_m linorder_not_less nat_SN.compat not_add_less2) + have "i < m + (n - 1)" + by (metis (no_types) A'_DR carrier_matD(1) dr i) + then have "1 + i < m + n" + using f1 by linarith + then show ?thesis + using f2 f1 by (metis (no_types) Groups.add_ac(2) M' append_rows_def carrier_matD(1) + dim_col_mat(1) index_mat_four_block(1) index_one_mat(2) index_smult_mat(2) + index_zero_mat(2,3) mat_of_rows_def nat_arith.rule0) + qed + also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)" + by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto) + also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m + by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv + linorder_not_less add_diff_cancel_right' add_diff_cancel_left') + also have "... = (D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" + by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto) + finally have 3: "?reduce_below $$ (i+1,j+1) = (D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" . + show ?thesis using 1 2 3 by presburger + qed + qed +qed + let ?A'_DR_n = "mat_of_rows (n - 1) (map (Matrix.row A'_DR) [0..P. P\carrier_mat (m + (n-1)) (m + (n-1)) \ invertible_mat P \ sub_PreHNF = P * A'_DR + \ echelon_form_JNF sub_PreHNF" + proof (cases "2 \ n - 1") + case True + show ?thesis + by (unfold sub_PreHNF_def, rule "1.hyps"[OF _ _ _ non_zero_positions_def A'_def _ _ _ _ _]) + (insert A n D0 m_le_n True A'DR_A'DR_m_D A A'_split abs_flag, auto) + next + case False + have "\P. P\carrier_mat (m + (n-1)) (m + (n-1)) \ invertible_mat P \ sub_PreHNF = P * A'_DR" + by (unfold sub_PreHNF_def, rule FindPreHNF_invertible_mat_mx2 + [OF A'DR_A'DR_m_D A'_DR_m _ _ D0 _]) + (insert False m_le_n n0 m0 "1"(4), auto) + moreover have "echelon_form_JNF sub_PreHNF" unfolding sub_PreHNF_def + by (rule FindPreHNF_echelon_form_mx1[OF A'DR_A'DR_m_D A'_DR_m _ D0 _], + insert False n0 m_le_n, auto) + ultimately show ?thesis by simp + qed + from this obtain P where P: "P \ carrier_mat (m + (n - 1)) (m + (n - 1))" + and inv_P: "invertible_mat P" and sub_PreHNF_P_A'_DR: "sub_PreHNF = P * A'_DR" by blast + define P' where "P' = (four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m+(n-1))) (0\<^sub>m (m+(n-1)) 1) P)" + have P': "P' \ carrier_mat (m+n) (m+n)" + proof - + have "P' \ carrier_mat (1 + (m+(n-1))) (1 + (m+(n-1))) " + unfolding P'_def by (rule four_block_carrier_mat[OF _ P], simp) + thus ?thesis using n by auto + qed + have inv_P': "invertible_mat P'" + unfolding P'_def by (rule invertible_mat_four_block_mat_lower_right[OF P inv_P]) + have dr_A2: "dim_row A \ 2" using A m0 n by auto + have dc_A2: "dim_col A \ 2" using n A by blast + have *: "(dim_col A = 0) = False" using dc_A2 by auto + have FindPreHNF_as_fbm: "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF" + unfolding FindPreHNF.simps[of abs_flag D A] using A'_split mn n A dr_A2 dc_A2 abs_flag + unfolding Let_def sub_PreHNF_def M_def A'_def non_zero_positions_def * + by (smt (z3) linorder_not_less split_conv) + also have "... = P' * (reduce_below_abs 0 non_zero_positions D M)" + proof - + have "P' * (reduce_below_abs 0 non_zero_positions D M) + = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m + (n - 1))) (0\<^sub>m (m + (n - 1)) 1) P + * four_block_mat A'_UL A'_UR A'_DL A'_DR" + unfolding P'_def fbm_R[unfolded M_def[symmetric], symmetric] .. + also have "... = four_block_mat + ((1\<^sub>m 1) * A'_UL + (0\<^sub>m 1 (m + (n - 1)) * A'_DL)) + ((1\<^sub>m 1) * A'_UR + (0\<^sub>m 1 (m + (n - 1))) * A'_DR) + ((0\<^sub>m (m + (n - 1)) 1) * A'_UL + P * A'_DL) + ((0\<^sub>m (m + (n - 1)) 1) * A'_UR + P * A'_DR)" + by (rule mult_four_block_mat[OF _ _ _ P A'_UL A'_UR A'_DL A'_DR], auto) + also have "... = four_block_mat A'_UL A'_UR (P * A'_DL) (P * A'_DR)" + by (rule cong_four_block_mat, insert A'_UL A'_UR A'_DL A'_DR P, auto) + also have "... = four_block_mat A'_UL A'_UR (0\<^sub>m (m + (n - 1)) 1) sub_PreHNF" + unfolding A'_DL0 sub_PreHNF_P_A'_DR using P by simp + also have "... = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF" + unfolding A'_DL0 by simp + finally show ?thesis .. + qed + finally have Find_P'_reduceM: "FindPreHNF abs_flag D A = P' * (reduce_below_abs 0 non_zero_positions D M)" . + have "\Q. invertible_mat Q \ Q \ carrier_mat (m + n) (m + n) + \ reduce_below_abs 0 (xs @ [m]) D M = Q * M" + proof (cases "xs = []") + case True note xs_empty = True + have rw: "reduce_below_abs 0 (xs @ [m]) D M = reduce_abs 0 m D M" using True by auto + obtain p q u v d where pquvd: "(p, q, u, v, d) = euclid_ext2 (M $$ (0, 0)) (M $$ (m, 0))" + by (simp add: euclid_ext2_def) + have "\P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) \ reduce_abs 0 m D M = P * M" + proof (rule reduce_abs_invertible_mat_case_m[OF _ _ m0 _ _ _ _ m_le_n n0 pquvd]) + show "M $$ (0, 0) \ 0" + using M_def mk_A'_not0 by blast + define M' where "M' = mat_of_rows n (map (Matrix.row M) [0..(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) + else if i = m then u * M $$ (0, k) + v * M $$ (m, k) + else M $$ (i, k))" + show M_M'_M'': "M = M' @\<^sub>r M''" unfolding M'_def M''_def + by (metis M append_rows_split carrier_matD le_add1) + show M': "M' \ carrier_mat m n" unfolding M'_def by fastforce + show M'': "M'' \ carrier_mat n n" unfolding M''_def by fastforce + show "0 \ m" using m0 by simp + show "A2 = Matrix.mat (dim_row M) (dim_col M) + (\(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) + else if i = m then u * M $$ (0, k) + v * M $$ (m, k) + else M $$ (i, k))" + (is "_ = ?rhs") using A A2_def by auto + define xs' where "xs' = filter (\i. abs (A2 $$ (0,i)) > D) [0..i. abs (A2 $$ (m,i)) > D) [0..i. abs (A2 $$ (0,i)) > D) [0..i. abs (A2 $$ (m,i)) > D) [0.. (\j'\{0..0" for j + proof - + have Ajm0: "A $$ (j+m,0) = 0" + proof - + have "A $$ (j+m,0) = (D \\<^sub>m 1\<^sub>m n) $$ (j+m-m,0)" + by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' add.commute append_rows_def carrier_matD + diff_add_inverse2 index_mat_four_block index_one_mat(2) index_smult_mat(2) + le_add2 less_diff_conv2 n0 not_add_less2 that(1)) + also have "... = 0" using jn j0 by auto + finally show ?thesis . + qed + have "M'' $$ (j, i) = (D \\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i\<^sub>m 1\<^sub>m n) $$ (j,i)" + by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n + carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1) + finally show ?thesis . + next + case False + have "A' = A" unfolding A'_def non_zero_positions_xs_m using False True by auto + hence "M'' $$ (j, i) = make_first_column_positive A $$ (j+m,i)" + by (smt m_le_n M' M'' M_M'_M'' M_def append_rows_nth2 jn nat_SN.compat that) + also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (j,i)" + by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n + carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1) + finally show ?thesis . + qed + thus ?thesis using jn j0 by auto + qed + have Am0D: "A$$(m,0) = D" + proof - + have "A$$(m,0) = (D \\<^sub>m 1\<^sub>m n) $$ (m-m,0)" + by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' append_rows_def carrier_matD + diff_less_mono2 diff_self_eq_0 index_mat_four_block index_one_mat(2) + index_smult_mat(2) less_add_same_cancel1 n0 semiring_norm(137)) + also have "... = D" using m0 n0 by auto + finally show ?thesis . + qed + hence S00D: "(swaprows 0 m A) $$ (0,0) = D" using n0 m0 A by auto + have Sm00: "(swaprows 0 m A) $$ (m,0) = A$$(0,0)" using n0 m0 A by auto + have M00D: "M $$ (0, 0) = D" if A00: "A$$(0,0) = 0" + proof - + have "M $$ (0,0) = (make_first_column_positive (swaprows 0 m A)) $$ (0,0)" + unfolding M_def A'_def using A00 + by (simp add: True non_zero_positions_xs_m) + also have "... = (if (swaprows 0 m A) $$ (0,0) < 0 then - (swaprows 0 m A) $$(0,0) + else (swaprows 0 m A) $$(0,0))" + unfolding make_first_column_positive.simps using m0 n0 A by auto + also have "... = (swaprows 0 m A) $$(0,0)" using S00D D0 by auto + also have "... = D" using S00D by auto + finally show ?thesis . + qed + have Mm00: "M $$ (m, 0) = 0" if A00: "A$$(0,0) = 0" + proof - + have "M $$ (m,0) = (make_first_column_positive (swaprows 0 m A)) $$ (m,0)" + unfolding M_def A'_def using A00 + by (simp add: True non_zero_positions_xs_m) + also have "... = (if (swaprows 0 m A) $$ (m,0) < 0 then - (swaprows 0 m A) $$(m,0) + else (swaprows 0 m A) $$(m,0))" + unfolding make_first_column_positive.simps using m0 n0 A by auto + also have "... = (swaprows 0 m A) $$(m,0)" using Sm00 A00 D0 by auto + also have "... = 0" using Sm00 A00 by auto + finally show ?thesis . + qed + have M000: "M $$ (0, 0) = abs (A$$(0,0))" if A00: "A$$(0,0) \ 0" + proof - + have "M $$ (0,0) = (make_first_column_positive A) $$ (0,0)" + unfolding M_def A'_def using A00 + by (simp add: True non_zero_positions_xs_m) + also have "... = (if A $$ (0,0) < 0 then - A $$(0,0) + else A $$(0,0))" + unfolding make_first_column_positive.simps using m0 n0 A by auto + also have "... = abs (A$$(0,0))" using Sm00 A00 by auto + finally show ?thesis . + qed + have Mm0D: "M $$ (m, 0) = D" if A00: "A $$ (0,0) \ 0" + proof - + have "M $$ (m,0) = (make_first_column_positive A) $$ (m,0)" + unfolding M_def A'_def using A00 + by (simp add: True non_zero_positions_xs_m) + also have "... = (if A $$ (m,0) < 0 then - A $$(m,0) + else A $$(m,0))" + unfolding make_first_column_positive.simps using m0 n0 A by auto + also have "... = A $$(m,0)" using S00D D0 Am0D by auto + also have "... = D" using Am0D D0 by auto + finally show ?thesis . + qed + have "0 \ set xs'" + proof - + have "A2 $$ (0,0) = p * M $$ (0, 0) + q * M $$ (m, 0)" + using A A2_def n0 M by auto + also have "... = gcd (M $$ (0, 0)) (M $$ (m, 0))" + by (metis euclid_ext2_works(1,2) pquvd) + also have "abs ... \ D" using M00D Mm00 M000 Mm0D using gcd_0_int D0 by fastforce + finally have "abs (A2 $$ (0,0)) \ D" . + thus ?thesis unfolding xs'_def using D0 by auto + qed + thus "\j\set xs'. j (M'' $$ (j, j) = D) \ (\j'\{0.. set ys'" + proof - + have "A2 $$ (m,0) = u * M $$ (0, 0) + v * M $$ (m, 0)" + using A A2_def n0 m0 M by auto + also have "... = - M $$ (m, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (0, 0) + + M $$ (0, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (m, 0) " + by (simp add: euclid_ext2_works[OF pquvd[symmetric]]) + also have "... = 0" using M00D Mm00 M000 Mm0D + by (smt dvd_div_mult_self euclid_ext2_works(3) euclid_ext2_works(5) + more_arith_simps(11) mult.commute mult_minus_left pquvd semiring_gcd_class.gcd_dvd1) + finally have "A2 $$ (m,0) = 0" . + thus ?thesis unfolding ys'_def using D0 by auto + qed + thus "\j\set ys'. j (M'' $$ (j, j) = D) \ (\j'\{0.. carrier_mat (m + n) (m + n)" + and reduce_QM: "reduce_below_abs 0 (xs @ [m]) D M = Q * M" by blast + have "\R. invertible_mat R + \ R \ carrier_mat (dim_row A') (dim_row A') \ M = R * A'" + by (unfold M_def, rule make_first_column_positive_invertible) + from this obtain R where inv_R: "invertible_mat R" + and R: "R \ carrier_mat (dim_row A') (dim_row A')" and M_RA': "M = R * A'" by blast + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ A' = P * A" + by (rule A'_swaprows_invertible_mat[OF A A'_def non_zero_positions_def], + insert non_zero_positions_xs_m n m0, auto) + from this obtain S where inv_S: "invertible_mat S" + and S: "S \ carrier_mat (dim_row A) (dim_row A)" and A'_SA: "A' = S * A" + using A by auto + have "(P'*Q*R*S) \ carrier_mat (m+n) (m+n)" using P' Q R S A' A by auto + moreover have "FindPreHNF abs_flag D A = (P'*Q*R*S) * A" using Find_P'_reduceM reduce_QM + unfolding M_RA' A'_SA M_def + by (smt A' A'_SA P' Q R S assoc_mult_mat carrier_matD carrier_mat_triv index_mult_mat(2,3) + non_zero_positions_xs_m) + moreover have "invertible_mat (P'*Q*R*S)" using inv_P' inv_Q inv_R inv_S using P' Q R S A' A + by (metis carrier_matD carrier_mat_triv index_mult_mat(2,3) invertible_mult_JNF) + ultimately have exists_inv: "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P + \ FindPreHNF abs_flag D A = P * A" by blast + moreover have "echelon_form_JNF (FindPreHNF abs_flag D A)" + proof (rule echelon_form_four_block_mat[OF A'_UL A'_UR sub_PreHNF' ]) + show "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR (0\<^sub>m (m + n - 1) 1) sub_PreHNF" + using A'_DL0 FindPreHNF_as_fbm sub_PreHNF sub_PreHNF' by auto + have "A'_UL $$ (0, 0) = ?R $$ (0,0)" + by (metis (mono_tags, lifting) A A'_DR A'_UL Find_P'_reduceM M_def + \FindPreHNF abs_flag D A = P' * Q * R * S * A\ add_Suc_right add_sign_intros(2) carrier_matD fbm_R + index_mat_four_block(1,3) index_mult_mat(3) m0 n0 plus_1_eq_Suc + zero_less_one_class.zero_less_one) + also have "... \ 0" + proof (cases "xs=[]") + case True + have "?R $$ (0,0) = reduce_abs 0 m D M $$ (0,0)" + unfolding non_zero_positions_xs_m True M_def by simp + also have "... \ 0" + by (metis D_not0 M M_def add_pos_pos less_add_same_cancel1 m0 mk_A'_not0 n0 reduce_not0) + finally show ?thesis . + next + case False + show ?thesis + by (unfold non_zero_positions_xs_m, + rule reduce_below_abs_not0_case_m[OF M' m0 n0 M_M'D[OF False] mk_A'_not0 m_le_n all_less_m D_not0]) + qed + finally show "A'_UL $$ (0, 0) \ 0" . + qed (insert mn n hyp, auto) + ultimately show ?thesis by blast + next + case False + hence A'_split: "(A'_UL, A'_UR, A'_DL, A'_DR) + = split_block (reduce_below 0 non_zero_positions D (make_first_column_positive A')) 1 1" using A'_split by auto + let ?R = "reduce_below 0 non_zero_positions D (make_first_column_positive A')" + have fbm_R: "four_block_mat A'_UL A'_UR A'_DL A'_DR + = reduce_below 0 non_zero_positions D (make_first_column_positive A')" + by (rule split_block(5)[symmetric, OF A'_split[symmetric], of "m+n-1" "n-1"], insert A' n, auto) + have A'_DL0: "A'_DL = (0\<^sub>m (m + (n - 1)) 1)" + proof (rule eq_matI) + show "dim_row A'_DL = dim_row (0\<^sub>m (m + (n - 1)) 1)" + and "dim_col A'_DL = dim_col (0\<^sub>m (m + (n - 1)) 1)" using A'_DL by auto + fix i j assume i: "i < dim_row (0\<^sub>m (m + (n - 1)) 1)" and j: "j < dim_col (0\<^sub>m (m + (n - 1)) 1)" + have j0: "j=0" using j by auto + have "0 = ?R $$ (i+1,j)" + proof (unfold M_def non_zero_positions_xs_m j0, + rule reduce_below_0_case_m_make_first_column_positive[symmetric, + OF A'' m0 n0 A_def m_le_n _ d_xs all_less_m _ _ D0 _ ]) + show "A' = (if A $$ (0, 0) \ 0 then A else let i = (xs @ [m]) ! 0 in swaprows 0 i A)" + using A'_def non_zero_positions_def non_zero_positions_xs_m by presburger + show "xs @ [m] = filter (\i. A $$ (i, 0) \ 0) [1..m (m + (n - 1)) 1 $$ (i, j)" using i j by auto + qed + + let ?A'_DR_m = "mat_of_rows (n-1) [Matrix.row A'_DR i. i \ [0.. carrier_mat m (n-1)" by auto + have A'DR_A'DR_m_D: "A'_DR = ?A'_DR_m @\<^sub>r D \\<^sub>m 1\<^sub>m (n - 1)" + proof (rule eq_matI) + show dr: "dim_row A'_DR = dim_row (?A'_DR_m @\<^sub>r D \\<^sub>m 1\<^sub>m (n - 1))" + by (metis A'_DR A'_DR_m append_rows_def carrier_matD(1) index_mat_four_block(2) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2)) + show dc: "dim_col A'_DR = dim_col (?A'_DR_m @\<^sub>r D \\<^sub>m 1\<^sub>m (n - 1))" + by (metis A'_DR A'_DR_m add.comm_neutral append_rows_def + carrier_matD(2) index_mat_four_block(3) index_zero_mat(3)) + fix i j assume i: "i < dim_row(?A'_DR_m @\<^sub>r D \\<^sub>m 1\<^sub>m (n - 1))" + and j: "jr D \\<^sub>m 1\<^sub>m (n - 1))" + have jn1: "jr D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)" + proof (cases "ir D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j)" + by (metis (mono_tags, lifting) A'_DR A'_DR_m True append_rows_def + carrier_matD dc i index_mat_four_block j) + finally show ?thesis . + next + case False note i_ge_m = False + let ?reduce_below = "reduce_below 0 non_zero_positions D (make_first_column_positive A')" + have 1: "(?A'_DR_m @\<^sub>r D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i,j) = (D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" + by (smt A'_DR A'_DR_m False append_rows_nth carrier_matD carrier_mat_triv dc dr i + index_one_mat(2) index_one_mat(3) index_smult_mat(2,3) j) + have "?reduce_below = four_block_mat A'_UL A'_UR A'_DL A'_DR" using fbm_R .. + also have "... $$ (i+1,j+1) = (if i+1 < dim_row A'_UL then if j+1 < dim_col A'_UL + then A'_UL $$ (i+1, j+1) else A'_UR $$ (i+1, j+1 - dim_col A'_UL) + else if j+1 < dim_col A'_UL then A'_DL $$ (i+1 - dim_row A'_UL, j+1) + else A'_DR $$ (i+1 - dim_row A'_UL, j+1 - dim_col A'_UL))" + by (rule index_mat_four_block, insert i j A'_UL A'_DR dr dc, auto) + also have "... = A'_DR $$ (i,j)" using A'_UL by auto + finally have 2: "?reduce_below $$ (i+1,j+1) = A'_DR $$ (i,j)" . + show ?thesis + proof (cases "xs = []") + case True note xs_empty = True + have i1_m: "i + 1 \ m" + using False less_add_one by blast + have j1n: "j+1\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)" + proof (cases "A $$ (0,0) = 0") + case True + let ?S = "(swaprows 0 m A)" + have S: "?S \ carrier_mat (m+n) n" using A by auto + have Si10: "?S $$ (i+1,0) = 0" + proof - + have "?S $$ (i+1,0) = A $$ (i+1,0)" using i1_m n0 i1_mn S by auto + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)" + by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn + index_mat_four_block less_imp_diff_less n0) + also have "... = 0" using i_ge_m n0 i1_mn by auto + finally show ?thesis . + qed + have "M $$ (i+1, j+1) = (make_first_column_positive ?S) $$ (i+1,j+1)" + by (simp add: A'_def M_def True non_zero_positions_xs_m xs_empty) + also have "... = (if ?S $$ (i+1,0) < 0 then - ?S $$ (i+1,j+1) else ?S $$ (i+1,j+1))" + unfolding make_first_column_positive.simps using S i1_mn j1n by auto + also have "... = ?S $$ (i+1,j+1)" using Si10 by auto + also have "... = A $$ (i+1,j+1)" using i1_m n0 i1_mn S jn1 by auto + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)" + by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right') + finally show ?thesis . + next + case False + have Ai10: "A $$ (i+1,0) = 0" + proof - + have "A $$ (i+1,0) = (D \\<^sub>m 1\<^sub>m n) $$ (i+1 - m,0)" + by (smt A_def A'' A i_ge_m append_rows_def carrier_matD diff_add_inverse2 i1_mn + index_mat_four_block less_imp_diff_less n0) + also have "... = 0" using i_ge_m n0 i1_mn by auto + finally show ?thesis . + qed + have "M $$ (i+1, j+1) = (make_first_column_positive A) $$ (i+1,j+1)" + by (simp add: A'_def M_def False True non_zero_positions_xs_m) + also have "... = (if A $$ (i+1,0) < 0 then - A $$ (i+1,j+1) else A $$ (i+1,j+1))" + unfolding make_first_column_positive.simps using A i1_mn j1n by auto + also have "... = A $$ (i+1,j+1)" using Ai10 by auto + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (i+1 - m,j+1)" + by (smt A_def A'' A i_ge_m append_rows_def carrier_matD i1_mn index_mat_four_block(1,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2) j1n less_imp_diff_less add_diff_cancel_right') + finally show ?thesis . + qed + also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)" + by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto) + also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m + by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv + linorder_not_less add_diff_cancel_right' add_diff_cancel_right' add_diff_cancel_left') + also have "... = (D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" + by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto) + finally show ?thesis using 1 2 by auto + next + case False + have "?reduce_below $$ (i+1, j+1) = M $$ (i+1, j+1)" + proof (unfold non_zero_positions_xs_m M_def, + rule reduce_below_preserves_case_m[OF M' m0 _ M_M'D mk_A'_not0 m_le_n _ d_xs all_less_m _ _ _ D0]) + show "j + 1 < n" using jn1 by auto + show "i + 1 \ set xs" using all_less_m i_ge_m non_zero_positions_xs_m by auto + show "i + 1 \ 0" by auto + show " i + 1 < m + n" using i_ge_m i dr A'_DR by auto + show " i + 1 \ m" using i_ge_m by auto + qed (insert False) + also have "... = (?M' @\<^sub>r D \\<^sub>m 1\<^sub>m n) $$ (i+1, j+1)" unfolding M_def using False M_M'D by argo + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ ((i+1)-m, j+1)" + proof - + have f1: "1 + j < n" + by (metis Groups.add_ac(2) jn1 less_diff_conv) + have f2: "\n. \ n + i < m" + by (meson i_ge_m linorder_not_less nat_SN.compat not_add_less2) + have "i < m + (n - 1)" + by (metis (no_types) A'_DR carrier_matD(1) dr i) + then have "1 + i < m + n" + using f1 by linarith + then show ?thesis + using f2 f1 by (metis (no_types) Groups.add_ac(2) M' append_rows_def carrier_matD(1) + dim_col_mat(1) index_mat_four_block(1) index_one_mat(2) index_smult_mat(2) + index_zero_mat(2,3) mat_of_rows_def nat_arith.rule0) + qed + also have "... = D * (1\<^sub>m n) $$ ((i+1)-m, j+1)" + by (rule index_smult_mat, insert i jn1 A'_DR False dr, auto) + also have "... = D *(1\<^sub>m (n - 1)) $$ (i-m,j)" using dc dr i j A'_DR i_ge_m + by (smt Nat.add_diff_assoc2 carrier_matD(1) index_one_mat(1) jn1 less_diff_conv + linorder_not_less add_diff_cancel_right' add_diff_cancel_left') + also have "... = (D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" + by (rule index_smult_mat[symmetric], insert i jn1 A'_DR False dr, auto) + finally have 3: "?reduce_below $$ (i+1,j+1) = (D \\<^sub>m 1\<^sub>m (n - 1)) $$ (i-m,j)" . + show ?thesis using 1 2 3 by presburger + qed + qed +qed + let ?A'_DR_n = "mat_of_rows (n - 1) (map (Matrix.row A'_DR) [0..P. P\carrier_mat (m + (n-1)) (m + (n-1)) \ invertible_mat P \ sub_PreHNF = P * A'_DR + \ echelon_form_JNF sub_PreHNF" + proof (cases "2 \ n - 1") + case True + show ?thesis + by (unfold sub_PreHNF_def, rule "1.hyps"[OF _ _ _ non_zero_positions_def A'_def _ _ _ _ _]) + (insert A n D0 m_le_n True A'DR_A'DR_m_D A A'_split False, auto) + next + case False + have "\P. P\carrier_mat (m + (n-1)) (m + (n-1)) \ invertible_mat P \ sub_PreHNF = P * A'_DR" + by (unfold sub_PreHNF_def, rule FindPreHNF_invertible_mat_mx2 + [OF A'DR_A'DR_m_D A'_DR_m _ _ D0 _]) + (insert False m_le_n n0 m0 "1"(4), auto) + moreover have "echelon_form_JNF sub_PreHNF" unfolding sub_PreHNF_def + by (rule FindPreHNF_echelon_form_mx1[OF A'DR_A'DR_m_D A'_DR_m _ D0 _], + insert False n0 m_le_n, auto) + ultimately show ?thesis by simp + qed + from this obtain P where P: "P \ carrier_mat (m + (n - 1)) (m + (n - 1))" + and inv_P: "invertible_mat P" and sub_PreHNF_P_A'_DR: "sub_PreHNF = P * A'_DR" by blast + define P' where "P' = (four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m+(n-1))) (0\<^sub>m (m+(n-1)) 1) P)" + have P': "P' \ carrier_mat (m+n) (m+n)" + proof - + have "P' \ carrier_mat (1 + (m+(n-1))) (1 + (m+(n-1))) " + unfolding P'_def by (rule four_block_carrier_mat[OF _ P], simp) + thus ?thesis using n by auto + qed + have inv_P': "invertible_mat P'" + unfolding P'_def by (rule invertible_mat_four_block_mat_lower_right[OF P inv_P]) + have dr_A2: "dim_row A \ 2" using A m0 n by auto + have dc_A2: "dim_col A \ 2" using n A by blast + have *: "(dim_col A = 0) = False" using dc_A2 by auto + have FindPreHNF_as_fbm: "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF" + unfolding FindPreHNF.simps[of abs_flag D A] using A'_split mn n A dr_A2 dc_A2 False + unfolding Let_def sub_PreHNF_def M_def A'_def non_zero_positions_def * + by (smt (z3) linorder_not_less split_conv) + also have "... = P' * (reduce_below 0 non_zero_positions D M)" + proof - + have "P' * (reduce_below 0 non_zero_positions D M) + = four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 (m + (n - 1))) (0\<^sub>m (m + (n - 1)) 1) P + * four_block_mat A'_UL A'_UR A'_DL A'_DR" + unfolding P'_def fbm_R[unfolded M_def[symmetric], symmetric] .. + also have "... = four_block_mat + ((1\<^sub>m 1) * A'_UL + (0\<^sub>m 1 (m + (n - 1)) * A'_DL)) + ((1\<^sub>m 1) * A'_UR + (0\<^sub>m 1 (m + (n - 1))) * A'_DR) + ((0\<^sub>m (m + (n - 1)) 1) * A'_UL + P * A'_DL) + ((0\<^sub>m (m + (n - 1)) 1) * A'_UR + P * A'_DR)" + by (rule mult_four_block_mat[OF _ _ _ P A'_UL A'_UR A'_DL A'_DR], auto) + also have "... = four_block_mat A'_UL A'_UR (P * A'_DL) (P * A'_DR)" + by (rule cong_four_block_mat, insert A'_UL A'_UR A'_DL A'_DR P, auto) + also have "... = four_block_mat A'_UL A'_UR (0\<^sub>m (m + (n - 1)) 1) sub_PreHNF" + unfolding A'_DL0 sub_PreHNF_P_A'_DR using P by simp + also have "... = four_block_mat A'_UL A'_UR A'_DL sub_PreHNF" + unfolding A'_DL0 by simp + finally show ?thesis .. + qed + finally have Find_P'_reduceM: "FindPreHNF abs_flag D A = P' * (reduce_below 0 non_zero_positions D M)" . + have "\Q. invertible_mat Q \ Q \ carrier_mat (m + n) (m + n) + \ reduce_below 0 (xs @ [m]) D M = Q * M" + proof (cases "xs = []") + case True note xs_empty = True + have rw: "reduce_below 0 (xs @ [m]) D M = reduce 0 m D M" using True by auto + obtain p q u v d where pquvd: "(p, q, u, v, d) = euclid_ext2 (M $$ (0, 0)) (M $$ (m, 0))" + by (simp add: euclid_ext2_def) + have "\P. invertible_mat P \ P \ carrier_mat (m + n) (m + n) \ reduce 0 m D M = P * M" + proof (rule reduce_invertible_mat_case_m[OF _ _ m0 _ _ _ _ m_le_n n0 pquvd]) + show "M $$ (0, 0) \ 0" + using M_def mk_A'_not0 by blast + define M' where "M' = mat_of_rows n (map (Matrix.row M) [0..(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) + else if i = m then u * M $$ (0, k) + v * M $$ (m, k) + else M $$ (i, k))" + show M_M'_M'': "M = M' @\<^sub>r M''" unfolding M'_def M''_def + by (metis M append_rows_split carrier_matD le_add1) + show M': "M' \ carrier_mat m n" unfolding M'_def by fastforce + show M'': "M'' \ carrier_mat n n" unfolding M''_def by fastforce + show "0 \ m" using m0 by simp + show "A2 = Matrix.mat (dim_row M) (dim_col M) + (\(i, k). if i = 0 then p * M $$ (0, k) + q * M $$ (m, k) + else if i = m then u * M $$ (0, k) + v * M $$ (m, k) + else M $$ (i, k))" + (is "_ = ?rhs") using A A2_def by auto + define xs' where "xs' = [1.. (\j'\{0..0" for j + proof - + have Ajm0: "A $$ (j+m,0) = 0" + proof - + have "A $$ (j+m,0) = (D \\<^sub>m 1\<^sub>m n) $$ (j+m-m,0)" + by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' add.commute append_rows_def carrier_matD + diff_add_inverse2 index_mat_four_block index_one_mat(2) index_smult_mat(2) + le_add2 less_diff_conv2 n0 not_add_less2 that(1)) + also have "... = 0" using jn j0 by auto + finally show ?thesis . + qed + have "M'' $$ (j, i) = (D \\<^sub>m 1\<^sub>m n) $$ (j,i)" if i_n: "i\<^sub>m 1\<^sub>m n) $$ (j,i)" + by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n + carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1) + finally show ?thesis . + next + case False + have "A' = A" unfolding A'_def non_zero_positions_xs_m using False True by auto + hence "M'' $$ (j, i) = make_first_column_positive A $$ (j+m,i)" + by (smt m_le_n M' M'' M_M'_M'' M_def append_rows_nth2 jn nat_SN.compat that) + also have "... = A $$ (j+m,i)" using A jn j0 i_n Ajm0 by auto + also have "... = (D \\<^sub>m 1\<^sub>m n) $$ (j,i)" + by (smt A Groups.add_ac(2) add_mono_thms_linordered_field(1) append_rows_def A_def A'' i_n + carrier_matD index_mat_four_block(1,2) add_diff_cancel_right' not_add_less2 jn trans_less_add1) + finally show ?thesis . + qed + thus ?thesis using jn j0 by auto + qed + have Am0D: "A$$(m,0) = D" + proof - + have "A$$(m,0) = (D \\<^sub>m 1\<^sub>m n) $$ (m-m,0)" + by (smt "1"(2) "1"(3) M M' M'' M_M'_M'' append_rows_def carrier_matD + diff_less_mono2 diff_self_eq_0 index_mat_four_block index_one_mat(2) + index_smult_mat(2) less_add_same_cancel1 n0 semiring_norm(137)) + also have "... = D" using m0 n0 by auto + finally show ?thesis . + qed + hence S00D: "(swaprows 0 m A) $$ (0,0) = D" using n0 m0 A by auto + have Sm00: "(swaprows 0 m A) $$ (m,0) = A$$(0,0)" using n0 m0 A by auto + have M00D: "M $$ (0, 0) = D" if A00: "A$$(0,0) = 0" + proof - + have "M $$ (0,0) = (make_first_column_positive (swaprows 0 m A)) $$ (0,0)" + unfolding M_def A'_def using A00 + by (simp add: True non_zero_positions_xs_m) + also have "... = (if (swaprows 0 m A) $$ (0,0) < 0 then - (swaprows 0 m A) $$(0,0) + else (swaprows 0 m A) $$(0,0))" + unfolding make_first_column_positive.simps using m0 n0 A by auto + also have "... = (swaprows 0 m A) $$(0,0)" using S00D D0 by auto + also have "... = D" using S00D by auto + finally show ?thesis . + qed + have Mm00: "M $$ (m, 0) = 0" if A00: "A$$(0,0) = 0" + proof - + have "M $$ (m,0) = (make_first_column_positive (swaprows 0 m A)) $$ (m,0)" + unfolding M_def A'_def using A00 + by (simp add: True non_zero_positions_xs_m) + also have "... = (if (swaprows 0 m A) $$ (m,0) < 0 then - (swaprows 0 m A) $$(m,0) + else (swaprows 0 m A) $$(m,0))" + unfolding make_first_column_positive.simps using m0 n0 A by auto + also have "... = (swaprows 0 m A) $$(m,0)" using Sm00 A00 D0 by auto + also have "... = 0" using Sm00 A00 by auto + finally show ?thesis . + qed + have M000: "M $$ (0, 0) = abs (A$$(0,0))" if A00: "A$$(0,0) \ 0" + proof - + have "M $$ (0,0) = (make_first_column_positive A) $$ (0,0)" + unfolding M_def A'_def using A00 + by (simp add: True non_zero_positions_xs_m) + also have "... = (if A $$ (0,0) < 0 then - A $$(0,0) + else A $$(0,0))" + unfolding make_first_column_positive.simps using m0 n0 A by auto + also have "... = abs (A$$(0,0))" using Sm00 A00 by auto + finally show ?thesis . + qed + have Mm0D: "M $$ (m, 0) = D" if A00: "A $$ (0,0) \ 0" + proof - + have "M $$ (m,0) = (make_first_column_positive A) $$ (m,0)" + unfolding M_def A'_def using A00 + by (simp add: True non_zero_positions_xs_m) + also have "... = (if A $$ (m,0) < 0 then - A $$(m,0) + else A $$(m,0))" + unfolding make_first_column_positive.simps using m0 n0 A by auto + also have "... = A $$(m,0)" using S00D D0 Am0D by auto + also have "... = D" using Am0D D0 by auto + finally show ?thesis . + qed + have "0 \ set xs'" + proof - + have "A2 $$ (0,0) = p * M $$ (0, 0) + q * M $$ (m, 0)" + using A A2_def n0 M by auto + also have "... = gcd (M $$ (0, 0)) (M $$ (m, 0))" + by (metis euclid_ext2_works(1,2) pquvd) + also have "abs ... \ D" using M00D Mm00 M000 Mm0D using gcd_0_int D0 by fastforce + finally have "abs (A2 $$ (0,0)) \ D" . + thus ?thesis unfolding xs'_def using D0 by auto + qed + thus "\j\set xs'. j (M'' $$ (j, j) = D) \ (\j'\{0.. set ys'" + proof - + have "A2 $$ (m,0) = u * M $$ (0, 0) + v * M $$ (m, 0)" + using A A2_def n0 m0 M by auto + also have "... = - M $$ (m, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (0, 0) + + M $$ (0, 0) div gcd (M $$ (0, 0)) (M $$ (m, 0)) * M $$ (m, 0) " + by (simp add: euclid_ext2_works[OF pquvd[symmetric]]) + also have "... = 0" using M00D Mm00 M000 Mm0D + by (smt dvd_div_mult_self euclid_ext2_works(3) euclid_ext2_works(5) + more_arith_simps(11) mult.commute mult_minus_left pquvd semiring_gcd_class.gcd_dvd1) + finally have "A2 $$ (m,0) = 0" . + thus ?thesis unfolding ys'_def using D0 by auto + qed + thus "\j\set ys'. j (M'' $$ (j, j) = D) \ (\j'\{0.. {0,D}" using Mm00 Mm0D by blast + show " M $$ (m, 0) = 0 \ M $$ (0, 0) = D" using Mm00 Mm0D D_not0 M00D by blast + qed (insert D0) + then show ?thesis using rw by auto + next + case False + show ?thesis + by (unfold M_def, rule reduce_below_invertible_mat_case_m[OF M' m0 n0 M_M'D[OF False] + mk_A'_not0 m_le_n d_xs all_less_m D0]) + qed + + from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \ carrier_mat (m + n) (m + n)" + and reduce_QM: "reduce_below 0 (xs @ [m]) D M = Q * M" by blast + have "\R. invertible_mat R + \ R \ carrier_mat (dim_row A') (dim_row A') \ M = R * A'" + by (unfold M_def, rule make_first_column_positive_invertible) + from this obtain R where inv_R: "invertible_mat R" + and R: "R \ carrier_mat (dim_row A') (dim_row A')" and M_RA': "M = R * A'" by blast + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ A' = P * A" + by (rule A'_swaprows_invertible_mat[OF A A'_def non_zero_positions_def], + insert non_zero_positions_xs_m n m0, auto) + from this obtain S where inv_S: "invertible_mat S" + and S: "S \ carrier_mat (dim_row A) (dim_row A)" and A'_SA: "A' = S * A" + using A by auto + have "(P'*Q*R*S) \ carrier_mat (m+n) (m+n)" using P' Q R S A' A by auto + moreover have "FindPreHNF abs_flag D A = (P'*Q*R*S) * A" using Find_P'_reduceM reduce_QM + unfolding M_RA' A'_SA M_def + by (smt A' A'_SA P' Q R S assoc_mult_mat carrier_matD carrier_mat_triv index_mult_mat(2,3) + non_zero_positions_xs_m) + moreover have "invertible_mat (P'*Q*R*S)" using inv_P' inv_Q inv_R inv_S using P' Q R S A' A + by (metis carrier_matD carrier_mat_triv index_mult_mat(2,3) invertible_mult_JNF) + ultimately have exists_inv: "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P + \ FindPreHNF abs_flag D A = P * A" by blast + moreover have "echelon_form_JNF (FindPreHNF abs_flag D A)" + proof (rule echelon_form_four_block_mat[OF A'_UL A'_UR sub_PreHNF' ]) + show "FindPreHNF abs_flag D A = four_block_mat A'_UL A'_UR (0\<^sub>m (m + n - 1) 1) sub_PreHNF" + using A'_DL0 FindPreHNF_as_fbm sub_PreHNF sub_PreHNF' by auto + have "A'_UL $$ (0, 0) = ?R $$ (0,0)" + by (metis (mono_tags, lifting) A A'_DR A'_UL Find_P'_reduceM M_def + \FindPreHNF abs_flag D A = P' * Q * R * S * A\ add_Suc_right add_sign_intros(2) carrier_matD fbm_R + index_mat_four_block(1,3) index_mult_mat(3) m0 n0 plus_1_eq_Suc + zero_less_one_class.zero_less_one) + also have "... \ 0" + proof (cases "xs=[]") + case True + have "?R $$ (0,0) = reduce 0 m D M $$ (0,0)" + unfolding non_zero_positions_xs_m True M_def by simp + also have "... \ 0" + by (metis D_not0 M M_def add_pos_pos less_add_same_cancel1 m0 mk_A'_not0 n0 reduce_not0) + finally show ?thesis . + next + case False + show ?thesis + by (unfold non_zero_positions_xs_m, + rule reduce_below_not0_case_m[OF M' m0 n0 M_M'D[OF False] mk_A'_not0 m_le_n all_less_m D_not0]) + qed + finally show "A'_UL $$ (0, 0) \ 0" . + qed (insert mn n hyp, auto) + ultimately show ?thesis by blast +qed +qed + +lemma + assumes A_def: "A = A'' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + and A'': "A'' \ carrier_mat m n" and "n\2" and m_le_n: "m\n" and "D>0" +shows FindPreHNF_invertible_mat_n_ge2: "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ FindPreHNF abs_flag D A = P * A" +and FindPreHNF_echelon_form_n_ge2: "echelon_form_JNF (FindPreHNF abs_flag D A)" + using FindPreHNF_works_n_ge2[OF assms] by blast+ + +lemma FindPreHNF_invertible_mat: + assumes A_def: "A = A'' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + and A'': "A'' \ carrier_mat m n" and n0: "0n" and D: "D>0" + shows "\P. P \ carrier_mat (m+n) (m+n) \ invertible_mat P \ FindPreHNF abs_flag D A = P * A" +proof - + have A: "A \ carrier_mat (m+n) n" using A_def A'' by auto + show ?thesis + proof (cases "m+n<2") + case True + show ?thesis by (rule FindPreHNF_invertible_mat_2xn[OF A True]) + next + case False note m_ge2 = False + show ?thesis + proof (cases "n<2") + case True + show ?thesis by (rule FindPreHNF_invertible_mat_mx2[OF A_def A'' True n0 D mn]) + next + case False + show ?thesis + by (rule FindPreHNF_invertible_mat_n_ge2[OF A_def A'' _ mn D], insert False, auto) + qed + qed +qed + + +lemma FindPreHNF_echelon_form: + assumes A_def: "A = A'' @\<^sub>r D \\<^sub>m 1\<^sub>m n" + and A'': "A'' \ carrier_mat m n" and mn: "m\n" and D: "D>0" + shows "echelon_form_JNF (FindPreHNF abs_flag D A)" +proof - + have A: "A \ carrier_mat (m+n) n" using A_def A'' by auto + have FindPreHNF: "(FindPreHNF abs_flag D A) \ carrier_mat (m+n) n" by (rule FindPreHNF[OF A]) + show ?thesis + proof (cases "m+n<2") + case True + show ?thesis by (rule echelon_form_JNF_1xn[OF FindPreHNF True]) + next + case False note m_ge2 = False + show ?thesis + proof (cases "n<2") + case True + show ?thesis by (rule FindPreHNF_echelon_form_mx1[OF A_def A'' True D mn]) + next + case False + show ?thesis + by (rule FindPreHNF_echelon_form_n_ge2[OF A_def A'' _ mn D], insert False, auto) + qed + qed +qed +end + +text \We connect the algorithm developed in the Hermite AFP entry with ours. This would permit +to reuse many existing results and prove easily the soundness.\ + +(*In HOL Analysis*) +thm Hermite.Hermite_reduce_above.simps +thm Hermite.Hermite_of_row_i_def +thm Hermite.Hermite_of_upt_row_i_def +thm Hermite.Hermite_of_def + +(*In JNF*) +thm Hermite_reduce_above.simps +thm Hermite_of_row_i_def +thm Hermite_of_list_of_rows.simps +thm mod_operation.Hermite_mod_det_def + +(*Connecting Hermite.Hermite_reduce_above and Hermite_reduce_above*) +thm Hermite.Hermite_reduce_above.simps Hermite_reduce_above.simps + +context includes lifting_syntax +begin + +definition "res_int = (\b n::int. n mod b)" + +lemma res_function_res_int: + "res_function res_int" + using res_function_euclidean2 unfolding res_int_def by auto + +lemma HMA_Hermite_reduce_above[transfer_rule]: + assumes "n int ^ 'n :: mod_type ^ 'm :: mod_type \ _) + ===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_M)) + (\A i j. Hermite_reduce_above A n i j) + (\A i j. Hermite.Hermite_reduce_above A n i j res_int)" +proof (intro rel_funI, goal_cases) + case (1 A A' i i' j j') + then show ?case using assms + proof (induct n arbitrary: A A') + case 0 + then show ?case by auto + next + case (Suc n) + note AA'[transfer_rule] = "Suc.prems"(1) + note ii'[transfer_rule] = "Suc.prems"(2) + note jj'[transfer_rule] = "Suc.prems"(3) + note Suc_n_less_m = "Suc.prems"(4) + + let ?H_JNF = "HNF_Mod_Det_Algorithm.Hermite_reduce_above" + let ?H_HMA = "Hermite.Hermite_reduce_above" + let ?from_nat_rows = "mod_type_class.from_nat :: _ \ 'm" + have nn[transfer_rule]: "Mod_Type_Connect.HMA_I n (?from_nat_rows n)" + unfolding Mod_Type_Connect.HMA_I_def + by (simp add: Suc_lessD Suc_n_less_m mod_type_class.from_nat_to_nat) + + have Anj: "A' $h (?from_nat_rows n) $h j' = A $$ (n,j)" + by (unfold index_hma_def[symmetric], transfer, simp) + have Aij: "A' $h i' $h j' = A $$ (i,j)" by (unfold index_hma_def[symmetric], transfer, simp) + let ?s = "(- (A $$ (n, j) div A $$ (i, j)))" + let ?s' = "((res_int (A' $h i' $h j') (A' $h ?from_nat_rows n $h j') + - A' $h ?from_nat_rows n $h j') div A' $h i' $h j')" + have ss'[transfer_rule]: "?s = ?s'" unfolding res_int_def Anj Aij + by (metis (no_types, hide_lams) Groups.add_ac(2) add_diff_cancel_left' div_by_0 + minus_div_mult_eq_mod more_arith_simps(7) nat_arith.rule0 nonzero_mult_div_cancel_right + uminus_add_conv_diff) + have H_JNF_eq: "?H_JNF A (Suc n) i j = ?H_JNF (addrow (- (A $$ (n, j) div A $$ (i, j))) n i A) n i j" + by auto + have H_HMA_eq: "?H_HMA A' (Suc n) i' j' res_int = ?H_HMA (row_add A' (?from_nat_rows n) i' ?s') n i' j' res_int" + by (auto simp add: Let_def) + have "Mod_Type_Connect.HMA_M (?H_JNF (addrow ?s n i A) n i j) + (?H_HMA (row_add A' (?from_nat_rows n) i' ?s') n i' j' res_int)" + by (rule "Suc.hyps"[OF _ ii' jj'], transfer_prover, insert Suc_n_less_m, simp) + thus ?case using H_JNF_eq H_HMA_eq by auto + qed +qed + + +corollary HMA_Hermite_reduce_above': + assumes "n is_zero_row_JNF i A" using False by transfer + hence "find_fst_non0_in_row i A \ None" using find_fst_non0_in_row_None[OF _ upt_A i] by auto + from this obtain j where j: "find_fst_non0_in_row i A = Some j" by blast + have j_eq: "j = (LEAST n. A $$ (i,n) \ 0)" + by (rule find_fst_non0_in_row_LEAST[OF _ upt_A j i], auto) + have H_JNF_rw: "(Hermite_of_row_i A i) = + (if A $$ (i, j) < 0 then Hermite_reduce_above (multrow i (- 1) A) i i j + else Hermite_reduce_above A i i j)" unfolding Hermite_of_row_i_def using j by auto + let ?H_HMA = "Hermite.Hermite_of_row_i" + let ?j' = "(LEAST n. A' $h i' $h n \ 0)" + have ii'2: "(mod_type_class.to_nat i') = i" using ii' + by (simp add: Mod_Type_Connect.HMA_I_def) + have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I j ?j'" + unfolding j_eq index_hma_def[symmetric] by (rule HMA_LEAST[OF AA' ii' nz_iA]) + have Aij: "A $$ (i, j) = A' $h i' $h (LEAST n. A' $h i' $h n \ 0)" + by (subst index_hma_def[symmetric], transfer', simp) + have H_HMA_rw: "?H_HMA ass_function_euclidean res_int A' i' = + Hermite.Hermite_reduce_above (mult_row A' i' (\A' $h i' $h ?j'\ + div A' $h i' $h ?j')) + (mod_type_class.to_nat i') i' ?j' res_int" + unfolding Hermite.Hermite_of_row_i_def Let_def ass_function_euclidean_def + by (auto simp add: False) + have im: "i < CARD('m)" using ii' unfolding Mod_Type_Connect.HMA_I_def + using mod_type_class.to_nat_less_card by blast + show ?thesis + proof (cases "A $$ (i, j) < 0") + case True + have A'i'j'_le_0: "A' $h i' $h ?j' < 0" using Aij True by auto + hence 1: "(\A' $h i' $h ?j'\ div A' $h i' $h ?j') + = -1" using div_pos_neg_trivial by auto + have [transfer_rule]: "Mod_Type_Connect.HMA_M (multrow i (- 1) A) + (mult_row A' i' (\A' $h i' $h ?j'\ + div A' $h i' $h ?j'))" unfolding 1 by transfer_prover + have H_HMA_rw2: "Hermite_of_row_i A i = Hermite_reduce_above (multrow i (- 1) A) i i j" + using True H_JNF_rw by auto + have *: "Mod_Type_Connect.HMA_M (Hermite_reduce_above (multrow i (- 1) A) i i j) + (Hermite.Hermite_reduce_above (mult_row A' i' (\A' $h i' $h ?j'\ + div A' $h i' $h ?j')) + (mod_type_class.to_nat i') i' ?j' res_int) " + unfolding 1 ii'2 + by (rule HMA_Hermite_reduce_above'[OF im _ ii' jj'], transfer_prover) + show ?thesis unfolding H_JNF_rw H_HMA_rw unfolding H_HMA_rw2 using True * by auto + next + case False + have Aij_not0: "A $$ (i, j) \ 0" using j_eq nz_iA + by (metis (mono_tags) LeastI is_zero_row_JNF_def) + have A'i'j'_le_0: "A' $h i' $h ?j' > 0" using False Aij_not0 Aij by auto + hence 1: "(\A' $h i' $h ?j'\ div A' $h i' $h ?j') = 1" by auto + have H_HMA_rw2: "Hermite_of_row_i A i = Hermite_reduce_above A i i j" + using False H_JNF_rw by auto + have *: "?H_HMA ass_function_euclidean res_int A' i' = + (Hermite.Hermite_reduce_above A' (mod_type_class.to_nat i') i' ?j' res_int)" + using H_HMA_rw unfolding 1 unfolding mult_row_1_id by simp + have "Mod_Type_Connect.HMA_M (Hermite_reduce_above A i i j) + (Hermite.Hermite_reduce_above A' (mod_type_class.to_nat i') i' ?j' res_int)" + unfolding 1 ii'2 + by (rule HMA_Hermite_reduce_above'[OF im AA' ii' jj']) + then show ?thesis using H_HMA_rw * H_HMA_rw2 by presburger + qed + qed +qed + + +lemma Hermite_of_list_of_rows_append: +"Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x" + by (induct xs arbitrary: A, auto) + + +lemma Hermite_reduce_above[simp]: "Hermite_reduce_above A n i j \ carrier_mat (dim_row A) (dim_col A)" +proof (induct n arbitrary: A) + case 0 + then show ?case by auto +next + case (Suc n) + let ?A = "(addrow (- (A $$ (n, j) div A $$ (i, j))) n i A)" + have "Hermite_reduce_above A (Suc n) i j = Hermite_reduce_above ?A n i j" + by (auto simp add: Let_def) + also have "... \ carrier_mat (dim_row ?A) (dim_col ?A)" by(rule Suc.hyps) + finally show ?case by auto +qed + + +lemma Hermite_of_row_i: "Hermite_of_row_i A i \ carrier_mat (dim_row A) (dim_col A)" +proof - + have "Hermite_reduce_above (multrow i (- 1) A) i i a + \ carrier_mat (dim_row (multrow i (- 1) A)) (dim_col (multrow i (- 1) A))" + for a by (rule Hermite_reduce_above) + thus ?thesis + unfolding Hermite_of_row_i_def using Hermite_reduce_above + by (cases "find_fst_non0_in_row i A", auto) +qed + +end + + +text \We now move more lemmas from HOL Analysis (with mod-type restrictions) to the JNF matrix +representation.\ + +(*thm echelon_form_Hermite_of_row will be transferred from HOL Analysis to JNF*) + +context +begin + +private lemma echelon_form_Hermite_of_row_mod_type: + fixes A::"int mat" + assumes "A \ carrier_mat CARD('m::mod_type) CARD('n::mod_type)" + assumes eA: "echelon_form_JNF A" + and i: "im A :: int ^'n :: mod_type ^'m :: mod_type)" + define i' where "i' = (Mod_Type.from_nat i :: 'm)" + have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" + unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto + have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i i'" + unfolding Mod_Type_Connect.HMA_I_def i'_def using assms + using from_nat_not_eq order.strict_trans by blast + have eA'[transfer_rule]: "echelon_form A'" using eA by transfer + have [transfer_rule]: "Mod_Type_Connect.HMA_M + (HNF_Mod_Det_Algorithm.Hermite_of_row_i A i) + (Hermite.Hermite_of_row_i ass_function_euclidean res_int A' i')" + by (rule HMA_Hermite_of_row_i[OF uA AA' ii']) + have "echelon_form (Hermite.Hermite_of_row_i ass_function_euclidean res_int A' i')" + by (rule echelon_form_Hermite_of_row[OF ass_function_euclidean res_function_res_int eA']) + thus ?thesis by (transfer, simp) +qed + + +private lemma echelon_form_Hermite_of_row_nontriv_mod_ring: + fixes A::"int mat" + assumes "A \ carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)" + assumes eA: "echelon_form_JNF A" + and "i(Rep :: ('b \ int)) Abs. type_definition Rep Abs {0..(Rep :: ('c \ int)) Abs. type_definition Rep Abs {0..1" + and n: "n>1" +begin + +lemma echelon_form_Hermite_of_row_nontriv_mod_ring_aux: + fixes A::"int mat" + assumes "A \ carrier_mat m n" + assumes eA: "echelon_form_JNF A" + and "iRep Abs. type_definition Rep Abs {0.. 1 < m \ 1 < n + \ A \ carrier_mat m n \ echelon_form_JNF A \ i < m + \ echelon_form_JNF (HNF_Mod_Det_Algorithm.Hermite_of_row_i A i)" + using echelon_form_Hermite_of_row_nontriv_mod_ring_aux[cancel_type_definition, of m n A i] + by auto + +(*Canceling the second*) +private lemma echelon_form_Hermite_of_row_i_cancelled_both: +"1 < m \ 1 < n \ A \ carrier_mat m n \ echelon_form_JNF A \ i < m + \ echelon_form_JNF (HNF_Mod_Det_Algorithm.Hermite_of_row_i A i)" + using echelon_form_Hermite_of_row_i_cancelled_first[cancel_type_definition, of n m A i] by simp + +(*The final results in JNF*) + +lemma echelon_form_JNF_Hermite_of_row_i': + fixes A::"int mat" + assumes "A \ carrier_mat m n" + assumes eA: "echelon_form_JNF A" + and "i {0,1}" by auto + show ?thesis + proof (cases "dim_col A = 0") + case True + have H: "Hermite_of_row_i A i \ carrier_mat (dim_row A) (dim_col A)" + using Hermite_of_row_i by blast + show ?thesis by (rule echelon_form_mx0, insert True H, auto) + next + case False + hence dc_1: "dim_col A = 1" using dc_01 by simp + then show ?thesis + proof (cases "i=0") + case True + have eA': "echelon_form_JNF (multrow 0 (- 1) A)" + by (rule echelon_form_JNF_multrow[OF _ _ eA], insert m_ge2, auto) + show ?thesis using True unfolding Hermite_of_row_i_def + by (cases "find_fst_non0_in_row 0 A", insert eA eA', auto) + next + case False + have all_zero: "(\j\{i.. carrier_mat (dim_row A) (dim_col A)" +proof (induct xs arbitrary: A rule: rev_induct) + case Nil + then show ?case by auto +next + case (snoc x xs) + let ?A = "(Hermite_of_list_of_rows A xs)" + have hyp: "(Hermite_of_list_of_rows A xs) \ carrier_mat (dim_row A) (dim_col A)" by (rule snoc.hyps) + have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i ?A x" + using Hermite_of_list_of_rows_append by auto + also have "... \ carrier_mat (dim_row ?A) (dim_col ?A)" using Hermite_of_row_i by auto + finally show ?case using hyp by auto +qed + +lemma echelon_form_JNF_Hermite_of_list_of_rows: + assumes "A\carrier_mat m n" + and "\x\set xs. x < m" + and "echelon_form_JNF A" +shows "echelon_form_JNF (Hermite_of_list_of_rows A xs)" + using assms +proof (induct xs arbitrary: A rule: rev_induct) + case Nil + then show ?case by auto +next + case (snoc x xs) + have hyp: "echelon_form_JNF (Hermite_of_list_of_rows A xs)" + by (rule snoc.hyps, insert snoc.prems, auto) + have H_Axs: "(Hermite_of_list_of_rows A xs) \ carrier_mat (dim_row A) (dim_col A)" + by (rule Hermite_of_list_of_rows) + have "(Hermite_of_list_of_rows A (xs @ [x])) = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x" + using Hermite_of_list_of_rows_append by simp + also have "echelon_form_JNF ..." + proof (rule echelon_form_JNF_Hermite_of_row_i[OF hyp]) + show "x < dim_row (Hermite_of_list_of_rows A xs)" using snoc.prems H_Axs by auto + qed + finally show ?case . +qed + + + + +lemma HMA_Hermite_of_upt_row_i[transfer_rule]: + assumes "xs = [0..x\set xs. x < CARD('m)" + assumes "Mod_Type_Connect.HMA_M A (A':: int ^ 'n :: mod_type ^ 'm :: mod_type)" + and "echelon_form_JNF A" + shows "Mod_Type_Connect.HMA_M (Hermite_of_list_of_rows A xs) + (Hermite.Hermite_of_upt_row_i A' i ass_function_euclidean res_int)" + using assms +proof (induct xs arbitrary: A A' i rule: rev_induct) + case Nil + have "i=0" using Nil by (metis le_0_eq upt_eq_Nil_conv) + then show ?case using Nil unfolding Hermite_of_upt_row_i_def by auto +next + case (snoc x xs) + note xs_x_eq = snoc.prems(1) + note all_xm = snoc.prems(2) + note AA' = snoc.prems(3) + note upt_A = snoc.prems(4) + let ?x' = "(mod_type_class.from_nat x::'m)" + have xm: "x < CARD('m)" using all_xm by auto + have xx'[transfer_rule]: "Mod_Type_Connect.HMA_I x ?x'" + unfolding Mod_Type_Connect.HMA_I_def using from_nat_not_eq xm by blast + have last_i1: "last [0..carrier_mat (CARD('m)) (CARD('n))" + using Mod_Type_Connect.dim_col_transfer_rule + Mod_Type_Connect.dim_row_transfer_rule snoc(4) by blast + show "\x\set xs. x < CARD('m)" using all_xm by auto + qed + show ?case unfolding 1 2 + by (rule HMA_Hermite_of_row_i[OF upt_H_Axs hyp xx']) +qed + +(*This is the lemma that I will transfer to JNF to get the soundness*) +lemma Hermite_Hermite_of_upt_row_i: + assumes a: "ass_function ass" + and r: "res_function res" + and eA: "echelon_form A" + shows "Hermite (range ass) (\c. range (res c)) (Hermite_of_upt_row_i A (nrows A) ass res)" +proof - + let ?H = "(Hermite_of_upt_row_i A (nrows A) ass res)" + show ?thesis + proof (rule Hermite_intro, auto) + show "Complete_set_non_associates (range ass)" + by (simp add: ass_function_Complete_set_non_associates a) + show "Complete_set_residues (\c. range (res c))" + by (simp add: r res_function_Complete_set_residues) + show "echelon_form ?H" + by (rule echelon_form_Hermite_of_upt_row_i[OF eA a r]) + fix i + assume i: "\ is_zero_row i ?H" + show "?H $ i $ (LEAST n. ?H $ i $ n \ 0) \ range ass" + proof - + have non_zero_i_eA: "\ is_zero_row i A" + using Hermite_of_upt_row_preserves_zero_rows[OF _ _ a r] i eA by blast + have least: "(LEAST n. ?H $h i $h n \ 0) = (LEAST n. A $h i $h n \ 0)" + by (rule Hermite_of_upt_row_i_Least[OF non_zero_i_eA eA a r], simp) + have "?H $ i $ (LEAST n. A $ i $ n \ 0) \ range ass" + by (rule Hermite_of_upt_row_i_in_range[OF non_zero_i_eA eA a r], auto) + thus ?thesis unfolding least by auto + qed + next + fix i j assume i: "\ is_zero_row i ?H" and j: "j < i" + show "?H $ j $ (LEAST n. ?H $ i $ n \ 0) + \ range (res (?H $ i $ (LEAST n. ?H $ i $ n \ 0)))" + proof - + have non_zero_i_eA: "\ is_zero_row i A" + using Hermite_of_upt_row_preserves_zero_rows[OF _ _ a r] i eA by blast + have least: "(LEAST n. ?H $h i $h n \ 0) = (LEAST n. A $h i $h n \ 0)" + by (rule Hermite_of_upt_row_i_Least[OF non_zero_i_eA eA a r], simp) + have "?H $ j $ (LEAST n. A $ i $ n \ 0) \ range (res (?H $ i $ (LEAST n. A $ i $ n \ 0)))" + by (rule Hermite_of_upt_row_i_in_range_res[OF non_zero_i_eA eA a r _ _ j], auto) + thus ?thesis unfolding least by auto + qed + qed +qed + + +lemma Hermite_of_row_i_0: + "Hermite_of_row_i A 0 = A \ Hermite_of_row_i A 0 = multrow 0 (- 1) A" + by (cases "find_fst_non0_in_row 0 A", unfold Hermite_of_row_i_def, auto) + +lemma Hermite_JNF_intro: +assumes +"Complete_set_non_associates associates" "(Complete_set_residues res)" "echelon_form_JNF A" + "(\i is_zero_row_JNF i A \ A $$ (i, LEAST n. A $$ (i, n) \ 0) \ associates)" + "(\i is_zero_row_JNF i A \ (\j. j A $$ (j, (LEAST n. A $$ (i, n) \ 0)) + \ res (A $$ (i,(LEAST n. A $$ (i,n) \ 0)))))" +shows "Hermite_JNF associates res A" + using assms unfolding Hermite_JNF_def by auto + +lemma least_multrow: + assumes "A \ carrier_mat m n" and "i is_zero_row_JNF ia (multrow i (- 1) A)" + shows "(LEAST n. multrow i (- 1) A $$ (ia, n) \ 0) = (LEAST n. A $$ (ia, n) \ 0)" +proof (rule Least_equality) + have nz_ia_A: "\ is_zero_row_JNF ia A" using nz_ia_mrA ia by auto + have Least_Aian_n: "(LEAST n. A $$ (ia, n) \ 0) < dim_col A" + by (smt dual_order.strict_trans is_zero_row_JNF_def not_less_Least not_less_iff_gr_or_eq nz_ia_A) + show "multrow i (- 1) A $$ (ia, LEAST n. A $$ (ia, n) \ 0) \ 0" + by (smt LeastI Least_Aian_n class_cring.cring_simprules(22) equation_minus_iff ia + index_mat_multrow(1) is_zero_row_JNF_def mult_minus1 nz_ia_A) + show " \y. multrow i (- 1) A $$ (ia, y) \ 0 \ (LEAST n. A $$ (ia, n) \ 0) \ y" + by (metis (mono_tags, lifting) Least_Aian_n class_cring.cring_simprules(22) ia + index_mat_multrow(1) leI mult_minus1 order.strict_trans wellorder_Least_lemma(2)) +qed + + +lemma Hermite_Hermite_of_row_i: + assumes A: "A \ carrier_mat 1 n" + shows "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (Hermite_of_row_i A 0)" +proof (rule Hermite_JNF_intro) + show "Complete_set_non_associates (range ass_function_euclidean)" + using ass_function_Complete_set_non_associates ass_function_euclidean by blast + show "Complete_set_residues (\c. range (res_int c))" + using res_function_Complete_set_residues res_function_res_int by blast + show "echelon_form_JNF (HNF_Mod_Det_Algorithm.Hermite_of_row_i A 0)" + by (metis (full_types) assms carrier_matD(1) echelon_form_JNF_Hermite_of_row_i + echelon_form_JNF_def less_one not_less_zero) + let ?H = "Hermite_of_row_i A 0" + show "\i is_zero_row_JNF i ?H + \ ?H $$ (i, LEAST n. ?H $$ (i, n) \ 0) \ range ass_function_euclidean" + proof (auto) + fix i assume i: "i is_zero_row_JNF i ?H" + have nz_iA: "\ is_zero_row_JNF i A" + by (metis (full_types) Hermite_of_row_i Hermite_of_row_i_0 carrier_matD(1) + i is_zero_row_JNF_multrow nz_iH) + have "?H $$ (i, LEAST n. ?H $$ (i, n) \ 0) \ 0" + proof (cases "find_fst_non0_in_row 0 A") + case None + then show ?thesis using nz_iH unfolding Hermite_of_row_i_def + by (smt HNF_Mod_Det_Algorithm.Hermite_of_row_i_def upper_triangular'_def assms + carrier_matD(1) find_fst_non0_in_row_None i less_one not_less_zero option.simps(4)) + next + case (Some a) + have upA: "upper_triangular' A" using A unfolding upper_triangular'_def by auto + have eA: "echelon_form_JNF A" by (metis A Suc_1 echelon_form_JNF_1xn lessI) + have i0: "i=0" using Hermite_of_row_i[of A 0] A i by auto + have Aia: "A $$ (i,a) \ 0" and a0: "0 \ a" and an: "a 0) = (LEAST n. multrow 0 (- 1) A $$ (i, n) \ 0)" + by (rule least_multrow[symmetric, OF A _ eA _], insert nz_iA i A i0, auto) + have a1: "a = (LEAST n. A $$ (i, n) \ 0)" + by (rule find_fst_non0_in_row_LEAST[OF A upA], insert Some i0, auto) + hence a2: "a = (LEAST n. multrow 0 (- 1) A $$ (i, n) \ 0)" unfolding l by simp + have m1: "multrow 0 (- 1) A $$ (i, LEAST n. multrow 0 (- 1) A $$ (i, n) \ 0) + = (- 1) * A $$ (i, LEAST n. A $$ (i, n) \ 0)" + by (metis Hermite_of_row_i_0 a1 a2 an assms carrier_matD(2) i i0 index_mat_multrow(1,4)) + then show ?thesis using nz_iH Some a1 Aia a2 i0 unfolding Hermite_of_row_i_def by auto + qed + thus "?H $$ (i, LEAST n. ?H $$ (i, n) \ 0) \ range ass_function_euclidean" + using ass_function_int ass_function_int_UNIV by auto + qed + show "\i is_zero_row_JNF i ?H \ (\j 0) + \ range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) \ 0))))" + using Hermite_of_row_i[of A 0] A by auto + qed + +lemma Hermite_of_row_i_0_eq_0: + assumes A: "A\carrier_mat m n" and i: "i>0" and eA: "echelon_form_JNF A" and im: "i 0" and a0: "0 \ a" and an: "a carrier_mat m 1" and eA: "echelon_form_JNF A" + shows "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (Hermite_of_row_i A 0)" +proof (rule Hermite_JNF_intro) + show "Complete_set_non_associates (range ass_function_euclidean)" + using ass_function_Complete_set_non_associates ass_function_euclidean by blast + show "Complete_set_residues (\c. range (res_int c))" + using res_function_Complete_set_residues res_function_res_int by blast + have H: "Hermite_of_row_i A 0 : carrier_mat m 1" using A Hermite_of_row_i[of A] by auto + have upA: "upper_triangular' A" + by (simp add: eA echelon_form_JNF_imp_upper_triangular) + show eH: "echelon_form_JNF (Hermite_of_row_i A 0)" + proof (rule echelon_form_JNF_mx1[OF H]) + show "\i\{1..i is_zero_row_JNF i ?H + \ ?H $$ (i, LEAST n. ?H $$ (i, n) \ 0) \ range ass_function_euclidean" + proof (auto) + fix i assume i: "i is_zero_row_JNF i ?H" + have nz_iA: "\ is_zero_row_JNF i A" + by (metis (full_types) Hermite_of_row_i Hermite_of_row_i_0 carrier_matD(1) + i is_zero_row_JNF_multrow nz_iH) + have "?H $$ (i, LEAST n. ?H $$ (i, n) \ 0) \ 0" + proof (cases "find_fst_non0_in_row 0 A") + case None + have "is_zero_row_JNF i A" + by (metis H upper_triangular'_def None assms(1) carrier_matD find_fst_non0_in_row_None + i is_zero_row_JNF_def less_one linorder_neqE_nat not_less0 upA) + then show ?thesis using nz_iH None unfolding Hermite_of_row_i_def by auto + next + case (Some a) + have Aia: "A $$ (0,a) \ 0" and a0: "0 \ a" and an: "a<1" + using find_fst_non0_in_row[OF A Some] A by auto + have nz_j_mA: "is_zero_row_JNF j (multrow 0 (- 1) A)" if j0: "j>0" and jm: "j 0) \ range ass_function_euclidean" + using ass_function_int ass_function_int_UNIV by auto + qed + show "\i is_zero_row_JNF i ?H \ (\j 0) + \ range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) \ 0))))" + proof auto + fix i j assume i: "i is_zero_row_JNF i ?H" and ji: "j 0) + \ range (res_int (?H $$ (i, LEAST n. ?H $$ (i, n) \ 0)))" using ji by auto + qed +qed + + +lemma Hermite_of_list_of_rows_1xn: + assumes A: "A \ carrier_mat 1 n" + and eA: "echelon_form_JNF A" + and x: "\x \ set xs. x < 1" and xs: "xs\[]" + shows "Hermite_JNF (range ass_function_euclidean) + (\c. range (res_int c)) (Hermite_of_list_of_rows A xs)" + using x xs +proof (induct xs rule: rev_induct) + case Nil + then show ?case by auto +next + case (snoc x xs) + have x0: "x=0" using snoc.prems by auto + show ?case + proof (cases "xs = []") + case True + have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A 0" + unfolding Hermite_of_list_of_rows_append x0 using True by auto + then show ?thesis using Hermite_Hermite_of_row_i[OF A] by auto + next + case False + have x0: "x=0" using snoc.prems by auto + have hyp: "Hermite_JNF (range ass_function_euclidean) + (\c. range (res_int c)) (Hermite_of_list_of_rows A xs)" + by (rule snoc.hyps, insert snoc.prems False, auto) + have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i (Hermite_of_list_of_rows A xs) 0" + unfolding Hermite_of_list_of_rows_append hyp x0 .. + thus ?thesis + by (metis A Hermite_Hermite_of_row_i Hermite_of_list_of_rows carrier_matD(1)) + qed +qed + + +lemma Hermite_of_row_i_id_mx1: + assumes H': "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) A" + and x: "xcarrier_mat m 1" +shows "Hermite_of_row_i A x = A" +proof (cases "find_fst_non0_in_row x A") + case None + then show ?thesis unfolding Hermite_of_row_i_def by auto +next + case (Some a) + have eH: "echelon_form_JNF A" using H' unfolding Hermite_JNF_def by simp + have ut_A: "upper_triangular' A" by (simp add: eH echelon_form_JNF_imp_upper_triangular) + have a_least: "a = (LEAST n. A $$ (x,n) \ 0)" + by (rule find_fst_non0_in_row_LEAST[OF _ ut_A Some], insert x, auto) + have Axa: "A $$ (x, a) \ 0" and xa: "x\a" and a: "a is_zero_row_JNF x A" using Axa xa x a unfolding is_zero_row_JNF_def by blast + have a0: "a = 0" using a A by auto + have x0: "x=0" using echelon_form_JNF_first_column_0[OF eH A] Axa a0 xa by blast + have "A $$ (x, a) \ (range ass_function_euclidean)" + using nz_xA H' x unfolding a_least unfolding Hermite_JNF_def by auto + hence "A $$ (x, a) > 0" using Axa unfolding image_def ass_function_euclidean_def by auto + then show ?thesis unfolding Hermite_of_row_i_def using Some x0 by auto +qed + +lemma Hermite_of_row_i_id_mx1': + assumes eA: "echelon_form_JNF A" + and x: "xcarrier_mat m 1" +shows "Hermite_of_row_i A x = A \ Hermite_of_row_i A x = multrow 0 (- 1) A" +proof (cases "find_fst_non0_in_row x A") + case None + then show ?thesis unfolding Hermite_of_row_i_def by auto +next + case (Some a) + have ut_A: "upper_triangular' A" by (simp add: eA echelon_form_JNF_imp_upper_triangular) + have a_least: "a = (LEAST n. A $$ (x,n) \ 0)" + by (rule find_fst_non0_in_row_LEAST[OF _ ut_A Some], insert x, auto) + have Axa: "A $$ (x, a) \ 0" and xa: "x\a" and a: "a is_zero_row_JNF x A" using Axa xa x a unfolding is_zero_row_JNF_def by blast + have a0: "a = 0" using a A by auto + have x0: "x=0" using echelon_form_JNF_first_column_0[OF eA A] Axa a0 xa by blast + show ?thesis by (cases "A $$(x,a)>0", unfold Hermite_of_row_i_def, insert Some x0, auto) +qed + + +lemma Hermite_of_list_of_rows_mx1: + assumes A: "A \ carrier_mat m 1" + and eA: "echelon_form_JNF A" + and x: "\x \ set xs. x < m" and xs: "xs=[0..0" + shows "Hermite_JNF (range ass_function_euclidean) + (\c. range (res_int c)) (Hermite_of_list_of_rows A xs)" + using x xs i +proof (induct xs arbitrary: i rule: rev_induct) + case Nil + then show ?case by (metis neq0_conv not_less upt_eq_Nil_conv) +next + case (snoc x xs) + note all_n_xs_x = snoc.prems(1) + note xs_x = snoc.prems(2) + note i0 = snoc.prems(3) + have i_list_rw:"[0.. carrier_mat m 1" + using A Hermite_of_list_of_rows[of A xs] by auto + show ?case + proof (cases "i-1=0") + case True + hence xs_empty: "xs = []" using xs by auto + have *: "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A 0" + unfolding Hermite_of_list_of_rows_append xs_empty x True by simp + show ?thesis unfolding * by (rule Hermite_Hermite_of_row_i_mx1[OF A eA]) + next + case False + have hyp: "Hermite_JNF (range ass_function_euclidean) + (\c. range (res_int c)) (Hermite_of_list_of_rows A xs)" + by (rule snoc.hyps[OF _ xs], insert False all_n_xs_x, auto) + have "Hermite_of_list_of_rows A (xs @ [x]) + = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x" + unfolding Hermite_of_list_of_rows_append .. + also have "... = (Hermite_of_list_of_rows A xs)" + by (rule Hermite_of_row_i_id_mx1[OF hyp _ H], insert snoc.prems H x, auto) + finally show ?thesis using hyp by auto + qed +qed + + + +lemma invertible_Hermite_of_list_of_rows_1xn: + assumes "A \ carrier_mat 1 n" + shows "\P. P \ carrier_mat 1 1 \ invertible_mat P \ Hermite_of_list_of_rows A [0..<1] = P * A" +proof - + let ?H = "Hermite_of_list_of_rows A [0..<1]" + have "?H = Hermite_of_row_i A 0" by auto + hence H_or: "?H = A \ ?H = multrow 0 (- 1) A" + using Hermite_of_row_i_0 by simp + show ?thesis + proof (cases "?H = A") + case True + then show ?thesis + by (metis assms invertible_mat_one left_mult_one_mat one_carrier_mat) + next + case False + hence H_mr: "?H = multrow 0 (- 1) A" using H_or by simp + let ?M = "multrow_mat 1 0 (-1)::int mat" + show ?thesis + proof (rule exI[of _ "?M"]) + have "?M \ carrier_mat 1 1" by auto + moreover have "invertible_mat ?M" + by (metis calculation det_multrow_mat det_one dvd_mult_right invertible_iff_is_unit_JNF + invertible_mat_one one_carrier_mat square_eq_1_iff zero_less_one_class.zero_less_one) + moreover have "?H= ?M * A" + by (metis H_mr assms multrow_mat) + ultimately show "?M \ carrier_mat 1 1 \ invertible_mat (?M) + \ Hermite_of_list_of_rows A [0..<1] = ?M * A" by blast + qed + qed +qed + + + +lemma invertible_Hermite_of_list_of_rows_mx1': + assumes A: "A \ carrier_mat m 1" and eA: "echelon_form_JNF A" + and xs_i: "xs = [0..x\set xs. x < m" and i: "i>0" + shows "\P. P \ carrier_mat m m \ invertible_mat P \ Hermite_of_list_of_rows A xs = P * A" + using xs_i xs_m i +proof (induct xs arbitrary: i rule: rev_induct) + case Nil + then show ?case by (metis diff_zero length_upt list.size(3) zero_order(3)) +next + case (snoc x xs) + note all_n_xs_x = snoc.prems(2) + note xs_x = snoc.prems(1) + note i0 = snoc.prems(3) + have i_list_rw:"[0.. carrier_mat m 1" + using A Hermite_of_list_of_rows[of A xs] by auto + show ?case + proof (cases "i-1=0") + case True + hence xs_empty: "xs = []" using xs by auto + let ?H = "Hermite_of_list_of_rows A (xs @ [x])" + have *: "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A 0" + unfolding Hermite_of_list_of_rows_append xs_empty x True by simp + hence H_or: "?H = A \ ?H = multrow 0 (- 1) A" using Hermite_of_row_i_0 by simp + thus ?thesis + proof (cases "?H=A") + case True + then show ?thesis unfolding * + by (metis A invertible_mat_one left_mult_one_mat one_carrier_mat) + next + case False + hence H_mr: "?H = multrow 0 (- 1) A" using H_or by simp + let ?M = "multrow_mat m 0 (-1)::int mat" + show ?thesis + proof (rule exI[of _ "?M"]) + have "?M \ carrier_mat m m" by auto + moreover have "invertible_mat ?M" + by (metis (full_types) det_multrow_mat dvd_mult_right invertible_iff_is_unit_JNF + invertible_mat_zero more_arith_simps(10) mult_minus1_right multrow_mat_carrier neq0_conv) + moreover have "?H = ?M * A" unfolding H_mr using A multrow_mat by blast + ultimately show "?M \ carrier_mat m m \ invertible_mat ?M \ ?H = ?M * A" by blast + qed + qed + next + case False + let ?A = "(Hermite_of_list_of_rows A xs)" + have A': "?A \ carrier_mat m 1" using A Hermite_of_list_of_rows[of A xs] by simp + have hyp: "\P. P \ carrier_mat m m \ invertible_mat P \ Hermite_of_list_of_rows A xs = P * A" + by (rule snoc.hyps[OF xs], insert False all_n_xs_x, auto) + have rw: "Hermite_of_list_of_rows A (xs @ [x]) + = Hermite_of_row_i (Hermite_of_list_of_rows A xs) x" + unfolding Hermite_of_list_of_rows_append .. + have *: "Hermite_of_row_i ?A x = ?A \ Hermite_of_row_i ?A x = multrow 0 (- 1) ?A" + proof (rule Hermite_of_row_i_id_mx1'[OF _ _ A']) + show "echelon_form_JNF ?A" + using A eA echelon_form_JNF_Hermite_of_list_of_rows snoc(3) by auto + show "x < dim_row ?A" using A' x i A by (simp add: snoc(3)) + qed + show ?thesis + proof (cases "Hermite_of_row_i ?A x = ?A") + case True + then show ?thesis + by (simp add: hyp rw) + next + case False + let ?M = "multrow_mat m 0 (-1)::int mat" + obtain P where P: "P \ carrier_mat m m" + and inv_P: "invertible_mat P" and H_PA: "Hermite_of_list_of_rows A xs = P * A" + using hyp by auto + have M: "?M \ carrier_mat m m" by auto + have inv_M: "invertible_mat ?M" + by (metis (full_types) det_multrow_mat dvd_mult_right invertible_iff_is_unit_JNF + invertible_mat_zero more_arith_simps(10) mult_minus1_right multrow_mat_carrier neq0_conv) + have H_MA': "Hermite_of_row_i ?A x = ?M * ?A" using False * H multrow_mat by metis + have inv_MP: "invertible_mat (?M*P)" using M inv_M P inv_P invertible_mult_JNF by blast + moreover have MP: "(?M*P) \ carrier_mat m m" using M P by fastforce + moreover have "Hermite_of_list_of_rows A (xs @ [x]) = (?M*P) * A" + by (metis A H_MA' H_PA M P assoc_mult_mat rw) + ultimately show ?thesis by blast + qed + qed +qed + + +corollary invertible_Hermite_of_list_of_rows_mx1: + assumes "A \ carrier_mat m 1" and eA: "echelon_form_JNF A" + shows "\P. P \ carrier_mat m m \ invertible_mat P \ Hermite_of_list_of_rows A [0.. carrier_mat m 0" + and xs: "xs = [0..x\ set xs. x < m" +shows "Hermite_of_list_of_rows A xs = A" + using xs x +proof (induct xs arbitrary: i rule: rev_induct) + case Nil + then show ?case by auto +next + case (snoc x xs) + note all_n_xs_x = snoc.prems(2) + note xs_x = snoc.prems(1) + have i0: "i>0" using neq0_conv snoc(2) by fastforce + have i_list_rw:"[0.. carrier_mat m 0" + using A Hermite_of_list_of_rows[of A xs] by auto + define A' where "A' = (Hermite_of_list_of_rows A xs)" + have A'A: "A' = A" by (unfold A'_def, rule snoc.hyps, insert snoc.prems xs, auto) + have "Hermite_of_list_of_rows A (xs @ [x]) = Hermite_of_row_i A' x" + using Hermite_of_list_of_rows_append A'_def by auto + also have "... = A" + proof (cases "find_fst_non0_in_row x A'") + case None + then show ?thesis unfolding Hermite_of_row_i_def using A'A by auto + next + case (Some a) + then show ?thesis + by (metis (full_types) A'A A carrier_matD(2) find_fst_non0_in_row(3) zero_order(3)) + qed + finally show ?case . +qed + + +text \Again, we move more lemmas from HOL Analysis (with mod-type restrictions) to the JNF matrix +representation.\ + +(* +The following lemmas will be transferred from HOL Analysis to JNF: +thm Hermite_Hermite_of_upt_row_i +thm invertible_Hermite_of_upt_row_i +*) + +context +begin + +private lemma Hermite_Hermite_of_list_of_rows_mod_type: + fixes A::"int mat" + assumes "A \ carrier_mat CARD('m::mod_type) CARD('n::mod_type)" + assumes eA: "echelon_form_JNF A" +shows "Hermite_JNF (range ass_function_euclidean) + (\c. range (res_int c)) (Hermite_of_list_of_rows A [0..m A :: int ^'n :: mod_type ^'m :: mod_type)" + have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" + unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto + have eA'[transfer_rule]: "echelon_form A'" using eA by transfer + have [transfer_rule]: "Mod_Type_Connect.HMA_M (Hermite_of_list_of_rows A [0..c. range (res_int c)) = (\c. range (res_int c))" .. + have n: "CARD('m) = nrows A'" using AA' unfolding nrows_def by auto + have "Hermite (range ass_function_euclidean) (\c. range (res_int c)) + (Hermite_of_upt_row_i A' (CARD('m)) ass_function_euclidean res_int)" + by (unfold n, rule Hermite_Hermite_of_upt_row_i[OF ass_function_euclidean res_function_res_int eA']) + thus ?thesis by transfer +qed + +private lemma invertible_Hermite_of_list_of_rows_mod_type: + fixes A::"int mat" + assumes "A \ carrier_mat CARD('m::mod_type) CARD('n::mod_type)" + assumes eA: "echelon_form_JNF A" + shows "\P. P \ carrier_mat CARD('m) CARD('m) \ + invertible_mat P \ Hermite_of_list_of_rows A [0..m A :: int ^'n :: mod_type ^'m :: mod_type)" + have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" + unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto + have eA'[transfer_rule]: "echelon_form A'" using eA by transfer + have [transfer_rule]: "Mod_Type_Connect.HMA_M (Hermite_of_list_of_rows A [0..c. range (res_int c)) = (\c. range (res_int c))" .. + have n: "CARD('m) = nrows A'" using AA' unfolding nrows_def by auto + have "\P. invertible P \ Hermite_of_upt_row_i A' (CARD('m)) ass_function_euclidean res_int + = P ** A'" by (rule invertible_Hermite_of_upt_row_i[OF ass_function_euclidean]) + thus ?thesis by (transfer, auto) +qed + + +private lemma Hermite_Hermite_of_list_of_rows_nontriv_mod_ring: + fixes A::"int mat" + assumes "A \ carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)" + assumes eA: "echelon_form_JNF A" +shows "Hermite_JNF (range ass_function_euclidean) + (\c. range (res_int c)) (Hermite_of_list_of_rows A [0.. carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)" + assumes eA: "echelon_form_JNF A" + shows "\P. P \ carrier_mat CARD('m) CARD('m) \ + invertible_mat P \ Hermite_of_list_of_rows A [0..(Rep :: ('b \ int)) Abs. type_definition Rep Abs {0..(Rep :: ('c \ int)) Abs. type_definition Rep Abs {0..1" + and n: "n>1" +begin + +lemma Hermite_Hermite_of_list_of_rows_nontriv_mod_ring_aux: + fixes A::"int mat" + assumes "A \ carrier_mat m n" + assumes eA: "echelon_form_JNF A" +shows "Hermite_JNF (range ass_function_euclidean) + (\c. range (res_int c)) (Hermite_of_list_of_rows A [0.. carrier_mat m n" + assumes eA: "echelon_form_JNF A" + shows "\P. P \ carrier_mat m m \ invertible_mat P \ Hermite_of_list_of_rows A [0..Rep Abs. type_definition Rep Abs {0.. 1 < m \ 1 < n \ A \ carrier_mat m n \ echelon_form_JNF A + \ \P. P \ carrier_mat m m \ invertible_mat P \ Hermite_of_list_of_rows A [0.. 1 < n \ A \ carrier_mat m n \ echelon_form_JNF A + \ \P. P \ carrier_mat m m \ invertible_mat P \ Hermite_of_list_of_rows A [0..Rep Abs. type_definition Rep Abs {0.. + 1 < m \ + 1 < n \ + A \ carrier_mat m n \ + echelon_form_JNF A + \ Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (Hermite_of_list_of_rows A [0.. + 1 < n \ + A \ carrier_mat m n \ + echelon_form_JNF A + \ Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (Hermite_of_list_of_rows A [0.. carrier_mat m n" + and "echelon_form_JNF A" + and "1 < m" and "1 < n" (*Required from the mod_type restrictions*) +shows "Hermite_JNF (range ass_function_euclidean) + (\c. range (res_int c)) (Hermite_of_list_of_rows A [0.. carrier_mat m n" + and eA: "echelon_form_JNF A" +shows "Hermite_JNF (range ass_function_euclidean) + (\c. range (res_int c)) (Hermite_of_list_of_rows A [0.. n=0") + case True + then show ?thesis + by (auto, metis Hermite_Hermite_of_row_i Hermite_JNF_def A eA carrier_matD(1) one_carrier_mat zero_order(3)) + (metis Hermite_Hermite_of_row_i Hermite_JNF_def Hermite_of_list_of_rows A carrier_matD(2) + echelon_form_mx0 is_zero_row_JNF_def mat_carrier zero_order(3)) +next + case False note not_m0_or_n0 = False + show ?thesis + proof (cases "m=1 \ n=1") + case True + then show ?thesis + by (metis False Hermite_of_list_of_rows_1xn Hermite_of_list_of_rows_mx1 A eA + atLeastLessThan_iff linorder_not_less neq0_conv set_upt upt_eq_Nil_conv) + next + case False + show ?thesis + by (rule Hermite_Hermite_of_list_of_rows'[OF A eA], insert not_m0_or_n0 False, auto) + qed +qed + +lemma invertible_Hermite_of_list_of_rows: + assumes A: "A \ carrier_mat m n" + and eA: "echelon_form_JNF A" +shows "\P. P \ carrier_mat m m \ invertible_mat P \ Hermite_of_list_of_rows A [0.. n=0") + case True + have *: "Hermite_of_list_of_rows A [0.. n=1") + case True + then show ?thesis + using A eA invertible_Hermite_of_list_of_rows_1xn invertible_Hermite_of_list_of_rows_mx1 by blast + next + case False + then show ?thesis + using invertible_Hermite_of_list_of_rows_cancelled_both[OF _ _ A eA] False mn by auto + qed +qed +end +end +end +end + + +text \Now we have all the required stuff to prove the soundness of the algorithm.\ + +context proper_mod_operation +begin + +(* +thm invertible_Hermite_of_list_of_rows +thm Hermite_Hermite_of_list_of_rows +thm LLL_with_assms.Hermite_append_det_id +thm FindPreHNF_invertible_mat +thm FindPreHNF_echelon_form +*) + +lemma Hermite_mod_det_mx0: + assumes "A \ carrier_mat m 0" + shows "Hermite_mod_det abs_flag A = A" + unfolding Hermite_mod_det_def Let_def using assms by auto + +lemma Hermite_JNF_mx0: + assumes A: "A \ carrier_mat m 0" + shows "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) A" + unfolding Hermite_JNF_def using A echelon_form_mx0 unfolding is_zero_row_JNF_def + using ass_function_Complete_set_non_associates[OF ass_function_euclidean] + using res_function_Complete_set_residues[OF res_function_res_int] by auto + + +lemma Hermite_mod_det_soundness_mx0: + assumes A: "A \ carrier_mat m n" + and n0: "n=0" +shows "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (Hermite_mod_det abs_flag A)" +and "(\P. invertible_mat P \ P \ carrier_mat m m \ (Hermite_mod_det abs_flag A) = P * A)" +proof - + have A: "A \ carrier_mat m 0" using A n0 by blast + then show "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (Hermite_mod_det abs_flag A)" + using Hermite_JNF_mx0[OF A] Hermite_mod_det_mx0[OF A] by auto + show "(\P. invertible_mat P \ P \ carrier_mat m m \ (Hermite_mod_det abs_flag A) = P * A)" + by (metis A Hermite_mod_det_mx0 invertible_mat_one left_mult_one_mat one_carrier_mat) +qed + + +lemma Hermite_mod_det_soundness_mxn: + assumes mn: "m = n" + and A: "A \ carrier_mat m n" + and n0: "0c. range (res_int c)) (Hermite_mod_det abs_flag A)" + and "(\P. invertible_mat P \ P \ carrier_mat m m \ (Hermite_mod_det abs_flag A) = P * A)" +proof - + define D A' E H H' where D_def: "D = \Determinant.det A\" + and A'_def: "A' = A @\<^sub>r D \\<^sub>m 1\<^sub>m n" and E_def: "E = FindPreHNF abs_flag D A'" + and H_def: "H = Hermite_of_list_of_rows E [0.. carrier_mat (m+n) n" using A A A'_def by auto + let ?RAT = "of_int_hom.mat_hom :: int mat \ rat mat" + have RAT_A: "?RAT A \ carrier_mat n n" + using A map_carrier_mat mat_of_rows_carrier(1) mn by auto + have det_RAT_fs_init: "det (?RAT A) \ 0" + using inv_RAT_A unfolding invertible_iff_is_unit_JNF[OF RAT_A] by auto + moreover have "mat_of_rows n (map (Matrix.row A') [0..\<^sub>m 1\<^sub>m n \ carrier_mat n n" using mn by auto + have "?A' $$ (i,j) = (map (Matrix.row A') [0.. carrier_mat (m+n) n" unfolding E_def by (rule FindPreHNF[OF A']) + have "\P. P \ carrier_mat (m + n) (m + n) \ invertible_mat P \ E = P * A'" + by (unfold E_def, rule FindPreHNF_invertible_mat[OF A'_def A n0 _ _], + insert mn D_def det_RAT_fs_init, auto) + from this obtain P where P: "P \ carrier_mat (m + n) (m + n)" + and inv_P: "invertible_mat P" and E_PA': "E = P * A'" + by blast + have "\Q. Q \ carrier_mat (m+n) (m+n) \ invertible_mat Q \ H = Q * E" + by (unfold H_def, rule invertible_Hermite_of_list_of_rows[OF E eE]) + from this obtain Q where Q: "Q \ carrier_mat (m+n) (m+n)" + and inv_Q: "invertible_mat Q" and H_QE: "H = Q * E" by blast + let ?ass ="(range ass_function_euclidean)" + let ?res = "(\c. range (res_int c))" + have Hermite_H: "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) H" + by (unfold H_def, rule Hermite_Hermite_of_list_of_rows[OF E eE]) + hence eH: "echelon_form_JNF H" unfolding Hermite_JNF_def by auto + have H': "H' \ carrier_mat m n" using H'_def by auto + have H_H'0: "H = H' @\<^sub>r 0\<^sub>m m n" + proof (unfold H'_def, rule upper_triangular_append_zero) + show "upper_triangular' H" using eH by (rule echelon_form_JNF_imp_upper_triangular) + show "H \ carrier_mat (m + m) n" + unfolding H_def using Hermite_of_list_of_rows[of E] E mn by auto + qed (insert mn, simp) + obtain P' where PP': "inverts_mat P P'" + and P'P: "inverts_mat P' P" and P': "P' \ carrier_mat (m+n) (m+n)" + using P inv_P obtain_inverse_matrix by blast + obtain Q' where QQ': "inverts_mat Q Q'" + and Q'Q: "inverts_mat Q' Q" and Q': "Q' \ carrier_mat (m+n) (m+n)" + using Q inv_Q obtain_inverse_matrix by blast + have P'Q': "(P'*Q') \ carrier_mat (m + m) (m + m)" using P' Q' mn by simp + have A'_P'Q'H: "A' = P' * Q' * H" + proof - + have QP: "Q * P \ carrier_mat (m + m) (m + m)" using Q P mn by auto + have "H = Q * (P * A')" using H_QE E_PA' by auto + also have "... = (Q * P) * A'" using A' P Q by auto + also have "(P' * Q') * ... = ((P' * Q') * (Q * P)) * A'" using A' P'Q' QP mn by auto + also have "... = (P' * (Q' * Q) * P) * A'" + by (smt P P' P'Q' Q Q' assms(1) assoc_mult_mat) + also have "... = (P'*P) * A'" + by (metis P' Q' Q'Q carrier_matD(1) inverts_mat_def right_mult_one_mat) + also have "... = A'" + by (metis A' P' P'P carrier_matD(1) inverts_mat_def left_mult_one_mat) + finally show "A' = P' * Q' * H" .. + qed + have inv_P'Q': "invertible_mat (P' * Q')" + by (metis P' P'P PP' Q' Q'Q QQ' carrier_matD(1) carrier_matD(2) invertible_mat_def + invertible_mult_JNF square_mat.simps) + interpret vec_module "TYPE(int)" . + interpret B: cof_vec_space n "TYPE(rat)" . + interpret A: LLL_with_assms n m "(Matrix.rows A)" "4/3" + proof + show "length (rows A) = m " using A unfolding Matrix.rows_def by simp + have s: "set (map of_int_hom.vec_hom (rows A)) \ carrier_vec n" + using A unfolding Matrix.rows_def by auto + have rw: "(map of_int_hom.vec_hom (rows A)) = (rows (?RAT A))" + by (metis A s carrier_matD(2) mat_of_rows_map mat_of_rows_rows rows_mat_of_rows set_rows_carrier subsetI) + have "B.lin_indpt (set (map of_int_hom.vec_hom (rows A)))" + unfolding rw by (rule B.det_not_0_imp_lin_indpt_rows[OF RAT_A det_RAT_fs_init]) + moreover have "distinct (map of_int_hom.vec_hom (rows A)::rat Matrix.vec list)" + proof (rule ccontr) + assume " \ distinct (map of_int_hom.vec_hom (rows A)::rat Matrix.vec list)" + from this obtain i j where "row (?RAT A) i = row (?RAT A) j" and "i \ j" and "i < n" and "j < n" + unfolding rw + by (metis Determinant.det_transpose RAT_A add_0 cols_transpose det_RAT_fs_init + not_add_less2 transpose_carrier_mat vec_space.det_rank_iff vec_space.non_distinct_low_rank) + thus False using Determinant.det_identical_rows[OF RAT_A] using det_RAT_fs_init RAT_A by auto + qed + ultimately show "B.lin_indpt_list (map of_int_hom.vec_hom (rows A))" + using s unfolding B.lin_indpt_list_def by auto + qed (simp) + have A_eq: "mat_of_rows n (Matrix.rows A) = A" using A mat_of_rows_rows by blast + have D_A: "D = \det (mat_of_rows n (rows A))\" using D_def A_eq by auto + have Hermite_H': "Hermite_JNF ?ass ?res H'" + by (rule A.Hermite_append_det_id(1)[OF _ mn _ H' H_H'0 P'Q' inv_P'Q' A'_P'Q'H Hermite_H], + insert D_def A'_def mn A inv_RAT_A D_A A_eq, auto) + have dc: "dim_row A = m" and dr: "dim_col A = n" using A by auto + have Hermite_mod_det_H': "Hermite_mod_det abs_flag A = H'" + unfolding Hermite_mod_det_def Let_def H'_def H_def E_def A'_def D_def dc dr det_int by blast + show "Hermite_JNF ?ass ?res (Hermite_mod_det abs_flag A)" using Hermite_mod_det_H' Hermite_H' by simp + have "\R. invertible_mat R \ R \ carrier_mat m m \ A = R * H'" + by (subst A_eq[symmetric], + rule A.Hermite_append_det_id(2)[OF _ mn _ H' H_H'0 P'Q' inv_P'Q' A'_P'Q'H Hermite_H], + insert D_def A'_def mn A inv_RAT_A D_A A_eq, auto) + from this obtain R where inv_R: "invertible_mat R" + and R: "R \ carrier_mat m m" and A_RH': "A = R * H'" + by blast + obtain R' where inverts_R: "inverts_mat R R'" and R': "R' \ carrier_mat m m" + by (meson R inv_R obtain_inverse_matrix) + have inv_R': "invertible_mat R'" using inverts_R unfolding invertible_mat_def inverts_mat_def + using R R' mat_mult_left_right_inverse by auto + moreover have "H' = R' * A" + proof - + have "R' * A = R' * (R * H')" using A_RH' by auto + also have "... = (R'*R) * H'" using H' R R' by auto + also have "... = H'" + by (metis H' R R' mat_mult_left_right_inverse carrier_matD(1) + inverts_R inverts_mat_def left_mult_one_mat) + finally show ?thesis .. + qed + ultimately show "\S. invertible_mat S \ S \ carrier_mat m m \ Hermite_mod_det abs_flag A = S * A" + using R' Hermite_mod_det_H' by blast +qed + + +lemma Hermite_mod_det_soundness: + assumes mn: "m = n" + and A_def: "A \ carrier_mat m n" + and i: "invertible_mat (map_mat rat_of_int A)" +shows "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (Hermite_mod_det abs_flag A)" + and "(\P. invertible_mat P \ P \ carrier_mat m m \ (Hermite_mod_det abs_flag A) = P * A)" + using A_def Hermite_mod_det_soundness_mx0(1) Hermite_mod_det_soundness_mxn(1) mn i + by blast (insert Hermite_mod_det_soundness_mx0(2) Hermite_mod_det_soundness_mxn(2) assms, blast) + + +text \We can even move the whole echelon form algorithm @{text "echelon_form_of"} from HOL Analysis +to JNF and then we can combine it with @{text "Hermite_of_list_of_rows"} to have another +HNF algorithm which is not efficient, but valid for arbitrary matrices.\ + +lemma reduce_D0: +"reduce a b 0 A = (let Aaj = A$$(a,0); Abj = A $$ (b,0) + in + if Aaj = 0 then A else + case euclid_ext2 Aaj Abj of (p,q,u,v,d) \ + Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k)) + else if i = b then u * A$$(a,k) + v * A$$(b,k) + else A$$(i,k) + ) + )" (is "?lhs = ?rhs") +proof + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A $$ (a, 0)) (A $$ (b, 0))" + by (simp add: euclid_ext2_def) + have *:" Matrix.mat (dim_row A) (dim_col A) + (\(i, k). + if i = a then let r = p * A $$ (a, k) + q * A $$ (b, k) in if 0 < \r\ then + if k = 0 \ 0 dvd r then 0 else r mod 0 else r + else if i = b then let r = u * A $$ (a, k) + v * A $$ (b, k) in + if 0 < \r\ then r mod 0 else r else A $$ (i, k)) + = Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k)) + else if i = b then u * A$$(a,k) + v * A$$(b,k) + else A$$(i,k) + )" + by (rule eq_matI, auto simp add: Let_def) + show "dim_row ?lhs = dim_row ?rhs" + unfolding reduce.simps Let_def by (smt dim_row_mat(1) pquvd prod.simps(2)) + show "dim_col ?lhs = dim_col ?rhs" + unfolding reduce.simps Let_def by (smt dim_col_mat(1) pquvd prod.simps(2)) + fix i j assume i: "i carrier_mat m n" and a: "a b" + and A_def: "A = A' @\<^sub>r B" and B: "B \ carrier_mat t n" + assumes pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,j)) (A$$(b,j))" + shows "Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k)) + else if i = b then u * A$$(a,k) + v * A$$(b,k) + else A$$(i,k) + ) = (bezout_matrix_JNF A a b j euclid_ext2) * A" (is "?A = ?BM * A") +proof (rule eq_matI) + have A: "A \ carrier_mat (m+t) n" using A_def A' B by simp + hence A_carrier: "?A \ carrier_mat (m+t) n" by auto + show dr: "dim_row ?A = dim_row (?BM * A)" and dc: "dim_col ?A = dim_col (?BM * A)" + unfolding bezout_matrix_JNF_def by auto + fix i ja assume i: "i < dim_row (?BM * A)" and ja: "ja < dim_col (?BM * A)" + let ?f = "\ia. (bezout_matrix_JNF A a b j euclid_ext2) $$ (i,ia) * A $$ (ia,ja)" + have dv: "dim_vec (col A ja) = m+t" using A by auto + have i_dr: "i col A ja" + by (rule index_mult_mat, insert i ja, auto) + also have "... = (\ia = 0..ia = 0..ia \ ({a,b} \ ({0.. {0.. i" using True x by blast + have x_dr: "x < dim_row A" using x A by auto + have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0" + unfolding bezout_matrix_JNF_def + unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto + thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto + qed + have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = p" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True pquvd + by (auto, metis split_conv) + have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = q" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True pquvd ab + by (auto, metis split_conv) + have "sum ?f {a,b} + sum ?f ({0.. {0.. i" using True x by blast + have x_dr: "x < dim_row A" using x A by auto + have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0" + unfolding bezout_matrix_JNF_def + unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto + thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto + qed + have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = u" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using True i_not_a pquvd + by (auto, metis split_conv) + have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = v" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using True i_not_a pquvd ab + by (auto, metis split_conv) + have "sum ?f {a,b} + sum ?f ({0.. {0.. i" using x by blast + have x_dr: "x < dim_row A" using x A by auto + have "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) = 0" + unfolding bezout_matrix_JNF_def + unfolding index_mat(1)[OF i_dr x_dr] using x_not_i x by auto + thus "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, x) * A $$ (x, ja) = 0" by auto + qed + have fa: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, a) = 0" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr a_dr] using False i_not_a pquvd + by auto + have fb: "bezout_matrix_JNF A a b j euclid_ext2 $$ (i, b) = 0" + unfolding bezout_matrix_JNF_def index_mat(1)[OF i_dr b_dr] using False i_not_a pquvd + by auto + have "sum ?f ({0.. carrier_mat m n" and a: "a b" + assumes pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,j)) (A$$(b,j))" + shows "Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k)) + else if i = b then u * A$$(a,k) + v * A$$(b,k) + else A$$(i,k) + ) = (bezout_matrix_JNF A a b j euclid_ext2) * A" (is "?A = ?BM * A") +proof (rule bezout_matrix_JNF_mult_eq'[OF A a b ab _ _ pquvd]) + show "A = A @\<^sub>r (0\<^sub>m 0 n)" by (rule eq_matI, unfold append_rows_def, auto) + show "(0\<^sub>m 0 n) \ carrier_mat 0 n" by auto +qed + + +lemma reduce_invertible_mat_D0_BM: + assumes A: "A \ carrier_mat m n" + and a: "a < m" + and b: "b < m" + and ab: "a \ b" + and Aa0: "A$$(a,0) \ 0" + shows "reduce a b 0 A = (bezout_matrix_JNF A a b 0 euclid_ext2) * A" +proof - + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))" + by (simp add: euclid_ext2_def) + let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2" + let ?A = "Matrix.mat (dim_row A) (dim_col A) + (\(i,k). if i = a then (p*A$$(a,k) + q*A$$(b,k)) + else if i = b then u * A$$(a,k) + v * A$$(b,k) + else A$$(i,k))" + have A'_BZ_A: "?A = ?BM * A" + by (rule bezout_matrix_JNF_mult_eq2[OF A _ _ ab pquvd], insert a b, auto) + moreover have "?A = reduce a b 0 A" using pquvd Aa0 unfolding reduce_D0 Let_def + by (metis (no_types, lifting) split_conv) + ultimately show ?thesis by simp +qed + + +lemma reduce_invertible_mat_D0: + assumes A: "A \ carrier_mat m n" + and a: "a < m" + and b: "b < m" + and n0: "0 b" + and a_less_b: "aP. invertible_mat P \ P \ carrier_mat m m \ reduce a b 0 A = P * A" +proof (cases "A$$(a,0) = 0") + case True + then show ?thesis + by (smt A invertible_mat_one left_mult_one_mat one_carrier_mat reduce.simps) +next + case False + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(b,0))" + by (simp add: euclid_ext2_def) + let ?BM = "bezout_matrix_JNF A a b 0 euclid_ext2" + have "reduce a b 0 A = ?BM * A" by (rule reduce_invertible_mat_D0_BM[OF A a b ab False]) + moreover have invertible_bezout: "invertible_mat ?BM" + by (rule invertible_bezout_matrix_JNF[OF A is_bezout_ext_euclid_ext2 a_less_b _ n0 False], + insert a_less_b b, auto) + moreover have BM: "?BM \ carrier_mat m m" unfolding bezout_matrix_JNF_def using A by auto + ultimately show ?thesis by blast +qed + +lemma reduce_below_invertible_mat_D0: + assumes A': "A \ carrier_mat m n" and a: "ax \ set xs. x < m \ a < x" + and "D=0" +shows "(\P. invertible_mat P \ P \ carrier_mat m m \ reduce_below a xs D A = P * A)" + using assms +proof (induct a xs D A arbitrary: A rule: reduce_below.induct) + case (1 a D A) + then show ?case + by (auto, metis invertible_mat_one left_mult_one_mat one_carrier_mat) +next + case (2 a x xs D A) + note A = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note d = "2.prems"(4) + note x_xs = "2.prems"(5) + note D0 = "2.prems"(6) + have xm: "x < m" using "2.prems" by auto + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat m n" + by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have h: "(\P. invertible_mat P \ P \ carrier_mat m m + \ reduce_below a xs D (reduce a x D A) = P * reduce a x D A)" + by (rule "2.hyps"[OF _ a j _ _ ],insert d x_xs D0 reduce_ax, auto) + from this obtain P where inv_P: "invertible_mat P" and P: "P \ carrier_mat m m" + and rb_Pr: "reduce_below a xs D (reduce a x D A) = P * reduce a x D A" by blast + have *: "reduce_below a (x # xs) D A = reduce_below a xs D (reduce a x D A)" by simp + have "\Q. invertible_mat Q \ Q \ carrier_mat m m \ (reduce a x D A) = Q * A" + by (unfold D0, rule reduce_invertible_mat_D0[OF A a xm j], insert "2.prems", auto) + from this obtain Q where inv_Q: "invertible_mat Q" and Q: "Q \ carrier_mat m m" + and r_QA: "reduce a x D A = Q * A" by blast + have "invertible_mat (P*Q)" using inv_P inv_Q P Q invertible_mult_JNF by blast + moreover have "P * Q \ carrier_mat m m" using P Q by auto + moreover have "reduce_below a (x # xs) D A = (P*Q) * A" + by (smt P Q * assoc_mult_mat carrier_matD(1) carrier_mat_triv index_mult_mat(2) + r_QA rb_Pr reduce_preserves_dimensions(1)) + ultimately show ?case by blast +qed + + +(*This lemma permits to get rid of one assumption in reduce_not0*) +lemma reduce_not0': + assumes A: "A \ carrier_mat m n" and a: "a 0" + shows "reduce a b 0 A $$ (a, 0) \ 0" (is "?reduce_ab $$ (a,0) \ _") +proof - + have "?reduce_ab $$ (a,0) = (let r = gcd (A $$ (a, 0)) (A $$ (b, 0)) in if 0 dvd r then 0 else r)" + by (rule reduce_gcd[OF A _ j Aaj], insert a, simp) + also have "... \ 0" unfolding Let_def + by (simp add: assms(6)) + finally show ?thesis . +qed + + +lemma reduce_below_preserves_D0: + assumes A': "A \ carrier_mat m n" and a: "a 0" + assumes "i \ set xs" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "i\a" and "i carrier_mat m n" + by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + have "reduce_below a (x # xs) D A $$ (i, j) = reduce_below a xs D (reduce a x D A) $$ (i, j)" + by auto + also have "... = reduce a x D A $$ (i, j)" + proof (rule "2.hyps"[OF _ a j _ _ ]) + show "i \ set xs" using i_set_xxs by auto + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce a x D A $$ (a, 0) \ 0" + by (unfold D0, rule reduce_not0'[OF A _ _ _ _ Aaj], insert "2.prems", auto) + show "reduce a x D A \ carrier_mat m n" using reduce_ax by linarith + qed (insert "2.prems", auto) + also have "... = A $$ (i,j)" by (rule reduce_preserves[OF A j Aaj], insert "2.prems", auto) + finally show ?case . +qed + + + +lemma reduce_below_0_D0: + assumes A: "A \ carrier_mat m n" and a: "a 0" + assumes "i \ set xs" and "distinct xs" and "\x \ set xs. x < m \ a < x" + and "D=0" + shows "reduce_below a xs D A $$ (i,0) = 0" + using assms +proof (induct a xs D A arbitrary: A i rule: reduce_below.induct) + case (1 a D A) + then show ?case by auto +next + case (2 a x xs D A) + note A = "2.prems"(1) + note a = "2.prems"(2) + note j = "2.prems"(3) + note Aaj = "2.prems"(4) + note i_set_xxs = "2.prems"(5) + note d = "2.prems"(6) + note xxs_less_m = "2.prems"(7) + note D0 = "2.prems"(8) + have xm: "x < m" using "2.prems" by auto + obtain p q u v d where pquvd: "(p,q,u,v,d) = euclid_ext2 (A$$(a,0)) (A$$(x,0))" + by (metis prod_cases5) + let ?reduce_ax = "reduce a x D A" + have reduce_ax: "?reduce_ax \ carrier_mat m n" + by (metis (no_types, lifting) "2" add.comm_neutral append_rows_def + carrier_matD carrier_mat_triv index_mat_four_block(2,3) + index_one_mat(2) index_smult_mat(2) index_zero_mat(2,3) reduce_preserves_dimensions) + show ?case + proof (cases "i=x") + case True + have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)" + by auto + also have "... = (reduce a x D A) $$ (i, 0)" + proof (rule reduce_below_preserves_D0[OF _ a j _ _ ]) + show "reduce a x D A \ carrier_mat m n" using reduce_ax by linarith + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce a x D A $$ (a, 0) \ 0" + by (unfold D0, rule reduce_not0'[OF A _ _ j _ Aaj], insert "2.prems", auto) + show "i \ set xs" using True d by auto + show "i \ a" using "2.prems" by blast + show "i < m" by (simp add: True trans_less_add1 xm) + qed (insert D0) + also have "... = 0" unfolding True by (rule reduce_0[OF A _ j _ _ Aaj], insert "2.prems", auto) + finally show ?thesis . + next + case False note i_not_x = False + have h: "reduce_below a xs D (reduce a x D A) $$ (i, 0) = 0 " + proof (rule "2.hyps"[OF _ a j _ _ ]) + show "reduce a x D A \ carrier_mat m n" using reduce_ax by linarith + show "i \ set xs" using i_set_xxs i_not_x by auto + show "distinct xs" using d by auto + show "\x\set xs. x < m \ a < x" using xxs_less_m by auto + show "reduce a x D A $$ (a, 0) \ 0" + by (unfold D0, rule reduce_not0'[OF A _ _ j _ Aaj], insert "2.prems", auto) + qed (insert D0) + have "reduce_below a (x # xs) D A $$ (i, 0) = reduce_below a xs D (reduce a x D A) $$ (i, 0)" + by auto + also have "... = 0" using h . + finally show ?thesis . + qed +qed + +end + +text \Definition of the echelon form algorithm in JNF\ + +primrec bezout_iterate_JNF +where "bezout_iterate_JNF A 0 i j bezout = A" + | "bezout_iterate_JNF A (Suc n) i j bezout = + (if (Suc n) \ i then A else + bezout_iterate_JNF (bezout_matrix_JNF A i ((Suc n)) j bezout * A) n i j bezout)" + +definition + "echelon_form_of_column_k_JNF bezout A' k = + (let (A, i) = A' + in if (i = dim_row A) \ (\m \ {i..m\{i+1.. 0 \ i \ n); + interchange_A = swaprows i n A + in + (bezout_iterate_JNF (interchange_A) (dim_row A - 1) i k bezout, i + 1) )" + + +definition "echelon_form_of_upt_k_JNF A k bezout = (fst (foldl (echelon_form_of_column_k_JNF bezout) (A,0) [0.. int ^ 'n :: mod_type ^ 'm :: mod_type \ _) + ===> (Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_I) ===> (=) ===> (Mod_Type_Connect.HMA_M)) + (\A i j bezout. bezout_iterate_JNF A n i j bezout) + (\A i j bezout. bezout_iterate A n i j bezout) + " +proof (intro rel_funI, goal_cases) + case (1 A A' i i' j j' bezout bezout') + then show ?case using assms + proof (induct n arbitrary: A A') + case 0 + then show ?case by auto + next + case (Suc n) + note AA'[transfer_rule] = "Suc.prems"(1) + note ii'[transfer_rule] = "Suc.prems"(2) + note jj'[transfer_rule] = "Suc.prems"(3) + note bb'[transfer_rule] = "Suc.prems"(4) + note Suc_n_less_m = "Suc.prems"(5) + let ?BI_JNF = "bezout_iterate_JNF" + let ?BI_HMA = "bezout_iterate" + let ?from_nat_rows = "mod_type_class.from_nat :: _ \ 'm" + have Sucn[transfer_rule]: "Mod_Type_Connect.HMA_I (Suc n) (?from_nat_rows (Suc n))" + unfolding Mod_Type_Connect.HMA_I_def + by (simp add: Suc_lessD Suc_n_less_m mod_type_class.from_nat_to_nat) + have n: " n < CARD('m)" using Suc_n_less_m by simp + have [transfer_rule]: + "Mod_Type_Connect.HMA_M (?BI_JNF (bezout_matrix_JNF A i (Suc n) j bezout * A) n i j bezout) + (?BI_HMA (bezout_matrix A' i' (?from_nat_rows (Suc n)) j' bezout' ** A') n i' j' bezout')" + by (rule Suc.hyps[OF _ ii' jj' bb' n], transfer_prover) + moreover have "Suc n \ i \ Suc n \ mod_type_class.to_nat i'" + and "Suc n > i \ Suc n > mod_type_class.to_nat i'" + by (metis "1"(2) Mod_Type_Connect.HMA_I_def)+ + ultimately show ?case using AA' by auto + qed +qed + + +corollary HMA_bezout_iterate'[transfer_rule]: + fixes A'::"int ^ 'n :: mod_type ^ 'm :: mod_type" + assumes n: "n dim_row A" + using assms unfolding echelon_form_of_column_k_JNF_def by auto + + + +lemma HMA_echelon_form_of_column_k[transfer_rule]: + assumes k: "k rel_prod (Mod_Type_Connect.HMA_M :: _ \ int ^ 'n :: mod_type ^ 'm :: mod_type \ _) (\a b. a=b \ a\CARD('m)) + ===> (rel_prod (Mod_Type_Connect.HMA_M) (\a b. a=b \ a\CARD('m)))) + (\bezout A. echelon_form_of_column_k_JNF bezout A k) + (\bezout A. echelon_form_of_column_k bezout A k) + " +proof (intro rel_funI, goal_cases) + case (1 bezout bezout' xa ya ) + obtain A i where xa: "xa = (A,i)" using surjective_pairing by blast + obtain A' i' where ya: "ya = (A',i')" using surjective_pairing by blast + have ii'[transfer_rule]: "i=i'" using "1"(2) xa ya by auto + have i_le_m: "i\CARD('m)" using "1"(2) xa ya by auto + have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" using "1"(2) xa ya by auto + have bb'[transfer_rule]: "bezout=bezout'" using "1" by auto + let ?from_nat_rows = "mod_type_class.from_nat :: _ \ 'm" + let ?from_nat_cols = "mod_type_class.from_nat :: _ \ 'n" + have kk'[transfer_rule]: "Mod_Type_Connect.HMA_I k (?from_nat_cols k)" + by (simp add: Mod_Type_Connect.HMA_I_def assms mod_type_class.to_nat_from_nat_id) + have c1_eq: "(i = dim_row A) = (i = nrows A')" + by (metis AA' Mod_Type_Connect.dim_row_transfer_rule nrows_def) + have c2_eq: "(\m \ {i..m\?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0)" (is "?lhs = ?rhs") if i_not: "i\dim_row A" + proof + assume lhs: "?lhs" + show "?rhs" + proof (rule+) + fix m + assume im: "?from_nat_rows i \ m" + have im': "i ?m'" + by (simp add: to_nat_mono') + hence "?m' >= i" using im im' by (simp add: mod_type_class.to_nat_from_nat_id) + hence "?m' \ {i.. {i..?from_nat_rows i" + using AA' Mod_Type_Connect.dim_row_transfer_rule from_nat_mono' m by fastforce + hence "A' $h ?m $h ?from_nat_cols k = 0" using rhs by auto + moreover have "A $$ (m, k) = A' $h ?m $h ?from_nat_cols k" + unfolding index_hma_def[symmetric] by transfer_prover + ultimately show "A $$ (m, k) = 0" by simp + qed + qed + show ?case + proof (cases "(i = dim_row A) \ (\m \ {i..m\?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0) \ (i = nrows A')" + using c1_eq c2_eq by auto + have "echelon_form_of_column_k_JNF bezout xa k = (A,i)" + unfolding echelon_form_of_column_k_JNF_def using True xa by auto + moreover have "echelon_form_of_column_k bezout ya k = (A',i')" + unfolding echelon_form_of_column_k_def Let_def using * ya ii' by simp + ultimately show ?thesis unfolding xa ya rel_prod.simps using AA' ii' bb' i_le_m by blast + next + case False note not_c1 = False + hence im': "im\{i+1..m>?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0)" (is "?lhs = ?rhs") + proof + assume lhs: "?lhs" + show "?rhs" + proof (rule+) + fix m + assume im: "?from_nat_rows i < m" + let ?m' = "mod_type_class.to_nat m" + have mm'[transfer_rule]: "Mod_Type_Connect.HMA_I ?m' m" + by (simp add: Mod_Type_Connect.HMA_I_def) + from im have "mod_type_class.to_nat (?from_nat_rows i) < ?m'" + by (simp add: to_nat_mono) + hence "?m' > i" using im im' by (simp add: mod_type_class.to_nat_from_nat_id) + hence "?m' \ {i+1.. {i+1..?from_nat_rows i" + by (metis Mod_Type_Connect.HMA_I_def One_nat_def add_Suc_right atLeastLessThan_iff from_nat_mono + le_simps(3) m mm' mod_type_class.to_nat_less_card nat_arith.rule0) + hence "A' $h ?m $h ?from_nat_cols k = 0" using rhs by auto + moreover have "A $$ (m, k) = A' $h ?m $h ?from_nat_cols k" + unfolding index_hma_def[symmetric] by transfer_prover + ultimately show "A $$ (m, k) = 0" by simp + qed + qed + show ?thesis + proof (cases "(\m\{i+1.. (\m>?from_nat_rows i. A' $ m $ ?from_nat_cols k = 0)" using * by auto + have **: "\ ((\m\?from_nat_rows i. A' $h m $h ?from_nat_cols k = 0) \ i = nrows A')" + using c1_eq c2_eq not_c1 by auto + define n where "n=(LEAST n. A $$ (n,k) \ 0 \ i \ n)" + define n' where "n'=(LEAST n. A' $ n $ ?from_nat_cols k \ 0 \ ?from_nat_rows i \ n)" + let ?interchange_A = "swaprows i n A" + let ?interchange_A' = "interchange_rows A' (?from_nat_rows i') n'" + have nn'[transfer_rule]: "Mod_Type_Connect.HMA_I n n'" + proof - + let ?n' = "mod_type_class.to_nat n'" + have exist: "\n. A' $ n $ ?from_nat_cols k \ 0 \ ?from_nat_rows i \ n" + using * by auto + from this obtain a where c: "A' $ a $ ?from_nat_cols k \ 0 \ ?from_nat_rows i \ a" by blast + have "n = ?n'" + proof (unfold n_def, rule Least_equality) + have n'n'[transfer_rule]: "Mod_Type_Connect.HMA_I ?n' n'" + by (simp add: Mod_Type_Connect.HMA_I_def) + have e: "(A' $ n' $ ?from_nat_cols k \ 0 \ ?from_nat_rows i \ n')" + by (metis (mono_tags, lifting) LeastI c2_eq n'_def not_c1) + hence "i \ mod_type_class.to_nat n'" + using im' mod_type_class.from_nat_to_nat to_nat_mono' by fastforce + moreover have "A' $ n' $ ?from_nat_cols k = A $$ (?n', k)" + unfolding index_hma_def[symmetric] by (transfer', auto) + ultimately show "A $$ (?n', k) \ 0 \ i \ ?n'" + using e by auto + show " \y. A $$ (y, k) \ 0 \ i \ y \ mod_type_class.to_nat n' \ y" + by (smt AA' Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma\<^sub>m_def assms from_nat_mono + from_nat_mono' index_mat(1) linorder_not_less mod_type_class.from_nat_to_nat_id + mod_type_class.to_nat_less_card n'_def order.strict_trans prod.simps(2) wellorder_Least_lemma(2)) + qed + thus ?thesis unfolding Mod_Type_Connect.HMA_I_def by auto + qed + have dr1[transfer_rule]: "(nrows A' - 1) = (dim_row A - 1)" unfolding nrows_def + using AA' Mod_Type_Connect.dim_row_transfer_rule by force + have ii'2[transfer_rule]: "Mod_Type_Connect.HMA_I i (?from_nat_rows i')" + by (metis "**" Mod_Type_Connect.HMA_I_def i_le_m ii' le_neq_implies_less + mod_type_class.to_nat_from_nat_id nrows_def) + have ii'3[transfer_rule]: "Mod_Type_Connect.HMA_I i' (?from_nat_rows i')" + using ii' ii'2 by blast + let ?BI_JNF = "(bezout_iterate_JNF (?interchange_A) (dim_row A - 1) i k bezout)" + let ?BI_HA = "(bezout_iterate (?interchange_A') (nrows A' - 1) (?from_nat_rows i) (?from_nat_cols k) bezout)" + have e_rw: "echelon_form_of_column_k_JNF bezout xa k = (?BI_JNF,i+1)" + unfolding echelon_form_of_column_k_JNF_def n_def using False xa not_c1 by auto + have e_rw2: "echelon_form_of_column_k bezout ya k = (?BI_HA,i+1)" + unfolding echelon_form_of_column_k_def Let_def n'_def using * ya ** ii' by auto + have s[transfer_rule]: "Mod_Type_Connect.HMA_M (swaprows i' n A) (interchange_rows A' (?from_nat_rows i') n')" + by transfer_prover + have n_CARD: "(nrows A' - 1) < CARD('m)" unfolding nrows_def by auto + note a[transfer_rule] = HMA_bezout_iterate[OF n_CARD] + have BI[transfer_rule]:"Mod_Type_Connect.HMA_M ?BI_JNF ?BI_HA" unfolding ii' dr1 + by (rule HMA_bezout_iterate'[OF _ s ii'3 kk'], insert n_CARD, transfer', simp) + thus ?thesis using e_rw e_rw2 bb' + by (metis (mono_tags, lifting) AA' False Mod_Type_Connect.dim_row_transfer_rule + atLeastLessThan_iff dual_order.trans order_less_imp_le rel_prod_inject) + qed + qed +qed + +corollary HMA_echelon_form_of_column_k'[transfer_rule]: + assumes k: "kCARD('m)" + and "(Mod_Type_Connect.HMA_M :: _ \ int ^ 'n :: mod_type ^ 'm :: mod_type \ _) A A'" + shows "(rel_prod (Mod_Type_Connect.HMA_M) (\a b. a=b \ a\CARD('m))) + (echelon_form_of_column_k_JNF bezout (A,i) k) + (echelon_form_of_column_k bezout (A',i) k)" + using assms HMA_echelon_form_of_column_k[OF k] unfolding rel_fun_def by force + +lemma HMA_foldl_echelon_form_of_column_k: + assumes k: "k\CARD('n)" + shows "((Mod_Type_Connect.HMA_M :: _ \ int ^ 'n :: mod_type ^ 'm :: mod_type \ _) ===> (=) + ===> (rel_prod (Mod_Type_Connect.HMA_M) (\a b. a=b \ a\CARD('m)))) + (\A bezout. (foldl (echelon_form_of_column_k_JNF bezout) (A,0) [0..A bezout. (foldl (echelon_form_of_column_k bezout) (A,0) [0..a b. a=b \ a\CARD('m)) (?foldl_JNF [0.. int ^ 'n :: mod_type ^ 'm :: mod_type \ _) ===> (=) + ===> (Mod_Type_Connect.HMA_M)) + (\A bezout. echelon_form_of_upt_k_JNF A k bezout) + (\A bezout. echelon_form_of_upt_k A k bezout) + " +proof (intro rel_funI, goal_cases) + case (1 A A' bezout bezout') + have k': "Suc k \ CARD('n)" using k by auto + have rel_foldl: "(rel_prod (Mod_Type_Connect.HMA_M) (\a b. a=b \ a\CARD('m))) + (foldl (echelon_form_of_column_k_JNF bezout) (A,0) [0.. int ^ 'n :: mod_type ^ 'm :: mod_type \ _) ===> (=) + ===> (Mod_Type_Connect.HMA_M)) + (\A bezout. echelon_form_of_JNF A bezout) + (\A bezout. echelon_form_of A bezout) + " +proof (intro rel_funI, goal_cases) + case (1 A A' bezout bezout') + note AA'[transfer_rule] = 1(1) + note bb'[transfer_rule] = 1(2) + have *: "(dim_col A - 1) < CARD('n)" using 1 + using Mod_Type_Connect.dim_col_transfer_rule by force + note **[transfer_rule] = HMA_echelon_form_of_upt_k[OF *] + have [transfer_rule]: "(ncols A' - 1) = (dim_col A - 1)" + by (metis "1"(1) Mod_Type_Connect.dim_col_transfer_rule ncols_def) + have [transfer_rule]: "(dim_col A - 1) = (dim_col A - 1)" .. + show ?case unfolding echelon_form_of_def echelon_form_of_JNF_def bb' + by (metis (mono_tags) "**" "1"(1) \ncols A' - 1 = dim_col A - 1\ rel_fun_def) +qed +end + + +context +begin + +private lemma echelon_form_of_euclidean_invertible_mod_type: + fixes A::"int mat" + assumes "A \ carrier_mat CARD('m::mod_type) CARD('n::mod_type)" + shows "\P. invertible_mat P \ P \ carrier_mat (CARD('m::mod_type)) (CARD('m::mod_type)) + \ P * A = echelon_form_of_JNF A euclid_ext2 + \ echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)" +proof - + define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: int ^'n :: mod_type ^'m :: mod_type)" + have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" + unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto + have [transfer_rule]: "Mod_Type_Connect.HMA_M + (echelon_form_of_JNF A euclid_ext2) (echelon_form_of A' euclid_ext2)" + by transfer_prover + have "\P. invertible P \ P**A' = (echelon_form_of A' euclid_ext2) + \ echelon_form (echelon_form_of A' euclid_ext2)" + by (rule echelon_form_of_euclidean_invertible) + thus ?thesis by (transfer, auto) +qed + + +private lemma echelon_form_of_euclidean_invertible_nontriv_mod_ring: + fixes A::"int mat" + assumes "A \ carrier_mat CARD('m::nontriv mod_ring) CARD('n::nontriv mod_ring)" + shows "\P. invertible_mat P \ P \ carrier_mat (CARD('m)) (CARD('m)) + \ P * A = echelon_form_of_JNF A euclid_ext2 + \ echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)" + using assms echelon_form_of_euclidean_invertible_mod_type by (smt CARD_mod_ring) + +(*We internalize both sort constraints in one step*) +lemmas echelon_form_of_euclidean_invertible_nontriv_mod_ring_internalized = + echelon_form_of_euclidean_invertible_nontriv_mod_ring[unfolded CARD_mod_ring, + internalize_sort "'m::nontriv", internalize_sort "'b::nontriv"] + +context + fixes m::nat and n::nat + assumes local_typedef1: "\(Rep :: ('b \ int)) Abs. type_definition Rep Abs {0..(Rep :: ('c \ int)) Abs. type_definition Rep Abs {0..1" + and n: "n>1" +begin + +lemma echelon_form_of_euclidean_invertible_nontriv_mod_ring_aux: + fixes A::"int mat" + assumes "A \ carrier_mat m n" + shows "\P. invertible_mat P \ P \ carrier_mat m m + \ P * A = echelon_form_of_JNF A euclid_ext2 + \ echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)" + using echelon_form_of_euclidean_invertible_nontriv_mod_ring_internalized + [OF type_to_set2(1)[OF local_typedef1 local_typedef2] + type_to_set1(1)[OF local_typedef1 local_typedef2]] + using assms + using type_to_set1(2) local_typedef1 local_typedef2 n m by metis + +end + + +(*Canceling the first local type definitions*) +context +begin + +(*Canceling the first*) + +private lemma echelon_form_of_euclidean_invertible_cancelled_first: +"\Rep Abs. type_definition Rep Abs {0.. 1 < m \ 1 < n \ + A \ carrier_mat m n \ \P. invertible_mat P \ P \ carrier_mat m m + \ P * (A::int mat) = echelon_form_of_JNF A euclid_ext2 \ echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)" + using echelon_form_of_euclidean_invertible_nontriv_mod_ring_aux[cancel_type_definition, of m n A] + by force + +(*Canceling the second*) +private lemma echelon_form_of_euclidean_invertible_cancelled_both: +"1 < m \ 1 < n \ A \ carrier_mat m n \ \P. invertible_mat P \ P \ carrier_mat m m + \ P * (A::int mat) = echelon_form_of_JNF A euclid_ext2 \ echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)" + using echelon_form_of_euclidean_invertible_cancelled_first[cancel_type_definition, of n m A] + by force + +(*The final result in JNF*) + +lemma echelon_form_of_euclidean_invertible': + fixes A::"int mat" + assumes "A \ carrier_mat m n" + and "1 < m" and "1 < n" (*Required from the mod_type restrictions*) + shows "\P. invertible_mat P \ + P \ carrier_mat m m \ P * A = echelon_form_of_JNF A euclid_ext2 + \ echelon_form_JNF (echelon_form_of_JNF A euclid_ext2)" + using echelon_form_of_euclidean_invertible_cancelled_both assms by auto +end +end + +context mod_operation +begin + +definition "FindPreHNF_rectangular A + = (let m = dim_row A; n = dim_col A in + if m < 2 \ n = 0 then A else \ \ No operations are carried out if m = 1 \ + if n = 1 then + let non_zero_positions = filter (\i. A $$ (i,0) \ 0) [1.. 0 then A else let i = non_zero_positions ! 0 in swaprows 0 i A) + in reduce_below_impl 0 non_zero_positions 0 A' + else (echelon_form_of_JNF A euclid_ext2))" + +text \This is the (non-efficient) HNF algorithm obtained from the echelon form and Hermite normal +form AFP entries\ + +definition "HNF_algorithm_from_HA A + = Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..<(dim_row A)]" + +(* + Now we can combine FindPreHNF_rectangular, FindPreHNF and Hermite_of_list_of_rows to get + an algorithm to compute the HNF of any matrix (if it is square and invertible, then the HNF is + computed reducing entries modulo D) +*) + +text \Now we can combine @{text"FindPreHNF_rectangular"}, @{text"FindPreHNF"} + and @{text"Hermite_of_list_of_rows"} to get an algorithm to compute the HNF of any matrix + (if it is square and invertible, then the HNF is computed reducing entries modulo D)\ + +definition "HNF_algorithm abs_flag A = + (let m = dim_row A; n = dim_col A in + if m \ n then Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..r D \\<^sub>m 1\<^sub>m n; + E = FindPreHNF abs_flag D A'; + H = Hermite_of_list_of_rows E [0.. carrier_mat m n" + shows "\P. invertible_mat P \ P \ carrier_mat m m \ P * A = FindPreHNF_rectangular A + \ echelon_form_JNF (FindPreHNF_rectangular A)" +proof (cases "m < 2 \ n = 0") + case True + then show ?thesis + by (smt A FindPreHNF_rectangular_def carrier_matD echelon_form_JNF_1xn echelon_form_mx0 + invertible_mat_one left_mult_one_mat one_carrier_mat) +next + case False + have m1: "m>1" using False by auto + have n0: "n>0" using False by auto + show ?thesis + proof (cases "n=1") + case True note n1 = True + let ?nz = "filter (\i. A $$ (i,0) \ 0) [1.. carrier_mat m n" using A by auto + have A'00: "?A' $$ (0,0) \ 0" if "?nz \ []" + by (smt True assms carrier_matD index_mat_swaprows(1) length_greater_0_conv m1 + mem_Collect_eq nat_SN.gt_trans nth_mem set_filter that zero_less_one_class.zero_less_one) + have e_r: "echelon_form_JNF (reduce_below 0 ?nz 0 ?A')" if nz_not_empty: "?nz \ []" + proof (rule echelon_form_JNF_mx1) + show "(reduce_below 0 ?nz 0 ?A') \ carrier_mat m n" using A reduce_below by auto + have "(reduce_below 0 ?nz 0 ?A') $$ (i,0) = 0" if i: "i \ {1.. set ?nz") + case True + show ?thesis + by (rule reduce_below_0_D0[OF A' _ _ A'00 True], insert m1 n0 True A nz_not_empty, auto) + next + case False + have "(reduce_below 0 ?nz 0 ?A') $$ (i,0) = ?A' $$ (i,0)" + by (rule reduce_below_preserves_D0[OF A' _ _ A'00 False], insert m1 n0 True A i nz_not_empty, auto) + also have "... = 0" using False n1 assms that by auto + finally show ?thesis . + qed + thus "\i \ {1..P. invertible_mat P \ P \ carrier_mat m m \ reduce_below 0 ?nz 0 ?A' = P * ?A'" + by (rule reduce_below_invertible_mat_D0[OF A'], insert m1 n0 True A, auto) + moreover have "\P. invertible_mat P \ P \ carrier_mat m m \ ?A' = P * A" if "?nz \ []" + using A A'_swaprows_invertible_mat m1 that by blast + ultimately have e_inv: "\P. invertible_mat P \ P \ carrier_mat m m \ reduce_below 0 ?nz 0 ?A' = P * A" + if "?nz \ []" + by (smt that A assoc_mult_mat invertible_mult_JNF mult_carrier_mat) + have e_r1: "echelon_form_JNF A" if nz_empty: "?nz = []" + proof (rule echelon_form_JNF_mx1[OF A]) + show "\i\{1..P. invertible_mat P \ P \ carrier_mat m m \ A = P * A" + by (metis A invertible_mat_one left_mult_one_mat one_carrier_mat) + have "FindPreHNF_rectangular A = (if ?nz = [] then A else reduce_below_impl 0 ?nz 0 ?A')" + unfolding FindPreHNF_rectangular_def Let_def using m1 n1 A True by auto + also have "reduce_below_impl 0 ?nz 0 ?A' = reduce_below 0 ?nz 0 ?A'" + by (rule reduce_below_impl[OF _ _ _ _ A'], insert m1 n0 A, auto) + finally show ?thesis using e_inv e_r e_r1 e_inv1 by metis + next + case False + have f_rw: "FindPreHNF_rectangular A = echelon_form_of_JNF A euclid_ext2" + unfolding FindPreHNF_rectangular_def Let_def using m1 n0 A False by auto + show ?thesis unfolding f_rw + by (rule echelon_form_of_euclidean_invertible'[OF A], insert False n0 m1, auto) + qed +qed + +lemma HNF_algorithm_from_HA_soundness: + assumes A: "A \ carrier_mat m n" + shows "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (HNF_algorithm_from_HA A) + \ (\P. P \ carrier_mat m m \ invertible_mat P \ (HNF_algorithm_from_HA A) = P * A)" +proof - + have m: "dim_row A = m" using A by auto + have "(\P. P \ carrier_mat m m \ invertible_mat P \ (HNF_algorithm_from_HA A) = P * (FindPreHNF_rectangular A))" + unfolding HNF_algorithm_from_HA_def m + proof (rule invertible_Hermite_of_list_of_rows) + show "FindPreHNF_rectangular A \ carrier_mat m n" + by (smt A FindPreHNF_rectangular_soundness mult_carrier_mat) + show "echelon_form_JNF (FindPreHNF_rectangular A)" + using FindPreHNF_rectangular_soundness by blast + qed + moreover have "(\P. P \ carrier_mat m m \ invertible_mat P \ (FindPreHNF_rectangular A) = P * A)" + by (metis A FindPreHNF_rectangular_soundness) + ultimately have "(\P. P \ carrier_mat m m \ invertible_mat P \ (HNF_algorithm_from_HA A) = P * A)" + by (smt assms assoc_mult_mat invertible_mult_JNF mult_carrier_mat) + moreover have "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (HNF_algorithm_from_HA A)" + by (metis A FindPreHNF_rectangular_soundness HNF_algorithm_from_HA_def m + Hermite_Hermite_of_list_of_rows mult_carrier_mat) + ultimately show ?thesis by simp +qed + + +text \Soundness theorem for any matrix\ +lemma HNF_algorithm_soundness: + assumes A: "A \ carrier_mat m n" + shows "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (HNF_algorithm abs_flag A) + \ (\P. P \ carrier_mat m m \ invertible_mat P \ (HNF_algorithm abs_flag A) = P * A)" +proof (cases "m\n \ Determinant.det A = 0") + case True + have H_rw: "HNF_algorithm abs_flag A = Hermite_of_list_of_rows (FindPreHNF_rectangular A) [0..P. P \ carrier_mat m m \ invertible_mat P \ (HNF_algorithm abs_flag A) = P * (FindPreHNF_rectangular A))" + unfolding H_rw + proof (rule invertible_Hermite_of_list_of_rows) + show "FindPreHNF_rectangular A \ carrier_mat m n" + by (smt A FindPreHNF_rectangular_soundness mult_carrier_mat) + show "echelon_form_JNF (FindPreHNF_rectangular A)" + using FindPreHNF_rectangular_soundness by blast + qed + moreover have "(\P. P \ carrier_mat m m \ invertible_mat P \ (FindPreHNF_rectangular A) = P * A)" + by (metis A FindPreHNF_rectangular_soundness) + ultimately have "(\P. P \ carrier_mat m m \ invertible_mat P \ (HNF_algorithm abs_flag A) = P * A)" + by (smt assms assoc_mult_mat invertible_mult_JNF mult_carrier_mat) + moreover have "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (HNF_algorithm abs_flag A)" + by (metis A FindPreHNF_rectangular_soundness H_rw Hermite_Hermite_of_list_of_rows mult_carrier_mat) + ultimately show ?thesis by simp +next + case False + hence mn: "m=n" and det_A_not0:"(Determinant.det A) \ 0" by auto + have inv_RAT_A: "invertible_mat (map_mat rat_of_int A)" + proof - + have "det (map_mat rat_of_int A) \ 0" using det_A_not0 by auto + thus ?thesis + by (metis False assms dvd_field_iff invertible_iff_is_unit_JNF map_carrier_mat) + qed + have "HNF_algorithm abs_flag A = Hermite_mod_det abs_flag A" + unfolding HNF_algorithm_def Hermite_mod_det_def Let_def using False A by simp + then show ?thesis using Hermite_mod_det_soundness[OF mn A inv_RAT_A] by auto +qed +end + + +text \New predicate of soundness of a HNF algorithm, without providing explicitly the transformation matrix.\ + +definition "is_sound_HNF' algorithm associates res + = (\A. let H = algorithm A; m = dim_row A; n = dim_col A in Hermite_JNF associates res H + \ H \ carrier_mat m n \ (\P. P \ carrier_mat m m \ invertible_mat P \ A = P * H))" + +lemma is_sound_HNF_conv: + assumes s: "is_sound_HNF' algorithm associates res" + shows "is_sound_HNF (\A. let H = algorithm A in (SOME P. P \ carrier_mat (dim_row A) (dim_row A) + \ invertible_mat P \ A = P * H, H)) associates res" +proof (unfold is_sound_HNF_def Let_def prod.case, rule allI) + fix A::"'a mat" + define m where "m = dim_row A" + obtain P where P: "P \ carrier_mat m m \ invertible_mat P \ A = P * (algorithm A)" + using s unfolding is_sound_HNF'_def Let_def m_def by auto + let ?some_P = "(SOME P. P \ carrier_mat m m \ invertible_mat P \ A = P * algorithm A)" + have some_P: "?some_P \ carrier_mat m m \ invertible_mat ?some_P \ A = ?some_P * algorithm A" + by (smt P verit_sko_ex_indirect) + moreover have "algorithm A \ carrier_mat (dim_row A) (dim_col A)" + and "Hermite_JNF associates res (algorithm A)" using s unfolding is_sound_HNF'_def Let_def by auto + ultimately show "?some_P \ carrier_mat m m \ algorithm A \ carrier_mat m (dim_col A) + \ invertible_mat ?some_P \ A = ?some_P * algorithm A \ Hermite_JNF associates res (algorithm A)" + unfolding is_sound_HNF_def Let_def m_def by (auto split: prod.split) +qed + +context proper_mod_operation +begin +corollary is_sound_HNF'_HNF_algorithm: + "is_sound_HNF' (HNF_algorithm abs_flag) (range ass_function_euclidean) (\c. range (res_int c))" +proof - + have "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (HNF_algorithm abs_flag A)" for A + using HNF_algorithm_soundness by blast + moreover have "HNF_algorithm abs_flag A \ carrier_mat (dim_row A) (dim_col A)" for A + by (metis HNF_algorithm_soundness carrier_matI mult_carrier_mat) + moreover have "\P. P \ carrier_mat (dim_row A) (dim_row A) \ invertible_mat P \ A = P * HNF_algorithm abs_flag A" for A + proof - + have "\P. P \ carrier_mat (dim_row A) (dim_row A) \ invertible_mat P \ HNF_algorithm abs_flag A = P * A" + using HNF_algorithm_soundness by blast + from this obtain P where P: "P \ carrier_mat (dim_row A) (dim_row A)" and inv_P: "invertible_mat P" + and H_PA: "HNF_algorithm abs_flag A = P * A" by blast + obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P" + using inv_P unfolding invertible_mat_def by auto + have P': "P' \ carrier_mat (dim_row A) (dim_row A) " + by (metis P PP' P'P carrier_matD carrier_mat_triv index_mult_mat(3) index_one_mat(3) inverts_mat_def) + moreover have inv_P': "invertible_mat P'" + by (metis P' P'P PP' carrier_matD(1) carrier_matD(2) invertible_mat_def square_mat.simps) + moreover have "A = P' * HNF_algorithm abs_flag A" + by (smt H_PA P P'P assoc_mult_mat calculation(1) carrier_matD(1) carrier_matI inverts_mat_def left_mult_one_mat') + ultimately show ?thesis by auto + qed + ultimately show ?thesis + unfolding is_sound_HNF'_def Let_def by auto +qed + + +corollary is_sound_HNF'_HNF_algorithm_from_HA: + "is_sound_HNF' (HNF_algorithm_from_HA) (range ass_function_euclidean) (\c. range (res_int c))" +proof - + have "Hermite_JNF (range ass_function_euclidean) (\c. range (res_int c)) (HNF_algorithm_from_HA A)" for A + using HNF_algorithm_from_HA_soundness by blast + moreover have "HNF_algorithm_from_HA A \ carrier_mat (dim_row A) (dim_col A)" for A + by (metis HNF_algorithm_from_HA_soundness carrier_matI mult_carrier_mat) + moreover have "\P. P \ carrier_mat (dim_row A) (dim_row A) \ invertible_mat P \ A = P * HNF_algorithm_from_HA A" for A + proof - + have "\P. P \ carrier_mat (dim_row A) (dim_row A) \ invertible_mat P \ HNF_algorithm_from_HA A = P * A" + using HNF_algorithm_from_HA_soundness by blast + from this obtain P where P: "P \ carrier_mat (dim_row A) (dim_row A)" and inv_P: "invertible_mat P" + and H_PA: "HNF_algorithm_from_HA A = P * A" by blast + obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P" + using inv_P unfolding invertible_mat_def by auto + have P': "P' \ carrier_mat (dim_row A) (dim_row A) " + by (metis P PP' P'P carrier_matD carrier_mat_triv index_mult_mat(3) index_one_mat(3) inverts_mat_def) + moreover have inv_P': "invertible_mat P'" + by (metis P' P'P PP' carrier_matD(1) carrier_matD(2) invertible_mat_def square_mat.simps) + moreover have "A = P' * HNF_algorithm_from_HA A" + by (smt H_PA P P'P assoc_mult_mat calculation(1) carrier_matD(1) carrier_matI inverts_mat_def left_mult_one_mat') + ultimately show ?thesis by auto + qed + ultimately show ?thesis + unfolding is_sound_HNF'_def Let_def by auto +qed +end + +text \Some work to make the algorithm executable\ + +definition find_non0' :: "nat \ nat \ 'a::comm_ring_1 mat \ nat option" where + "find_non0' i k A = (let is = [i ..< dim_row A]; + Ais = filter (\j. A $$ (j, k) \ 0) is + in case Ais of [] \ None | _ \ Some (Ais!0))" + +lemma find_non0': + assumes A: "A \ carrier_mat m n" + and res: "find_non0' i k A = Some j" + shows "A $$ (j,k) \ 0" "i \ j" "j < dim_row A" +proof - + let ?xs = "filter (\j. A $$ (j,k) \ 0) [i ..< dim_row A]" + from res[unfolded find_non0'_def Let_def] + have xs: "?xs \ []" by (cases ?xs, auto) + have j_in_xs: "j \ set ?xs" using res unfolding find_non0'_def Let_def + by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs) + show "A $$ (j,k) \ 0" "i \ j" "j < dim_row A" using j_in_xs by auto+ +qed + + +lemma find_non0'_w_zero_before: + assumes A: "A \ carrier_mat m n" + and res: "find_non0' i k A = Some j" + shows "\j'\{i.. []" by (cases ?xs, auto) + have j_in_xs: "j \ set ?xs" using res unfolding find_non0'_def Let_def + by (metis (no_types, lifting) length_greater_0_conv list.case(2) list.exhaust nth_mem option.simps(1) xs) + have j_xs0: "j = ?xs ! 0" + by (smt res[unfolded find_non0'_def Let_def] list.case(2) list.exhaust option.inject xs) + show "\j'\{i.. 0" + have j'j: "j' set ?xs" + by (metis (mono_tags, lifting) A Alj' Set.member_filter atLeastLessThan_iff filter_set + find_non0'(3) j' nat_SN.gt_trans res set_upt) + have l_rw: "[i..j. A $$ (j,k) \ 0) ([i ..j. A $$ (j,k) \ 0) [i .. carrier_mat m n" + and res: "find_non0' i k A = Some j" +shows "j = (LEAST n. A $$ (n,k) \ 0 \ i\n)" +proof (rule Least_equality[symmetric]) + show " A $$ (j, k) \ 0 \ i \ j" + using A res find_non0'[OF A] by auto + show " \y. A $$ (y, k) \ 0 \ i \ y \ j \ y" + by (meson A res atLeastLessThan_iff find_non0'_w_zero_before linorder_not_le) +qed + +lemma echelon_form_of_column_k_JNF_code[code]: + "echelon_form_of_column_k_JNF bezout (A,i) k = + (if (i = dim_row A) \ (\m \ {i..m\{i+1.. ((i = dim_row A) \ (\m \ {i.. \ (\m\{i+1.. 0 \ i \ n)" + proof (rule find_non0'_LEAST) + have "find_non0' i k A \ None" using True unfolding find_non0'_def Let_def + by (auto split: list.split) + (metis (mono_tags, lifting) atLeastLessThan_iff atLeastLessThan_upt empty_filter_conv) + thus "find_non0' i k A = Some (the (find_non0' i k A))" by auto + qed (auto) + show ?thesis unfolding echelon_form_of_column_k_JNF_def Let_def f_rw using True by auto +next + case False + then show ?thesis unfolding echelon_form_of_column_k_JNF_def by auto +qed + + +subsection \Instantiation of the HNF-algorithm with modulo-operation\ + +text \We currently use a Boolean flag to indicate whether standard-mod or symmetric modulo + should be used.\ + +lemma sym_mod: "proper_mod_operation sym_mod sym_div" + by (unfold_locales, auto simp: sym_mod_sym_div) + +lemma standard_mod: "proper_mod_operation (mod) (div)" + by (unfold_locales, auto, intro HOL.nitpick_unfold(7)) + +definition HNF_algorithm :: "bool \ int mat \ int mat" where + "HNF_algorithm use_sym_mod = (if use_sym_mod + then mod_operation.HNF_algorithm sym_mod False else mod_operation.HNF_algorithm (mod) True)" + +definition HNF_algorithm_from_HA :: "bool \ int mat \ int mat" where + "HNF_algorithm_from_HA use_sym_mod = (if use_sym_mod + then mod_operation.HNF_algorithm_from_HA sym_mod else mod_operation.HNF_algorithm_from_HA (mod))" + + +corollary is_sound_HNF'_HNF_algorithm: + "is_sound_HNF' (HNF_algorithm use_sym_mod) (range ass_function_euclidean) (\c. range (res_int c))" + using proper_mod_operation.is_sound_HNF'_HNF_algorithm[OF sym_mod] + proper_mod_operation.is_sound_HNF'_HNF_algorithm[OF standard_mod] + unfolding HNF_algorithm_def by (cases use_sym_mod, auto) + +corollary is_sound_HNF'_HNF_algorithm_from_HA: + "is_sound_HNF' (HNF_algorithm_from_HA use_sym_mod) (range ass_function_euclidean) (\c. range (res_int c))" + using proper_mod_operation.is_sound_HNF'_HNF_algorithm_from_HA[OF sym_mod] + proper_mod_operation.is_sound_HNF'_HNF_algorithm_from_HA[OF standard_mod] + unfolding HNF_algorithm_from_HA_def by (cases use_sym_mod, auto) + + +(*Examples:*) +(*Rectangular matrix (6x4)*) +value [code]"let A = mat_of_rows_list 4 ( + [[0,3,1,4], + [7,1,0,0], + [8,0,19,16], + [2,0,0,3::int], + [9,-3,2,5], + [6,3,2,4]]) in + show (HNF_algorithm True A)" + +(*Rectangular matrix (4x6)*) + +value [code]"let A = mat_of_rows_list 6 ( + [[0,3,1,4,8,7], + [7,1,0,0,4,1], + [8,0,19,16,33,5], + [2,0,0,3::int,-5,8]]) in + show (HNF_algorithm False A)" + +(*Singular matrix*) +value [code]"let A = mat_of_rows_list 6 ( + [[0,3,1,4,8,7], + [7,1,0,0,4,1], + [8,0,19,16,33,5], + [0,3,1,4,8,7], + [2,0,0,3::int,-5,8], + [2,4,6,8,10,12]]) in + show (Determinant.det A, HNF_algorithm True A)" + +(*Invertible matrix*) +value [code]"let A = mat_of_rows_list 6 ( + [[0,3,1,4,8,7], + [7,1,0,0,4,1], + [8,0,19,16,33,5], + [5,6,1,2,8,7], + [2,0,0,3::int,-5,8], + [2,4,6,8,10,12]]) in + show (Determinant.det A, HNF_algorithm True A)" + +end \ No newline at end of file diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/LLL_Certification_via_HNF.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/LLL_Certification_via_HNF.thy new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/LLL_Certification_via_HNF.thy @@ -0,0 +1,424 @@ +section \LLL certification via Hermite normal forms\ + +text \In this file, we define the new certified approach and prove its soundness.\ + +theory LLL_Certification_via_HNF + imports + LLL_Basis_Reduction.LLL_Certification + Jordan_Normal_Form.DL_Rank + HNF_Mod_Det_Soundness +begin + + +context LLL_with_assms +begin + +lemma m_le_n: "m\n" +proof - + have "gs.lin_indpt (set (RAT fs_init))" + using cof_vec_space.lin_indpt_list_def lin_dep by blast + moreover have "gs.dim = n" + by (simp add: gs.dim_is_n) + moreover have "card (set (RAT fs_init)) = m" + using LLL_invD(2) LLL_inv_initial_state cof_vec_space.lin_indpt_list_def distinct_card lin_dep + by blast + ultimately show ?thesis using gs.li_le_dim + by (metis cof_vec_space.lin_indpt_list_def gs.fin_dim lin_dep) +qed + +end + +text \This lemma is a generalization of the theorem named @{text "HNF_A_eq_HNF_PA"}, using +the new uniqueness statement of the HNF. We provide two versions, one +assuming the existence and the other one obtained from a sound algorithm.\ + +lemma HNF_A_eq_HNF_PA'_exist: + fixes A::"int mat" + assumes A: "A \ carrier_mat n n" and inv_A: "invertible_mat (map_mat rat_of_int A)" + and inv_P: "invertible_mat P" and P: "P \ carrier_mat n n" + and HNF_H1: "Hermite_JNF associates res H1" + and H1: "H1 \ carrier_mat n n" + and HNF_H2: "Hermite_JNF associates res H2" + and H2: "H2 \ carrier_mat n n" + and sound_HNF1: "\P1. P1 \ carrier_mat n n \ invertible_mat P1 \ (P * A) = P1 * H1" + and sound_HNF2: "\P2. P2 \ carrier_mat n n \ invertible_mat P2 \ A = P2 * H2" + shows "H1 = H2" +proof - + obtain inv_P where P_inv_P: "inverts_mat P inv_P" and inv_P_P: "inverts_mat inv_P P" + and inv_P: "inv_P \ carrier_mat n n" + using P inv_P obtain_inverse_matrix by blast + obtain P1 where P1: "P1 \ carrier_mat n n" and inv_P1: "invertible_mat P1" and P1_H1: "P* A = P1 * H1" + using sound_HNF1 by auto + obtain P2 where P2: "P2 \ carrier_mat n n" and inv_P2: "invertible_mat P2" and P2_H2: "A = P2 * H2" + using sound_HNF2 by auto + have invertible_inv_P: "invertible_mat inv_P" + using P_inv_P inv_P inv_P_P invertible_mat_def square_mat.simps by blast + have P_A_P1_H1: "P * A = P1 * H1" using P1_H1 P2_H2 unfolding is_sound_HNF_def Let_def + by (metis (mono_tags, lifting) case_prod_conv) + hence "A = inv_P * (P1 * H1)" + by (smt A P inv_P_P inv_P assoc_mult_mat carrier_matD(1) inverts_mat_def left_mult_one_mat) + hence A_inv_P_P1_H1: "A = (inv_P * P1) * H1" using P P1_H1 assoc_mult_mat inv_P H1 P1 by auto + have invertible_inv_P_P1: "invertible_mat (inv_P * P1)" + by (rule invertible_mult_JNF[OF inv_P P1 invertible_inv_P inv_P1]) + show ?thesis + proof (rule HNF_unique_generalized_JNF[OF A _ H1 P2 H2 A_inv_P_P1_H1 P2_H2 + inv_A invertible_inv_P_P1 inv_P2 HNF_H1 HNF_H2]) + show "inv_P * P1 \ carrier_mat n n" + by (metis carrier_matD(1) carrier_matI index_mult_mat(2) inv_P + invertible_inv_P_P1 invertible_mat_def square_mat.simps) + qed +qed + + +corollary HNF_A_eq_HNF_PA': + fixes A::"int mat" + assumes A: "A \ carrier_mat n n" and inv_A: "invertible_mat (map_mat rat_of_int A)" + and inv_P: "invertible_mat P" and P: "P \ carrier_mat n n" + and sound_HNF: "is_sound_HNF HNF associates res" + and P1_H1: "(P1,H1) = HNF (P*A)" + and P2_H2: "(P2,H2) = HNF A" + shows "H1 = H2" +proof - + have H1: "H1 \ carrier_mat n n" + by (smt P1_H1 A P carrier_matD index_mult_mat is_sound_HNF_def prod.sel(2) sound_HNF split_beta) + have H2: "H2 \ carrier_mat n n" + by (smt P2_H2 A carrier_matD index_mult_mat is_sound_HNF_def prod.sel(2) sound_HNF split_beta) + have HNF_H1: "Hermite_JNF associates res H1" + by (smt P1_H1 is_sound_HNF_def prod.sel(2) sound_HNF split_beta) + have HNF_H2: "Hermite_JNF associates res H2" + by (smt P2_H2 is_sound_HNF_def prod.sel(2) sound_HNF split_beta) + have sound_HNF1: "\P1. P1 \ carrier_mat n n \ invertible_mat P1 \ (P * A) = P1 * H1" + using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def + by (metis (mono_tags, lifting) P carrier_matD(1) index_mult_mat(2) old.prod.simps(2)) + have sound_HNF2: "\P2. P2 \ carrier_mat n n \ invertible_mat P2 \ A = P2 * H2" + using sound_HNF P1_H1 unfolding is_sound_HNF_def Let_def + by (metis (mono_tags, lifting) A P2_H2 carrier_matD(1) old.prod.simps(2)) + show ?thesis + by (rule HNF_A_eq_HNF_PA'_exist[OF A inv_A inv_P P HNF_H1 H1 HNF_H2 H2 sound_HNF1 sound_HNF2]) +qed + + +context LLL_with_assms +begin + + +lemma certification_via_eq_HNF2_exist: + assumes HNF_H1: "Hermite_JNF associates res H1" + and H1: "H1 \ carrier_mat n n" + and HNF_H2: "Hermite_JNF associates res H2" + and H2: "H2 \ carrier_mat n n" + and sound_HNF1: "\P1. P1 \ carrier_mat n n \ invertible_mat P1 \ (mat_of_rows n fs_init) = P1 * H1" + and sound_HNF2: "\P2. P2 \ carrier_mat n n \ invertible_mat P2 \ (mat_of_rows n gs) = P2 * H2" + and gs: "set gs \ carrier_vec n" + and l: "lattice_of fs_init = lattice_of gs" + and mn: "m = n" and len_gs: "length gs = n" (*For the moment, only for square matrices*) + shows "H1 = H2" +proof - + have "\P \ carrier_mat n n. invertible_mat P \ mat_of_rows n fs_init = P * mat_of_rows n gs" + by (rule eq_lattice_imp_mat_mult_invertible_rows[OF fs_init gs lin_dep len[unfolded mn] len_gs l]) + from this obtain P where P: "P \ carrier_mat n n" and inv_P: "invertible_mat P" + and fs_P_gs: "mat_of_rows n fs_init = P * mat_of_rows n gs" by auto + obtain P1 where P1: "P1 \ carrier_mat n n" and inv_P1: "invertible_mat P1" and P1_H1: "(mat_of_rows n fs_init) = P1 * H1" + using sound_HNF1 by auto + obtain P2 where P2: "P2 \ carrier_mat n n" and inv_P2: "invertible_mat P2" and P2_H2: "(mat_of_rows n gs) = P2 * H2" + using sound_HNF2 by auto + have P1_H1_2: "P * mat_of_rows n gs = P1 * H1" + using P1_H1 fs_P_gs by auto + have gs_carrier: "mat_of_rows n gs \ carrier_mat n n" by (simp add: len_gs carrier_matI) + show ?thesis + proof (rule HNF_A_eq_HNF_PA'_exist[OF gs_carrier _ inv_P P HNF_H1 H1 HNF_H2 H2 _ sound_HNF2]) + from inv_P obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P" + using invertible_mat_def by blast + let ?RAT = "of_int_hom.mat_hom :: int mat \ rat mat" + have det_RAT_fs_init: "det (?RAT (mat_of_rows n fs_init)) \ 0" + proof (rule gs.lin_indpt_rows_imp_det_not_0) + show "?RAT (mat_of_rows n fs_init) \ carrier_mat n n" + using len map_carrier_mat mat_of_rows_carrier(1) mn by blast + have rw: "Matrix.rows (?RAT (mat_of_rows n fs_init)) = RAT fs_init" + by (metis cof_vec_space.lin_indpt_list_def fs_init lin_dep mat_of_rows_map rows_mat_of_rows) + thus "gs.lin_indpt (set (Matrix.rows (?RAT (mat_of_rows n fs_init))))" + by (insert lin_dep, simp add: cof_vec_space.lin_indpt_list_def) + show "distinct (Matrix.rows (?RAT (mat_of_rows n fs_init)))" + using rw cof_vec_space.lin_indpt_list_def lin_dep by auto + qed + hence d: "det (?RAT (mat_of_rows n fs_init)) dvd 1" using dvd_field_iff by blast + hence inv_RAT_fs_init: "invertible_mat (?RAT (mat_of_rows n fs_init))" + using invertible_iff_is_unit_JNF by (metis mn len map_carrier_mat mat_of_rows_carrier(1)) + have "invertible_mat (?RAT P)" + by (metis P dvd_field_iff inv_P invertible_iff_is_unit_JNF map_carrier_mat + not_is_unit_0 of_int_hom.hom_0 of_int_hom.hom_det) + have "det (?RAT (mat_of_rows n fs_init)) = det (?RAT P) * det (?RAT (mat_of_rows n gs))" + by (metis Determinant.det_mult P fs_P_gs gs_carrier of_int_hom.hom_det of_int_hom.hom_mult) + hence "det (?RAT (mat_of_rows n gs)) \ 0" using d by auto + thus "invertible_mat (?RAT (mat_of_rows n gs))" + by (meson dvd_field_iff gs_carrier invertible_iff_is_unit_JNF map_carrier_mat) + show "\P1. P1 \ carrier_mat n n \ invertible_mat P1 \ P * mat_of_rows n gs = P1 * H1" + using P1 P1_H1_2 inv_P1 by blast + qed +qed + +lemma certification_via_eq_HNF2: + assumes sound_HNF: "is_sound_HNF HNF associates res" + and P1_H1: "(P1,H1) = HNF (mat_of_rows n fs_init)" + and P2_H2: "(P2,H2) = HNF (mat_of_rows n gs)" + and gs: "set gs \ carrier_vec n" + and l: "lattice_of fs_init = lattice_of gs" + and mn: "m = n" and len_gs: "length gs = n" (*For the moment, only for square matrices*) + shows "H1 = H2" +proof - + have "\P \ carrier_mat n n. invertible_mat P \ mat_of_rows n fs_init = P * mat_of_rows n gs" + by (rule eq_lattice_imp_mat_mult_invertible_rows[OF fs_init gs lin_dep len[unfolded mn] len_gs l]) + from this obtain P where P: "P \ carrier_mat n n" and inv_P: "invertible_mat P" + and fs_P_gs: "mat_of_rows n fs_init = P * mat_of_rows n gs" by auto + have P1_H1_2: "(P1,H1) = HNF (P * mat_of_rows n gs)" using fs_P_gs P1_H1 by auto + have gs_carrier: "mat_of_rows n gs \ carrier_mat n n" by (simp add: len_gs carrier_matI) + show ?thesis + proof (rule HNF_A_eq_HNF_PA'[OF gs_carrier _ inv_P P sound_HNF P1_H1_2 P2_H2]) + from inv_P obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P" + using invertible_mat_def by blast + let ?RAT = "of_int_hom.mat_hom :: int mat \ rat mat" + have det_RAT_fs_init: "det (?RAT (mat_of_rows n fs_init)) \ 0" + proof (rule gs.lin_indpt_rows_imp_det_not_0) + show "?RAT (mat_of_rows n fs_init) \ carrier_mat n n" + using len map_carrier_mat mat_of_rows_carrier(1) mn by blast + have rw: "Matrix.rows (?RAT (mat_of_rows n fs_init)) = RAT fs_init" + by (metis cof_vec_space.lin_indpt_list_def fs_init lin_dep mat_of_rows_map rows_mat_of_rows) + thus "gs.lin_indpt (set (Matrix.rows (?RAT (mat_of_rows n fs_init))))" + by (insert lin_dep, simp add: cof_vec_space.lin_indpt_list_def) + show "distinct (Matrix.rows (?RAT (mat_of_rows n fs_init)))" + using rw cof_vec_space.lin_indpt_list_def lin_dep by auto + qed + hence d: "det (?RAT (mat_of_rows n fs_init)) dvd 1" using dvd_field_iff by blast + hence inv_RAT_fs_init: "invertible_mat (?RAT (mat_of_rows n fs_init))" + using invertible_iff_is_unit_JNF by (metis mn len map_carrier_mat mat_of_rows_carrier(1)) + have "invertible_mat (?RAT P)" + by (metis P dvd_field_iff inv_P invertible_iff_is_unit_JNF map_carrier_mat + not_is_unit_0 of_int_hom.hom_0 of_int_hom.hom_det) + have "det (?RAT (mat_of_rows n fs_init)) = det (?RAT P) * det (?RAT (mat_of_rows n gs))" + by (metis Determinant.det_mult P fs_P_gs gs_carrier of_int_hom.hom_det of_int_hom.hom_mult) + hence "det (?RAT (mat_of_rows n gs)) \ 0" using d by auto + thus "invertible_mat (?RAT (mat_of_rows n gs))" + by (meson dvd_field_iff gs_carrier invertible_iff_is_unit_JNF map_carrier_mat) + qed +qed + + +corollary lattice_of_eq_via_HNF: + assumes sound_HNF: "is_sound_HNF HNF associates res" + and P1_H1: "(P1,H1) = HNF (mat_of_rows n fs_init)" + and P2_H2: "(P2,H2) = HNF (mat_of_rows n gs)" + and gs: "set gs \ carrier_vec n" + and mn: "m = n" and len_gs: "length gs = n" + shows "(H1 = H2) \ (lattice_of fs_init = lattice_of gs)" + using certification_via_eq_HNF certification_via_eq_HNF2 assms by metis +end + + + +context +begin + +interpretation vec_module "TYPE(int)" n . + +lemma lattice_of_eq_via_HNF_paper: + fixes F G :: "int mat" and HNF :: "int mat \ int mat" + assumes sound_HNF': "is_sound_HNF' HNF \ \" (* HNF is a sound algorithm *) + and inv_F_Q: "invertible_mat (map_mat rat_of_int F)" (* invertible over Q *) + and FG: "{F,G} \ carrier_mat n n" + shows "(HNF F = HNF G) \ (lattice_of (rows F) = lattice_of (rows G))" +proof - + define HNF' + where "HNF' = (\A. let H = HNF A + in (SOME P. P \ carrier_mat (dim_row A) (dim_row A) \ invertible_mat P \ A = P * H, H))" + have sound_HNF': "is_sound_HNF HNF' \ \" by (unfold HNF'_def, rule is_sound_HNF_conv[OF sound_HNF']) + have F_eq: "F = mat_of_rows n (rows F)" and G_eq: "G = mat_of_rows n (rows G)" + using FG by auto + interpret L: LLL_with_assms n n "(rows F)" "4/3" + proof + interpret gs: cof_vec_space n "TYPE(rat)" . + thm gs.upper_triangular_imp_lin_indpt_rows + let ?RAT ="map_mat rat_of_int" + have m_rw: "(map (map_vec rat_of_int) (rows F)) = rows (?RAT F)" + unfolding Matrix.rows_def by auto + show "gs.lin_indpt_list (map (map_vec rat_of_int) (rows F))" + proof - + have det_RAT_F: "det (?RAT F) \ 0" + by (metis inv_F_Q carrier_mat_triv invertible_iff_is_unit_JNF + invertible_mat_def not_is_unit_0 square_mat.simps) + have d_RAT_F: "distinct (rows (?RAT F))" + proof (rule ccontr) + assume "\ distinct (rows (?RAT F))" + from this obtain i j + where ij: "row (?RAT F) i = row (?RAT F) j" + and i: "ij" + unfolding Matrix.rows_def distinct_conv_nth by auto + have "det (?RAT F) = 0" using ij i j i_not_j + by (metis Determinant.det_def Determinant.det_identical_rows carrier_mat_triv) + thus False using inv_F_Q + by (metis carrier_mat_triv invertible_iff_is_unit_JNF invertible_mat_def + not_is_unit_0 square_mat.simps) + qed + moreover have "\ gs.lin_dep (set (rows (?RAT F)))" + using gs.det_not_0_imp_lin_indpt_rows[OF _ det_RAT_F] using FG by auto + ultimately show ?thesis + unfolding gs.lin_indpt_list_def m_rw using FG unfolding Matrix.rows_def by auto + qed + qed (insert FG F_eq, auto) + show ?thesis + proof (rule L.lattice_of_eq_via_HNF[OF sound_HNF']) + show "(fst (HNF' F), HNF F) = HNF' (mat_of_rows n (rows F))" + unfolding HNF'_def Let_def using F_eq by auto + show "(fst (HNF' G), HNF G) = HNF' (mat_of_rows n (rows G))" + unfolding HNF'_def Let_def using G_eq by auto + show "length (rows G) = n " using FG by auto + show "set (rows G) \ carrier_vec n" using FG + by (metis G_eq mat_of_rows_carrier(3) rows_carrier) + qed (simp) +qed +end + +text \We define a new const similar to @{text "external_lll_solver"}, +but now it only returns the reduced matrix.\ + +consts external_lll_solver' :: "integer \ integer \ integer list list \ integer list list" + +hide_type (open) Finite_Cartesian_Product.vec + + +text \The following definition is an adaptation of @{text "reduce_basis_external"}\ + +definition reduce_basis_external' :: "(int mat \ int mat) \ rat \ int vec list \ int vec list" where + "reduce_basis_external' HNF \ fs = (case fs of Nil \ [] | Cons f _ \ (let + rb = reduce_basis \; + fsi = map (map integer_of_int o list_of_vec) fs; + n = dim_vec f; + m = length fs; + gsi = external_lll_solver' (map_prod integer_of_int integer_of_int (quotient_of \)) fsi; + gs = (map (vec_of_list o map int_of_integer) gsi) in + if \ (length gs = m \ (\ gi \ set gs. dim_vec gi = n)) then + Code.abort (STR ''error in external LLL invocation: dimensions of reduced basis do not fit\input to external solver: '' + + String.implode (show fs) + STR ''\\'') (\ _. rb fs) + else + let Fs = mat_of_rows n fs; + Gs = mat_of_rows n gs; + H1 = HNF Fs; + H2 = HNF Gs in + if (H1 = H2) then rb gs + else Code.abort (STR ''the reduced matrix does not span the same lattice\f,g,P1,P2,H1,H2 are as follows\'' + + String.implode (show Fs) + STR ''\\'' + + String.implode (show Gs) + STR ''\\'' + + String.implode (show H1) + STR ''\\'' + + String.implode (show H2) + STR ''\\'' + ) (\ _. rb fs)) + )" + +locale certification = LLL_with_assms + + fixes HNF::"int mat \ int mat" and associates res (*HNF operation without explicit transformation matrix*) + assumes sound_HNF': "is_sound_HNF' HNF associates res" +begin + +lemma reduce_basis_external': assumes res: "reduce_basis_external' HNF \ fs_init = fs" + shows "reduced fs m" "LLL_invariant True m fs" +proof (atomize(full), goal_cases) + case 1 + show ?case + proof (cases "LLL_Impl.reduce_basis \ fs_init = fs") + case True + from reduce_basis[OF this] show ?thesis by simp + next + case False note a = False + show ?thesis + proof (cases fs_init) + case Nil + with res have "fs = []" unfolding reduce_basis_external'_def by auto + with False Nil have False by (simp add: LLL_Impl.reduce_basis_def) + thus ?thesis .. + next + case (Cons f rest) + from Cons fs_init len have dim_fs_n: "dim_vec f = n" by auto + let ?ext = "external_lll_solver' (map_prod integer_of_int integer_of_int (quotient_of \)) + (map (map integer_of_int \ list_of_vec) fs_init)" + note res = res[unfolded reduce_basis_external'_def Cons Let_def list.case Code.abort_def dim_fs_n, + folded Cons] + define gs where "gs = map (vec_of_list o map int_of_integer) ?ext" + define Fs where "Fs = mat_of_rows n fs_init" + define Gs where "Gs = mat_of_rows n gs" + define H1 where "H1 = HNF Fs" + define H2 where "H2 = HNF Gs" + note res = res[unfolded ext option.simps split len dim_fs_n, folded gs_def] + from res False have not: "(\ (length gs = m \ (\gi\set gs. dim_vec gi = n))) = False" + by (auto split: if_splits) + note res = res[unfolded this if_False] + from not have gs: "set gs \ carrier_vec n" + and len_gs: "length gs = m" by auto + show ?thesis + proof (cases "H1 = H2") + case True + hence H1_eq_H2: "H1 = H2" by auto + let ?HNF = "(\A. let H = HNF A in (SOME P. P \ carrier_mat (dim_row A) (dim_row A) \ invertible_mat P \ A = P * H, H))" + obtain P1 where P1_H1: "(P1,H1) = ?HNF Fs" by (metis H1_def) + obtain P2 where P2_H2: "(P2,H2) = ?HNF Gs" by (metis H2_def) + have sound_HNF: "is_sound_HNF ?HNF associates res" + by (rule is_sound_HNF_conv[OF sound_HNF']) + have laticce_gs_fs_init: "lattice_of gs = lattice_of fs_init" + and gs_assms: "LLL_with_assms n m gs \" + by (rule certification_via_eq_HNF[OF sound_HNF P1_H1[unfolded Fs_def] + P2_H2[unfolded Gs_def] H1_eq_H2 gs len_gs])+ + from res a True + have gs_fs: "LLL_Impl.reduce_basis \ gs = fs" by (auto split: prod.split) + have lattice_gs_fs: "lattice_of gs = lattice_of fs" + and "gram_schmidt_fs.reduced n (map of_int_hom.vec_hom fs) \ m" + and "gs.lin_indpt_list (map of_int_hom.vec_hom fs)" + and "length fs = length gs" + using LLL_with_assms.reduce_basis gs_fs gs_assms laticce_gs_fs_init gs_assms + using LLL_with_assms_def len_gs unfolding LLL.L_def by fast+ + from this show ?thesis + using laticce_gs_fs_init gs_assms LLL_with_assms_def lattice_gs_fs + unfolding LLL_invariant_def L_def by auto + next + case False + then show ?thesis + using a Fs_def Gs_def res H1_def H2_def by auto + qed + qed + qed +qed +end + +context LLL_with_assms +begin + +text \We interpret the certification context using our formalized @{text "HNF_algorithm"}\ + +interpretation efficient_cert: certification n m fs_init \ "HNF_algorithm use_sym_mod" "range ass_function_euclidean" "\c. range (res_int c)" + by (unfold_locales, rule is_sound_HNF'_HNF_algorithm) + +(*We get the final lemma for our algorithm. It works for any matrix, but it only applies operations +modulo determinant for non-singular matrices.*) +thm efficient_cert.reduce_basis_external' + +text \Same, but applying the naive HNF algorithm, moved to JNF library from the echelon form + and Hermite normal form AFP entries\ + +interpretation cert: certification n m fs_init \ "HNF_algorithm_from_HA use_sym_mod" "range ass_function_euclidean" "\c. range (res_int c)" + by (unfold_locales, rule is_sound_HNF'_HNF_algorithm_from_HA) +thm cert.reduce_basis_external' + +(*Explicit versions for paper-presentation:*) +lemma RBE_HNF_algorithm_efficient: + assumes "reduce_basis_external' (HNF_algorithm use_sym_mod) \ fs_init = fs" + shows "gram_schmidt_fs.reduced n (map of_int_hom.vec_hom fs) \ m" + and "LLL_invariant True m fs" using efficient_cert.reduce_basis_external' assms by blast+ + +lemma RBE_HNF_algorithm_naive: + assumes "reduce_basis_external' (HNF_algorithm_from_HA use_sym_mod) \ fs_init = fs" + shows "gram_schmidt_fs.reduced n (map of_int_hom.vec_hom fs) \ m" + and "LLL_invariant True m fs" using cert.reduce_basis_external' assms by blast+ + +end + +lemma external_lll_solver'_code[code]: + "external_lll_solver' = Code.abort (STR ''require proper implementation of external_lll_solver'') (\ _. external_lll_solver')" + by simp +end diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Matrix_Change_Row.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Matrix_Change_Row.thy new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Matrix_Change_Row.thy @@ -0,0 +1,62 @@ +section \Missing Matrix Operations\ + +text \In this theory we provide an operation that can change a single + row in a matrix efficiently, and all other rows in the matrix implementation + will be reused.\ + +(* TODO: move this part into JNF-AFP-entry *) + +theory Matrix_Change_Row + imports + Jordan_Normal_Form.Matrix_IArray_Impl + Polynomial_Interpolation.Missing_Unsorted +begin + +definition change_row :: "nat \ (nat \ 'a \ 'a) \ 'a mat \ 'a mat" where + "change_row k f A = mat (dim_row A) (dim_col A) (\ (i,j). + if i = k then f j (A $$ (k,j)) else A $$ (i,j))" + +lemma change_row_carrier[simp]: + "(change_row k f A \ carrier_mat nr nc) = (A \ carrier_mat nr nc)" + "dim_row (change_row k f A) = dim_row A" + "dim_col (change_row k f A) = dim_col A" + unfolding change_row_def carrier_mat_def by auto + +lemma change_row_index[simp]: "A \ carrier_mat nr nc \ i < nr \ j < nc \ + change_row k f A $$ (i,j) = (if i = k then f j (A $$ (k,j)) else A $$ (i,j))" + "i < dim_row A \ j < dim_col A \ change_row k f A $$ (i,j) = (if i = k then f j (A $$ (k,j)) else A $$ (i,j))" + unfolding change_row_def by auto + +lift_definition change_row_impl :: "nat \ (nat \ 'a \ 'a) \ 'a mat_impl \ 'a mat_impl" is + "\ k f (nr,nc,A). let Ak = IArray.sub A k; Arows = IArray.list_of A; + Ak' = IArray.IArray (map (\ (i,c). f i c) (zip [0 ..< nc] (IArray.list_of Ak))); + A' = IArray.IArray (Arows [k := Ak']) + in (nr,nc,A')" +proof (auto, goal_cases) + case (1 k f nc b row) + show ?case + proof (cases b) + case (IArray rows) + with 1 have "row \ set rows \ k < length rows + \ row = IArray (map (\ (i,c). f i c) (zip [0 ..< nc] (IArray.list_of (rows ! k))))" + by (cases "k < length rows", auto simp: set_list_update dest: in_set_takeD in_set_dropD) + with 1 IArray show ?thesis by (cases, auto) + qed +qed + +lemma change_row_code[code]: "change_row k f (mat_impl A) = (if k < dim_row_impl A + then mat_impl (change_row_impl k f A) + else Code.abort (STR ''index out of bounds in change_row'') (\ _. change_row k f (mat_impl A)))" + (is "?l = ?r") +proof (cases "k < dim_row_impl A") + case True + hence id: "?r = mat_impl (change_row_impl k f A)" by simp + show ?thesis unfolding id unfolding change_row_def + proof (rule eq_matI, goal_cases) + case (1 i j) + thus ?case using True + by (transfer, auto simp: mk_mat_def) + qed (transfer, auto)+ +qed simp + +end diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/ROOT b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/ROOT new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/ROOT @@ -0,0 +1,22 @@ +chapter AFP + +session Modular_arithmetic_LLL_and_HNF_algorithms (AFP) = Smith_Normal_Form + + options [timeout = 1200] + sessions + LLL_Basis_Reduction + Show + Jordan_Normal_Form + Hermite + theories + Matrix_Change_Row + Signed_Modulo + Storjohann_Mod_Operation + Storjohann + Storjohann_Impl + Uniqueness_Hermite + Uniqueness_Hermite_JNF + HNF_Mod_Det_Algorithm + HNF_Mod_Det_Soundness + LLL_Certification_via_HNF + document_files + "root.tex" diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Signed_Modulo.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Signed_Modulo.thy new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Signed_Modulo.thy @@ -0,0 +1,109 @@ +section \Signed Modulo Operation\ + +theory Signed_Modulo + imports + Berlekamp_Zassenhaus.Poly_Mod + Sqrt_Babylonian.Sqrt_Babylonian_Auxiliary +begin + +text \The upcoming definition of symmetric modulo + is different to the HOL-Library-Signed\_Division.smod, since + here the modulus will be in range $\{-m/2,...,m/2\}$, + whereas there -1 symmod m = m - 1. + + The advantage of have range $\{-m/2,...,m/2\}$ is that small negative + numbers are represented by small numbers. + + One limitation is that the symmetric modulo is only working properly, + if the modulus is a positive number.\ + +definition sym_mod :: "int \ int \ int" (infixl "symmod" 70) where + "sym_mod x y = poly_mod.inv_M y (x mod y)" + +lemma sym_mod_code[code]: "sym_mod x y = (let m = x mod y + in if m + m \ y then m else m - y)" + unfolding sym_mod_def poly_mod.inv_M_def Let_def .. + +lemma sym_mod_zero[simp]: "n symmod 0 = n" "n > 0 \ 0 symmod n = 0" + unfolding sym_mod_def poly_mod.inv_M_def by auto + +lemma sym_mod_range: "y > 0 \ x symmod y \ {- ((y - 1) div 2) .. y div 2}" + unfolding sym_mod_def poly_mod.inv_M_def using pos_mod_bound[of y x] + by (cases "x mod y \ y", auto) + (smt (verit) Euclidean_Division.pos_mod_bound Euclidean_Division.pos_mod_sign half_nonnegative_int_iff)+ + +text \The range is optimal in the sense that exactly y elements can be represented.\ +lemma card_sym_mod_range: "y > 0 \ card {- ((y - 1) div 2) .. y div 2} = y" + by simp + +lemma sym_mod_abs: "y > 0 \ \x symmod y\ < y" + "y \ 1 \ \x symmod y\ \ y div 2" + using sym_mod_range[of y x] by auto + + +lemma sym_mod_sym_mod[simp]: "x symmod y symmod y = x symmod (y :: int)" + unfolding sym_mod_def using poly_mod.M_def poly_mod.M_inv_M_id by auto + +lemma sym_mod_diff_eq: "(a symmod c - b symmod c) symmod c = (a - b) symmod c" + unfolding sym_mod_def + by (metis mod_diff_cong mod_mod_trivial poly_mod.M_def poly_mod.M_inv_M_id) + +lemma sym_mod_sym_mod_cancel: "c dvd b \ a symmod b symmod c = a symmod c" + using mod_mod_cancel[of c b] unfolding sym_mod_def + by (metis poly_mod.M_def poly_mod.M_inv_M_id) + +lemma sym_mod_diff_right_eq: "(a - b symmod c) symmod c = (a - b) symmod c" + using sym_mod_diff_eq by (metis sym_mod_sym_mod) + +lemma sym_mod_mult_right_eq: "a * (b symmod c) symmod c = a * b symmod c" + unfolding sym_mod_def by (metis poly_mod.M_def poly_mod.M_inv_M_id mod_mult_right_eq) + +lemma dvd_imp_sym_mod_0 [simp]: + "b symmod a = 0" if "a > 0" "a dvd b" + unfolding sym_mod_def poly_mod.inv_M_def using that by simp + +lemma sym_mod_0_imp_dvd [dest!]: + "b dvd a" if "a symmod b = 0" + using that unfolding sym_mod_def poly_mod.inv_M_def + by (smt (verit) Euclidean_Division.pos_mod_bound dvd_eq_mod_eq_0) + +definition sym_div :: "int \ int \ int" (infixl "symdiv" 70) where + "sym_div x y = (let d = x div y; m = x mod y in + if m + m \ y then d else d + 1)" + +lemma of_int_mod_integer: "(of_int (x mod y) :: integer) = (of_int x :: integer) mod (of_int y)" + using integer_of_int_eq_of_int modulo_integer.abs_eq by presburger + +lemma sym_div_code[code]: + "sym_div x y = (let yy = integer_of_int y in + (case divmod_integer (integer_of_int x) yy + of (d, m) \ if m + m \ yy then int_of_integer d else (int_of_integer (d + 1))))" + unfolding sym_div_def Let_def divmod_integer_def split + apply (rule if_cong, subst of_int_le_iff[symmetric], unfold of_int_add) + by (subst (1 2) of_int_mod_integer, auto) + +lemma sym_mod_sym_div: assumes y: "y > 0" shows "x symmod y = x - sym_div x y * y" +proof - + let ?z = "x - y * (x div y)" + let ?u = "y * (x div y)" + have "x = y * (x div y) + x mod y" using y by simp + hence id: "x mod y = ?z" by linarith + have "x symmod y = poly_mod.inv_M y ?z" unfolding sym_mod_def id by auto + also have "\ = (if ?z + ?z \ y then ?z else ?z - y)" unfolding poly_mod.inv_M_def .. + also have "\ = x - (if (x mod y) + (x mod y) \ y then x div y else x div y + 1) * y" + by (simp add: algebra_simps id) + also have "(if (x mod y) + (x mod y) \ y then x div y else x div y + 1) = sym_div x y" + unfolding sym_div_def Let_def .. + finally show ?thesis . +qed + +lemma dvd_sym_div_mult_right [simp]: + "(a symdiv b) * b = a" if "b > 0" "b dvd a" + using sym_mod_sym_div[of b a] that by simp + +lemma dvd_sym_div_mult_left [simp]: + "b * (a symdiv b) = a" if "b > 0" "b dvd a" + using dvd_sym_div_mult_right[OF that] by (simp add: ac_simps) + + +end \ No newline at end of file diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann.thy new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann.thy @@ -0,0 +1,2327 @@ +section \Storjohann's basis reduction algorithm (abstract version)\ + +text \This theory contains the soundness proofs of Storjohann's basis + reduction algorithms, both for the normal and the improved-swap-order variant. + + The implementation of Storjohann's version of LLL uses modular operations throughout. + It is an abstract implementation that is already quite close to what the actual implementation will be. + In particular, the swap operation here is derived from the computation lemma for the swap + operation in the old, integer-only formalization of LLL.\ + +theory Storjohann + imports + Storjohann_Mod_Operation + LLL_Basis_Reduction.LLL_Number_Bounds + Sqrt_Babylonian.NthRoot_Impl +begin + +subsection \Definition of algorithm\ + +text \In the definition of the algorithm, the first-flag determines, whether only the first vector + of the reduced basis should be computed, i.e., a short vector. Then the modulus can be slightly + decreased in comparison to the required modulus for computing the whole reduced matrix.\ + +fun max_list_rats_with_index :: "(int * int * nat) list \ (int * int * nat)" where + "max_list_rats_with_index [x] = x" | + "max_list_rats_with_index ((n1,d1,i1) # (n2,d2,i2) # xs) + = max_list_rats_with_index ((if n1 * d2 \ n2 * d1 then (n2,d2,i2) else (n1,d1,i1)) # xs)" + +context LLL +begin + +definition "log_base = (10 :: int)" + +definition bound_number :: "bool \ nat" where + "bound_number first = (if first \ m \ 0 then 1 else m)" + +definition compute_mod_of_max_gso_norm :: "bool \ rat \ int" where + "compute_mod_of_max_gso_norm first mn = log_base ^ (log_ceiling log_base (max 2 ( + root_rat_ceiling 2 (mn * (rat_of_nat (bound_number first) + 3)) + 1)))" + +definition g_bnd_mode :: "bool \ rat \ int vec list \ bool" where + "g_bnd_mode first b fs = (if first \ m \ 0 then sq_norm (gso fs 0) \ b else g_bnd b fs)" + +definition d_of where "d_of dmu i = (if i = 0 then 1 :: int else dmu $$ (i - 1, i - 1))" + +definition compute_max_gso_norm :: "bool \ int mat \ rat \ nat" where + "compute_max_gso_norm first dmu = (if m = 0 then (0,0) else + case max_list_rats_with_index (map (\ i. (d_of dmu (Suc i), d_of dmu i, i)) [0 ..< (if first then 1 else m)]) + of (num, denom, i) \ (of_int num / of_int denom, i))" + + +context + fixes p :: int \ \the modulus\ + and first :: bool \ \only compute first vector of reduced basis\ +begin + +definition basis_reduction_mod_add_row :: + "int vec list \ int mat \ nat \ nat \ (int vec list \ int mat)" where + "basis_reduction_mod_add_row mfs dmu i j = + (let c = round_num_denom (dmu $$ (i,j)) (d_of dmu (Suc j)) in + (if c = 0 then (mfs, dmu) + else (mfs[ i := (map_vec (\ x. x symmod p)) (mfs ! i - c \\<^sub>v mfs ! j)], + mat m m (\(i',j'). (if (i' = i \ j' \ j) + then (if j'=j then (dmu $$ (i,j') - c * dmu $$ (j,j')) + else (dmu $$ (i,j') - c * dmu $$ (j,j')) + symmod (p * d_of dmu j' * d_of dmu (Suc j'))) + else (dmu $$ (i',j')))))))" + +fun basis_reduction_mod_add_rows_loop where + "basis_reduction_mod_add_rows_loop mfs dmu i 0 = (mfs, dmu)" +| "basis_reduction_mod_add_rows_loop mfs dmu i (Suc j) = ( + let (mfs', dmu') = basis_reduction_mod_add_row mfs dmu i j + in basis_reduction_mod_add_rows_loop mfs' dmu' i j)" + +definition basis_reduction_mod_swap_dmu_mod :: "int mat \ nat \ int mat" where + "basis_reduction_mod_swap_dmu_mod dmu k = mat m m (\(i, j). ( + if j < i \ (j = k \ j = k - 1) then + dmu $$ (i, j) symmod (p * d_of dmu j * d_of dmu (Suc j)) + else dmu $$ (i, j)))" + +definition basis_reduction_mod_swap where + "basis_reduction_mod_swap mfs dmu k = + (mfs[k := mfs ! (k - 1), k - 1 := mfs ! k], + basis_reduction_mod_swap_dmu_mod (mat m m (\(i,j). ( + if j < i then + if i = k - 1 then + dmu $$ (k, j) + else if i = k \ j \ k - 1 then + dmu $$ (k - 1, j) + else if i > k \ j = k then + ((d_of dmu (Suc k)) * dmu $$ (i, k - 1) - dmu $$ (k, k - 1) * dmu $$ (i, j)) + div (d_of dmu k) + else if i > k \ j = k - 1 then + (dmu $$ (k, k - 1) * dmu $$ (i, j) + dmu $$ (i, k) * (d_of dmu (k-1))) + div (d_of dmu k) + else dmu $$ (i, j) + else if i = j then + if i = k - 1 then + ((d_of dmu (Suc k)) * (d_of dmu (k-1)) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) + div (d_of dmu k) + else (d_of dmu (Suc i)) + else dmu $$ (i, j)) + )) k)" + +fun basis_reduction_adjust_mod where + "basis_reduction_adjust_mod mfs dmu = + (let (b,g_idx) = compute_max_gso_norm first dmu; + p' = compute_mod_of_max_gso_norm first b + in if p' < p then + let mfs' = map (map_vec (\x. x symmod p')) mfs; + d_vec = vec (Suc m) (\ i. d_of dmu i); + dmu' = mat m m (\ (i,j). if j < i then dmu $$ (i,j) + symmod (p' * d_vec $ j * d_vec $ (Suc j)) else + dmu $$ (i,j)) + in (p', mfs', dmu', g_idx) + else (p, mfs, dmu, g_idx))" + +definition basis_reduction_adjust_swap_add_step where + "basis_reduction_adjust_swap_add_step mfs dmu g_idx i = ( + let i1 = i - 1; + (mfs1, dmu1) = basis_reduction_mod_add_row mfs dmu i i1; + (mfs2, dmu2) = basis_reduction_mod_swap mfs1 dmu1 i + in if i1 = g_idx then basis_reduction_adjust_mod mfs2 dmu2 + else (p, mfs2, dmu2, g_idx))" + + +definition basis_reduction_mod_step where + "basis_reduction_mod_step mfs dmu g_idx i (j :: int) = (if i = 0 then (p, mfs, dmu, g_idx, Suc i, j) + else let di = d_of dmu i; + (num, denom) = quotient_of \ + in if di * di * denom \ num * d_of dmu (i - 1) * d_of dmu (Suc i) then + (p, mfs, dmu, g_idx, Suc i, j) + else let (p', mfs', dmu', g_idx') = basis_reduction_adjust_swap_add_step mfs dmu g_idx i + in (p', mfs', dmu', g_idx', i - 1, j + 1))" + +primrec basis_reduction_mod_add_rows_outer_loop where + "basis_reduction_mod_add_rows_outer_loop mfs dmu 0 = (mfs, dmu)" | + "basis_reduction_mod_add_rows_outer_loop mfs dmu (Suc i) = + (let (mfs', dmu') = basis_reduction_mod_add_rows_outer_loop mfs dmu i in + basis_reduction_mod_add_rows_loop mfs' dmu' (Suc i) (Suc i))" +end + +text \the main loop of the normal Storjohann algorithm\ +partial_function (tailrec) basis_reduction_mod_main where + "basis_reduction_mod_main p first mfs dmu g_idx i (j :: int) = ( + (if i < m + then + case basis_reduction_mod_step p first mfs dmu g_idx i j + of (p', mfs', dmu', g_idx', i', j') \ + basis_reduction_mod_main p' first mfs' dmu' g_idx' i' j' + else + (p, mfs, dmu)))" + +definition compute_max_gso_quot:: "int mat \ (int * int * nat)" where + "compute_max_gso_quot dmu = max_list_rats_with_index + (map (\i. ((d_of dmu (i+1)) * (d_of dmu (i+1)), (d_of dmu (i+2)) * (d_of dmu i), Suc i)) [0..<(m-1)])" + +text \the main loop of Storjohann's algorithm with improved swap order\ +partial_function (tailrec) basis_reduction_iso_main where + "basis_reduction_iso_main p first mfs dmu g_idx (j :: int) = ( + (if m > 1 then + (let (max_gso_num, max_gso_denum, indx) = compute_max_gso_quot dmu; + (num, denum) = quotient_of \ in + (if (max_gso_num * denum > num * max_gso_denum) then + case basis_reduction_adjust_swap_add_step p first mfs dmu g_idx indx of + (p', mfs', dmu', g_idx') \ + basis_reduction_iso_main p' first mfs' dmu' g_idx' (j + 1) + else + (p, mfs, dmu))) + else (p, mfs, dmu)))" + +definition compute_initial_mfs where + "compute_initial_mfs p = map (map_vec (\x. x symmod p)) fs_init" + +definition compute_initial_dmu where + "compute_initial_dmu p dmu = mat m m (\(i',j'). if j' < i' + then dmu $$ (i', j') symmod (p * d_of dmu j' * d_of dmu (Suc j')) + else dmu $$ (i', j'))" + +definition "dmu_initial = (let dmu = d\_impl fs_init + in mat m m (\ (i,j). + if j \ i then d\_impl fs_init !! i !! j else 0))" + +definition "compute_initial_state first = + (let dmu = dmu_initial; + (b, g_idx) = compute_max_gso_norm first dmu; + p = compute_mod_of_max_gso_norm first b + in (p, compute_initial_mfs p, compute_initial_dmu p dmu, g_idx))" + +text \Storjohann's algorithm\ +definition reduce_basis_mod :: "int vec list" where + "reduce_basis_mod = ( + let first = False; + (p0, mfs0, dmu0, g_idx) = compute_initial_state first; + (p', mfs', dmu') = basis_reduction_mod_main p0 first mfs0 dmu0 g_idx 0 0; + (mfs'', dmu'') = basis_reduction_mod_add_rows_outer_loop p' mfs' dmu' (m-1) + in mfs'')" + +text \Storjohann's algorithm with improved swap order\ +definition reduce_basis_iso :: "int vec list" where + "reduce_basis_iso = ( + let first = False; + (p0, mfs0, dmu0, g_idx) = compute_initial_state first; + (p', mfs', dmu') = basis_reduction_iso_main p0 first mfs0 dmu0 g_idx 0; + (mfs'', dmu'') = basis_reduction_mod_add_rows_outer_loop p' mfs' dmu' (m-1) + in mfs'')" + +text \Storjohann's algorithm for computing a short vector\ +definition + "short_vector_mod = ( + let first = True; + (p0, mfs0, dmu0, g_idx) = compute_initial_state first; + (p', mfs', dmu') = basis_reduction_mod_main p0 first mfs0 dmu0 g_idx 0 0 + in hd mfs')" + +text \Storjohann's algorithm (iso-variant) for computing a short vector\ +definition + "short_vector_iso = ( + let first = True; + (p0, mfs0, dmu0, g_idx) = compute_initial_state first; + (p', mfs', dmu') = basis_reduction_iso_main p0 first mfs0 dmu0 g_idx 0 + in hd mfs')" +end + +subsection \Towards soundness of Storjohann's algorithm\ + +lemma max_list_rats_with_index_in_set: + assumes max: "max_list_rats_with_index xs = (nm, dm, im)" + and len: "length xs \ 1" +shows "(nm, dm, im) \ set xs" + using assms +proof (induct xs rule: max_list_rats_with_index.induct) + case (2 n1 d1 i1 n2 d2 i2 xs) + have "1 \ length ((if n1 * d2 \ n2 * d1 then (n2, d2, i2) else (n1, d1, i1)) # xs)" by simp + moreover have "max_list_rats_with_index ((if n1 * d2 \ n2 * d1 then (n2, d2, i2) else (n1, d1, i1)) # xs) + = (nm, dm, im)" using 2 by simp + moreover have "(if n1 * d2 \ n2 * d1 then (n2, d2, i2) else (n1, d1, i1)) \ + set ((n1, d1, i1) # (n2, d2, i2) # xs)" by simp + moreover then have "set ((if n1 * d2 \ n2 * d1 then (n2, d2, i2) else (n1, d1, i1)) # xs) \ + set ((n1, d1, i1) # (n2, d2, i2) # xs)" by auto + ultimately show ?case using 2(1) by auto +qed auto + +lemma max_list_rats_with_index: assumes "\ n d i. (n,d,i) \ set xs \ d > 0" + and max: "max_list_rats_with_index xs = (nm, dm, im)" + and "(n,d,i) \ set xs" +shows "rat_of_int n / of_int d \ of_int nm / of_int dm" + using assms +proof (induct xs arbitrary: n d i rule: max_list_rats_with_index.induct) + case (2 n1 d1 i1 n2 d2 i2 xs n d i) + let ?r = "rat_of_int" + from 2(2) have "d1 > 0" "d2 > 0" by auto + hence d: "?r d1 > 0" "?r d2 > 0" by auto + have "(n1 * d2 \ n2 * d1) = (?r n1 * ?r d2 \ ?r n2 * ?r d1)" + unfolding of_int_mult[symmetric] by presburger + also have "\ = (?r n1 / ?r d1 \ ?r n2 / ?r d2)" using d + by (smt divide_strict_right_mono leD le_less_linear mult.commute nonzero_mult_div_cancel_left + not_less_iff_gr_or_eq times_divide_eq_right) + finally have id: "(n1 * d2 \ n2 * d1) = (?r n1 / ?r d1 \ ?r n2 / ?r d2)" . + obtain n' d' i' where new: "(if n1 * d2 \ n2 * d1 then (n2, d2, i2) else (n1, d1, i1)) = (n',d',i')" + by force + have nd': "(n',d',i') \ {(n1,d1,i1), (n2, d2, i2)}" using new[symmetric] by auto + from 2(3) have res: "max_list_rats_with_index ((n',d',i') # xs) = (nm, dm, im)" using new by auto + note 2 = 2[unfolded new] + show ?case + proof (cases "(n,d,i) \ set xs") + case True + show ?thesis + by (rule 2(1)[of n d, OF 2(2) res], insert True nd', force+) + next + case False + with 2(4) have "n = n1 \ d = d1 \ n = n2 \ d = d2" by auto + hence "?r n / ?r d \ ?r n' / ?r d'" using new[unfolded id] + by (metis linear prod.inject) + also have "?r n' / ?r d' \ ?r nm / ?r dm" + by (rule 2(1)[of n' d', OF 2(2) res], insert nd', force+) + finally show ?thesis . + qed +qed auto + +context LLL +begin + +lemma log_base: "log_base \ 2" unfolding log_base_def by auto + +definition LLL_invariant_weak' :: "nat \ int vec list \ bool" where + "LLL_invariant_weak' i fs = ( + gs.lin_indpt_list (RAT fs) \ + lattice_of fs = L \ + weakly_reduced fs i \ + i \ m \ + length fs = m + )" + +lemma LLL_invD_weak: assumes "LLL_invariant_weak' i fs" + shows + "lin_indep fs" + "length (RAT fs) = m" + "set fs \ carrier_vec n" + "\ i. i < m \ fs ! i \ carrier_vec n" + "\ i. i < m \ gso fs i \ carrier_vec n" + "length fs = m" + "lattice_of fs = L" + "weakly_reduced fs i" + "i \ m" +proof (atomize (full), goal_cases) + case 1 + interpret gs': gram_schmidt_fs_lin_indpt n "RAT fs" + by (standard) (use assms LLL_invariant_weak'_def gs.lin_indpt_list_def in auto) + show ?case + using assms gs'.fs_carrier gs'.f_carrier gs'.gso_carrier + by (auto simp add: LLL_invariant_weak'_def gram_schmidt_fs.reduced_def) +qed + +lemma LLL_invI_weak: assumes + "set fs \ carrier_vec n" + "length fs = m" + "lattice_of fs = L" + "i \ m" + "lin_indep fs" + "weakly_reduced fs i" +shows "LLL_invariant_weak' i fs" + unfolding LLL_invariant_weak'_def Let_def using assms by auto + +lemma LLL_invw'_imp_w: "LLL_invariant_weak' i fs \ LLL_invariant_weak fs" + unfolding LLL_invariant_weak'_def LLL_invariant_weak_def by auto + +lemma basis_reduction_add_row_weak: + assumes Linvw: "LLL_invariant_weak' i fs" + and i: "i < m" and j: "j < i" + and fs': "fs' = fs[ i := fs ! i - c \\<^sub>v fs ! j]" +shows "LLL_invariant_weak' i fs'" + "g_bnd B fs \ g_bnd B fs'" +proof (atomize(full), goal_cases) + case 1 + note Linv = LLL_invw'_imp_w[OF Linvw] + note main = basis_reduction_add_row_main[OF Linv i j fs'] + have bnd: "g_bnd B fs \ g_bnd B fs'" using main(6) unfolding g_bnd_def by auto + note new = LLL_inv_wD[OF main(1)] + note old = LLL_invD_weak[OF Linvw] + have red: "weakly_reduced fs' i" using \weakly_reduced fs i\ main(6) \i < m\ + unfolding gram_schmidt_fs.weakly_reduced_def by auto + have inv: "LLL_invariant_weak' i fs'" using LLL_inv_wD[OF main(1)] \i < m\ + by (intro LLL_invI_weak, auto intro: red) + show ?case using inv red main bnd by auto +qed + +lemma LLL_inv_weak_m_impl_i: + assumes inv: "LLL_invariant_weak' m fs" + and i: "i \ m" +shows "LLL_invariant_weak' i fs" +proof - + have "weakly_reduced fs i" using LLL_invD_weak(8)[OF inv] + by (meson assms(2) gram_schmidt_fs.weakly_reduced_def le_trans less_imp_le_nat linorder_not_less) + then show ?thesis + using LLL_invI_weak[of fs i, OF LLL_invD_weak(3,6,7)[OF inv] _ LLL_invD_weak(1)[OF inv]] + LLL_invD_weak(2,4,5,8-)[OF inv] i by simp +qed + +definition mod_invariant where + "mod_invariant b p first = (b \ rat_of_int (p - 1)^2 / (rat_of_nat (bound_number first) + 3) + \ (\ e. p = log_base ^ e))" + +lemma compute_mod_of_max_gso_norm: assumes mn: "mn \ 0" + and m: "m = 0 \ mn = 0" + and p: "p = compute_mod_of_max_gso_norm first mn" +shows + "p > 1" + "mod_invariant mn p first" +proof - + let ?m = "bound_number first" + define p' where "p' = root_rat_ceiling 2 (mn * (rat_of_nat ?m + 3)) + 1" + define p'' where "p'' = max 2 p'" + define q where "q = real_of_rat (mn * (rat_of_nat ?m + 3))" + have *: "-1 < (0 :: real)" by simp + also have "0 \ root 2 (real_of_rat (mn * (rat_of_nat ?m + 3)))" using mn by auto + finally have "p' \ 0 + 1" unfolding p'_def + by (intro plus_left_mono, simp) + hence p': "p' > 0" by auto + have p'': "p'' > 1" unfolding p''_def by auto + have pp'': "p \ p''" unfolding compute_mod_of_max_gso_norm_def p p'_def[symmetric] p''_def[symmetric] + using log_base p'' log_ceiling_sound by auto + hence pp': "p \ p'" unfolding p''_def by auto + show "p > 1" using pp'' p'' by auto + + have q0: "q \ 0" unfolding q_def using mn m by auto + have "(mn \ rat_of_int (p' - 1)^2 / (rat_of_nat ?m + 3)) + = (real_of_rat mn \ real_of_rat (rat_of_int (p' - 1)^2 / (rat_of_nat ?m + 3)))" using of_rat_less_eq by blast + also have "\ = (real_of_rat mn \ real_of_rat (rat_of_int (p' - 1)^2) / real_of_rat (rat_of_nat ?m + 3))" by (simp add: of_rat_divide) + also have "\ = (real_of_rat mn \ ((real_of_int (p' - 1))^2) / real_of_rat (rat_of_nat ?m + 3))" + by (metis of_rat_of_int_eq of_rat_power) + also have "\ = (real_of_rat mn \ (real_of_int \sqrt q\)^2 / real_of_rat (rat_of_nat ?m + 3))" + unfolding p'_def sqrt_def q_def by simp + also have "\" + proof - + have "real_of_rat mn \ q / real_of_rat (rat_of_nat ?m + 3)" unfolding q_def using m + by (auto simp: of_rat_mult) + also have "\ \ (real_of_int \sqrt q\)^2 / real_of_rat (rat_of_nat ?m + 3)" + proof (rule divide_right_mono) + have "q = (sqrt q)^2" using q0 by simp + also have "\ \ (real_of_int \sqrt q\)^2" + by (rule power_mono, auto simp: q0) + finally show "q \ (real_of_int \sqrt q\)^2" . + qed auto + finally show ?thesis . + qed + finally have "mn \ rat_of_int (p' - 1)^2 / (rat_of_nat ?m + 3)" . + also have "\ \ rat_of_int (p - 1)^2 / (rat_of_nat ?m + 3)" + unfolding power2_eq_square + by (intro divide_right_mono mult_mono, insert p' pp', auto) + finally have "mn \ rat_of_int (p - 1)^2 / (rat_of_nat ?m + 3)" . + moreover have "\ e. p = log_base ^ e" unfolding p compute_mod_of_max_gso_norm_def by auto + ultimately show "mod_invariant mn p first" unfolding mod_invariant_def by auto +qed + +lemma g_bnd_mode_cong: assumes "\ i. i < m \ gso fs i = gso fs' i" + shows "g_bnd_mode first b fs = g_bnd_mode first b fs'" + using assms unfolding g_bnd_mode_def g_bnd_def by auto + +definition LLL_invariant_mod :: "int vec list \ int vec list \ int mat \ int \ bool \ rat \ nat \ bool" where + "LLL_invariant_mod fs mfs dmu p first b i = ( + length fs = m \ + length mfs = m \ + i \ m \ + lattice_of fs = L \ + gs.lin_indpt_list (RAT fs) \ + weakly_reduced fs i \ + (map (map_vec (\x. x symmod p)) fs = mfs) \ + (\i' < m. \ j' < i'. \d\ fs i' j'\ < p * d fs j' * d fs (Suc j')) \ + (\i' < m. \j' < m. d\ fs i' j' = dmu $$ (i',j')) \ + p > 1 \ + g_bnd_mode first b fs \ + mod_invariant b p first +)" + +lemma LLL_invD_mod: assumes "LLL_invariant_mod fs mfs dmu p first b i" +shows + "length mfs = m" + "i \ m" + "length fs = m" + "lattice_of fs = L" + "gs.lin_indpt_list (RAT fs)" + "weakly_reduced fs i" + "(map (map_vec (\x. x symmod p)) fs = mfs)" + "(\i' < m. \j' < i'. \d\ fs i' j'\ < p * d fs j' * d fs (Suc j'))" + "(\i' < m. \j' < m. d\ fs i' j' = dmu $$ (i',j'))" + "\ i. i < m \ fs ! i \ carrier_vec n" + "set fs \ carrier_vec n" + "\ i. i < m \ gso fs i \ carrier_vec n" + "\ i. i < m \ mfs ! i \ carrier_vec n" + "set mfs \ carrier_vec n" + "p > 1" + "g_bnd_mode first b fs" + "mod_invariant b p first" +proof (atomize (full), goal_cases) + case 1 + interpret gs': gram_schmidt_fs_lin_indpt n "RAT fs" + using assms LLL_invariant_mod_def gs.lin_indpt_list_def + by (meson gram_schmidt_fs_Rn.intro gram_schmidt_fs_lin_indpt.intro gram_schmidt_fs_lin_indpt_axioms.intro) + have allfs: "\i < m. fs ! i \ carrier_vec n" using assms gs'.f_carrier + by (simp add: LLL.LLL_invariant_mod_def) + then have setfs: "set fs \ carrier_vec n" by (metis LLL_invariant_mod_def assms in_set_conv_nth subsetI) + have allgso: "(\i < m. gso fs i \ carrier_vec n)" using assms gs'.gso_carrier + by (simp add: LLL.LLL_invariant_mod_def) + show ?case + using assms gs'.fs_carrier gs'.f_carrier gs'.gso_carrier allfs allgso + LLL_invariant_mod_def gram_schmidt_fs.reduced_def in_set_conv_nth setfs by fastforce +qed + +lemma LLL_invI_mod: assumes + "length mfs = m" + "i \ m" + "length fs = m" + "lattice_of fs = L" + "gs.lin_indpt_list (RAT fs)" + "weakly_reduced fs i" + "map (map_vec (\x. x symmod p)) fs = mfs" + "(\i' < m. \j' < i'. \d\ fs i' j'\ < p * d fs j' * d fs (Suc j'))" + "(\i' < m. \j' < m. d\ fs i' j' = dmu $$ (i',j'))" + "p > 1" + "g_bnd_mode first b fs" + "mod_invariant b p first" +shows "LLL_invariant_mod fs mfs dmu p first b i" + unfolding LLL_invariant_mod_def using assms by blast + +definition LLL_invariant_mod_weak :: "int vec list \ int vec list \ int mat \ int \ bool \ rat \ bool" where + "LLL_invariant_mod_weak fs mfs dmu p first b = ( + length fs = m \ + length mfs = m \ + lattice_of fs = L \ + gs.lin_indpt_list (RAT fs) \ + (map (map_vec (\x. x symmod p)) fs = mfs) \ + (\i' < m. \ j' < i'. \d\ fs i' j'\ < p * d fs j' * d fs (Suc j')) \ + (\i' < m. \j' < m. d\ fs i' j' = dmu $$ (i',j')) \ + p > 1 \ + g_bnd_mode first b fs \ + mod_invariant b p first +)" + +lemma LLL_invD_modw: assumes "LLL_invariant_mod_weak fs mfs dmu p first b" +shows + "length mfs = m" + "length fs = m" + "lattice_of fs = L" + "gs.lin_indpt_list (RAT fs)" + "(map (map_vec (\x. x symmod p)) fs = mfs)" + "(\i' < m. \j' < i'. \d\ fs i' j'\ < p * d fs j' * d fs (Suc j'))" + "(\i' < m. \j' < m. d\ fs i' j' = dmu $$ (i',j'))" + "\ i. i < m \ fs ! i \ carrier_vec n" + "set fs \ carrier_vec n" + "\ i. i < m \ gso fs i \ carrier_vec n" + "\ i. i < m \ mfs ! i \ carrier_vec n" + "set mfs \ carrier_vec n" + "p > 1" + "g_bnd_mode first b fs" + "mod_invariant b p first" +proof (atomize (full), goal_cases) + case 1 + interpret gs': gram_schmidt_fs_lin_indpt n "RAT fs" + using assms LLL_invariant_mod_weak_def gs.lin_indpt_list_def + by (meson gram_schmidt_fs_Rn.intro gram_schmidt_fs_lin_indpt.intro gram_schmidt_fs_lin_indpt_axioms.intro) + have allfs: "\i < m. fs ! i \ carrier_vec n" using assms gs'.f_carrier + by (simp add: LLL.LLL_invariant_mod_weak_def) + then have setfs: "set fs \ carrier_vec n" by (metis LLL_invariant_mod_weak_def assms in_set_conv_nth subsetI) + have allgso: "(\i < m. gso fs i \ carrier_vec n)" using assms gs'.gso_carrier + by (simp add: LLL.LLL_invariant_mod_weak_def) + show ?case + using assms gs'.fs_carrier gs'.f_carrier gs'.gso_carrier allfs allgso + LLL_invariant_mod_weak_def gram_schmidt_fs.reduced_def in_set_conv_nth setfs by fastforce +qed + +lemma LLL_invI_modw: assumes + "length mfs = m" + "length fs = m" + "lattice_of fs = L" + "gs.lin_indpt_list (RAT fs)" + "map (map_vec (\x. x symmod p)) fs = mfs" + "(\i' < m. \j' < i'. \d\ fs i' j'\ < p * d fs j' * d fs (Suc j'))" + "(\i' < m. \j' < m. d\ fs i' j' = dmu $$ (i',j'))" + "p > 1" + "g_bnd_mode first b fs" + "mod_invariant b p first" +shows "LLL_invariant_mod_weak fs mfs dmu p first b" + unfolding LLL_invariant_mod_weak_def using assms by blast + +lemma dd\: + assumes i: "i < m" + shows "d fs (Suc i) = d\ fs i i" +proof- + have "\ fs i i = 1" using i by (simp add: gram_schmidt_fs.\.simps) + then show ?thesis using d\_def by simp +qed + +lemma d_of_main: assumes "(\i' < m. d\ fs i' i' = dmu $$ (i',i'))" + and "i \ m" +shows "d_of dmu i = d fs i" +proof (cases "i = 0") + case False + with assms have "i - 1 < m" by auto + from assms(1)[rule_format, OF this] dd\[OF this, of fs] False + show ?thesis by (simp add: d_of_def) +next + case True + thus ?thesis unfolding d_of_def True d_def by simp +qed + +lemma d_of: assumes inv: "LLL_invariant_mod fs mfs dmu p b first j" + and "i \ m" +shows "d_of dmu i = d fs i" + by (rule d_of_main[OF _ assms(2)], insert LLL_invD_mod(9)[OF inv], auto) + +lemma d_of_weak: assumes inv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and "i \ m" +shows "d_of dmu i = d fs i" + by (rule d_of_main[OF _ assms(2)], insert LLL_invD_modw(7)[OF inv], auto) + +lemma compute_max_gso_norm: assumes dmu: "(\i' < m. d\ fs i' i' = dmu $$ (i',i'))" + and Linv: "LLL_invariant_weak fs" +shows "g_bnd_mode first (fst (compute_max_gso_norm first dmu)) fs" + "fst (compute_max_gso_norm first dmu) \ 0" + "m = 0 \ fst (compute_max_gso_norm first dmu) = 0" +proof - + show gbnd: "g_bnd_mode first (fst (compute_max_gso_norm first dmu)) fs" + proof (cases "first \ m \ 0") + case False + have "?thesis = (g_bnd (fst (compute_max_gso_norm first dmu)) fs)" unfolding g_bnd_mode_def using False by auto + also have \ unfolding g_bnd_def + proof (intro allI impI) + fix i + assume i: "i < m" + have id: "(if first then 1 else m) = m" using False i by auto + define list where "list = map (\ i. (d_of dmu (Suc i), d_of dmu i, i)) [0 ..< m ]" + obtain num denom j where ml: "max_list_rats_with_index list = (num, denom, j)" + by (metis prod_cases3) + have dpos: "d fs i > 0" using LLL_d_pos[OF Linv, of i] i by auto + have pos: "(n, d, i) \ set list \ 0 < d" for n d i + using LLL_d_pos[OF Linv] unfolding list_def using d_of_main[OF dmu] by auto + from i have "list ! i \ set list" using i unfolding list_def by auto + also have "list ! i = (d_of dmu (Suc i), d_of dmu i, i)" unfolding list_def using i by auto + also have "\ = (d fs (Suc i), d fs i, i)" using d_of_main[OF dmu] i by auto + finally have "(d fs (Suc i), d fs i, i) \ set list" . + from max_list_rats_with_index[OF pos ml this] + have "of_int (d fs (Suc i)) / of_int (d fs i) \ fst (compute_max_gso_norm first dmu)" + unfolding compute_max_gso_norm_def list_def[symmetric] ml id split using i by auto + also have "of_int (d fs (Suc i)) / of_int (d fs i) = sq_norm (gso fs i)" + using LLL_d_Suc[OF Linv i] dpos by auto + finally show "sq_norm (gso fs i) \ fst (compute_max_gso_norm first dmu)" . + qed + finally show ?thesis . + next + case True + thus ?thesis unfolding g_bnd_mode_def compute_max_gso_norm_def using d_of_main[OF dmu] + LLL_d_Suc[OF Linv, of 0] LLL_d_pos[OF Linv, of 0] LLL_d_pos[OF Linv, of 1] by auto + qed + show "fst (compute_max_gso_norm first dmu) \ 0" + proof (cases "m = 0") + case True + thus ?thesis unfolding compute_max_gso_norm_def by simp + next + case False + hence 0: "0 < m" by simp + have "0 \ sq_norm (gso fs 0)" by blast + also have "\ \ fst (compute_max_gso_norm first dmu)" + using gbnd[unfolded g_bnd_mode_def g_bnd_def] using 0 by metis + finally show ?thesis . + qed +qed (auto simp: LLL.compute_max_gso_norm_def) + + +lemma increase_i_mod: + assumes Linv: "LLL_invariant_mod fs mfs dmu p first b i" + and i: "i < m" + and red_i: "i \ 0 \ sq_norm (gso fs (i - 1)) \ \ * sq_norm (gso fs i)" +shows "LLL_invariant_mod fs mfs dmu p first b (Suc i)" "LLL_measure i fs > LLL_measure (Suc i) fs" +proof - + note inv = LLL_invD_mod[OF Linv] + from inv have red: "weakly_reduced fs i" by (auto) + from red red_i i have red: "weakly_reduced fs (Suc i)" + unfolding gram_schmidt_fs.weakly_reduced_def + by (intro allI impI, rename_tac ii, case_tac "Suc ii = i", auto) + show "LLL_invariant_mod fs mfs dmu p first b (Suc i)" + by (intro LLL_invI_mod, insert inv red i, auto) + show "LLL_measure i fs > LLL_measure (Suc i) fs" unfolding LLL_measure_def using i by auto +qed + +lemma basis_reduction_mod_add_row_main: + assumes Linvmw: "LLL_invariant_mod_weak fs mfs dmu p first b" + and i: "i < m" and j: "j < i" + and c: "c = round (\ fs i j)" + and mfs': "mfs' = mfs[ i := (map_vec (\ x. x symmod p)) (mfs ! i - c \\<^sub>v mfs ! j)]" + and dmu': "dmu' = mat m m (\(i',j'). (if (i' = i \ j' \ j) + then (if j'=j then (dmu $$ (i,j') - c * dmu $$ (j,j')) + else (dmu $$ (i,j') - c * dmu $$ (j,j')) + symmod (p * (d_of dmu j') * (d_of dmu (Suc j')))) + else (dmu $$ (i',j'))))" +shows "(\fs'. LLL_invariant_mod_weak fs' mfs' dmu' p first b \ + LLL_measure i fs' = LLL_measure i fs + \ (\_small_row i fs (Suc j) \ \_small_row i fs' j) + \ (\k < m. gso fs' k = gso fs k) + \ (\ii \ m. d fs' ii = d fs ii) + \ \\ fs' i j\ \ 1 / 2 + \ (\i' j'. i' < i \ j' \ i' \ \ fs' i' j' = \ fs i' j') + \ (LLL_invariant_mod fs mfs dmu p first b i \ LLL_invariant_mod fs' mfs' dmu' p first b i))" +proof - + define fs' where "fs' = fs[ i := fs ! i - c \\<^sub>v fs ! j]" + from LLL_invD_modw[OF Linvmw] have gbnd: "g_bnd_mode first b fs" and p1: "p > 1" and pgtz: "p > 0" by auto + have Linvww: "LLL_invariant_weak fs" using LLL_invD_modw[OF Linvmw] LLL_invariant_weak_def by simp + have + Linvw': "LLL_invariant_weak fs'" and + 01: "c = round (\ fs i j) \ \_small_row i fs (Suc j) \ \_small_row i fs' j" and + 02: "LLL_measure i fs' = LLL_measure i fs" and + 03: "\ i. i < m \ gso fs' i = gso fs i" and + 04: "\ i' j'. i' < m \ j' < m \ + \ fs' i' j' = (if i' = i \ j' \ j then \ fs i j' - of_int c * \ fs j j' else \ fs i' j')" and + 05: "\ ii. ii \ m \ d fs' ii = d fs ii" and + 06: "\\ fs' i j\ \ 1 / 2" and + 061: "(\i' j'. i' < i \ j' \ i' \ \ fs i' j' = \ fs' i' j')" + using basis_reduction_add_row_main[OF Linvww i j fs'_def] c i by auto + have 07: "lin_indep fs'" and + 08: "length fs' = m" and + 09: "lattice_of fs' = L" using LLL_inv_wD Linvw' by auto + have 091: "fs_int_indpt n fs'" using 07 using Gram_Schmidt_2.fs_int_indpt.intro by simp + define I where "I = {(i',j'). i' = i \ j' < j}" + have 10: "I \ {(i',j'). i' < m \ j' < i'}" "(i,j)\ I" "\j' \ j. (i,j') \ I" using I_def i j by auto + obtain fs'' where + 11: "lattice_of fs'' = L" and + 12: "map (map_vec (\ x. x symmod p)) fs'' = map (map_vec (\ x. x symmod p)) fs'" and + 13: "lin_indep fs''" and + 14: "length fs'' = m" and + 15: "(\ k < m. gso fs'' k = gso fs' k)" and + 16: "(\ k \ m. d fs'' k = d fs' k)" and + 17: "(\ i' < m. \ j' < m. d\ fs'' i' j' = + (if (i',j') \ I then d\ fs' i' j' symmod (p * d fs' j' * d fs' (Suc j')) else d\ fs' i' j'))" + using mod_finite_set[OF 07 08 10(1) 09 pgtz] by blast + have 171: "(\i' j'. i' < i \ j' \ i' \ \ fs'' i' j' = \ fs' i' j')" + proof - + { + fix i' j' + assume i'j': "i' < i" "j' \ i'" + have "rat_of_int (d\ fs'' i' j') = rat_of_int (d\ fs' i' j')" using "17" I_def i i'j' by auto + then have "rat_of_int (int_of_rat (rat_of_int (d fs'' (Suc j')) * \ fs'' i' j')) = + rat_of_int (int_of_rat (rat_of_int (d fs' (Suc j')) * \ fs' i' j'))" + using d\_def i'j' j by auto + then have "rat_of_int (d fs'' (Suc j')) * \ fs'' i' j' = + rat_of_int (d fs' (Suc j')) * \ fs' i' j'" + by (smt "08" "091" "13" "14" d_def dual_order.strict_trans fs_int.d_def + fs_int_indpt.fs_int_mu_d_Z fs_int_indpt.intro i i'j'(1) i'j'(2) int_of_rat(2)) + then have "\ fs'' i' j' = \ fs' i' j'" by (smt "16" + LLL_d_pos[OF Linvw'] Suc_leI int_of_rat(1) + dual_order.strict_trans fs'_def i i'j' j + le_neq_implies_less nonzero_mult_div_cancel_left of_int_hom.hom_zero) + } + then show ?thesis by simp + qed + then have 172: "(\i' j'. i' < i \ j' \ i' \ \ fs'' i' j' = \ fs i' j')" using 061 by simp (* goal *) + have 18: "LLL_measure i fs'' = LLL_measure i fs'" using 16 LLL_measure_def logD_def D_def by simp + have 19: "(\k < m. gso fs'' k = gso fs k)" using 03 15 by simp + have "\j' \ {j..(m-1)}. j' < m" using j i by auto + then have 20: "\j' \ {j..(m-1)}. d\ fs'' i j' = d\ fs' i j'" + using 10(3) 17 Suc_lessD less_trans_Suc by (meson atLeastAtMost_iff i) + have 21: "\j' \ {j..(m-1)}. \ fs'' i j' = \ fs' i j'" + proof - + { + fix j' + assume j': "j' \ {j..(m-1)}" + define \'' :: rat where "\'' = \ fs'' i j'" + define \' :: rat where "\' = \ fs' i j'" + have "rat_of_int (d\ fs'' i j') = rat_of_int (d\ fs' i j')" using 20 j' by simp + moreover have "j' < length fs'" using i j' 08 by auto + ultimately have "rat_of_int (d fs' (Suc j')) * gram_schmidt_fs.\ n (map of_int_hom.vec_hom fs') i j' + = rat_of_int (d fs'' (Suc j')) * gram_schmidt_fs.\ n (map of_int_hom.vec_hom fs'') i j'" + using 20 08 091 13 14 fs_int_indpt.d\_def fs_int.d_def fs_int_indpt.d\ d\_def d_def i fs_int_indpt.intro j' + by metis + then have "rat_of_int (d fs' (Suc j')) * \'' = rat_of_int (d fs' (Suc j')) * \'" + using 16 i j' \'_def \''_def unfolding d\_def by auto + moreover have "0 < d fs' (Suc j')" using LLL_d_pos[OF Linvw', of "Suc j'"] i j' by auto + ultimately have "\ fs'' i j' = \ fs' i j'" using \'_def \''_def by simp + } + then show ?thesis by simp + qed + then have 22: "\ fs'' i j = \ fs' i j" using i j by simp + then have 23: "\\ fs'' i j\ \ 1 / 2" using 06 by simp (* goal *) + have 24: "LLL_measure i fs'' = LLL_measure i fs" using 02 18 by simp (* goal *) + have 25: "(\ k \ m. d fs'' k = d fs k)" using 16 05 by simp (* goal *) + have 26: "(\ k < m. gso fs'' k = gso fs k)" using 15 03 by simp (* goal *) + have 27: "\_small_row i fs (Suc j) \ \_small_row i fs'' j" + using 21 01 \_small_row_def i j c by auto (* goal *) + have 28: "length fs = m" "length mfs = m" using LLL_invD_modw[OF Linvmw] by auto + have 29: "map (map_vec (\x. x symmod p)) fs = mfs" using assms LLL_invD_modw by simp + have 30: "\ i. i < m \ fs ! i \ carrier_vec n" "\ i. i < m \ mfs ! i \ carrier_vec n" + using LLL_invD_modw[OF Linvmw] by auto + have 31: "\ i. i < m \ fs' ! i \ carrier_vec n" using fs'_def 30(1) + using "08" "091" fs_int_indpt.f_carrier by blast + have 32: "\ i. i < m \ mfs' ! i \ carrier_vec n" unfolding mfs' using 30(2) 28(2) + by (metis (no_types, lifting) Suc_lessD j less_trans_Suc map_carrier_vec minus_carrier_vec + nth_list_update_eq nth_list_update_neq smult_closed) + have 33: "length mfs' = m" using 28(2) mfs' by simp (* invariant goal *) + then have 34: "map (map_vec (\x. x symmod p)) fs' = mfs'" + proof - + { + fix i' j' + have j2: "j < m" using j i by auto + assume i': "i' < m" + assume j': "j' < n" + then have fsij: "(fs ! i' $ j') symmod p = mfs ! i' $ j'" using 30 i' j' 28 29 by fastforce + have "mfs' ! i $ j' = (mfs ! i $ j'- (c \\<^sub>v mfs ! j) $ j') symmod p" + unfolding mfs' using 30(2) j' 28 j2 + by (metis (no_types, lifting) carrier_vecD i index_map_vec(1) index_minus_vec(1) + index_minus_vec(2) index_smult_vec(2) nth_list_update_eq) + then have mfs'ij: "mfs' ! i $ j' = (mfs ! i $ j'- c * mfs ! j $ j') symmod p" + unfolding mfs' using 30(2) i' j' 28 j2 by fastforce + have "(fs' ! i' $ j') symmod p = mfs' ! i' $ j'" + proof(cases "i' = i") + case True + show ?thesis using fs'_def mfs' True 28 fsij + proof - + have "fs' ! i' $ j' = (fs ! i' - c \\<^sub>v fs ! j) $ j'" using fs'_def True i' j' 28(1) by simp + also have "\ = fs ! i' $ j' - (c \\<^sub>v fs ! j) $ j'" using i' j' 30(1) + by (metis Suc_lessD carrier_vecD i index_minus_vec(1) index_smult_vec(2) j less_trans_Suc) + finally have "fs' ! i' $ j' = fs ! i' $ j' - (c \\<^sub>v fs ! j) $ j'" by auto + then have "(fs' ! i' $ j') symmod p = (fs ! i' $ j' - (c \\<^sub>v fs ! j) $ j') symmod p" by auto + also have "\ = ((fs ! i' $ j') symmod p - ((c \\<^sub>v fs ! j) $ j') symmod p) symmod p" + by (simp add: sym_mod_diff_eq) + also have "(c \\<^sub>v fs ! j) $ j' = c * (fs ! j $ j')" + using i' j' True 28 30(1) j + by (metis Suc_lessD carrier_vecD index_smult_vec(1) less_trans_Suc) + also have "((fs ! i' $ j') symmod p - (c * (fs ! j $ j')) symmod p) symmod p = + ((fs ! i' $ j') symmod p - c * ((fs ! j $ j') symmod p)) symmod p" + using i' j' True 28 30(1) j by (metis sym_mod_diff_right_eq sym_mod_mult_right_eq) + also have "((fs ! j $ j') symmod p) = mfs ! j $ j'" using 30 i' j' 28 29 j2 by fastforce + also have "((fs ! i' $ j') symmod p - c * mfs ! j $ j') symmod p = + (mfs ! i' $ j' - c * mfs ! j $ j') symmod p" using fsij by simp + finally show ?thesis using mfs'ij by (simp add: True) + qed + next + case False + show ?thesis using fs'_def mfs' False 28 fsij by simp + qed + } + then have "\i' < m. (map_vec (\x. x symmod p)) (fs' ! i') = mfs' ! i'" + using 31 32 33 08 by fastforce + then show ?thesis using 31 32 33 08 by (simp add: map_nth_eq_conv) + qed + then have 35: "map (map_vec (\x. x symmod p)) fs'' = mfs'" using 12 by simp (* invariant req. *) + have 36: "lin_indep fs''" using 13 by simp (* invariant req. *) + have Linvw'': "LLL_invariant_weak fs''" using LLL_invariant_weak_def 11 13 14 by simp + have 39: "(\i' < m. \j' < i'. \d\ fs'' i' j'\ < p * d fs'' j' * d fs'' (Suc j'))" (* invariant req. *) + proof - + { + fix i' j' + assume i': "i' < m" + assume j': "j' < i'" + define pdd where "pdd = (p * d fs'' j' * d fs'' (Suc j'))" + then have pddgtz: "pdd > 0" + using pgtz j' LLL_d_pos[OF Linvw', of "Suc j'"] LLL_d_pos[OF Linvw', of j'] j' i' 16 by simp + have "\d\ fs'' i' j'\ < p * d fs'' j' * d fs'' (Suc j')" + proof(cases "i' = i") + case i'i: True + then show ?thesis + proof (cases "j' < j") + case True + then have eq'': "d\ fs'' i' j' = d\ fs' i' j' symmod (p * d fs'' j' * d fs'' (Suc j'))" + using 16 17 10 I_def True i' j' i'i by simp + have "0 < pdd" using pddgtz by simp + then show ?thesis unfolding eq'' unfolding pdd_def[symmetric] using sym_mod_abs by blast + next + case fls: False + then have "(i',j') \ I" using I_def i'i by simp + then have dmufs''fs': "d\ fs'' i' j' = d\ fs' i' j'" using 17 i' j' by simp + show ?thesis + proof (cases "j' = j") + case True + define \'' where "\'' = \ fs'' i' j'" + define d'' where "d'' = d fs'' (Suc j')" + have pge1: "p \ 1" using pgtz by simp + have lh: "\\''\ \ 1 / 2" using 23 True i'i \''_def by simp + moreover have eq: "d\ fs'' i' j' = \'' * d''" using d\_def i' j' \''_def d''_def + by (smt "14" "36" LLL.d_def Suc_lessD fs_int.d_def fs_int_indpt.d\ fs_int_indpt.intro + int_of_rat(1) less_trans_Suc mult_of_int_commute of_rat_mult of_rat_of_int_eq) + moreover have Sj': "Suc j' \ m" "j' \ m" using True j' i i' by auto + moreover then have gtz: "0 < d''" using LLL_d_pos[OF Linvw''] d''_def by simp + moreover have "rat_of_int \d\ fs'' i' j'\ = \\'' * (rat_of_int d'')\" + using eq by (metis of_int_abs of_rat_hom.injectivity of_rat_mult of_rat_of_int_eq) + moreover then have "\\'' * rat_of_int d'' \ = \\''\ * rat_of_int \d''\" + by (metis (mono_tags, hide_lams) abs_mult of_int_abs) + moreover have "\ = \\''\ * rat_of_int d'' " using gtz by simp + moreover have "\ < rat_of_int d''" using lh gtz by simp + ultimately have "rat_of_int \d\ fs'' i' j'\ < rat_of_int d''" by simp + then have "\d\ fs'' i' j'\ < d fs'' (Suc j')" using d''_def by simp + then have "\d\ fs'' i' j'\ < p * d fs'' (Suc j')" using pge1 + by (smt mult_less_cancel_right2) + then show ?thesis using pge1 LLL_d_pos[OF Linvw'' Sj'(2)] gtz unfolding d''_def + by (smt mult_less_cancel_left2 mult_right_less_imp_less) + next + case False + have "j' < m" using i' j' by simp + moreover have "j' > j" using False fls by simp + ultimately have "\ fs' i' j' = \ fs i' j'" using i' 04 i by simp + then have "d\ fs' i' j' = d\ fs i' j'" using d\_def i' j' 05 by simp + then have "d\ fs'' i' j' = d\ fs i' j'" using dmufs''fs' by simp + then show ?thesis using LLL_invD_modw[OF Linvmw] i' j' 25 by simp + qed + qed + next + case False + then have "(i',j') \ I" using I_def by simp + then have dmufs''fs': "d\ fs'' i' j' = d\ fs' i' j'" using 17 i' j' by simp + have "\ fs' i' j' = \ fs i' j'" using i' 04 j' False by simp + then have "d\ fs' i' j' = d\ fs i' j'" using d\_def i' j' 05 by simp + moreover then have "d\ fs'' i' j' = d\ fs i' j'" using dmufs''fs' by simp + then show ?thesis using LLL_invD_modw[OF Linvmw] i' j' 25 by simp + qed + } + then show ?thesis by simp + qed + have 40: "(\i' < m. \j' < m. i' \ i \ j' > j \ d\ fs' i' j' = dmu $$ (i',j'))" + proof - + { + fix i' j' + assume i': "i' < m" and j': "j' < m" + assume assm: "i' \ i \ j' > j" + have "d\ fs' i' j' = dmu $$ (i',j')" + proof (cases "i' \ i") + case True + then show ?thesis using fs'_def LLL_invD_modw[OF Linvmw] d\_def i i' j j' + 04 28(1) LLL_invI_weak basis_reduction_add_row_main(8)[OF Linvww] by auto + next + case False + then show ?thesis + using 05 LLL_invD_modw[OF Linvmw] d\_def i j j' 04 assm by simp + qed + } + then show ?thesis by simp + qed + have 41: "\j' \ j. d\ fs' i j' = dmu $$ (i,j') - c * dmu $$ (j,j')" + proof - + { + let ?oi = "of_int :: _ \ rat" + fix j' + assume j': "j' \ j" + define dj' \i \j where "dj' = d fs (Suc j')" and "\i = \ fs i j'" and "\j = \ fs j j'" + have "?oi (d\ fs' i j') = ?oi (d fs (Suc j')) * (\ fs i j' - ?oi c * \ fs j j')" + using j' 04 d\_def + by (smt "05" "08" "091" Suc_leI d_def diff_diff_cancel fs_int.d_def + fs_int_indpt.fs_int_mu_d_Z i int_of_rat(2) j less_imp_diff_less less_imp_le_nat) + also have "\ = (?oi dj') * (\i - of_int c * \j)" + using dj'_def \i_def \j_def by (simp add: of_rat_mult) + also have "\ = (rat_of_int dj') * \i - of_int c * (rat_of_int dj') * \j" by algebra + also have "\ = rat_of_int (d\ fs i j') - ?oi c * rat_of_int (d\ fs j j')" unfolding dj'_def \i_def \j_def + using i j j' d\_def + using "28"(1) LLL.LLL_invD_modw(4) Linvmw d_def fs_int.d_def fs_int_indpt.fs_int_mu_d_Z fs_int_indpt.intro by auto + also have "\ = rat_of_int (dmu $$ (i,j')) - ?oi c * rat_of_int (dmu $$ (j,j'))" + using LLL_invD_modw(7)[OF Linvmw] d\_def j' i j by auto + finally have "?oi (d\ fs' i j') = rat_of_int (dmu $$ (i,j')) - ?oi c * rat_of_int (dmu $$ (j,j'))" by simp + then have "d\ fs' i j' = dmu $$ (i,j') - c * dmu $$ (j,j')" + using of_int_eq_iff by fastforce + } + then show ?thesis by simp + qed + have 42: "(\i' < m. \j' < m. d\ fs'' i' j' = dmu' $$ (i',j'))" + proof - + { + fix i' j' + assume i': "i' < m" and j': "j' < m" + have "d\ fs'' i' j' = dmu' $$ (i',j')" + proof (cases "i' = i") + case i'i: True + then show ?thesis + proof (cases "j' > j") + case True + then have "(i',j')\I" using I_def by simp + moreover then have "d\ fs' i' j' = d\ fs i' j'" using "04" "05" True Suc_leI d\_def i' j' by simp + moreover have "dmu' $$ (i',j') = dmu $$ (i',j')" using dmu' True i' j' by simp + ultimately show ?thesis using "17" "40" True i' j' by auto + next + case False + then have j'lej: "j' \ j" by simp + then have eq': "d\ fs' i j' = dmu $$ (i,j') - c * dmu $$ (j,j')" using 41 by simp + have id: "d_of dmu j' = d fs j'" "d_of dmu (Suc j') = d fs (Suc j')" + using d_of_weak[OF Linvmw] \j' < m\ by auto + show ?thesis + proof (cases "j' \ j") + case True + then have j'ltj: "j' < j" using True False by simp + then have "(i',j') \ I" using I_def True i'i by simp + then have "d\ fs'' i' j' = + (dmu $$ (i,j') - c * dmu $$ (j,j')) symmod (p * d fs' j' * d fs' (Suc j'))" + using 17 i' 41 j'lej by (simp add: j' i'i) + also have "\ = (dmu $$ (i,j') - c * dmu $$ (j,j')) symmod (p * d fs j' * d fs (Suc j'))" + using 05 i j'ltj j by simp + also have "\ = dmu' $$ (i,j')" + unfolding dmu' index_mat(1)[OF \i < m\ \j' < m\] split id using j'lej True by auto + finally show ?thesis using i'i by simp + next + case False + then have j'j: "j' = j" by simp + then have "d\ fs'' i j' = d\ fs' i j'" using 20 j' by simp + also have "\ = dmu $$ (i,j') - c * dmu $$ (j,j')" using eq' by simp + also have "\ = dmu' $$ (i,j')" using dmu' j'j i j' by simp + finally show ?thesis using i'i by simp + qed + qed + next + case False + then have "(i',j')\I" using I_def by simp + moreover then have "d\ fs' i' j' = d\ fs i' j'" by (simp add: "04" "05" False Suc_leI d\_def i' j') + moreover then have "dmu' $$ (i',j') = dmu $$ (i',j')" using dmu' False i' j' by simp + ultimately show ?thesis using "17" "40" False i' j' by auto + qed + } + then show ?thesis by simp + qed + from gbnd 26 have gbnd: "g_bnd_mode first b fs''" using g_bnd_mode_cong[of fs'' fs] by simp + { + assume Linv: "LLL_invariant_mod fs mfs dmu p first b i" + have Linvw: "LLL_invariant_weak' i fs" using Linv LLL_invD_mod LLL_invI_weak by simp + note Linvww = LLL_invw'_imp_w[OF Linvw] + have 00: "LLL_invariant_weak' i fs'" using Linvw basis_reduction_add_row_weak[OF Linvw i j fs'_def] by auto + have 37: "weakly_reduced fs'' i" using 15 LLL_invD_weak(8)[OF 00] gram_schmidt_fs.weakly_reduced_def + by (smt Suc_lessD i less_trans_Suc) (* invariant req. *) + have 38: "LLL_invariant_weak' i fs''" + using 00 11 14 36 37 i 31 12 LLL_invariant_weak'_def by blast + have "LLL_invariant_mod fs'' mfs' dmu' p first b i" + using LLL_invI_mod[OF 33 _ 14 11 13 37 35 39 42 p1 gbnd LLL_invD_mod(17)[OF Linv]] i by simp + } + moreover have "LLL_invariant_mod_weak fs'' mfs' dmu' p first b" + using LLL_invI_modw[OF 33 14 11 13 35 39 42 p1 gbnd LLL_invD_modw(15)[OF Linvmw]] by simp + ultimately show ?thesis using 27 23 24 25 26 172 by auto +qed + +definition D_mod :: "int mat \ nat" where "D_mod dmu = nat (\ i < m. d_of dmu i)" + +definition logD_mod :: "int mat \ nat" + where "logD_mod dmu = (if \ = 4/3 then (D_mod dmu) else nat (floor (log (1 / of_rat reduction) (D_mod dmu))))" +end + +locale fs_int'_mod = + fixes n m fs_init \ i fs mfs dmu p first b + assumes LLL_inv_mod: "LLL.LLL_invariant_mod n m fs_init \ fs mfs dmu p first b i" + +context LLL_with_assms +begin + +lemma basis_reduction_swap_weak': assumes Linvw: "LLL_invariant_weak' i fs" + and i: "i < m" + and i0: "i \ 0" + and mu_F1_i: "\\ fs i (i-1)\ \ 1 / 2" + and norm_ineq: "sq_norm (gso fs (i - 1)) > \ * sq_norm (gso fs i)" + and fs'_def: "fs' = fs[i := fs ! (i - 1), i - 1 := fs ! i]" +shows "LLL_invariant_weak' (i - 1) fs'" +proof - + note inv = LLL_invD_weak[OF Linvw] + note invw = LLL_invw'_imp_w[OF Linvw] + note main = basis_reduction_swap_main[OF invw disjI2[OF mu_F1_i] i i0 norm_ineq fs'_def] + note inv' = LLL_inv_wD[OF main(1)] + from \weakly_reduced fs i\ have "weakly_reduced fs (i - 1)" + unfolding gram_schmidt_fs.weakly_reduced_def by auto + also have "weakly_reduced fs (i - 1) = weakly_reduced fs' (i - 1)" + unfolding gram_schmidt_fs.weakly_reduced_def + by (intro all_cong, insert i0 i main(5), auto) + finally have red: "weakly_reduced fs' (i - 1)" . + show "LLL_invariant_weak' (i - 1) fs'" using i + by (intro LLL_invI_weak red inv', auto) +qed + +lemma basis_reduction_add_row_done_weak: + assumes Linv: "LLL_invariant_weak' i fs" + and i: "i < m" + and mu_small: "\_small_row i fs 0" +shows "\_small fs i" +proof - + note inv = LLL_invD_weak[OF Linv] + from mu_small + have mu_small: "\_small fs i" unfolding \_small_row_def \_small_def by auto + show ?thesis + using i mu_small LLL_invI_weak[OF inv(3,6,7,9,1)] by auto +qed + +lemma LLL_invariant_mod_to_weak_m_to_i: assumes + inv: "LLL_invariant_mod fs mfs dmu p first b m" + and i: "i \ m" +shows "LLL_invariant_mod fs mfs dmu p first b i" + "LLL_invariant_weak' m fs" + "LLL_invariant_weak' i fs" +proof - + show "LLL_invariant_mod fs mfs dmu p first b i" + proof - + have "LLL_invariant_weak' m fs" using LLL_invD_mod[OF inv] LLL_invI_weak by simp + then have "LLL_invariant_weak' i fs" using LLL_inv_weak_m_impl_i i by simp + then have "weakly_reduced fs i" using i LLL_invD_weak(8) by simp + then show ?thesis using LLL_invD_mod[OF inv] LLL_invI_mod i by simp + qed + then show fsinvwi: "LLL_invariant_weak' i fs" using LLL_invD_mod LLL_invI_weak by simp + show "LLL_invariant_weak' m fs" using LLL_invD_mod[OF inv] LLL_invI_weak by simp +qed + +lemma basis_reduction_mod_swap_main: + assumes Linvmw: "LLL_invariant_mod_weak fs mfs dmu p first b" + and k: "k < m" + and k0: "k \ 0" + and mu_F1_i: "\\ fs k (k-1)\ \ 1 / 2" + and norm_ineq: "sq_norm (gso fs (k - 1)) > \ * sq_norm (gso fs k)" + and mfs'_def: "mfs' = mfs[k := mfs ! (k - 1), k - 1 := mfs ! k]" + and dmu'_def: "dmu' = (mat m m (\(i,j). ( + if j < i then + if i = k - 1 then + dmu $$ (k, j) + else if i = k \ j \ k - 1 then + dmu $$ (k - 1, j) + else if i > k \ j = k then + ((d_of dmu (Suc k)) * dmu $$ (i, k - 1) - dmu $$ (k, k - 1) * dmu $$ (i, j)) + div (d_of dmu k) + else if i > k \ j = k - 1 then + (dmu $$ (k, k - 1) * dmu $$ (i, j) + dmu $$ (i, k) * (d_of dmu (k-1))) + div (d_of dmu k) + else dmu $$ (i, j) + else if i = j then + if i = k - 1 then + ((d_of dmu (Suc k)) * (d_of dmu (k-1)) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) + div (d_of dmu k) + else (d_of dmu (Suc i)) + else dmu $$ (i, j)) + ))" + and dmu'_mod_def: "dmu'_mod = mat m m (\(i, j). ( + if j < i \ (j = k \ j = k - 1) then + dmu' $$ (i, j) symmod (p * (d_of dmu' j) * (d_of dmu' (Suc j))) + else dmu' $$ (i, j)))" +shows "(\fs'. LLL_invariant_mod_weak fs' mfs' dmu'_mod p first b \ + LLL_measure (k-1) fs' < LLL_measure k fs \ + (LLL_invariant_mod fs mfs dmu p first b k \ LLL_invariant_mod fs' mfs' dmu'_mod p first b (k-1)))" +proof - + define fs' where "fs' = fs[k := fs ! (k - 1), k - 1 := fs ! k]" + have pgtz: "p > 0" and p1: "p > 1" using LLL_invD_modw[OF Linvmw] by auto + have invw: "LLL_invariant_weak fs" using LLL_invD_modw[OF Linvmw] LLL_invariant_weak_def by simp + note swap_main = basis_reduction_swap_main(3-)[OF invw disjI2[OF mu_F1_i] k k0 norm_ineq fs'_def] + note dd\_swap = d_d\_swap[OF invw disjI2[OF mu_F1_i] k k0 norm_ineq fs'_def] + have invw': "LLL_invariant_weak fs'" using fs'_def assms invw basis_reduction_swap_main(1) by simp + have 02: "LLL_measure k fs > LLL_measure (k - 1) fs'" by fact + have 03: "\ i j. i < m \ j < i \ + d\ fs' i j = ( + if i = k - 1 then + d\ fs k j + else if i = k \ j \ k - 1 then + d\ fs (k - 1) j + else if i > k \ j = k then + (d fs (Suc k) * d\ fs i (k - 1) - d\ fs k (k - 1) * d\ fs i j) div d fs k + else if i > k \ j = k - 1 then + (d\ fs k (k - 1) * d\ fs i j + d\ fs i k * d fs (k - 1)) div d fs k + else d\ fs i j)" + using dd\_swap by auto + have 031: "\i. i < k-1 \ gso fs' i = gso fs i" + using swap_main(2) k k0 by auto + have 032: "\ ii. ii \ m \ of_int (d fs' ii) = (if ii = k then + sq_norm (gso fs' (k - 1)) / sq_norm (gso fs (k - 1)) * of_int (d fs k) + else of_int (d fs ii))" + by fact + have gbnd: "g_bnd_mode first b fs'" + proof (cases "first \ m \ 0") + case True + have "sq_norm (gso fs' 0) \ sq_norm (gso fs 0)" + proof (cases "k - 1 = 0") + case False + thus ?thesis using 031[of 0] by simp + next + case *: True + have k_1: "k - 1 < m" using k by auto + from * k0 have k1: "k = 1" by simp + (* this is a copy of what is done in LLL.swap-main, should be made accessible in swap-main *) + have "sq_norm (gso fs' 0) \ abs (sq_norm (gso fs' 0))" by simp + also have "\ = abs (sq_norm (gso fs 1) + \ fs 1 0 * \ fs 1 0 * sq_norm (gso fs 0))" + by (subst swap_main(3)[OF k_1, unfolded *], auto simp: k1) + also have "\ \ sq_norm (gso fs 1) + abs (\ fs 1 0) * abs (\ fs 1 0) * sq_norm (gso fs 0)" + by (simp add: sq_norm_vec_ge_0) + also have "\ \ sq_norm (gso fs 1) + (1 / 2) * (1 / 2) * sq_norm (gso fs 0)" + using mu_F1_i[unfolded k1] + by (intro plus_right_mono mult_mono, auto) + also have "\ < 1 / \ * sq_norm (gso fs 0) + (1 / 2) * (1 / 2) * sq_norm (gso fs 0)" + by (intro add_strict_right_mono, insert norm_ineq[unfolded mult.commute[of \], + THEN mult_imp_less_div_pos[OF \0(1)]] k1, auto) + also have "\ = reduction * sq_norm (gso fs 0)" unfolding reduction_def + using \0 by (simp add: ring_distribs add_divide_distrib) + also have "\ \ 1 * sq_norm (gso fs 0)" using reduction(2) + by (intro mult_right_mono, auto) + finally show ?thesis by simp + qed + thus ?thesis using LLL_invD_modw(14)[OF Linvmw] True + unfolding g_bnd_mode_def by auto + next + case False + from LLL_invD_modw(14)[OF Linvmw] False have "g_bnd b fs" unfolding g_bnd_mode_def by auto + hence "g_bnd b fs'" using g_bnd_swap[OF k k0 invw mu_F1_i norm_ineq fs'_def] by simp + thus ?thesis using False unfolding g_bnd_mode_def by auto + qed + note d_of = d_of_weak[OF Linvmw] + have 033: "\ i. i < m \ d\ fs' i i = ( + if i = k - 1 then + ((d_of dmu (Suc k)) * (d_of dmu (k-1)) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) + div (d_of dmu k) + else (d_of dmu (Suc i)))" + proof - + fix i + assume i: "i < m" + have "d\ fs' i i = d fs' (Suc i)" using dd\ i by simp + also have "\ = (if i = k - 1 then + (d fs (Suc k) * d fs (k - 1) + d\ fs k (k - 1) * d\ fs k (k - 1)) div d fs k + else d fs (Suc i))" + by (subst dd\_swap, insert dd\ k0 i, auto) + also have "\ = (if i = k - 1 then + ((d_of dmu (Suc k)) * (d_of dmu (k-1)) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) + div (d_of dmu k) + else (d_of dmu (Suc i)))" (is "_ = ?r") + using d_of i k LLL_invD_modw(7)[OF Linvmw] by auto + finally show "d\ fs' i i = ?r" . + qed + have 04: "lin_indep fs'" "length fs' = m" "lattice_of fs' = L" using LLL_inv_wD[OF invw'] by auto + define I where "I = {(i, j). i < m \ j < i \ (j = k \ j = k - 1)}" + then have Isubs: "I \ {(i,j). i < m \ j < i}" using k k0 by auto + obtain fs'' where + 05: "lattice_of fs'' = L" and + 06: "map (map_vec (\ x. x symmod p)) fs'' = map (map_vec (\ x. x symmod p)) fs'" and + 07: "lin_indep fs''" and + 08: "length fs'' = m" and + 09: "(\ k < m. gso fs'' k = gso fs' k)" and + 10: "(\ k \ m. d fs'' k = d fs' k)" and + 11: "(\ i' < m. \ j' < m. d\ fs'' i' j' = + (if (i',j') \ I then d\ fs' i' j' symmod (p * d fs' j' * d fs' (Suc j')) else d\ fs' i' j'))" + using mod_finite_set[OF 04(1) 04(2) Isubs 04(3) pgtz] by blast + have 13: "length mfs' = m" using mfs'_def LLL_invD_modw(1)[OF Linvmw] by simp (* invariant requirement *) + have 14: "map (map_vec (\ x. x symmod p)) fs'' = mfs'" (* invariant requirement *) + using 06 fs'_def k k0 04(2) LLL_invD_modw(5)[OF Linvmw] + by (metis (no_types, lifting) length_list_update less_imp_diff_less map_update mfs'_def nth_map) + have "LLL_measure (k - 1) fs'' = LLL_measure (k - 1) fs'" using 10 LLL_measure_def logD_def D_def by simp + then have 15: "LLL_measure (k - 1) fs'' < LLL_measure k fs" using 02 by simp (* goal *) + { + fix i' j' + assume i'j': "i' k" "j' \ k - 1" + hence j'k: "j' \ k" "Suc j' \ k" using k0 by auto + hence "d fs'' j' = d fs j'" "d fs'' (Suc j') = d fs (Suc j')" + using \k < m\ i'j' k0 + 10[rule_format, of j'] 032[rule_format, of j'] + 10[rule_format, of "Suc j'"] 032[rule_format, of "Suc j'"] + by auto + } note d_id = this + + have 16: "\i'j'd\ fs'' i' j'\ < p * d fs'' j' * d fs'' (Suc j')" (* invariant requirement *) + proof - + { + fix i' j' + assume i'j': "i'd\ fs'' i' j'\ < p * d fs'' j' * d fs'' (Suc j')" + proof (cases "(i',j') \ I") + case True + define pdd where "pdd = (p * d fs' j' * d fs' (Suc j'))" + have pdd_pos: "pdd > 0" using pgtz i'j' LLL_d_pos[OF invw'] pdd_def by simp + have "d\ fs'' i' j' = d\ fs' i' j' symmod pdd" using True 11 i'j' pdd_def by simp + then have "\d\ fs'' i' j'\ < pdd" using True 11 i'j' pdd_pos sym_mod_abs by simp + then show ?thesis unfolding pdd_def using 10 i'j' by simp + next + case False + from False[unfolded I_def] i'j' have neg: "j' \ k" "j' \ k - 1" by auto + + consider (1) "i' = k - 1 \ i' = k" | (2) "\ (i' = k - 1 \ i' = k)" + using False i'j' unfolding I_def by linarith + thus ?thesis + proof cases + case **: 1 + let ?i'' = "if i' = k - 1 then k else k -1" + from ** neg i'j' have i'': "?i'' < m" "j' < ?i''" using k0 k by auto + have "d\ fs'' i' j' = d\ fs' i' j'" using 11 False i'j' by simp + also have "\ = d\ fs ?i'' j'" unfolding 03[OF \i' < m\ \j' < i'\] + using ** neg by auto + finally show ?thesis using LLL_invD_modw(6)[OF Linvmw, rule_format, OF i''] unfolding d_id[OF i'j' neg] by auto + next + case **: 2 + hence neq: "j' \ k" "j' \ k - 1" using False k k0 i'j' unfolding I_def by auto + have "d\ fs'' i' j' = d\ fs' i' j'" using 11 False i'j' by simp + also have "\ = d\ fs i' j'" unfolding 03[OF \i' < m\ \j' < i'\] using ** neq by auto + finally show ?thesis using LLL_invD_modw(6)[OF Linvmw, rule_format, OF i'j'] using d_id[OF i'j' neq] by auto + qed + qed + } + then show ?thesis by simp + qed + have 17: "\i'j' fs'' i' j' = dmu'_mod $$ (i', j')" (* invariant requirement *) + proof - + { + fix i' j' + assume i'j': "i'j' < m. d fs' (Suc j') = dmu' $$ (j', j')" using dd\ dmu'_def 033 by simp + have eq': "d\ fs' i' j' = dmu' $$ (i', j')" + proof - + have t00: "d\ fs k j' = dmu $$ (k, j')" and + t01: "d\ fs (k - 1) j' = dmu $$ (k - 1, j')" and + t04: "d\ fs k (k - 1) = dmu $$ (k, k - 1)" and + t05: "d\ fs i' k = dmu $$ (i', k)" + using LLL_invD_modw(7)[OF Linvmw] i'j' k dd\ k0 by auto + have t03: "d fs k = d\ fs (k-1) (k-1)" using k0 k by (metis LLL.dd\ Suc_diff_1 lessI not_gr_zero) + have t06: "d fs (k - 1) = (d_of dmu (k-1))" using d_of k by auto + have t07: "d fs k = (d_of dmu k)" using d_of k by auto + have j': "j' < m" using i'j' by simp + have "d\ fs' i' j' = (if i' = k - 1 then + dmu $$ (k, j') + else if i' = k \ j' \ k - 1 then + dmu $$ (k - 1, j') + else if i' > k \ j' = k then + (dmu $$ (k, k) * dmu $$ (i', k - 1) - dmu $$ (k, k - 1) * dmu $$ (i', j')) div (d_of dmu k) + else if i' > k \ j' = k - 1 then + (dmu $$ (k, k - 1) * dmu $$ (i', j') + dmu $$ (i', k) * d fs (k - 1)) div (d_of dmu k) + else dmu $$ (i', j'))" + using dd\ k t00 t01 t03 LLL_invD_modw(7)[OF Linvmw] k i'j' j' 03 t07 by simp + then show ?thesis using dmu'_def i'j' j' t06 t07 by (simp add: d_of_def) + qed + have "d\ fs'' i' j' = dmu'_mod $$ (i', j')" + proof (cases "(i',j') \ I") + case i'j'I: True + have j': "j' < m" using i'j' by simp + show ?thesis + proof - + have "dmu'_mod $$ (i',j') = dmu' $$ (i',j') + symmod (p * (d_of dmu' j') * (d_of dmu' (Suc j')))" + using dmu'_mod_def i'j' i'j'I I_def by simp + also have "d_of dmu' j' = d fs' j'" + using j' d'dmu' d_def Suc_diff_1 less_imp_diff_less unfolding d_of_def + by (cases j', auto) + finally have "dmu'_mod $$ (i',j') = dmu' $$ (i',j') symmod (p * d fs' j' * d fs' (Suc j'))" + using dd\[OF j'] d'dmu' j' by (auto simp: d_of_def) + then show ?thesis using i'j'I 11 i'j' eq' by simp + qed + next + case False + have "d\ fs'' i' j' = d\ fs' i' j'" using False 11 i'j' by simp + also have "\ = dmu' $$ (i', j')" unfolding eq' .. + finally show ?thesis unfolding dmu'_mod_def using False[unfolded I_def] i'j' by auto + qed + } + moreover have "\i' j'. i' < m \ j' < m \ i' = j' \ d\ fs'' i' j' = dmu'_mod $$ (i', j')" + using dd\ dmu'_def 033 10 dmu'_mod_def 11 I_def by simp + moreover { + fix i' j' + assume i'j'': "i' < m" "j' < m" "i' < j'" + then have \z: "\ fs'' i' j' = 0" by (simp add: gram_schmidt_fs.\.simps) + have "dmu'_mod $$ (i',j') = dmu' $$ (i',j')" using dmu'_mod_def i'j'' by auto + also have "\ = d\ fs i' j'" using LLL_invD_modw(7)[OF Linvmw] i'j'' dmu'_def by simp + also have "\ = 0" using d\_def i'j'' by (simp add: gram_schmidt_fs.\.simps) + finally have "d\ fs'' i' j' = dmu'_mod $$ (i',j')" using \z d_def i'j'' d\_def by simp + } + ultimately show ?thesis by (meson nat_neq_iff) + qed + from gbnd 09 have g_bnd: "g_bnd_mode first b fs''" using g_bnd_mode_cong[of fs' fs''] by auto + { + assume Linv: "LLL_invariant_mod fs mfs dmu p first b k" + have 00: "LLL_invariant_weak' k fs" using LLL_invD_mod[OF Linv] LLL_invI_weak by simp + note swap_weak' = basis_reduction_swap_weak'[OF 00 k k0 mu_F1_i norm_ineq fs'_def] + have 01: "LLL_invariant_weak' (k - 1) fs'" by fact + have 12: "weakly_reduced fs'' (k-1)" (* invariant requirement *) + using 031 09 k LLL_invD_weak(8)[OF 00] unfolding gram_schmidt_fs.weakly_reduced_def by simp + have "LLL_invariant_mod fs'' mfs' dmu'_mod p first b (k-1)" + using LLL_invI_mod[OF 13 _ 08 05 07 12 14 16 17 p1 g_bnd LLL_invD_mod(17)[OF Linv]] k by simp + } + moreover have "LLL_invariant_mod_weak fs'' mfs' dmu'_mod p first b" + using LLL_invI_modw[OF 13 08 05 07 14 16 17 p1 g_bnd LLL_invD_modw(15)[OF Linvmw]] by simp + ultimately show ?thesis using 15 by auto +qed + +lemma dmu_quot_is_round_of_\: + assumes Linv: "LLL_invariant_mod fs mfs dmu p first b i'" + and c: "c = round_num_denom (dmu $$ (i,j)) (d_of dmu (Suc j))" + and i: "i < m" + and j: "j < i" + shows "c = round(\ fs i j)" +proof - + have Linvw: "LLL_invariant_weak' i' fs" using LLL_invD_mod[OF Linv] LLL_invI_weak by simp + have j2: "j < m" using i j by simp + then have j3: "Suc j \ m" by simp + have \1: "\ fs j j = 1" using i j by (meson gram_schmidt_fs.\.elims less_irrefl_nat) + have inZ: "rat_of_int (d fs (Suc j)) * \ fs i j \ \" using fs_int_indpt.fs_int_mu_d_Z_m_m i j + LLL_invD_mod(5)[OF Linv] LLL_invD_weak(2) Linvw d_def fs_int.d_def fs_int_indpt.intro by auto + have "c = round(rat_of_int (d\ fs i j) / rat_of_int (d\ fs j j))" using LLL_invD_mod(9) Linv i j c + by (simp add: round_num_denom d_of_def) + then show ?thesis using LLL_d_pos[OF LLL_invw'_imp_w[OF Linvw] j3] j i inZ d\_def \1 by simp +qed + +lemma dmu_quot_is_round_of_\_weak: + assumes Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and c: "c = round_num_denom (dmu $$ (i,j)) (d_of dmu (Suc j))" + and i: "i < m" + and j: "j < i" + shows "c = round(\ fs i j)" +proof - + have Linvww: "LLL_invariant_weak fs" using LLL_invD_modw[OF Linv] LLL_invariant_weak_def by simp + have j2: "j < m" using i j by simp + then have j3: "Suc j \ m" by simp + have \1: "\ fs j j = 1" using i j by (meson gram_schmidt_fs.\.elims less_irrefl_nat) + have inZ: "rat_of_int (d fs (Suc j)) * \ fs i j \ \" using fs_int_indpt.fs_int_mu_d_Z_m_m i j + LLL_invD_modw[OF Linv] d_def fs_int.d_def fs_int_indpt.intro by auto + have "c = round(rat_of_int (d\ fs i j) / rat_of_int (d\ fs j j))" using LLL_invD_modw(7) Linv i j c + by (simp add: round_num_denom d_of_def) + then show ?thesis using LLL_d_pos[OF Linvww j3] j i inZ d\_def \1 by simp +qed + +lemma basis_reduction_mod_add_row: assumes + Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and res: "basis_reduction_mod_add_row p mfs dmu i j = (mfs', dmu')" + and i: "i < m" + and j: "j < i" + and igtz: "i \ 0" +shows "(\fs'. LLL_invariant_mod_weak fs' mfs' dmu' p first b \ + LLL_measure i fs' = LLL_measure i fs \ + (\_small_row i fs (Suc j) \ \_small_row i fs' j) \ + \\ fs' i j\ \ 1 / 2 \ + (\i' j'. i' < i \ j' \ i' \ \ fs' i' j' = \ fs i' j') \ + (LLL_invariant_mod fs mfs dmu p first b i \ LLL_invariant_mod fs' mfs' dmu' p first b i) \ + (\ii \ m. d fs' ii = d fs ii))" +proof - + define c where "c = round_num_denom (dmu $$ (i,j)) (d_of dmu (Suc j))" + then have c: "c = round(\ fs i j)" using dmu_quot_is_round_of_\_weak[OF Linv c_def i j] by simp + show ?thesis + proof (cases "c = 0") + case True + then have pair_id: "(mfs', dmu') = (mfs, dmu)" + using res c_def unfolding basis_reduction_mod_add_row_def Let_def by auto + moreover have "\\ fs i j\ \ inverse 2" using c[symmetric, unfolded True] + by (simp add: round_def, linarith) + moreover then have "(\_small_row i fs (Suc j) \ \_small_row i fs j)" + unfolding \_small_row_def using Suc_leI le_neq_implies_less by blast + ultimately show ?thesis using Linv pair_id by auto + next + case False + then have pair_id: "(mfs', dmu') = (mfs[i := map_vec (\x. x symmod p) (mfs ! i - c \\<^sub>v mfs ! j)], + mat m m (\(i', j'). if i' = i \ j' \ j + then if j' = j then dmu $$ (i, j') - c * dmu $$ (j, j') + else (dmu $$ (i,j') - c * dmu $$ (j,j')) + symmod (p * (d_of dmu j') * (d_of dmu (Suc j'))) + else dmu $$ (i', j')))" + using res c_def unfolding basis_reduction_mod_add_row_def Let_def by auto + then have mfs': "mfs' = mfs[i := map_vec (\x. x symmod p) (mfs ! i - c \\<^sub>v mfs ! j)]" + and dmu': "dmu' = mat m m (\(i', j'). if i' = i \ j' \ j + then if j' = j then dmu $$ (i, j') - c * dmu $$ (j, j') + else (dmu $$ (i,j') - c * dmu $$ (j,j')) + symmod (p * (d_of dmu j') * (d_of dmu (Suc j'))) + else dmu $$ (i', j'))" by auto + show ?thesis using basis_reduction_mod_add_row_main[OF Linv i j c mfs' dmu'] by blast + qed +qed + +lemma basis_reduction_mod_swap: assumes + Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and mu: "\\ fs k (k-1)\ \ 1 / 2" + and res: "basis_reduction_mod_swap p mfs dmu k = (mfs', dmu'_mod)" + and cond: "sq_norm (gso fs (k - 1)) > \ * sq_norm (gso fs k)" + and i: "k < m" "k \ 0" +shows "(\fs'. LLL_invariant_mod_weak fs' mfs' dmu'_mod p first b \ + LLL_measure (k - 1) fs' < LLL_measure k fs \ + (LLL_invariant_mod fs mfs dmu p first b k \ LLL_invariant_mod fs' mfs' dmu'_mod p first b (k-1)))" + using res[unfolded basis_reduction_mod_swap_def basis_reduction_mod_swap_dmu_mod_def] + basis_reduction_mod_swap_main[OF Linv i mu cond] by blast + +lemma basis_reduction_adjust_mod: assumes + Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and res: "basis_reduction_adjust_mod p first mfs dmu = (p', mfs', dmu', g_idx')" +shows "(\fs' b'. (LLL_invariant_mod fs mfs dmu p first b i \ LLL_invariant_mod fs' mfs' dmu' p' first b' i) \ + LLL_invariant_mod_weak fs' mfs' dmu' p' first b' \ + LLL_measure i fs' = LLL_measure i fs)" +proof (cases "\ g_idx. basis_reduction_adjust_mod p first mfs dmu = (p, mfs, dmu, g_idx)") + case True + thus ?thesis using res Linv by auto +next + case False + obtain b' g_idx where norm: "compute_max_gso_norm first dmu = (b', g_idx)" by force + define p'' where "p'' = compute_mod_of_max_gso_norm first b'" + define d_vec where "d_vec = vec (Suc m) (\i. d_of dmu i)" + define mfs'' where "mfs'' = map (map_vec (\x. x symmod p'')) mfs" + define dmu'' where "dmu'' = mat m m (\(i, j). + if j < i then dmu $$ (i, j) symmod (p'' * d_vec $ j * d_vec $ Suc j) + else dmu $$ (i, j))" + note res = res False + note res = res[unfolded basis_reduction_adjust_mod.simps Let_def norm split, + folded p''_def, folded d_vec_def mfs''_def, folded dmu''_def] + from res have pp': "p'' < p" and id: "dmu' = dmu''" "mfs' = mfs''" "p' = p''" "g_idx' = g_idx" + by (auto split: if_splits) + define I where "I = {(i',j'). i' < m \ j' < i'}" + note inv = LLL_invD_modw[OF Linv] + from inv(4) have lin: "gs.lin_indpt_list (RAT fs)" . + from inv(3) have lat: "lattice_of fs = L" . + from inv(2) have len: "length fs = m" . + have weak: "LLL_invariant_weak fs" using Linv + by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_weak_def) + from compute_max_gso_norm[OF _ weak, of dmu first, unfolded norm] inv(7) + have bnd: "g_bnd_mode first b' fs" and b': "b' \ 0" "m = 0 \ b' = 0" by auto + from compute_mod_of_max_gso_norm[OF b' p''_def] + have p'': "0 < p''" "1 < p''" "mod_invariant b' p'' first" + by auto + obtain fs' where + 01: "lattice_of fs' = L" and + 02: "map (map_vec (\ x. x symmod p'')) fs' = map (map_vec (\ x. x symmod p'')) fs" and + 03: "lin_indep fs'" and + 04: "length fs' = m" and + 05: "(\ k < m. gso fs' k = gso fs k)" and + 06: "(\ k \ m. d fs' k = d fs k)" and + 07: "(\ i' < m. \ j' < m. d\ fs' i' j' = + (if (i',j') \ I then d\ fs i' j' symmod (p'' * d fs j' * d fs (Suc j')) else d\ fs i' j'))" + using mod_finite_set[OF lin len _ lat, of I] I_def p'' by blast + from bnd 05 have bnd: "g_bnd_mode first b' fs'" using g_bnd_mode_cong[of fs fs'] by auto + have D: "D fs = D fs'" unfolding D_def using 06 by auto + + + have Linv': "LLL_invariant_mod_weak fs' mfs'' dmu'' p'' first b'" + proof (intro LLL_invI_modw p'' 04 03 01 bnd) + { + have "mfs'' = map (map_vec (\x. x symmod p'')) mfs" by fact + also have "\ = map (map_vec (\x. x symmod p'')) (map (map_vec (\x. x symmod p)) fs)" + using inv by simp + also have "\ = map (map_vec (\x. x symmod p symmod p'')) fs" by auto + also have "(\ x. x symmod p symmod p'') = (\ x. x symmod p'')" + proof (intro ext) + fix x + from \mod_invariant b p first\[unfolded mod_invariant_def] obtain e where + p: "p = log_base ^ e" by auto + from p''[unfolded mod_invariant_def] obtain e' where + p'': "p'' = log_base ^ e'" by auto + from pp'[unfolded p p''] log_base have "e' \ e" by simp + hence dvd: "p'' dvd p" unfolding p p'' using log_base by (metis le_imp_power_dvd) + thus "x symmod p symmod p'' = x symmod p''" + by (intro sym_mod_sym_mod_cancel) + qed + finally show "map (map_vec (\x. x symmod p'')) fs' = mfs''" unfolding 02 .. + } + thus "length mfs'' = m" using 04 by auto + show "\i'j'd\ fs' i' j'\ < p'' * d fs' j' * d fs' (Suc j')" + proof - + { + fix i' j' + assume i'j': "i' < m" "j' < i'" + then have "d\ fs' i' j' = d\ fs i' j' symmod (p'' * d fs' j' * d fs' (Suc j'))" + using 07 06 unfolding I_def by simp + then have "\d\ fs' i' j'\ < p'' * d fs' j' * d fs' (Suc j')" + using sym_mod_abs p'' LLL_d_pos[OF weak] mult_pos_pos + by (smt "06" i'j' less_imp_le_nat less_trans_Suc nat_SN.gt_trans) + } + then show ?thesis by simp + qed + from inv(7) have dmu: "i' < m \ j' < m \ dmu $$ (i', j') = d\ fs i' j'" for i' j' + by auto + note d_of = d_of_weak[OF Linv] + have dvec: "i \ m \ d_vec $ i = d fs i" for i unfolding d_vec_def using d_of by auto + show "\i'j' fs' i' j' = dmu'' $$ (i', j')" + using 07 unfolding dmu''_def I_def + by (auto simp: dmu dvec) + qed + + moreover + { + assume linv: "LLL_invariant_mod fs mfs dmu p first b i" + note inv = LLL_invD_mod[OF linv] + hence i: "i \ m" by auto + have norm: "j < m \ \gso fs j\\<^sup>2 = \gso fs' j\\<^sup>2" for j + using 05 by auto + have "weakly_reduced fs i = weakly_reduced fs' i" + unfolding gram_schmidt_fs.weakly_reduced_def using i + by (intro all_cong arg_cong2[where f = "(\)"] arg_cong[where f = "\ x. _ * x"] norm, auto) + with inv have "weakly_reduced fs' i" by auto + hence "LLL_invariant_mod fs' mfs'' dmu'' p'' first b' i" using inv + by (intro LLL_invI_mod LLL_invD_modw[OF Linv']) + } + + moreover have "LLL_measure i fs' = LLL_measure i fs" + unfolding LLL_measure_def logD_def D .. + ultimately show ?thesis unfolding id by blast +qed + +lemma alpha_comparison: assumes + Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and alph: "quotient_of \ = (num, denom)" + and i: "i < m" + and i0: "i \ 0" +shows "(d_of dmu i * d_of dmu i * denom \ num * d_of dmu (i - 1) * d_of dmu (Suc i)) + = (sq_norm (gso fs (i - 1)) \ \ * sq_norm (gso fs i))" +proof - + note inv = LLL_invD_modw[OF Linv] + interpret fs_indep: fs_int_indpt n fs + by (unfold_locales, insert inv, auto) + from inv(2) i have ifs: "i < length fs" by auto + note d_of_fs = d_of_weak[OF Linv] + show ?thesis + unfolding fs_indep.d_sq_norm_comparison[OF alph ifs i0, symmetric] + by (subst (1 2 3 4) d_of_fs, use i d_def fs_indep.d_def in auto) +qed + +lemma basis_reduction_adjust_swap_add_step: assumes + Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and res: "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx i = (p', mfs', dmu', g_idx')" + and alph: "quotient_of \ = (num, denom)" + and ineq: "\ (d_of dmu i * d_of dmu i * denom + \ num * d_of dmu (i - 1) * d_of dmu (Suc i))" + and i: "i < m" + and i0: "i \ 0" +shows "\fs' b'. LLL_invariant_mod_weak fs' mfs' dmu' p' first b' \ + LLL_measure (i - 1) fs' < LLL_measure i fs \ + LLL_measure (m - 1) fs' < LLL_measure (m - 1) fs \ + (LLL_invariant_mod fs mfs dmu p first b i \ + LLL_invariant_mod fs' mfs' dmu' p' first b' (i - 1))" +proof - + obtain mfs0 dmu0 where add: "basis_reduction_mod_add_row p mfs dmu i (i-1) = (mfs0, dmu0)" by force + obtain mfs1 dmu1 where swap: "basis_reduction_mod_swap p mfs0 dmu0 i = (mfs1, dmu1)" by force + note res = res[unfolded basis_reduction_adjust_swap_add_step_def Let_def add split swap] + from i0 have ii: "i - 1 < i" by auto + from basis_reduction_mod_add_row[OF Linv add i ii i0] + obtain fs0 where Linv0: "LLL_invariant_mod_weak fs0 mfs0 dmu0 p first b" + and meas0: "LLL_measure i fs0 = LLL_measure i fs" + and small: "\\ fs0 i (i - 1)\ \ 1 / 2" + and Linv0': "LLL_invariant_mod fs mfs dmu p first b i \ LLL_invariant_mod fs0 mfs0 dmu0 p first b i" + by blast + { + have id: "d_of dmu0 i = d_of dmu i" "d_of dmu0 (i - 1) = d_of dmu (i - 1)" + "d_of dmu0 (Suc i) = d_of dmu (Suc i)" + using i i0 add[unfolded basis_reduction_mod_add_row_def Let_def] + by (auto split: if_splits simp: d_of_def) + from ineq[folded id, unfolded alpha_comparison[OF Linv0 alph i i0]] + have "\gso fs0 (i - 1)\\<^sup>2 > \ * \gso fs0 i\\<^sup>2" by simp + } note ineq = this + from Linv have "LLL_invariant_weak fs" + by (auto simp: LLL_invariant_weak_def LLL_invariant_mod_weak_def) + from basis_reduction_mod_swap[OF Linv0 small swap ineq i i0, unfolded meas0] Linv0' + obtain fs1 where Linv1: "LLL_invariant_mod_weak fs1 mfs1 dmu1 p first b" + and meas1: "LLL_measure (i - 1) fs1 < LLL_measure i fs" + and Linv1': "LLL_invariant_mod fs mfs dmu p first b i \ LLL_invariant_mod fs1 mfs1 dmu1 p first b (i - 1)" + by auto + show ?thesis + proof (cases "i - 1 = g_idx") + case False + with res have id: "p' = p" "mfs' = mfs1" "dmu' = dmu1" "g_idx' = g_idx" by auto + show ?thesis unfolding id using Linv1' meas1 Linv1 by (intro exI[of _ fs1] exI[of _ b], auto simp: LLL_measure_def) + next + case True + with res have adjust: "basis_reduction_adjust_mod p first mfs1 dmu1 = (p', mfs', dmu', g_idx')" by simp + from basis_reduction_adjust_mod[OF Linv1 adjust, of "i - 1"] Linv1' + obtain fs' b' where Linvw: "LLL_invariant_mod_weak fs' mfs' dmu' p' first b'" + and Linv: "LLL_invariant_mod fs mfs dmu p first b i \ LLL_invariant_mod fs' mfs' dmu' p' first b' (i - 1)" + and meas: "LLL_measure (i - 1) fs' = LLL_measure (i - 1) fs1" + by blast + note meas = meas1[folded meas] + from meas have meas': "LLL_measure (m - 1) fs' < LLL_measure (m - 1) fs" + unfolding LLL_measure_def using i by auto + show ?thesis + by (intro exI conjI impI, rule Linvw, rule meas, rule meas', rule Linv) + qed +qed + + +lemma basis_reduction_mod_step: assumes + Linv: "LLL_invariant_mod fs mfs dmu p first b i" + and res: "basis_reduction_mod_step p first mfs dmu g_idx i j = (p', mfs', dmu', g_idx', i', j')" + and i: "i < m" +shows "\fs' b'. LLL_measure i' fs' < LLL_measure i fs \ LLL_invariant_mod fs' mfs' dmu' p' first b' i'" +proof - + note res = res[unfolded basis_reduction_mod_step_def Let_def] + from Linv have Linvw: "LLL_invariant_mod_weak fs mfs dmu p first b" + by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_mod_def) + show ?thesis + proof (cases "i = 0") + case True + then have ids: "mfs' = mfs" "dmu' = dmu" "i' = Suc i" "p' = p" using res by auto + have "LLL_measure i' fs < LLL_measure i fs \ LLL_invariant_mod fs mfs' dmu' p first b i'" + using increase_i_mod[OF Linv i] True res ids inv by simp + then show ?thesis using res ids inv by auto + next + case False + hence id: "(i = 0) = False" by auto + obtain num denom where alph: "quotient_of \ = (num, denom)" by force + note res = res[unfolded id if_False alph split] + let ?comp = "d_of dmu i * d_of dmu i * denom \ num * d_of dmu (i - 1) * d_of dmu (Suc i)" + show ?thesis + proof (cases ?comp) + case False + hence id: "?comp = False" by simp + note res = res[unfolded id if_False] + let ?step = "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx i" + from res have step: "?step = (p', mfs', dmu', g_idx')" + and i': "i' = i - 1" + by (cases ?step, auto)+ + from basis_reduction_adjust_swap_add_step[OF Linvw step alph False i \i \ 0\] Linv + show ?thesis unfolding i' by blast + next + case True + hence id: "?comp = True" by simp + note res = res[unfolded id if_True] + from res have ids: "p' = p" "mfs' = mfs" "dmu' = dmu" "i' = Suc i" by auto + from True alpha_comparison[OF Linvw alph i False] + have ineq: "sq_norm (gso fs (i - 1)) \ \ * sq_norm (gso fs i)" by simp + from increase_i_mod[OF Linv i ineq] + show ?thesis unfolding ids by auto + qed + qed +qed + +lemma basis_reduction_mod_main: assumes "LLL_invariant_mod fs mfs dmu p first b i" + and res: "basis_reduction_mod_main p first mfs dmu g_idx i j = (p', mfs', dmu')" +shows "\fs' b'. LLL_invariant_mod fs' mfs' dmu' p' first b' m" + using assms +proof (induct "LLL_measure i fs" arbitrary: i mfs dmu j p b fs g_idx rule: less_induct) + case (less i fs mfs dmu j p b g_idx) + hence fsinv: "LLL_invariant_mod fs mfs dmu p first b i" by auto + note res = less(3)[unfolded basis_reduction_mod_main.simps[of p first mfs dmu g_idx i j]] + note inv = less(2) + note IH = less(1) + show ?case + proof (cases "i < m") + case i: True + obtain p' mfs' dmu' g_idx' i' j' where step: "basis_reduction_mod_step p first mfs dmu g_idx i j = (p', mfs', dmu', g_idx', i', j')" + (is "?step = _") by (cases ?step, auto) + then obtain fs' b' where Linv: "LLL_invariant_mod fs' mfs' dmu' p' first b' i'" + and decr: "LLL_measure i' fs' < LLL_measure i fs" + using basis_reduction_mod_step[OF fsinv step i] i fsinv by blast + note res = res[unfolded step split] + from res i show ?thesis using IH[OF decr Linv] by auto + next + case False + with LLL_invD_mod[OF fsinv] res have i: "i = m" "p' = p" by auto + then obtain fs' b' where "LLL_invariant_mod fs' mfs' dmu' p first b' m" using False res fsinv by simp + then show ?thesis using i by auto + qed +qed + +lemma compute_max_gso_quot_alpha: + assumes inv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and max: "compute_max_gso_quot dmu = (msq_num, msq_denum, idx)" + and alph: "quotient_of \ = (num, denum)" + and cmp: "(msq_num * denum > num * msq_denum) = cmp" + and m: "m > 1" +shows "cmp \ idx \ 0 \ idx < m \ \ (d_of dmu idx * d_of dmu idx * denum + \ num * d_of dmu (idx - 1) * d_of dmu (Suc idx))" + and "\ cmp \ LLL_invariant_mod fs mfs dmu p first b m" +proof - + from inv + have fsinv: "LLL_invariant_weak fs" + by (simp add: LLL_invariant_mod_weak_def LLL_invariant_weak_def) + define qt where "qt = (\i. ((d_of dmu (i + 1)) * (d_of dmu (i + 1)), + (d_of dmu (i + 2)) * (d_of dmu i), Suc i))" + define lst where "lst = (map (\i. qt i) [0..<(m-1)])" + have msqlst: "(msq_num, msq_denum, idx) = max_list_rats_with_index lst" + using max lst_def qt_def unfolding compute_max_gso_quot_def by simp + have nz: "\n d i. (n, d, i) \ set lst \ d > 0" + unfolding lst_def qt_def using d_of_weak[OF inv] LLL_d_pos[OF fsinv] by auto + have geq: "\(n, d, i) \ set lst. rat_of_int msq_num / of_int msq_denum \ rat_of_int n / of_int d" + using max_list_rats_with_index[of lst] nz msqlst by (metis (no_types, lifting) case_prodI2) + have len: "length lst \ 1" using m unfolding lst_def by simp + have inset: "(msq_num, msq_denum, idx) \ set lst" + using max_list_rats_with_index_in_set[OF msqlst[symmetric] len] nz by simp + then have idxm: "idx \ {1.. 0" and idx: "idx < m" by auto + have 00: "(msq_num, msq_denum, idx) = qt (idx - 1)" using lst_def inset qt_def by auto + then have id_qt: "msq_num = d_of dmu idx * d_of dmu idx" "msq_denum = d_of dmu (Suc idx) * d_of dmu (idx - 1)" + unfolding qt_def by auto + have "msq_denum = (d_of dmu (idx + 1)) * (d_of dmu (idx - 1))" + using 00 unfolding qt_def by simp + then have dengt0: "msq_denum > 0" using d_of_weak[OF inv] idxm LLL_d_pos[OF fsinv] by auto + have \dengt0: "denum > 0" using alph by (metis quotient_of_denom_pos) + from cmp[unfolded id_qt] + have cmp: "cmp = (\ (d_of dmu idx * d_of dmu idx * denum \ num * d_of dmu (idx - 1) * d_of dmu (Suc idx)))" + by (auto simp: ac_simps) + { + assume cmp + from this[unfolded cmp] + show "idx \ 0 \ idx < m \ \ (d_of dmu idx * d_of dmu idx * denum + \ num * d_of dmu (idx - 1) * d_of dmu (Suc idx))" using idx0 idx by auto + } + { + assume "\ cmp" + from this[unfolded cmp] have small: "d_of dmu idx * d_of dmu idx * denum \ num * d_of dmu (idx - 1) * d_of dmu (Suc idx)" by auto + note d_pos = LLL_d_pos[OF fsinv] + have gso: "k < m \ sq_norm (gso fs k) = of_int (d fs (Suc k)) / of_int (d fs k)" for k using + LLL_d_Suc[OF fsinv, of k] d_pos[of k] by simp + have gso_pos: "k < m \ sq_norm (gso fs k) > 0" for k + using gso[of k] d_pos[of k] d_pos[of "Suc k"] by auto + from small[unfolded alpha_comparison[OF inv alph idx idx0]] + have alph: "sq_norm (gso fs (idx - 1)) \ \ * sq_norm (gso fs idx)" . + with gso_pos[OF idx] have alph: "sq_norm (gso fs (idx - 1)) / sq_norm (gso fs idx) \ \" + by (metis mult_imp_div_pos_le) + have weak: "weakly_reduced fs m" unfolding gram_schmidt_fs.weakly_reduced_def + proof (intro allI impI, goal_cases) + case (1 i) + from idx have idx1: "idx - 1 < m" by auto + from geq[unfolded lst_def] + have mem: "(d_of dmu (Suc i) * d_of dmu (Suc i), + d_of dmu (Suc (Suc i)) * d_of dmu i, Suc i) \ set lst" + unfolding lst_def qt_def using 1 by auto + have "sq_norm (gso fs i) / sq_norm (gso fs (Suc i)) = + of_int (d_of dmu (Suc i) * d_of dmu (Suc i)) / of_int (d_of dmu (Suc (Suc i)) * d_of dmu i)" + using gso idx0 d_of_weak[OF inv] 1 by auto + also have "\ \ rat_of_int msq_num / rat_of_int msq_denum" + using geq[rule_format, OF mem, unfolded split] by auto + also have "\ = sq_norm (gso fs (idx - 1)) / sq_norm (gso fs idx)" + unfolding id_qt gso[OF idx] gso[OF idx1] using idx0 d_of_weak[OF inv] idx by auto + also have "\ \ \" by fact + finally show "sq_norm (gso fs i) \ \ * sq_norm (gso fs (Suc i))" using gso_pos[OF 1] + using pos_divide_le_eq by blast + qed + with inv show "LLL_invariant_mod fs mfs dmu p first b m" + by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_mod_def) + } +qed + + +lemma small_m: + assumes inv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and m: "m \ 1" +shows "LLL_invariant_mod fs mfs dmu p first b m" +proof - + have weak: "weakly_reduced fs m" unfolding gram_schmidt_fs.weakly_reduced_def using m + by auto + with inv show "LLL_invariant_mod fs mfs dmu p first b m" + by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_mod_def) +qed + +lemma basis_reduction_iso_main: assumes "LLL_invariant_mod_weak fs mfs dmu p first b" + and res: "basis_reduction_iso_main p first mfs dmu g_idx j = (p', mfs', dmu')" +shows "\fs' b'. LLL_invariant_mod fs' mfs' dmu' p' first b' m" + using assms +proof (induct "LLL_measure (m-1) fs" arbitrary: fs mfs dmu j p b g_idx rule: less_induct) + case (less fs mfs dmu j p b g_idx) + have inv: "LLL_invariant_mod_weak fs mfs dmu p first b" using less by auto + hence fsinv: "LLL_invariant_weak fs" + by (simp add: LLL_invariant_mod_weak_def LLL_invariant_weak_def) + note res = less(3)[unfolded basis_reduction_iso_main.simps[of p first mfs dmu g_idx j]] + note IH = less(1) + obtain msq_num msq_denum idx where max: "compute_max_gso_quot dmu = (msq_num, msq_denum, idx)" + by (metis prod_cases3) + obtain num denum where alph: "quotient_of \ = (num, denum)" by force + note res = res[unfolded max alph Let_def split] + consider (small) "m \ 1" | (final) "m > 1" "\ (num * msq_denum < msq_num * denum)" | (step) "m > 1" "num * msq_denum < msq_num * denum" + by linarith + thus ?case + proof cases + case *: step + obtain p1 mfs1 dmu1 g_idx1 where step: "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx idx = (p1, mfs1, dmu1, g_idx1)" + by (metis prod_cases4) + from res[unfolded step split] * have res: "basis_reduction_iso_main p1 first mfs1 dmu1 g_idx1 (j + 1) = (p', mfs', dmu')" by auto + from compute_max_gso_quot_alpha(1)[OF inv max alph refl *] + have idx0: "idx \ 0" and idx: "idx < m" and cmp: "\ d_of dmu idx * d_of dmu idx * denum \ num * d_of dmu (idx - 1) * d_of dmu (Suc idx)" by auto + from basis_reduction_adjust_swap_add_step[OF inv step alph cmp idx idx0] obtain fs1 b1 + where inv1: "LLL_invariant_mod_weak fs1 mfs1 dmu1 p1 first b1" and meas: "LLL_measure (m - 1) fs1 < LLL_measure (m - 1) fs" + by auto + from IH[OF meas inv1 res] show ?thesis . + next + case small + with res small_m[OF inv] show ?thesis by auto + next + case final + from compute_max_gso_quot_alpha(2)[OF inv max alph refl final] + final show ?thesis using res by auto + qed +qed + +lemma basis_reduction_mod_add_rows_loop_inv': assumes + fsinv: "LLL_invariant_mod fs mfs dmu p first b m" + and res: "basis_reduction_mod_add_rows_loop p mfs dmu i i = (mfs', dmu')" + and i: "i < m" +shows "\fs'. LLL_invariant_mod fs' mfs' dmu' p first b m \ + (\i' j'. i' < i \ j' \ i' \ \ fs i' j' = \ fs' i' j') \ + \_small fs' i" +proof - + { + fix j + assume j: "j \ i" and mu_small: "\_small_row i fs j" + and resj: "basis_reduction_mod_add_rows_loop p mfs dmu i j = (mfs', dmu')" + have "\fs'. LLL_invariant_mod fs' mfs' dmu' p first b m \ + (\i' j'. i' < i \ j' \ i' \ \ fs i' j' = \ fs' i' j') \ + (\_small fs' i)" + proof (insert fsinv mu_small resj i j, induct j arbitrary: fs mfs dmu mfs' dmu') + case (0 fs) + then have "(mfs', dmu') = (mfs, dmu)" by simp + then show ?case + using LLL_invariant_mod_to_weak_m_to_i(3) basis_reduction_add_row_done_weak 0 by auto + next + case (Suc j) + hence j: "j < i" by auto + have in0: "i \ 0" using Suc(6) by simp + define c where "c = round_num_denom (dmu $$ (i,j)) (d_of dmu (Suc j))" + have c2: "c = round (\ fs i j)" using dmu_quot_is_round_of_\[OF _ _ i j] c_def Suc by simp + define mfs'' where "mfs'' = (if c=0 then mfs else mfs[ i := (map_vec (\ x. x symmod p)) (mfs ! i - c \\<^sub>v mfs ! j)])" + define dmu'' where "dmu'' = (if c=0 then dmu else mat m m (\(i',j'). (if (i' = i \ j' \ j) + then (if j'=j then (dmu $$ (i,j') - c * dmu $$ (j,j')) + else (dmu $$ (i,j') - c * dmu $$ (j,j')) symmod (p * (d_of dmu j') * (d_of dmu (Suc j')))) + else (dmu $$ (i',j')))))" + have 00: "basis_reduction_mod_add_row p mfs dmu i j = (mfs'', dmu'')" + using mfs''_def dmu''_def unfolding basis_reduction_mod_add_row_def c_def[symmetric] by simp + then have 01: "basis_reduction_mod_add_rows_loop p mfs'' dmu'' i j = (mfs', dmu')" + using basis_reduction_mod_add_rows_loop.simps(2)[of p mfs dmu i j] Suc by simp + have fsinvi: "LLL_invariant_mod fs mfs dmu p first b i" using LLL_invariant_mod_to_weak_m_to_i[OF Suc(2)] i by simp + then have fsinvmw: "LLL_invariant_mod_weak fs mfs dmu p first b" using LLL_invD_mod LLL_invI_modw by simp + obtain fs'' where fs''invi: "LLL_invariant_mod fs'' mfs'' dmu'' p first b i" and + \_small': "(\_small_row i fs (Suc j) \ \_small_row i fs'' j)" and + \s: "(\i' j'. i' < i \ j' \ i' \ \ fs'' i' j' = \ fs i' j')" + using Suc basis_reduction_mod_add_row[OF fsinvmw 00 i j] fsinvi by auto + moreover then have \sm: "\_small_row i fs'' j" using Suc by simp + have fs''invwi: "LLL_invariant_weak' i fs''" using LLL_invD_mod[OF fs''invi] LLL_invI_weak by simp + have fsinvwi: "LLL_invariant_weak' i fs" using LLL_invD_mod[OF fsinvi] LLL_invI_weak by simp + note invw = LLL_invw'_imp_w[OF fsinvwi] + note invw'' = LLL_invw'_imp_w[OF fs''invwi] + have "LLL_invariant_mod fs'' mfs'' dmu'' p first b m" + proof - + have "(\ l. Suc l < m \ sq_norm (gso fs'' l) \ \ * sq_norm (gso fs'' (Suc l)))" + proof - + { + fix l + assume l: "Suc l < m" + have "sq_norm (gso fs'' l) \ \ * sq_norm (gso fs'' (Suc l))" + proof (cases "i \ Suc l") + case True + have deq: "\k. k < m \ d fs (Suc k) = d fs'' (Suc k)" + using dd\ LLL_invD_mod(9)[OF fs''invi] LLL_invD_mod(9)[OF Suc(2)] dmu''_def j by simp + { + fix k + assume k: "k < m" + then have "d fs (Suc k) = d fs'' (Suc k)" + using dd\ LLL_invD_mod(9)[OF fs''invi] LLL_invD_mod(9)[OF Suc(2)] dmu''_def j by simp + have "d fs 0 = 1" "d fs'' 0 = 1" using d_def by auto + moreover have sqid: "sq_norm (gso fs'' k) = rat_of_int (d fs'' (Suc k)) / rat_of_int (d fs'' k)" + using LLL_d_Suc[OF invw''] LLL_d_pos[OF invw''] k + by (smt One_nat_def Suc_less_eq Suc_pred le_imp_less_Suc mult_eq_0_iff less_imp_le_nat + nonzero_mult_div_cancel_right of_int_0_less_iff of_int_hom.hom_zero) + moreover have "sq_norm (gso fs k) = rat_of_int (d fs (Suc k)) / rat_of_int (d fs k)" + using LLL_d_Suc[OF invw] LLL_d_pos[OF invw] k + by (smt One_nat_def Suc_less_eq Suc_pred le_imp_less_Suc mult_eq_0_iff less_imp_le_nat + nonzero_mult_div_cancel_right of_int_0_less_iff of_int_hom.hom_zero) + ultimately have "sq_norm (gso fs k) = sq_norm (gso fs'' k)" using k deq + LLL_d_pos[OF invw] LLL_d_pos[OF invw''] + by (metis (no_types, lifting) Nat.lessE Suc_lessD old.nat.inject zero_less_Suc) + } + then show ?thesis using LLL_invD_mod(6)[OF Suc(2)] by (simp add: gram_schmidt_fs.weakly_reduced_def l) + next + case False + then show ?thesis using LLL_invD_mod(6)[OF fs''invi] gram_schmidt_fs.weakly_reduced_def + by (metis less_or_eq_imp_le nat_neq_iff) + qed + } + then show ?thesis by simp + qed + then have "weakly_reduced fs'' m" using gram_schmidt_fs.weakly_reduced_def by blast + then show ?thesis using LLL_invD_mod[OF fs''invi] LLL_invI_mod by simp + qed + then show ?case using "01" Suc.hyps i j less_imp_le_nat \sm \s by metis + qed + } + then show ?thesis using \_small_row_refl res by auto +qed + +lemma basis_reduction_mod_add_rows_outer_loop_inv: + assumes inv: "LLL_invariant_mod fs mfs dmu p first b m" + and "(mfs', dmu') = basis_reduction_mod_add_rows_outer_loop p mfs dmu i" + and i: "i < m" +shows "(\fs'. LLL_invariant_mod fs' mfs' dmu' p first b m \ + (\j. j \ i \ \_small fs' j))" +proof(insert assms, induct i arbitrary: fs mfs dmu mfs' dmu') + case (0 fs) + then show ?case using \_small_def by auto +next + case (Suc i fs mfs dmu mfs' dmu') + obtain mfs'' dmu'' where mfs''dmu'': "(mfs'', dmu'') + = basis_reduction_mod_add_rows_outer_loop p mfs dmu i" by (metis surj_pair) + then obtain fs'' where fs'': "LLL_invariant_mod fs'' mfs'' dmu'' p first b m" + and 00: "(\j. j \ i \ \_small fs'' j)" using Suc by fastforce + have "(mfs', dmu') = basis_reduction_mod_add_rows_loop p mfs'' dmu'' (Suc i) (Suc i)" + using Suc(3,4) mfs''dmu'' by (smt basis_reduction_mod_add_rows_outer_loop.simps(2) case_prod_conv) + then obtain fs' where 01: "LLL_invariant_mod fs' mfs' dmu' p first b m" + and 02: "\i' j'. i' < (Suc i) \ j' \ i' \ \ fs'' i' j' = \ fs' i' j'" and 03: "\_small fs' (Suc i)" + using fs'' basis_reduction_mod_add_rows_loop_inv' Suc by metis + moreover have "\j. j \ (Suc i) \ \_small fs' j" using 02 00 03 \_small_def by (simp add: le_Suc_eq) + ultimately show ?case by blast +qed + +lemma basis_reduction_mod_fs_bound: + assumes Linv: "LLL_invariant_mod fs mfs dmu p first b k" + and mu_small: "\_small fs i" + and i: "i < m" + and nFirst: "\ first" +shows "fs ! i = mfs ! i" +proof - + from LLL_invD_mod(16-17)[OF Linv] nFirst g_bnd_mode_def + have gbnd: "g_bnd b fs" and bp: "b \ (rat_of_int (p - 1))\<^sup>2 / (rat_of_nat m + 3)" + by (auto simp: mod_invariant_def bound_number_def) + have Linvw: "LLL_invariant_weak' k fs" using LLL_invD_mod[OF Linv] LLL_invI_weak by simp + have "fs_int_indpt n fs" using LLL_invD_mod(5)[OF Linv] Gram_Schmidt_2.fs_int_indpt.intro by simp + then interpret fs: fs_int_indpt n fs + using fs_int_indpt.sq_norm_fs_via_sum_mu_gso by simp + have "\gso fs 0\\<^sup>2 \ b" using gbnd i unfolding g_bnd_def by blast + then have b0: "0 \ b" using sq_norm_vec_ge_0 dual_order.trans by auto + have 00: "of_int \fs ! i\\<^sup>2 = (\j\[0.. fs i j)\<^sup>2 * \gso fs j\\<^sup>2)" + using fs.sq_norm_fs_via_sum_mu_gso LLL_invD_mod[OF Linv] Gram_Schmidt_2.fs_int_indpt.intro i by simp + have 01: "\j < i. (\ fs i j)\<^sup>2 * \gso fs j\\<^sup>2 \ (1 / rat_of_int 4) * \gso fs j\\<^sup>2" + proof - + { + fix j + assume j: "j < i" + then have "\fs.gs.\ i j\ \ 1 / (rat_of_int 2)" + using mu_small Power.linordered_idom_class.abs_square_le_1 j unfolding \_small_def by simp + moreover have "\\ fs i j\ \ 0" by simp + ultimately have "\\ fs i j\\<^sup>2 \ (1 / rat_of_int 2)\<^sup>2" + using Power.linordered_idom_class.abs_le_square_iff by fastforce + also have "\ = 1 / (rat_of_int 4)" by (simp add: field_simps) + finally have "\\ fs i j\\<^sup>2 \ 1 / rat_of_int 4" by simp + } + then show ?thesis using fs.gs.\.simps by (metis mult_right_mono power2_abs sq_norm_vec_ge_0) + qed + then have 0111: "\j. j \ set [0.. (\ fs i j)\<^sup>2 * \gso fs j\\<^sup>2 \ (1 / rat_of_int 4) * \gso fs j\\<^sup>2" + by simp + { + fix j + assume j: "j < n" + have 011: "(\ fs i i)\<^sup>2 * \gso fs i\\<^sup>2 = 1 * \gso fs i\\<^sup>2" + using fs.gs.\.simps by simp + have 02: "\j < Suc i. \gso fs j\\<^sup>2 \ b" + using gbnd i unfolding g_bnd_def by simp + have 03: "length [0..fs ! i\\<^sup>2 = (\j\[0.. fs i j)\<^sup>2 * \gso fs j\\<^sup>2) + \gso fs i\\<^sup>2" + unfolding 00 using 011 by simp + also have "(\j\[0.. fs i j)\<^sup>2 * \gso fs j\\<^sup>2) \ (\j\[0..gso fs j\\<^sup>2))" + using Groups_List.sum_list_mono[OF 0111] by fast + finally have "of_int \fs ! i\\<^sup>2 \ (\j\[0..gso fs j\\<^sup>2)) + \gso fs i\\<^sup>2" + by simp + also have "(\j\[0..gso fs j\\<^sup>2)) \ (\j\[0..gso fs i\\<^sup>2 \ b" using 02 by simp + finally have "of_int \fs ! i\\<^sup>2 \ (\j\[0.. = (rat_of_nat i) * ((1 / rat_of_int 4) * b) + b" + using 03 sum_list_triv[of "(1 / rat_of_int 4) * b" "[0.. = (rat_of_nat i) / 4 * b + b" by simp + also have "\ = ((rat_of_nat i) / 4 + 1)* b" by algebra + also have "\ = (rat_of_nat i + 4) / 4 * b" by simp + finally have "of_int \fs ! i\\<^sup>2 \ (rat_of_nat i + 4) / 4 * b" by simp + also have "\ \ (rat_of_nat (m + 3)) / 4 * b" using i b0 times_left_mono by fastforce + finally have "of_int \fs ! i\\<^sup>2 \ rat_of_nat (m+3) / 4 * b" by simp + moreover have "\fs ! i $ j\\<^sup>2 \ \fs ! i\\<^sup>2" using vec_le_sq_norm LLL_invD_mod(10)[OF Linv] i j by blast + ultimately have 04: "of_int (\fs ! i $ j\\<^sup>2) \ rat_of_nat (m+3) / 4 * b" using ge_trans i by linarith + then have 05: "real_of_int (\fs ! i $ j\\<^sup>2) \ real_of_rat (rat_of_nat (m+3) / 4 * b)" + proof - + from j have "rat_of_int (\fs ! i $ j\\<^sup>2) \ rat_of_nat (m+3) / 4 * b" using 04 by simp + then have "real_of_int (\fs ! i $ j\\<^sup>2) \ real_of_rat (rat_of_nat (m+3) / 4 * b)" + using j of_rat_less_eq by (metis of_rat_of_int_eq) + then show ?thesis by simp + qed + define rhs where "rhs = real_of_rat (rat_of_nat (m+3) / 4 * b)" + have rhs0: "rhs \ 0" using b0 i rhs_def by simp + have fsij: "real_of_int \fs ! i $ j\ \ 0" by simp + have "real_of_int (\fs ! i $ j\\<^sup>2) = (real_of_int \fs ! i $ j\)\<^sup>2" by simp + then have "(real_of_int \fs ! i $ j\)\<^sup>2 \ rhs" using 05 j rhs_def by simp + then have g1: "real_of_int \fs ! i $ j\ \ sqrt rhs" using NthRoot.real_le_rsqrt by simp + have pbnd: "2 * \fs ! i $ j\ < p" + proof - + have "rat_of_nat (m+3) / 4 * b \ (rat_of_nat (m +3) / 4) * (rat_of_int (p - 1))\<^sup>2 / (rat_of_nat m+3)" + using bp b0 i times_left_mono SN_Orders.of_nat_ge_zero gs.m_comm times_divide_eq_right + by (smt gs.l_null le_divide_eq_numeral1(1)) + also have "\ = (rat_of_int (p - 1))\<^sup>2 / 4 * (rat_of_nat (m + 3) / rat_of_nat (m + 3))" + by (metis (no_types, lifting) gs.m_comm of_nat_add of_nat_numeral times_divide_eq_left) + finally have "rat_of_nat (m+3) / 4 * b \ (rat_of_int (p - 1))\<^sup>2 / 4" by simp + then have "sqrt rhs \ sqrt (real_of_rat ((rat_of_int (p - 1))\<^sup>2 / 4))" + unfolding rhs_def using of_rat_less_eq by fastforce + then have two_ineq: + "2 * \fs ! i $ j\ \ 2 * sqrt (real_of_rat ((rat_of_int (p - 1))\<^sup>2 / 4))" + using g1 by linarith + have "2 * sqrt (real_of_rat ((rat_of_int (p - 1))\<^sup>2 / 4)) = + sqrt (real_of_rat (4 * ((rat_of_int (p - 1))\<^sup>2 / 4)))" + by (metis (no_types, hide_lams) real_sqrt_mult of_int_numeral of_rat_hom.hom_mult + of_rat_of_int_eq real_sqrt_four times_divide_eq_right) + also have "\ = sqrt (real_of_rat ((rat_of_int (p - 1))\<^sup>2))" using i by simp + also have "(real_of_rat ((rat_of_int (p - 1))\<^sup>2)) = (real_of_rat (rat_of_int (p - 1)))\<^sup>2" + using Rat.of_rat_power by blast + also have "sqrt ((real_of_rat (rat_of_int (p - 1)))\<^sup>2) = real_of_rat (rat_of_int (p - 1))" + using LLL_invD_mod(15)[OF Linv] by simp + finally have "2 * sqrt (real_of_rat ((rat_of_int (p - 1))\<^sup>2 / 4)) = + real_of_rat (rat_of_int (p - 1))" by simp + then have "2 * \fs ! i $ j\ \ real_of_rat (rat_of_int (p - 1))" + using two_ineq by simp + then show ?thesis by (metis of_int_le_iff of_rat_of_int_eq zle_diff1_eq) + qed + have p1: "p > 1" using LLL_invD_mod[OF Linv] by blast + interpret pm: poly_mod_2 p + by (unfold_locales, rule p1) + from LLL_invD_mod[OF Linv] have len: "length fs = m" and fs: "set fs \ carrier_vec n" by auto + from pm.inv_M_rev[OF pbnd, unfolded pm.M_def] have "pm.inv_M (fs ! i $ j mod p) = fs ! i $ j" . + also have "pm.inv_M (fs ! i $ j mod p) = mfs ! i $ j" unfolding LLL_invD_mod(7)[OF Linv, symmetric] sym_mod_def + using i j len fs by auto + finally have "fs ! i $ j = mfs ! i $ j" .. + } + thus "fs ! i = mfs ! i" using LLL_invD_mod(10,13)[OF Linv i] by auto +qed + +lemma basis_reduction_mod_fs_bound_first: + assumes Linv: "LLL_invariant_mod fs mfs dmu p first b k" + and m0: "m > 0" + and first: "first" +shows "fs ! 0 = mfs ! 0" +proof - + from LLL_invD_mod(16-17)[OF Linv] first g_bnd_mode_def m0 + have gbnd: "sq_norm (gso fs 0) \ b" and bp: "b \ (rat_of_int (p - 1))\<^sup>2 / 4" + by (auto simp: mod_invariant_def bound_number_def) + from LLL_invD_mod[OF Linv] have p1: "p > 1" by blast + have Linvw: "LLL_invariant_weak' k fs" using LLL_invD_mod[OF Linv] LLL_invI_weak by simp + have "fs_int_indpt n fs" using LLL_invD_mod(5)[OF Linv] Gram_Schmidt_2.fs_int_indpt.intro by simp + then interpret fs: fs_int_indpt n fs + using fs_int_indpt.sq_norm_fs_via_sum_mu_gso by simp + from gbnd have b0: "0 \ b" using sq_norm_vec_ge_0 dual_order.trans by auto + have "of_int \fs ! 0\\<^sup>2 = (\ fs 0 0)\<^sup>2 * \gso fs 0\\<^sup>2" + using fs.sq_norm_fs_via_sum_mu_gso LLL_invD_mod[OF Linv] Gram_Schmidt_2.fs_int_indpt.intro m0 by simp + also have "\ = \gso fs 0\\<^sup>2" unfolding fs.gs.\.simps by (simp add: gs.\.simps) + also have "\ \ (rat_of_int (p - 1))\<^sup>2 / 4" using gbnd bp by auto + finally have one: "of_int (sq_norm (fs ! 0)) \ (rat_of_int (p - 1))\<^sup>2 / 4" . + { + fix j + assume j: "j < n" + have leq: "\fs ! 0 $ j\\<^sup>2 \ \fs ! 0\\<^sup>2" using vec_le_sq_norm LLL_invD_mod(10)[OF Linv] m0 j by blast + have "rat_of_int ((2 * \fs ! 0 $ j\)^2) = rat_of_int (4 * \fs ! 0 $ j\\<^sup>2)" by simp + also have "\ \ 4 * of_int \fs ! 0\\<^sup>2" using leq by simp + also have "\ \ 4 * (rat_of_int (p - 1))\<^sup>2 / 4" using one by simp + also have "\ = (rat_of_int (p - 1))\<^sup>2" by simp + also have "\ = rat_of_int ((p - 1)\<^sup>2)" by simp + finally have "(2 * \fs ! 0 $ j\)^2 \ (p - 1)\<^sup>2" by linarith + hence "2 * \fs ! 0 $ j\ \ p - 1" using p1 + by (smt power_mono_iff zero_less_numeral) + hence pbnd: "2 * \fs ! 0 $ j\ < p" by simp + interpret pm: poly_mod_2 p + by (unfold_locales, rule p1) + from LLL_invD_mod[OF Linv] m0 have len: "length fs = m" "length mfs = m" + and fs: "fs ! 0 \ carrier_vec n" "mfs ! 0 \ carrier_vec n" by auto + from pm.inv_M_rev[OF pbnd, unfolded pm.M_def] have "pm.inv_M (fs ! 0 $ j mod p) = fs ! 0 $ j" . + also have "pm.inv_M (fs ! 0 $ j mod p) = mfs ! 0 $ j" unfolding LLL_invD_mod(7)[OF Linv, symmetric] sym_mod_def + using m0 j len fs by auto + finally have "mfs ! 0 $ j = fs ! 0 $ j" . + } + thus "fs ! 0 = mfs ! 0" using LLL_invD_mod(10,13)[OF Linv m0] by auto +qed + +lemma dmu_initial: "dmu_initial = mat m m (\ (i,j). d\ fs_init i j)" +proof - + interpret fs: fs_int_indpt n fs_init + by (unfold_locales, intro lin_dep) + show ?thesis unfolding dmu_initial_def Let_def + proof (intro cong_mat refl refl, unfold split, goal_cases) + case (1 i j) + show ?case + proof (cases "j \ i") + case False + thus ?thesis by (auto simp: d\_def gs.\.simps) + next + case True + hence id: "d\_impl fs_init !! i !! j = fs.d\ i j" unfolding fs.d\_impl + by (subst of_fun_nth, use 1 len in force, subst of_fun_nth, insert True, auto) + also have "\ = d\ fs_init i j" unfolding fs.d\_def d\_def fs.d_def d_def by simp + finally show ?thesis using True by auto + qed + qed +qed + +lemma LLL_initial_invariant_mod: assumes res: "compute_initial_state first = (p, mfs, dmu', g_idx)" +shows "\fs b. LLL_invariant_mod fs mfs dmu' p first b 0" +proof - + from dmu_initial have dmu: "(\i' < m. \j' < m. d\ fs_init i' j' = dmu_initial $$ (i',j'))" by auto + obtain b g_idx where norm: "compute_max_gso_norm first dmu_initial = (b,g_idx)" by force + note res = res[unfolded compute_initial_state_def Let_def norm split] + from res have p: "p = compute_mod_of_max_gso_norm first b" by auto + then have p0: "p > 0" unfolding compute_mod_of_max_gso_norm_def using log_base by simp + then have p1: "p \ 1" by simp + note res = res[folded p] + from res[unfolded compute_initial_mfs_def] + have mfs: "mfs = map (map_vec (\x. x symmod p)) fs_init" by auto + from res[unfolded compute_initial_dmu_def] + have dmu': "dmu' = mat m m (\(i',j'). if j' < i' + then dmu_initial $$ (i', j') symmod (p * d_of dmu_initial j' * d_of dmu_initial (Suc j')) + else dmu_initial $$ (i',j'))" by auto + have lat: "lattice_of fs_init = L" by (auto simp: L_def) + define I where "I = {(i',j'). i' < m \ j' < i'}" + obtain fs where + 01: "lattice_of fs = L" and + 02: "map (map_vec (\ x. x symmod p)) fs = map (map_vec (\ x. x symmod p)) fs_init" and + 03: "lin_indep fs" and + 04: "length fs = m" and + 05: "(\ k < m. gso fs k = gso fs_init k)" and + 06: "(\ k \ m. d fs k = d fs_init k)" and + 07: "(\ i' < m. \ j' < m. d\ fs i' j' = + (if (i',j') \ I then d\ fs_init i' j' symmod (p * d fs_init j' * d fs_init (Suc j')) else d\ fs_init i' j'))" + using mod_finite_set[OF lin_dep len _ lat p0, of I] I_def by blast + have inv: "LLL_invariant_weak fs_init" + by (intro LLL_inv_wI lat len lin_dep fs_init) + have "\i' fs_init i' i' = dmu_initial $$ (i', i')" unfolding dmu_initial by auto + from compute_max_gso_norm[OF this inv, of first, unfolded norm] have gbnd: "g_bnd_mode first b fs_init" + and b0: "0 \ b" and mb0: "m = 0 \ b = 0" by auto + from gbnd 05 have gbnd: "g_bnd_mode first b fs" using g_bnd_mode_cong[of fs fs_init] by auto + have d\dmu': "\i'j' fs i' j' = dmu' $$ (i', j')" using 07 dmu d_of_main[of fs_init dmu_initial] + unfolding I_def dmu' by simp + have wred: "weakly_reduced fs 0" by (simp add: gram_schmidt_fs.weakly_reduced_def) + have fs_carr: "set fs \ carrier_vec n" using 03 unfolding gs.lin_indpt_list_def by force + have m0: "m \ 0" using len by auto + have Linv: "LLL_invariant_weak' 0 fs" + by (intro LLL_invI_weak 03 04 01 wred fs_carr m0) + note Linvw = LLL_invw'_imp_w[OF Linv] + from compute_mod_of_max_gso_norm[OF b0 mb0 p] + have p: "mod_invariant b p first" "p > 1" by auto + from len mfs have len': "length mfs = m" by auto + have modbnd: "\i'j'd\ fs i' j'\ < p * d fs j' * d fs (Suc j')" + proof - + have "\ i' < m. \ j' < i'. d\ fs i' j' = d\ fs i' j' symmod (p * d fs j' * d fs (Suc j'))" + using I_def 07 06 by simp + moreover have "\j' < m. p * d fs j' * d fs (Suc j') > 0" using p(2) LLL_d_pos[OF Linvw] by simp + ultimately show ?thesis using sym_mod_abs + by (smt Euclidean_Division.pos_mod_bound Euclidean_Division.pos_mod_sign less_trans) + qed + have "LLL_invariant_mod fs mfs dmu' p first b 0" + using LLL_invI_mod[OF len' m0 04 01 03 wred _ modbnd d\dmu' p(2) gbnd p(1)] 02 mfs by simp + then show ?thesis by auto +qed + +subsection \Soundness of Storjohann's algorithm\ + +text \For all of these abstract algorithms, we actually formulate their soundness proofs by linking + to the LLL-invariant (which implies that @{term fs} is reduced (@{term "LLL_invariant True m fs"}) + or that the first vector of @{term fs} is short (@{term "LLL_invariant_weak fs \ weakly_reduced fs m"}).\ + +text \Soundness of Storjohann's algorithm\ +lemma reduce_basis_mod_inv: assumes res: "reduce_basis_mod = fs" + shows "LLL_invariant True m fs" +proof (cases "m = 0") + case True + from True have *: "fs_init = []" using len by simp + moreover have "fs = []" using res basis_reduction_mod_add_rows_outer_loop.simps(1) + unfolding reduce_basis_mod_def Let_def basis_reduction_mod_main.simps[of _ _ _ _ _ 0] + compute_initial_mfs_def compute_initial_state_def compute_initial_dmu_def + unfolding True * by (auto split: prod.splits) + ultimately show ?thesis using True LLL_inv_initial_state by blast +next + case False + let ?first = False + obtain p mfs0 dmu0 g_idx0 where init: "compute_initial_state ?first = (p, mfs0, dmu0, g_idx0)" by (metis prod_cases4) + from LLL_initial_invariant_mod[OF init] + obtain fs0 b where fs0: "LLL_invariant_mod fs0 mfs0 dmu0 p ?first b 0" by blast + note res = res[unfolded reduce_basis_mod_def init Let_def split] + obtain p1 mfs1 dmu1 where mfs1dmu1: "(p1, mfs1, dmu1) = basis_reduction_mod_main p ?first mfs0 dmu0 g_idx0 0 0" + by (metis prod.exhaust) + obtain fs1 b1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 m" + using basis_reduction_mod_main[OF fs0 mfs1dmu1[symmetric]] by auto + obtain mfs2 dmu2 where mfs2dmu2: + "(mfs2, dmu2) = basis_reduction_mod_add_rows_outer_loop p1 mfs1 dmu1 (m-1)" by (metis old.prod.exhaust) + obtain fs2 where fs2: "LLL_invariant_mod fs2 mfs2 dmu2 p1 ?first b1 m" + and \s: "((\j. j < m \ \_small fs2 j))" + using basis_reduction_mod_add_rows_outer_loop_inv[OF _ mfs2dmu2, of fs1 ?first b1] Linv1 False by auto + have rbd: "LLL_invariant_weak' m fs2" "\j < m. \_small fs2 j" + using LLL_invD_mod[OF fs2] LLL_invI_weak \s by auto + have redfs2: "reduced fs2 m" using rbd LLL_invD_weak(8) gram_schmidt_fs.reduced_def \_small_def by blast + have fs: "fs = mfs2" + using res[folded mfs1dmu1, unfolded Let_def split, folded mfs2dmu2, unfolded split] .. + have "\i < m. fs2 ! i = fs ! i" + proof (intro allI impI) + fix i + assume i: "i < m" + then have fs2i: "LLL_invariant_mod fs2 mfs2 dmu2 p1 ?first b1 i" + using fs2 LLL_invariant_mod_to_weak_m_to_i by simp + have \si: "\_small fs2 i" using \s i by simp + show "fs2 ! i = fs ! i" + using basis_reduction_mod_fs_bound(1)[OF fs2i \si i] fs by simp + qed + then have "fs2 = fs" + using LLL_invD_mod(1,3,10,13)[OF fs2] fs by (metis nth_equalityI) + then show ?thesis using redfs2 fs rbd(1) reduce_basis_def res LLL_invD_weak + LLL_invariant_def by simp +qed + +text \Soundness of Storjohann's algorithm for computing a short vector.\ +lemma short_vector_mod_inv: assumes res: "short_vector_mod = v" + and m: "m > 0" + shows "\ fs. LLL_invariant_weak fs \ weakly_reduced fs m \ v = hd fs" +proof - + let ?first = True + obtain p mfs0 dmu0 g_idx0 where init: "compute_initial_state ?first = (p, mfs0, dmu0, g_idx0)" by (metis prod_cases4) + from LLL_initial_invariant_mod[OF init] + obtain fs0 b where fs0: "LLL_invariant_mod fs0 mfs0 dmu0 p ?first b 0" by blast + obtain p1 mfs1 dmu1 where main: "basis_reduction_mod_main p ?first mfs0 dmu0 g_idx0 0 0 = (p1, mfs1, dmu1)" + by (metis prod.exhaust) + obtain fs1 b1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 m" + using basis_reduction_mod_main[OF fs0 main] by auto + have "v = hd mfs1" using res[unfolded short_vector_mod_def Let_def init split main] .. + with basis_reduction_mod_fs_bound_first[OF Linv1 m] LLL_invD_mod(1,3)[OF Linv1] m + have v: "v = hd fs1" by (cases fs1; cases mfs1; auto) + from Linv1 have Linv1: "LLL_invariant_weak fs1" and red: "weakly_reduced fs1 m" + unfolding LLL_invariant_mod_def LLL_invariant_weak_def by auto + show ?thesis + by (intro exI[of _ fs1] conjI Linv1 red v) +qed + +text \Soundness of Storjohann's algorithm with improved swap order\ +lemma reduce_basis_iso_inv: assumes res: "reduce_basis_iso = fs" + shows "LLL_invariant True m fs" +proof (cases "m = 0") + case True + then have *: "fs_init = []" using len by simp + moreover have "fs = []" using res basis_reduction_mod_add_rows_outer_loop.simps(1) + unfolding reduce_basis_iso_def Let_def basis_reduction_iso_main.simps[of _ _ _ _ _ 0] + compute_initial_mfs_def compute_initial_state_def compute_initial_dmu_def + unfolding True * by (auto split: prod.splits) + ultimately show ?thesis using True LLL_inv_initial_state by blast +next + case False + let ?first = False + obtain p mfs0 dmu0 g_idx0 where init: "compute_initial_state ?first = (p, mfs0, dmu0, g_idx0)" by (metis prod_cases4) + from LLL_initial_invariant_mod[OF init] + obtain fs0 b where fs0: "LLL_invariant_mod fs0 mfs0 dmu0 p ?first b 0" by blast + have fs0w: "LLL_invariant_mod_weak fs0 mfs0 dmu0 p ?first b" using LLL_invD_mod[OF fs0] LLL_invI_modw by simp + note res = res[unfolded reduce_basis_iso_def init Let_def split] + obtain p1 mfs1 dmu1 where mfs1dmu1: "(p1, mfs1, dmu1) = basis_reduction_iso_main p ?first mfs0 dmu0 g_idx0 0" + by (metis prod.exhaust) + obtain fs1 b1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 m" + using basis_reduction_iso_main[OF fs0w mfs1dmu1[symmetric]] by auto + obtain mfs2 dmu2 where mfs2dmu2: + "(mfs2, dmu2) = basis_reduction_mod_add_rows_outer_loop p1 mfs1 dmu1 (m-1)" by (metis old.prod.exhaust) + obtain fs2 where fs2: "LLL_invariant_mod fs2 mfs2 dmu2 p1 ?first b1 m" + and \s: "((\j. j < m \ \_small fs2 j))" + using basis_reduction_mod_add_rows_outer_loop_inv[OF _ mfs2dmu2, of fs1 ?first b1] Linv1 False by auto + have rbd: "LLL_invariant_weak' m fs2" "\j < m. \_small fs2 j" + using LLL_invD_mod[OF fs2] LLL_invI_weak \s by auto + have redfs2: "reduced fs2 m" using rbd LLL_invD_weak(8) gram_schmidt_fs.reduced_def \_small_def by blast + have fs: "fs = mfs2" + using res[folded mfs1dmu1, unfolded Let_def split, folded mfs2dmu2, unfolded split] .. + have "\i < m. fs2 ! i = fs ! i" + proof (intro allI impI) + fix i + assume i: "i < m" + then have fs2i: "LLL_invariant_mod fs2 mfs2 dmu2 p1 ?first b1 i" + using fs2 LLL_invariant_mod_to_weak_m_to_i by simp + have \si: "\_small fs2 i" using \s i by simp + show "fs2 ! i = fs ! i" + using basis_reduction_mod_fs_bound(1)[OF fs2i \si i] fs by simp + qed + then have "fs2 = fs" + using LLL_invD_mod(1,3,10,13)[OF fs2] fs by (metis nth_equalityI) + then show ?thesis using redfs2 fs rbd(1) reduce_basis_def res LLL_invD_weak + LLL_invariant_def by simp +qed + +text \Soundness of Storjohann's algorithm to compute short vectors with improved swap order\ +lemma short_vector_iso_inv: assumes res: "short_vector_iso = v" + and m: "m > 0" + shows "\ fs. LLL_invariant_weak fs \ weakly_reduced fs m \ v = hd fs" +proof - + let ?first = True + obtain p mfs0 dmu0 g_idx0 where init: "compute_initial_state ?first = (p, mfs0, dmu0, g_idx0)" by (metis prod_cases4) + from LLL_initial_invariant_mod[OF init] + obtain fs0 b where fs0: "LLL_invariant_mod fs0 mfs0 dmu0 p ?first b 0" by blast + have fs0w: "LLL_invariant_mod_weak fs0 mfs0 dmu0 p ?first b" using LLL_invD_mod[OF fs0] LLL_invI_modw by simp + obtain p1 mfs1 dmu1 where main: "basis_reduction_iso_main p ?first mfs0 dmu0 g_idx0 0 = (p1, mfs1, dmu1)" + by (metis prod.exhaust) + obtain fs1 b1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 m" + using basis_reduction_iso_main[OF fs0w main] by auto + have "v = hd mfs1" using res[unfolded short_vector_iso_def Let_def init split main] .. + with basis_reduction_mod_fs_bound_first[OF Linv1 m] LLL_invD_mod(1,3)[OF Linv1] m + have v: "v = hd fs1" by (cases fs1; cases mfs1; auto) + from Linv1 have Linv1: "LLL_invariant_weak fs1" and red: "weakly_reduced fs1 m" + unfolding LLL_invariant_mod_def LLL_invariant_weak_def by auto + show ?thesis + by (intro exI[of _ fs1] conjI Linv1 red v) +qed + +end + +text \From the soundness results of these abstract versions of the algorithms, + one just needs to derive actual implementations that may integrate low-level + optimizations.\ + +end diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Impl.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Impl.thy new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Impl.thy @@ -0,0 +1,1223 @@ +section \Storjohann's basis reduction algorithm (concrete implementation)\ + +text \We refine the abstract algorithm into a more efficient executable one.\ + +theory Storjohann_Impl + imports + Storjohann +begin + +subsection \Implementation\ + +text \We basically store four components: + \<^item> The $f$-basis (as list, all values taken modulo $p$) + \<^item> The $d\mu$-matrix (as nested arrays, all values taken modulo $d_id_{i+1}p$) + \<^item> The $d$-values (as array) + \<^item> The modulo-values $d_id_{i+1}p$ (as array) +\ + +type_synonym state_impl = "int vec list \ int iarray iarray \ int iarray \ int iarray" + +fun di_of :: "state_impl \ int iarray" where + "di_of (mfsi, dmui, di, mods) = di" + +context LLL +begin + +fun state_impl_inv :: "_ \ _ \ _ \ state_impl \ bool" where + "state_impl_inv p mfs dmu (mfsi, dmui, di, mods) = (mfsi = mfs \ di = IArray.of_fun (d_of dmu) (Suc m) + \ dmui = IArray.of_fun (\ i. IArray.of_fun (\ j. dmu $$ (i,j)) i) m + \ mods = IArray.of_fun (\ j. p * di !! j * di !! (Suc j)) (m - 1))" + +definition state_iso_inv :: "(int \ int) iarray \ int iarray \ bool" where + "state_iso_inv prods di = (prods = IArray.of_fun + (\ i. (di !! (i+1) * di !! (i+1), di !! (i+2) * di !! i)) (m - 1))" + +definition perform_add_row :: "int \ state_impl \ nat \ nat \ int \ int iarray \ int \ int \ state_impl" where + "perform_add_row p state i j c rowi muij dij1 = (let + (mfsi, dmui, di, mods) = state; + fsj = mfsi ! j; + rowj = dmui !! j + in + (case split_at i mfsi of (start, fsi # end) \ start @ vec n (\ k. (fsi $ k - c * fsj $ k) symmod p) # end, + IArray.of_fun (\ ii. if i = ii then + IArray.of_fun (\ jj. if jj < j then + (rowi !! jj - c * rowj !! jj) symmod (mods !! jj) + else if jj = j then muij - c * dij1 + else rowi !! jj) i + else dmui !! ii) m, + di, mods))" + +definition LLL_add_row :: "int \ state_impl \ nat \ nat \ state_impl" where + "LLL_add_row p state i j = (let + (_, dmui, di, _) = state; + rowi = dmui !! i; + dij1 = di !! (Suc j); + muij = rowi !! j; + c = round_num_denom muij dij1 + in if c = 0 then state + else perform_add_row p state i j c rowi muij dij1)" + + +definition LLL_swap_row :: "int \ state_impl \ nat \ state_impl" where + "LLL_swap_row p state k = (case state of (mfsi, dmui, di, mods) \ let + k1 = k - 1; + kS1 = Suc k; + muk = dmui !! k; + muk1 = dmui !! k1; + mukk1 = muk !! k1; + dk1 = di !! k1; + dkS1 = di !! kS1; + dk = di !! k; + dk' = (dkS1 * dk1 + mukk1 * mukk1) div dk; + mod1 = p * dk1 * dk'; + modk = p * dk' * dkS1 + in + (case split_at k1 mfsi + of (start, fsk1 # fsk # end) \ start @ fsk # fsk1 # end, + IArray.of_fun (\ i. + if i < k1 then dmui !! i + else if i > k then + let row_i = dmui !! i; muik = row_i !! k; muik1 = row_i !! k1 in IArray.of_fun + (\ j. if j = k1 then ((mukk1 * muik1 + muik * dk1) div dk) symmod mod1 + else if j = k then ((dkS1 * muik1 - mukk1 * muik) div dk) symmod modk + else row_i !! j) i + else if i = k then IArray.of_fun (\ j. if j = k1 then mukk1 symmod mod1 else muk1 !! j) i + else IArray.of_fun ((!!) muk) i + ) m, + IArray.of_fun (\ i. if i = k then dk' else di !! i) (Suc m), + IArray.of_fun (\ j. if j = k1 then mod1 else if j = k then modk else mods !! j) (m - 1)))" + +definition perform_swap_add where "perform_swap_add p state k k1 c row_k mukk1 dk = +(let (fs, dmu, dd, mods) = state; + row_k1 = dmu !! k1; + kS1 = Suc k; + mukk1' = mukk1 - c * dk; + dk1 = dd !! k1; + dkS1 = dd !! kS1; + dk' = (dkS1 * dk1 + mukk1' * mukk1') div dk; + mod1 = p * dk1 * dk'; + modk = p * dk' * dkS1 + in + (case split_at k1 fs of (start, fsk1 # fsk # end) \ + start @ vec n (\k. (fsk $ k - c * fsk1 $ k) symmod p) # fsk1 # end, + IArray.of_fun + (\i. if i < k1 + then dmu !! i + else if k < i + then let row_i = dmu !! i; + muik1 = row_i !! k1; + muik = row_i !! k + in IArray.of_fun + (\j. if j = k1 then (mukk1' * muik1 + muik * dk1) div dk symmod mod1 + else if j = k then (dkS1 * muik1 - mukk1' * muik) div dk symmod modk + else row_i !! j) + i + else if i = k then IArray.of_fun (\j. if j = k1 then mukk1' symmod mod1 else row_k1 !! j) k + else IArray.of_fun (\j. (row_k !! j - c * row_k1 !! j) symmod mods !! j) i) + m, + IArray.of_fun (\i. if i = k then dk' else dd !! i) (Suc m), + IArray.of_fun (\j. if j = k1 then mod1 else if j = k then modk else mods !! j) (m - 1)))" + + +definition LLL_swap_add where + "LLL_swap_add p state i = (let + i1 = i - 1; + (_, dmui, di, _) = state; + rowi = dmui !! i; + dii = di !! i; + muij = rowi !! i1; + c = round_num_denom muij dii + in if c = 0 then LLL_swap_row p state i + else perform_swap_add p state i i1 c rowi muij dii)" + +definition LLL_max_gso_norm_di :: "bool \ int iarray \ rat \ nat" where + "LLL_max_gso_norm_di first di = + (if first then (of_int (di !! 1), 0) + else case max_list_rats_with_index (map (\ i. (di !! (Suc i), di !! i, i)) [0 ..< m ]) + of (num, denom, i) \ (of_int num / of_int denom, i))" + +definition LLL_max_gso_quot:: "(int * int) iarray \ (int * int * nat)" where + "LLL_max_gso_quot di_prods = max_list_rats_with_index + (map (\i. case di_prods !! i of (l,r) \ (l, r, Suc i)) [0..<(m-1)])" + + +definition LLL_max_gso_norm :: "bool \ state_impl \ rat \ nat" where + "LLL_max_gso_norm first state = (case state of (_, _, di, mods) \ LLL_max_gso_norm_di first di)" + +definition perform_adjust_mod :: "int \ state_impl \ state_impl" where + "perform_adjust_mod p state = (case state of (mfsi, dmui, di, _) \ + let mfsi' = map (map_vec (\x. x symmod p)) mfsi; + mods = IArray.of_fun (\ j. p * di !! j * di !! (Suc j)) (m - 1); + dmui' = IArray.of_fun (\ i. let row = dmui !! i in IArray.of_fun (\ j. row !! j symmod (mods !! j)) i) m + in + ((mfsi', dmui', di, mods)))" + +definition mod_of_gso_norm :: "bool \ rat \ int" where + "mod_of_gso_norm first mn = log_base ^ (log_ceiling log_base (max 2 ( + root_rat_ceiling 2 (mn * (rat_of_nat (if first then 4 else m + 3))) + 1)))" + +definition LLL_adjust_mod :: "int \ bool \ state_impl \ int \ state_impl \ nat" where + "LLL_adjust_mod p first state = ( + let (b', g_idx) = LLL_max_gso_norm first state; + p' = mod_of_gso_norm first b' + in if p' < p then (p', perform_adjust_mod p' state, g_idx) + else (p, state, g_idx) + )" + +definition LLL_adjust_swap_add where + "LLL_adjust_swap_add p first state g_idx i = ( + let state1 = LLL_swap_add p state i + in if i - 1 = g_idx then + LLL_adjust_mod p first state1 else (p, state1, g_idx))" + + +definition LLL_step :: "int \ bool \ state_impl \ nat \ nat \ int \ (int \ state_impl \ nat) \ nat \ int" where + "LLL_step p first state g_idx i j = (if i = 0 then ((p, state, g_idx), Suc i, j) + else let + i1 = i - 1; + iS = Suc i; + (_, _, di, _) = state; + (num, denom) = quotient_of \; + d_i = di !! i; + d_i1 = di !! i1; + d_Si = di !! iS + in if d_i * d_i * denom \ num * d_i1 * d_Si then + ((p, state, g_idx), iS, j) + else (LLL_adjust_swap_add p first state g_idx i, i1, j + 1))" + +partial_function (tailrec) LLL_main :: "int \ bool \ state_impl \ nat \ nat \ int \ int \ state_impl" + where + "LLL_main p first state g_idx i (j :: int) = ( + (if i < m + then case LLL_step p first state g_idx i j of + ((p', state', g_idx'), i', j') \ + LLL_main p' first state' g_idx' i' j' + else + (p, state)))" + +partial_function (tailrec) LLL_iso_main_inner where + "LLL_iso_main_inner p first state di_prods g_idx (j :: int) = ( + case state of (_, _, di, _) \ + ( + (let (max_gso_num, max_gso_denum, indx) = LLL_max_gso_quot di_prods; + (num, denum) = quotient_of \ in + (if max_gso_num * denum > num * max_gso_denum then + case LLL_adjust_swap_add p first state g_idx indx of + (p', state', g_idx') \ case state' of (_, _, di', _) \ + let di_prods' = IArray.of_fun (\ i. case di_prods !! i of lr \ + if i > indx \ i + 2 < indx then lr + else case lr of (l,r) + \ if i + 1 = indx then let d_idx = di' !! indx in (d_idx * d_idx, r) else (l, di' !! (i + 2) * di' !! i)) (m - 1) + in LLL_iso_main_inner p' first state' di_prods' g_idx' (j + 1) + else + (p, state)))))" + +definition LLL_iso_main where + "LLL_iso_main p first state g_idx j = (if m > 1 then + case state of (_, _, di, _) \ + let di_prods = IArray.of_fun (\ i. (di !! (i+1) * di !! (i+1), di !! (i+2) * di !! i)) (m - 1) + in LLL_iso_main_inner p first state di_prods g_idx j else (p,state))" + + +definition LLL_initial :: "bool \ int \ state_impl \ nat" where + "LLL_initial first = (let init = d\_impl fs_init; + di = IArray.of_fun (\ i. if i = 0 then 1 else let i1 = i - 1 in init !! i1 !! i1) (Suc m); + (b,g_idx) = LLL_max_gso_norm_di first di; + p = mod_of_gso_norm first b; + mods = IArray.of_fun (\ j. p * di !! j * di !! (Suc j)) (m - 1); + dmui = IArray.of_fun (\ i. let row = init !! i in IArray.of_fun (\ j. row !! j symmod (mods !! j)) i) m + in (p, (compute_initial_mfs p, dmui, di, mods), g_idx))" + +fun LLL_add_rows_loop where + "LLL_add_rows_loop p state i 0 = state" +| "LLL_add_rows_loop p state i (Suc j) = ( + let state' = LLL_add_row p state i j + in LLL_add_rows_loop p state' i j)" + +primrec LLL_add_rows_outer_loop where + "LLL_add_rows_outer_loop p state 0 = state" | + "LLL_add_rows_outer_loop p state (Suc i) = + (let state' = LLL_add_rows_outer_loop p state i in + LLL_add_rows_loop p state' (Suc i) (Suc i))" + +definition + "LLL_reduce_basis = (if m = 0 then [] else + let first = False; + (p0, state0, g_idx0) = LLL_initial first; + (p, state) = LLL_main p0 first state0 g_idx0 0 0; + (mfs,_,_,_) = LLL_add_rows_outer_loop p state (m - 1) + in mfs)" + +definition + "LLL_reduce_basis_iso = (if m = 0 then [] else + let first = False; + (p0, state0, g_idx0) = LLL_initial first; + (p, state) = LLL_iso_main p0 first state0 g_idx0 0; + (mfs,_,_,_) = LLL_add_rows_outer_loop p state (m - 1) + in mfs)" + +definition + "LLL_short_vector = ( + let first = True; + (p0, state0, g_idx0) = LLL_initial first; + (p, (mfs,_,_,_)) = LLL_main p0 first state0 g_idx0 0 0 + in hd mfs)" + +definition + "LLL_short_vector_iso = ( + let first = True; + (p0, state0, g_idx0) = LLL_initial first; + (p, (mfs,_,_,_)) = LLL_iso_main p0 first state0 g_idx0 0 + in hd mfs)" + +end + +declare LLL.LLL_short_vector_def[code] +declare LLL.LLL_short_vector_iso_def[code] +declare LLL.LLL_reduce_basis_def[code] +declare LLL.LLL_reduce_basis_iso_def[code] +declare LLL.LLL_iso_main_def[code] +declare LLL.LLL_iso_main_inner.simps[code] +declare LLL.LLL_add_rows_outer_loop.simps[code] +declare LLL.LLL_add_rows_loop.simps[code] +declare LLL.LLL_initial_def[code] +declare LLL.LLL_main.simps[code] +declare LLL.LLL_adjust_mod_def[code] +declare LLL.LLL_max_gso_norm_def[code] +declare LLL.perform_adjust_mod_def[code] +declare LLL.LLL_max_gso_norm_di_def[code] +declare LLL.LLL_max_gso_quot_def[code] +declare LLL.LLL_step_def[code] +declare LLL.LLL_add_row_def[code] +declare LLL.perform_add_row_def[code] +declare LLL.LLL_swap_row_def[code] +declare LLL.LLL_swap_add_def[code] +declare LLL.LLL_adjust_swap_add_def[code] +declare LLL.perform_swap_add_def[code] +declare LLL.mod_of_gso_norm_def[code] +declare LLL.compute_initial_mfs_def[code] +declare LLL.log_base_def[code] + + +subsection \Towards soundness proof of implementation\ + +context LLL +begin +lemma perform_swap_add: assumes k: "k \ 0" "k < m" and fs: "length fs = m" + shows "LLL_swap_row p (perform_add_row p (fs, dmu, di, mods) k (k - 1) c (dmu !! k) (dmu !! k !! (k - 1)) (di !! k)) k + = perform_swap_add p (fs, dmu, di, mods) k (k - 1) c (dmu !! k) (dmu !! k !! (k - 1)) (di !! k)" +proof - + from k[folded fs] + have drop: "drop k fs = fs ! k # drop (Suc k) fs" + by (simp add: Cons_nth_drop_Suc) + obtain v where v: "vec n (\ka. (fs ! k $ ka - c * fs ! (k - 1) $ ka) symmod p) = v" by auto + from k[folded fs] + have drop1: "drop (k - 1) (take k fs @ v # drop (Suc k) fs) = fs ! (k - 1) # v # drop (Suc k) fs" + by (simp add: Cons_nth_drop_Suc) + (smt Cons_nth_drop_Suc Suc_diff_Suc Suc_less_eq Suc_pred diff_Suc_less diff_self_eq_0 drop_take less_SucI take_Suc_Cons take_eq_Nil) + from k[folded fs] + have drop2: "drop (k - 1) fs = fs ! (k - 1) # fs ! k # drop (Suc k) fs" + by (metis Cons_nth_drop_Suc One_nat_def Suc_less_eq Suc_pred less_SucI neq0_conv) + have take: "take (k - 1) (take k fs @ xs) = take (k - 1) fs" for xs using k[folded fs] by auto + obtain rowk where rowk: "IArray.of_fun + (\jj. if jj < k - 1 then (dmu !! k !! jj - c * dmu !! (k - 1) !! jj) symmod mods !! jj + else if jj = k - 1 then dmu !! k !! (k - 1) - c * di !! k else dmu !! k !! jj) k = rowk" + by auto + obtain mukk1' where mukk1': "(di !! Suc k * di !! (k - 1) + rowk !! (k - 1) * rowk !! (k - 1)) div di !! k = mukk1'" + by auto + have kk1: "k - 1 < k" using k by auto + have mukk1'': "(di !! Suc k * di !! (k - 1) + + (dmu !! k !! (k - 1) - c * di !! k) * (dmu !! k !! (k - 1) - c * di !! k)) div + di !! k = mukk1'" + unfolding mukk1'[symmetric] rowk[symmetric] IArray.of_fun_nth[OF kk1] by auto + have id: "(k = k) = True" by simp + have rowk1: "dmu !! k !! (k - 1) - c * di !! k = rowk !! (k - 1)" + unfolding rowk[symmetric] IArray.of_fun_nth[OF kk1] by simp + show ?thesis + unfolding perform_swap_add_def split perform_add_row_def Let_def split LLL_swap_row_def split_at_def + unfolding drop list.simps v drop1 take prod.inject drop2 rowk IArray.of_fun_nth[OF \k < m\] id if_True + unfolding rowk1 + proof (intro conjI refl iarray_cong, unfold rowk1[symmetric], goal_cases) + case i: (1 i) + show ?case unfolding IArray.of_fun_nth[OF i] IArray.of_fun_nth[OF \k < m\] id if_True mukk1' mukk1'' + rowk1[symmetric] + proof (intro if_cong[OF refl], force, goal_cases) + case 3 + hence i: "i = k - 1" by auto + show ?case unfolding i by (intro iarray_cong[OF refl], unfold rowk[symmetric], + subst IArray.of_fun_nth, insert k, auto) + next + case ki: 1 (* k < i *) + hence id: "(k = i) = False" by auto + show ?case unfolding id if_False rowk + by (intro iarray_cong if_cong refl) + next + case 2 (* k = i *) + show ?case unfolding 2 + by (intro iarray_cong if_cong refl, subst IArray.of_fun_nth, insert k, auto) + qed + qed +qed + + +lemma LLL_swap_add_eq: assumes i: "i \ 0" "i < m" and fs: "length fs = m" + shows "LLL_swap_add p (fs,dmu,di,mods) i = (LLL_swap_row p (LLL_add_row p (fs,dmu,di,mods) i (i - 1)) i)" +proof - + define c where "c = round_num_denom (dmu !! i !! (i - 1)) (di !! i)" + from i have si1: "Suc (i - 1) = i" by auto + note res1 = LLL_swap_add_def[of p "(fs,dmu,di,mods)" i, unfolded split Let_def c_def[symmetric]] + show ?thesis + proof (cases "c = 0") + case True + thus ?thesis using i unfolding res1 LLL_add_row_def split id c_def Let_def by auto + next + case False + hence c: "(c = 0) = False" by simp + have add: "LLL_add_row p (fs, dmu, di, mods) i (i - 1) = + perform_add_row p (fs, dmu, di, mods) i (i - 1) c (dmu !! i) (dmu !! i !! (i - 1)) (di !! i)" + unfolding LLL_add_row_def Let_def split si1 c_def[symmetric] c by auto + show ?thesis unfolding res1 c if_False add + by (subst perform_swap_add[OF assms]) simp + qed +qed +end + + +context LLL_with_assms +begin + +lemma LLL_mod_inv_to_weak: "LLL_invariant_mod fs mfs dmu p first b i \ LLL_invariant_mod_weak fs mfs dmu p first b" + unfolding LLL_invariant_mod_def LLL_invariant_mod_weak_def by auto + +declare IArray.of_fun_def[simp del] + +lemma LLL_swap_row: assumes impl: "state_impl_inv p mfs dmu state" + and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and res: "basis_reduction_mod_swap p mfs dmu k = (mfs', dmu')" + and res': "LLL_swap_row p state k = state'" + and k: "k < m" "k \ 0" +shows "state_impl_inv p mfs' dmu' state'" +proof - + note inv = LLL_invD_modw[OF Linv] + obtain fsi dmui di mods where state: "state = (fsi, dmui, di, mods)" by (cases state, auto) + obtain fsi' dmui' di' mods' where state': "state' = (fsi', dmui', di', mods')" by (cases state', auto) + from impl[unfolded state, simplified] + have id: "fsi = mfs" + "di = IArray.of_fun (d_of dmu) (Suc m)" + "dmui = IArray.of_fun (\i. IArray.of_fun (\j. dmu $$ (i, j)) i) m" + "mods = IArray.of_fun (\j. p * di !! j * di !! Suc j) (m - 1)" + by auto + have kk1: "dmui !! k !! (k - 1) = dmu $$ (k, k - 1)" using k unfolding id + IArray.of_fun_nth[OF k(1)] + by (subst IArray.of_fun_nth, auto) + have di: "i \ m \ di !! i = d_of dmu i" for i + unfolding id by (subst IArray.of_fun_nth, auto) + have dS1: "di !! Suc k = d_of dmu (Suc k)" using di k by auto + have d1: "di !! (k - 1) = d_of dmu (k - 1)" using di k by auto + have dk: "di !! k = d_of dmu k" using di k by auto + define dk' where "dk' = (d_of dmu (Suc k) * d_of dmu (k - 1) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) div d_of dmu k" + define mod1 where "mod1 = p * d_of dmu (k - 1) * dk'" + define modk where "modk = p * dk' * d_of dmu (Suc k)" + define dmu'' where "dmu'' = (mat m m + (\(i, j). + if j < i + then if i = k - 1 then dmu $$ (k, j) + else if i = k \ j \ k - 1 then dmu $$ (k - 1, j) + else if k < i \ j = k then (d_of dmu (Suc k) * dmu $$ (i, k - 1) - dmu $$ (k, k - 1) * dmu $$ (i, j)) div d_of dmu k + else if k < i \ j = k - 1 then (dmu $$ (k, k - 1) * dmu $$ (i, j) + dmu $$ (i, k) * d_of dmu (k - 1)) div d_of dmu k else dmu $$ (i, j) + else if i = j then if i = k - 1 then (d_of dmu (Suc k) * d_of dmu (k - 1) + dmu $$ (k, k - 1) * dmu $$ (k, k - 1)) div d_of dmu k else d_of dmu (Suc i) + else dmu $$ (i, j)))" + have drop: "drop (k - 1) fsi = mfs ! (k - 1) # mfs ! k # drop (Suc k) mfs" unfolding id using \length mfs = m\ k + by (metis Cons_nth_drop_Suc One_nat_def Suc_less_eq Suc_pred less_SucI linorder_neqE_nat not_less0) + have dk': "dk' = d_of dmu'' k" unfolding dk'_def d_of_def dmu''_def using k by auto + have mod1: "mod1 = p * d_of dmu'' (k - 1) * d_of dmu'' k" unfolding mod1_def dk' using k + by (auto simp: dmu''_def d_of_def) + have modk: "modk = p * d_of dmu'' k * d_of dmu'' (Suc k)" unfolding modk_def dk' using k + by (auto simp: dmu''_def d_of_def) + note res = res[unfolded basis_reduction_mod_swap_def, folded dmu''_def, symmetric] + note res' = res'[unfolded state state' split_at_def drop list.simps split LLL_swap_row_def Let_def kk1 dS1 d1 dk, + folded dk'_def mod1_def modk_def, symmetric] + from res' have fsi': "fsi' = take (k - 1) mfs @ mfs ! k # mfs ! (k - 1) # drop (Suc k) mfs" unfolding id by simp + from res' have di': "di' = IArray.of_fun (\ii. if ii = k then dk' else di !! ii) (Suc m)" by simp + from res' have dmui': "dmui' = IArray.of_fun + (\i. if i < k - 1 then dmui !! i + else if k < i then IArray.of_fun + (\j. if j = k - 1 + then (dmu $$ (k, k - 1) * dmui !! i !! (k - 1) + dmui !! i !! k * d_of dmu (k - 1)) + div d_of dmu k symmod mod1 + else if j = k + then (d_of dmu (Suc k) * dmui !! i !! (k - 1) - dmu $$ (k, k - 1) * dmui !! i !! k) + div d_of dmu k symmod modk + else dmui !! i !! j) + i + else if i = k then IArray.of_fun (\j. if j = k - 1 then dmu $$ (k, k - 1) symmod mod1 + else dmui !! (k - 1) !! j) i else IArray.of_fun ((!!) (dmui !! k)) i) + m" by auto + from res' have mods': "mods' = IArray.of_fun (\jj. if jj = k - 1 then mod1 else if jj = k then modk else mods !! jj) (m - 1)" + by auto + from res have dmu': "dmu' = basis_reduction_mod_swap_dmu_mod p dmu'' k" by auto + show ?thesis unfolding state' state_impl_inv.simps + proof (intro conjI) + from res have mfs': "mfs' = mfs[k := mfs ! (k - 1), k - 1 := mfs ! k]" by simp + show "fsi' = mfs'" unfolding fsi' mfs' using \length mfs = m\ k + proof (intro nth_equalityI, force, goal_cases) + case (1 j) + have choice: "j = k - 1 \ j = k \ j < k - 1 \ j > k" by linarith + have "min (length mfs) (k - 1) = k - 1" using 1 by auto + with 1 choice show ?case by (auto simp: nth_append) + qed + show "di' = IArray.of_fun (d_of dmu') (Suc m)" unfolding di' + proof (intro iarray_cong refl, goal_cases) + case i: (1 i) + hence "d_of dmu' i = d_of dmu'' i" unfolding dmu' basis_reduction_mod_swap_dmu_mod_def d_of_def + by (intro if_cong, auto) + also have "\ = ((if i = k then dk' else di !! i))" + proof (cases "i = k") + case False + hence "d_of dmu'' i = d_of dmu i" unfolding dmu''_def d_of_def using i k + by (intro if_cong refl, auto) + thus ?thesis using False i k unfolding id by (metis iarray_of_fun_sub) + next + case True + thus ?thesis using dk' by auto + qed + finally show ?case by simp + qed + have dkS1: "d_of dmu (Suc k) = d_of dmu'' (Suc k)" + unfolding dmu''_def d_of_def using k by auto + have dk1: "d_of dmu (k - 1) = d_of dmu'' (k - 1)" + unfolding dmu''_def d_of_def using k by auto + show "dmui' = IArray.of_fun (\i. IArray.of_fun (\j. dmu' $$ (i, j)) i) m" + unfolding dmui' + proof (intro iarray_cong refl, goal_cases) + case i: (1 i) + consider (1) "i < k - 1" | (2) "i = k - 1" | (3) "i = k" | (4) "i > k" by linarith + thus ?case + proof (cases) + case 1 + hence *: "(i < k - 1) = True" by simp + show ?thesis unfolding * if_True id IArray.of_fun_nth[OF i] using i k 1 + by (intro iarray_cong refl, auto simp: dmu' basis_reduction_mod_swap_dmu_mod_def, auto simp: dmu''_def) + next + case 2 + hence *: "(i < k - 1) = False" "(k < i) = False" "(i = k) = False" using k by auto + show ?thesis unfolding * if_False id using i k 2 unfolding IArray.of_fun_nth[OF k(1)] + by (intro iarray_cong refl, subst IArray.of_fun_nth, auto simp: dmu' basis_reduction_mod_swap_dmu_mod_def dmu''_def) + next + case 3 + hence *: "(i < k - 1) = False" "(k < i) = False" "(i = k) = True" using k by auto + show ?thesis unfolding * if_False if_True id IArray.of_fun_nth[OF k(1)] + proof (intro iarray_cong refl, goal_cases) + case j: (1 j) + show ?case + proof (cases "j = k - 1") + case False + hence *: "(j = k - 1) = False" by auto + show ?thesis unfolding * if_False using False j k i 3 + by (subst IArray.of_fun_nth, force, subst IArray.of_fun_nth, force, auto simp: dmu' basis_reduction_mod_swap_dmu_mod_def dmu''_def) + next + case True + hence *: "(j = k - 1) = True" by auto + show ?thesis unfolding * if_True unfolding True 3 using k + by (auto simp: basis_reduction_mod_swap_dmu_mod_def dmu' dk' mod1 dmu''_def) + qed + qed + next + case 4 + hence *: "(i < k - 1) = False" "(k < i) = True" using k by auto + show ?thesis unfolding * if_False if_True id IArray.of_fun_nth[OF k(1)] IArray.of_fun_nth[OF \i < m\] + proof (intro iarray_cong refl, goal_cases) + case j: (1 j) + from 4 have k1: "k - 1 < i" by auto + show ?case unfolding IArray.of_fun_nth[OF j] IArray.of_fun_nth[OF 4] IArray.of_fun_nth[OF k1] + unfolding mod1 modk dmu' basis_reduction_mod_swap_dmu_mod_def using i j 4 k + by (auto intro!: arg_cong[of _ _ "\ x. x symmod _"], auto simp: dmu''_def) + qed + qed + qed + show "mods' = IArray.of_fun (\j. p * di' !! j * di' !! Suc j) (m - 1)" + unfolding mods' di' dk' mod1 modk + proof (intro iarray_cong refl, goal_cases) + case (1 j) + hence j: "j < Suc m" "Suc j < Suc m" by auto + show ?case unfolding + IArray.of_fun_nth[OF 1] + IArray.of_fun_nth[OF j(1)] + IArray.of_fun_nth[OF j(2)] id(4) using k di dk1 dkS1 + by auto + qed + qed +qed + + +lemma LLL_add_row: assumes impl: "state_impl_inv p mfs dmu state" + and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and res: "basis_reduction_mod_add_row p mfs dmu i j = (mfs', dmu')" + and res': "LLL_add_row p state i j = state'" + and i: "i < m" + and j: "j < i" +shows "state_impl_inv p mfs' dmu' state'" +proof - + note inv = LLL_invD_modw[OF Linv] + obtain fsi dmui di mods where state: "state = (fsi, dmui, di, mods)" by (cases state, auto) + obtain fsi' dmui' di' mods' where state': "state' = (fsi', dmui', di', mods')" by (cases state', auto) + from impl[unfolded state, simplified] + have id: "fsi = mfs" + "di = IArray.of_fun (d_of dmu) (Suc m)" + "dmui = IArray.of_fun (\i. IArray.of_fun (\j. dmu $$ (i, j)) i) m" + "mods = IArray.of_fun (\j. p * di !! j * di !! Suc j) (m - 1)" + by auto + let ?c = "round_num_denom (dmu $$ (i, j)) (d_of dmu (Suc j))" + let ?c' = "round_num_denom (dmui !! i !! j) (di !! Suc j)" + obtain c where c: "?c = c" by auto + have c': "?c' = c" unfolding id c[symmetric] using i j + by (subst (1 2) IArray.of_fun_nth, (force+)[2], + subst IArray.of_fun_nth, force+) + have drop: "drop i fsi = mfs ! i # drop (Suc i) mfs" unfolding id using \length mfs = m\ i + by (metis Cons_nth_drop_Suc) + note res = res[unfolded basis_reduction_mod_add_row_def Let_def c, symmetric] + note res' = res'[unfolded state state' split LLL_add_row_def Let_def c', symmetric] + show ?thesis + proof (cases "c = 0") + case True + from res[unfolded True] res'[unfolded True] show ?thesis unfolding state' using id by auto + next + case False + hence False: "(c = 0) = False" by simp + note res = res[unfolded Let_def False if_False] + from res have mfs': "mfs' = mfs[i := map_vec (\x. x symmod p) (mfs ! i - c \\<^sub>v mfs ! j)]" by auto + from res have dmu': "dmu' = mat m m (\(i', j'). + if i' = i \ j' \ j + then if j' = j then dmu $$ (i, j') - c * dmu $$ (j, j') + else (dmu $$ (i, j') - c * dmu $$ (j, j')) symmod (p * d_of dmu j' * d_of dmu (Suc j')) + else dmu $$ (i', j'))" by auto + note res' = res'[unfolded Let_def False if_False perform_add_row_def drop list.simps split_at_def split] + from res' have fsi': "fsi' = take i fsi @ vec n (\k. (mfs ! i $ k - c * mfs ! j $ k) symmod p) # drop (Suc i) mfs" + by (auto simp: id) + from res' have di': "di' = di" and mods': "mods' = mods" by auto + from res' have dmui': "dmui' = IArray.of_fun (\ii. if i = ii + then IArray.of_fun + (\jj. if jj < j then (dmui !! i !! jj - c * dmui !! j !! jj) symmod (mods !! jj) + else if jj = j then dmui !! i !! j - c * di !! (Suc j) else dmui !! i !! jj) + i + else dmui !! ii) m" by auto + show ?thesis unfolding state' state_impl_inv.simps + proof (intro conjI) + from inv(11) i j have vec: "mfs ! i \ carrier_vec n" "mfs ! j \ carrier_vec n" by auto + hence id': "map_vec (\x. x symmod p) (mfs ! i - c \\<^sub>v mfs ! j) = vec n (\k. (mfs ! i $ k - c * mfs ! j $ k) symmod p)" + by (intro eq_vecI, auto) + show "mods' = IArray.of_fun (\j. p * di' !! j * di' !! Suc j) (m - 1)" using id unfolding mods' di' by auto + show "fsi' = mfs'" unfolding fsi' mfs' id unfolding id' using \length mfs = m\ i + by (simp add: upd_conv_take_nth_drop) + show "di' = IArray.of_fun (d_of dmu') (Suc m)" + unfolding dmu' di' id d_of_def + by (intro iarray_cong if_cong refl, insert i j, auto) + show "dmui' = IArray.of_fun (\i. IArray.of_fun (\j. dmu' $$ (i, j)) i) m" + unfolding dmui' + proof (intro iarray_cong refl) + fix ii + assume ii: "ii < m" + show "(if i = ii + then IArray.of_fun + (\jj. if jj < j then (dmui !! i !! jj - c * dmui !! j !! jj) symmod (mods !! jj) + else if jj = j then dmui !! i !! j - c * di !! (Suc j) else dmui !! i !! jj) + i + else dmui !! ii) = + IArray.of_fun (\j. dmu' $$ (ii, j)) ii" + proof (cases "i = ii") + case False + hence *: "(i = ii) = False" by auto + show ?thesis unfolding * if_False id dmu' using False i j ii + unfolding IArray.of_fun_nth[OF ii] + by (intro iarray_cong refl, auto) + next + case True + hence *: "(i = ii) = True" by auto + from i j have "j < m" by simp + show ?thesis unfolding * if_True dmu' id IArray.of_fun_nth[OF i] IArray.of_fun_nth[OF \j < m\] + unfolding True[symmetric] + proof (intro iarray_cong refl, goal_cases) + case jj: (1 jj) + consider (1) "jj < j" | (2) "jj = j" | (3) "jj > j" by linarith + thus ?case + proof cases + case 1 + thus ?thesis using jj i j unfolding id(4) + by (subst (1 2 3 4 5 6) IArray.of_fun_nth, auto) + next + case 2 + thus ?thesis using jj i j + by (subst (5 6) IArray.of_fun_nth, auto simp: d_of_def) + next + case 3 + thus ?thesis using jj i j + by (subst (7) IArray.of_fun_nth, auto simp: d_of_def) + qed + qed + qed + qed + qed + qed +qed + + +lemma LLL_max_gso_norm_di: assumes di: "di = IArray.of_fun (d_of dmu) (Suc m)" + and m: "m \ 0" +shows "LLL_max_gso_norm_di first di = compute_max_gso_norm first dmu" +proof - + have di: "j \ m \ di !! j = d_of dmu j" for j unfolding di + by (subst IArray.of_fun_nth, auto) + have id: "(m = 0) = False" using m by auto + show ?thesis + proof (cases first) + case False + hence id': "first = False" by auto + show ?thesis unfolding LLL_max_gso_norm_di_def compute_max_gso_norm_def id id' if_False + by (intro if_cong refl arg_cong[of _ _ "\ xs. case max_list_rats_with_index xs of (num, denom, i) \ (rat_of_int num / rat_of_int denom, i)"], + unfold map_eq_conv, intro ballI, subst (1 2) di, auto) + next + case True + hence id': "first = True" by auto + show ?thesis unfolding LLL_max_gso_norm_di_def compute_max_gso_norm_def id id' if_False if_True + using m di[of 1] + by (simp add: d_of_def) + qed +qed + +lemma LLL_max_gso_quot: assumes di: "di = IArray.of_fun (d_of dmu) (Suc m)" + and prods: "state_iso_inv di_prods di" +shows "LLL_max_gso_quot di_prods = compute_max_gso_quot dmu" +proof - + have di: "j \ m \ di !! j = d_of dmu j" for j unfolding di + by (subst IArray.of_fun_nth, auto) + show ?thesis unfolding LLL_max_gso_quot_def compute_max_gso_quot_def prods[unfolded state_iso_inv_def] + by (intro if_cong refl arg_cong[of _ _ max_list_rats_with_index], unfold map_eq_conv Let_def, intro ballI, + subst IArray.of_fun_nth, force, unfold split, + subst (1 2 3 4) di, auto) +qed + +lemma LLL_max_gso_norm: assumes impl: "state_impl_inv p mfs dmu state" + and m: "m \ 0" +shows "LLL_max_gso_norm first state = compute_max_gso_norm first dmu" +proof - + obtain mfsi dmui di mods where state: "state = (mfsi, dmui, di,mods)" + by (metis prod_cases3) + from impl[unfolded state state_impl_inv.simps] + have di: "di = IArray.of_fun (d_of dmu) (Suc m)" by auto + show ?thesis using LLL_max_gso_norm_di[OF di m] unfolding LLL_max_gso_norm_def state split . +qed + +lemma mod_of_gso_norm: "m \ 0 \ mod_of_gso_norm first mn = + compute_mod_of_max_gso_norm first mn" + unfolding mod_of_gso_norm_def compute_mod_of_max_gso_norm_def bound_number_def + by auto + +lemma LLL_adjust_mod: assumes impl: "state_impl_inv p mfs dmu state" + and res: "basis_reduction_adjust_mod p first mfs dmu = (p', mfs', dmu', g_idx)" + and res': "LLL_adjust_mod p first state = (p'', state', g_idx')" + and m: "m \ 0" +shows "state_impl_inv p' mfs' dmu' state' \ p'' = p' \ g_idx' = g_idx" +proof - + from LLL_max_gso_norm[OF impl m] + have id: "LLL_max_gso_norm first state = compute_max_gso_norm first dmu" by auto + obtain b gi where norm: "compute_max_gso_norm first dmu = (b, gi)" by force + obtain P where P: "compute_mod_of_max_gso_norm first b = P" by auto + note res = res[unfolded basis_reduction_adjust_mod.simps Let_def P norm split] + note res' = res'[unfolded LLL_adjust_mod_def id Let_def P norm split mod_of_gso_norm[OF m]] + show ?thesis + proof (cases "P < p") + case False + thus ?thesis using res res' impl by (auto split: if_splits) + next + case True + hence id: "(P < p) = True" by auto + obtain fsi dmui di mods where state: "state = (fsi, dmui, di, mods)" by (metis prod_cases3) + from impl[unfolded state state_impl_inv.simps] + have impl: "fsi = mfs" "di = IArray.of_fun (d_of dmu) (Suc m)" "dmui = IArray.of_fun (\i. IArray.of_fun (\j. dmu $$ (i, j)) i) m" by auto + note res = res[unfolded id if_True] + from res have mfs': "mfs' = map (map_vec (\x. x symmod P)) mfs" + and p': "p' = P" + and dmu': "dmu' = mat m m (\(i, j). if j < i then dmu $$ (i, j) symmod (P * vec (Suc m) (d_of dmu) $ j * vec (Suc m) (d_of dmu) $ Suc j) else dmu $$ (i, j))" + and gidx: "g_idx = gi" + by auto + let ?mods = "IArray.of_fun (\j. P * di !! j * di !! Suc j) (m - 1)" + let ?dmu = "IArray.of_fun (\i. IArray.of_fun (\j. dmui !! i !! j symmod ?mods !! j) i) m" + note res' = res'[unfolded id if_True state split impl(1) perform_adjust_mod_def Let_def] + from res' have p'': "p'' = P" and state': "state' = (map (map_vec (\x. x symmod P)) mfs, ?dmu, di, ?mods)" + and gidx': "g_idx' = gi" by auto + show ?thesis unfolding state' state_impl_inv.simps mfs' p'' p' gidx gidx' + proof (intro conjI refl) + show "di = IArray.of_fun (d_of dmu') (Suc m)" unfolding impl + by (intro iarray_cong refl, auto simp: dmu' d_of_def) + show "?dmu = IArray.of_fun (\i. IArray.of_fun (\j. dmu' $$ (i, j)) i) m" + proof (intro iarray_cong refl, goal_cases) + case (1 i j) + hence "j < m" "Suc j < Suc m" "j < Suc m" "j < m - 1" by auto + show ?case unfolding dmu' impl IArray.of_fun_nth[OF \i < m\] IArray.of_fun_nth[OF \j < i\] + IArray.of_fun_nth[OF \j < m\] IArray.of_fun_nth[OF \Suc j < Suc m\] + IArray.of_fun_nth[OF \j < Suc m\] IArray.of_fun_nth[OF \j < m - 1\] using 1 by auto + qed + qed + qed +qed + +lemma LLL_adjust_swap_add: assumes impl: "state_impl_inv p mfs dmu state" + and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and res: "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx k = (p', mfs', dmu', g_idx')" + and res': "LLL_adjust_swap_add p first state g_idx k = (p'',state', G_idx')" + and k: "k < m" and k0: "k \ 0" +shows "state_impl_inv p' mfs' dmu' state'" "p'' = p'" "G_idx' = g_idx'" + "i \ m \ i \ k \ di_of state' !! i = di_of state !! i" +proof (atomize(full), goal_cases) + case 1 + from k have m: "m \ 0" by auto + obtain mfsi dmui di mods where state: "state = (mfsi, dmui, di, mods)" + by (metis prod_cases3) + obtain state'' where add': "LLL_add_row p state k (k - 1) = state''" by blast + obtain mfs'' dmu'' where add: "basis_reduction_mod_add_row p mfs dmu k (k - 1) = (mfs'', dmu'')" by force + obtain mfs3 dmu3 where swap: "basis_reduction_mod_swap p mfs'' dmu'' k = (mfs3, dmu3)" by force + obtain state3 where swap': "LLL_swap_row p state'' k = state3" by blast + obtain mfsi2 dmui2 di2 mods2 where state2: "state'' = (mfsi2, dmui2, di2, mods2)" by (cases state'', auto) + obtain mfsi3 dmui3 di3 mods3 where state3: "state3 = (mfsi3, dmui3, di3, mods3)" by (cases state3, auto) + have "length mfsi = m" using impl[unfolded state state_impl_inv.simps] LLL_invD_modw[OF Linv] by auto + note res' = res'[unfolded state LLL_adjust_swap_add_def LLL_swap_add_eq[OF k0 k this], folded state, unfolded add' swap' Let_def] + note res = res[unfolded basis_reduction_adjust_swap_add_step_def Let_def add split swap] + from LLL_add_row[OF impl Linv add add' k] k0 + have impl': "state_impl_inv p mfs'' dmu'' state''" by auto + from basis_reduction_mod_add_row[OF Linv add k _ k0] k0 + obtain fs'' where Linv': "LLL_invariant_mod_weak fs'' mfs'' dmu'' p first b" by auto + from LLL_swap_row[OF impl' Linv' swap swap' k k0] + have impl3: "state_impl_inv p mfs3 dmu3 state3" . + have di2: "di2 = di" using add'[unfolded state LLL_add_row_def Let_def split perform_add_row_def state2] + by (auto split: if_splits) + have di3: "di3 = IArray.of_fun (\i. if i = k then (di2 !! Suc k * di2 !! (k - 1) + dmui2 !! k !! (k - 1) * dmui2 !! k !! (k - 1)) div di2 !! k else di2 !! i) (Suc m)" + using swap'[unfolded state2 state3] + unfolding LLL_swap_row_def Let_def by simp + have di3: "i \ m \ i \ k \ di3 !! i = di !! i" + unfolding di2[symmetric] di3 + by (subst IArray.of_fun_nth, auto) + show ?case + proof (cases "k - 1 = g_idx") + case True + hence id: "(k - 1 = g_idx) = True" by simp + note res = res[unfolded id if_True] + note res' = res'[unfolded id if_True] + obtain mfsi4 dmui4 di4 mods4 where state': "state' = (mfsi4, dmui4, di4, mods4)" by (cases state', auto) + from res'[unfolded state3 state' LLL_adjust_mod_def Let_def perform_adjust_mod_def] have di4: "di4 = di3" + by (auto split: if_splits prod.splits) + from LLL_adjust_mod[OF impl3 res res' m] di3 state state' di4 res' + show ?thesis by auto + next + case False + hence id: "(k - 1 = g_idx) = False" by simp + note res = res[unfolded id if_False] + note res' = res'[unfolded id if_False] + from impl3 res res' di3 state state3 show ?thesis by auto + qed +qed + + + +lemma LLL_step: assumes impl: "state_impl_inv p mfs dmu state" + and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and res: "basis_reduction_mod_step p first mfs dmu g_idx k j = (p', mfs', dmu', g_idx', k', j')" + and res': "LLL_step p first state g_idx k j = ((p'',state', g_idx''), k'', j'')" + and k: "k < m" +shows "state_impl_inv p' mfs' dmu' state' \ k'' = k' \ p'' = p' \ j'' = j' \ g_idx'' = g_idx'" +proof (cases "k = 0") + case True + thus ?thesis using res res' impl unfolding LLL_step_def basis_reduction_mod_step_def by auto +next + case k0: False + hence id: "(k = 0) = False" by simp + note res = res[unfolded basis_reduction_mod_step_def id if_False] + obtain num denom where alph: "quotient_of \ = (num,denom)" by force + obtain mfsi dmui di mods where state: "state = (mfsi, dmui, di, mods)" + by (metis prod_cases3) + note res' = res'[unfolded LLL_step_def id if_False Let_def state split alph, folded state] + from k0 have kk1: "k - 1 < k" by auto + note res = res[unfolded Let_def alph split] + obtain state'' where addi: "LLL_swap_add p state k = state''" by auto + from impl[unfolded state state_impl_inv.simps] + have di: "di = IArray.of_fun (d_of dmu) (Suc m)" by auto + have id: "di !! k = d_of dmu k" + "di !! (Suc k) = d_of dmu (Suc k)" + "di !! (k - 1) = d_of dmu (k - 1)" + unfolding di using k + by (subst IArray.of_fun_nth, force, force)+ + have "length mfsi = m" using impl[unfolded state state_impl_inv.simps] LLL_invD_modw[OF Linv] by auto + note res' = res'[unfolded id] + let ?cond = "d_of dmu k * d_of dmu k * denom \ num * d_of dmu (k - 1) * d_of dmu (Suc k)" + show ?thesis + proof (cases ?cond) + case True + from True res res' state show ?thesis using impl by auto + next + case False + hence cond: "?cond = False" by simp + note res = res[unfolded cond if_False] + note res' = res'[unfolded cond if_False] + let ?step = "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx k" + let ?step' = "LLL_adjust_swap_add p first state g_idx k" + from res have step: "?step = (p', mfs', dmu', g_idx')" by (cases ?step, auto) + note res = res[unfolded step split] + from res' have step': "?step' = (p'',state', g_idx'')" by auto + note res' = res'[unfolded step'] + from LLL_adjust_swap_add[OF impl Linv step step' k k0] + show ?thesis using res res' by auto + qed +qed + + +lemma LLL_main: assumes impl: "state_impl_inv p mfs dmu state" + and Linv: "LLL_invariant_mod fs mfs dmu p first b i" + and res: "basis_reduction_mod_main p first mfs dmu g_idx i k = (p', mfs', dmu')" + and res': "LLL_main p first state g_idx i k = (pi', state')" +shows "state_impl_inv p' mfs' dmu' state' \ pi' = p'" + using assms +proof (induct "LLL_measure i fs" arbitrary: mfs dmu state fs p b k i g_idx rule: less_induct) + case (less fs i mfs dmu state p b k g_idx) + note impl = less(2) + note Linv = less(3) + note res = less(4) + note res' = less(5) + note IH = less(1) + note res = res[unfolded basis_reduction_mod_main.simps[of _ _ _ _ _ _ k]] + note res' = res'[unfolded LLL_main.simps[of _ _ _ _ _ k]] + note Linvw = LLL_mod_inv_to_weak[OF Linv] + show ?case + proof (cases "i < m") + case False + thus ?thesis using res res' impl by auto + next + case i: True + hence id: "(i < m) = True" by simp + obtain P'' state'' I'' K'' G_idx'' where step': "LLL_step p first state g_idx i k = ((P'', state'', G_idx''), I'', K'')" + by (metis prod_cases3) + obtain p'' mfs'' dmu'' i'' k'' g_idx'' where step: "basis_reduction_mod_step p first mfs dmu g_idx i k = (p'', mfs'', dmu'', g_idx'', i'', k'')" + by (metis prod_cases3) + from LLL_step[OF impl Linvw step step' i] + have impl'': "state_impl_inv p'' mfs'' dmu'' state''" and ID: "I'' = i''" "K'' = k''" "P'' = p''" "G_idx'' = g_idx''" by auto + from basis_reduction_mod_step[OF Linv step i] obtain + fs'' b'' where + Linv'': "LLL_invariant_mod fs'' mfs'' dmu'' p'' first b'' i''" and + decr: "LLL_measure i'' fs'' < LLL_measure i fs" by auto + note res = res[unfolded id if_True step split] + note res' = res'[unfolded id if_True step' split ID] + show ?thesis + by (rule IH[OF decr impl'' Linv'' res res']) + qed +qed + +lemma LLL_iso_main_inner: assumes impl: "state_impl_inv p mfs dmu state" + and di_prods: "state_iso_inv di_prods (di_of state)" + and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and res: "basis_reduction_iso_main p first mfs dmu g_idx k = (p', mfs', dmu')" + and res': "LLL_iso_main_inner p first state di_prods g_idx k = (pi', state')" + and m: "m > 1" +shows "state_impl_inv p' mfs' dmu' state' \ pi' = p'" + using assms(1-5) +proof (induct "LLL_measure (m - 1) fs" arbitrary: mfs dmu state fs p b k di_prods g_idx rule: less_induct) + case (less fs mfs dmu state p b k di_prods g_idx) + note impl = less(2) + note di_prods = less(3) + note Linv = less(4) + note res = less(5) + note res' = less(6) + note IH = less(1) + obtain mfsi dmui di mods where state: "state = (mfsi, dmui, di, mods)" + by (metis prod_cases4) + from di_prods state have di_prods: "state_iso_inv di_prods di" by auto + obtain num denom idx where quot': "LLL_max_gso_quot di_prods = (num, denom, idx)" + by (metis prod_cases3) + note inv = LLL_invD_modw[OF Linv] + obtain na da where alph: "quotient_of \ = (na,da)" by force + from impl[unfolded state] have di: "di = IArray.of_fun (d_of dmu) (Suc m)" by auto + from LLL_max_gso_quot[OF di di_prods] have quot: "compute_max_gso_quot dmu = LLL_max_gso_quot di_prods" .. + obtain cmp where cmp: "(na * denom < num * da) = cmp" by force + have "(m > 1) = True" using m by auto + note res = res[unfolded basis_reduction_iso_main.simps[of _ _ _ _ _ k] this if_True Let_def quot quot' split alph cmp] + note res' = res'[unfolded LLL_iso_main_inner.simps[of _ _ _ _ _ k] state split Let_def quot' alph cmp, folded state] + note cmp = compute_max_gso_quot_alpha[OF Linv quot[unfolded quot'] alph cmp m] + show ?case + proof (cases cmp) + case False + thus ?thesis using res res' impl by auto + next + case True + hence id: "cmp = True" by simp + note cmp = cmp(1)[OF True] + obtain state'' P'' G_idx'' where step': "LLL_adjust_swap_add p first state g_idx idx = (P'',state'', G_idx'')" + by (metis prod.exhaust) + obtain mfs'' dmu'' p'' g_idx'' where step: "basis_reduction_adjust_swap_add_step p first mfs dmu g_idx idx = (p'', mfs'', dmu'', g_idx'')" + by (metis prod_cases3) + obtain mfsi2 dmui2 di2 mods2 where state2: "state'' = (mfsi2, dmui2, di2, mods2)" by (cases state'', auto) + note res = res[unfolded id if_True step split] + note res' = res'[unfolded id if_True step' state2 split, folded state2] + from cmp have idx0: "idx \ 0" and idx: "idx < m" and ineq: "\ d_of dmu idx * d_of dmu idx * da \ na * d_of dmu (idx - 1) * d_of dmu (Suc idx)" + by auto + from basis_reduction_adjust_swap_add_step[OF Linv step alph ineq idx idx0] + obtain fs'' b'' where Linv'': "LLL_invariant_mod_weak fs'' mfs'' dmu'' p'' first b''" and + meas: "LLL_measure (m - 1) fs'' < LLL_measure (m - 1) fs" by auto + from LLL_adjust_swap_add[OF impl Linv step step' idx idx0] + have impl'': "state_impl_inv p'' mfs'' dmu'' state''" and P'': "P'' = p''" "G_idx'' = g_idx''" + and di_prod_upd: "\ i. i \ m \ i \ idx \ di2 !! i = di !! i" + using state state2 by auto + have di_prods: "state_iso_inv (IArray.of_fun + (\i. if idx < i \ i + 2 < idx then di_prods !! i + else case di_prods !! i of (l, r) \ if i + 1 = idx then (di2 !! idx * di2 !! idx, r) else (l, di2 !! (i + 2) * di2 !! i)) + (m - 1)) di2" unfolding state_iso_inv_def + by (intro iarray_cong', insert di_prod_upd, unfold di_prods[unfolded state_iso_inv_def], + subst (1 2) IArray.of_fun_nth, auto) + show ?thesis + by (rule IH[OF meas impl'' _ Linv'' res res'[unfolded step' P'']], insert di_prods state2, auto) + qed +qed + +lemma LLL_iso_main: assumes impl: "state_impl_inv p mfs dmu state" + and Linv: "LLL_invariant_mod_weak fs mfs dmu p first b" + and res: "basis_reduction_iso_main p first mfs dmu g_idx k = (p', mfs', dmu')" + and res': "LLL_iso_main p first state g_idx k = (pi', state')" +shows "state_impl_inv p' mfs' dmu' state' \ pi' = p'" +proof (cases "m > 1") + case True + from LLL_iso_main_inner[OF impl _ Linv res _ True, unfolded state_iso_inv_def, OF refl, of pi' state'] res' True + show ?thesis unfolding LLL_iso_main_def by (cases state, auto) +next + case False + thus ?thesis using res res' impl unfolding LLL_iso_main_def + basis_reduction_iso_main.simps[of _ _ _ _ _ k] by auto +qed + +lemma LLL_initial: assumes res: "compute_initial_state first = (p, mfs, dmu, g_idx)" + and res': "LLL_initial first = (p', state, g_idx')" + and m: "m \ 0" +shows "state_impl_inv p mfs dmu state \ p' = p \ g_idx' = g_idx" +proof - + obtain b gi where norm: "compute_max_gso_norm first dmu_initial = (b,gi)" by force + obtain P where P: "compute_mod_of_max_gso_norm first b = P" by auto + define di where "di = IArray.of_fun (\i. if i = 0 then 1 else d\_impl fs_init !! (i - 1) !! (i - 1)) (Suc m)" + note res = res[unfolded compute_initial_state_def Let_def P norm split] + have di: "di = IArray.of_fun (d_of dmu_initial) (Suc m)" + unfolding di_def dmu_initial_def Let_def d_of_def + by (intro iarray_cong refl if_cong, auto) + note norm' = LLL_max_gso_norm_di[OF di m, of first, unfolded norm] + note res' = res'[unfolded LLL_initial_def Let_def, folded di_def, unfolded norm' P split mod_of_gso_norm[OF m]] + from res have p: "p = P" and mfs: "mfs = compute_initial_mfs p" and dmu: "dmu = compute_initial_dmu P dmu_initial" + and g_idx: "g_idx = gi" + by auto + let ?mods = "IArray.of_fun (\j. P * di !! j * di !! Suc j) (m - 1)" + have di': "di = IArray.of_fun (d_of (compute_initial_dmu P dmu_initial)) (Suc m)" + unfolding di + by (intro iarray_cong refl, auto simp: compute_initial_dmu_def d_of_def) + from res' have p': "p' = P" and g_idx': "g_idx' = gi" and state: + "state = (compute_initial_mfs P, IArray.of_fun (\i. IArray.of_fun (\j. d\_impl fs_init !! i !! j symmod ?mods !! j) i) m, di, ?mods)" + by auto + show ?thesis unfolding mfs p state p' dmu state_impl_inv.simps g_idx' g_idx + proof (intro conjI refl di' iarray_cong, goal_cases) + case (1 i j) + hence "j < m" "Suc j < Suc m" "j < Suc m" "j < m - 1" by auto + thus ?case unfolding compute_initial_dmu_def di + IArray.of_fun_nth[OF \j < m\] + IArray.of_fun_nth[OF \Suc j < Suc m\] + IArray.of_fun_nth[OF \j < Suc m\] + IArray.of_fun_nth[OF \j < m - 1\] + unfolding dmu_initial_def Let_def using 1 by auto + qed +qed + +lemma LLL_add_rows_loop: assumes impl: "state_impl_inv p mfs dmu state" + and Linv: "LLL_invariant_mod fs mfs dmu p b first i" + and res: "basis_reduction_mod_add_rows_loop p mfs dmu i j = (mfs', dmu')" + and res': "LLL_add_rows_loop p state i j = state'" + and j: "j \ i" + and i: "i < m" +shows "state_impl_inv p mfs' dmu' state'" + using assms(1-5) +proof (induct j arbitrary: fs mfs dmu state) + case (Suc j) + note impl = Suc(2) + note Linv = Suc(3) + note res = Suc(4) + note res' = Suc(5) + note IH = Suc(1) + from Suc have j: "j < i" and ji: "j \ i" by auto + obtain mfs1 dmu1 where add: "basis_reduction_mod_add_row p mfs dmu i j = (mfs1, dmu1)" by force + note res = res[unfolded basis_reduction_mod_add_rows_loop.simps Let_def add split] + obtain state1 where add': "LLL_add_row p state i j = state1" by auto + note res' = res'[unfolded LLL_add_rows_loop.simps Let_def add'] + note Linvw = LLL_mod_inv_to_weak[OF Linv] + from LLL_add_row[OF impl Linvw add add' i j] + have impl1: "state_impl_inv p mfs1 dmu1 state1" . + from basis_reduction_mod_add_row[OF Linvw add i j] Linv j + obtain fs1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p b first i" by auto + show ?case using IH[OF impl1 Linv1 res res' ji] . +qed auto + +lemma LLL_add_rows_outer_loop: assumes impl: "state_impl_inv p mfs dmu state" + and Linv: "LLL_invariant_mod fs mfs dmu p first b m" + and res: "basis_reduction_mod_add_rows_outer_loop p mfs dmu i = (mfs', dmu')" + and res': "LLL_add_rows_outer_loop p state i = state'" + and i: "i \ m - 1" +shows "state_impl_inv p mfs' dmu' state'" + using assms +proof (induct i arbitrary: fs mfs dmu state mfs' dmu' state') + case (Suc i) + note impl = Suc(2) + note Linv = Suc(3) + note res = Suc(4) + note res' = Suc(5) + note i = Suc(6) + note IH = Suc(1) + from i have im: "i < m" "i \ m - 1" "Suc i < m" by auto + obtain mfs1 dmu1 where add: "basis_reduction_mod_add_rows_outer_loop p mfs dmu i = (mfs1, dmu1)" by force + note res = res[unfolded basis_reduction_mod_add_rows_outer_loop.simps Let_def add split] + obtain state1 where add': "LLL_add_rows_outer_loop p state i = state1" by auto + note res' = res'[unfolded LLL_add_rows_outer_loop.simps Let_def add'] + from IH[OF impl Linv add add' im(2)] + have impl1: "state_impl_inv p mfs1 dmu1 state1" . + from basis_reduction_mod_add_rows_outer_loop_inv[OF Linv add[symmetric] im(1)] + obtain fs1 where Linv1: "LLL_invariant_mod fs1 mfs1 dmu1 p first b m" by auto + from basis_reduction_mod_add_rows_loop_inv'[OF Linv1 res im(3)] obtain fs' where + Linv': "LLL_invariant_mod fs' mfs' dmu' p first b m" by auto + from LLL_add_rows_loop[OF impl1 LLL_invariant_mod_to_weak_m_to_i(1)[OF Linv1] res res' le_refl im(3)] i + show ?case by auto +qed auto + +subsection \Soundness of implementation\ + +text \We just prove that the concrete implementations have the same input-output-behaviour as + the abstract versions of Storjohann's algorithms.\ + +lemma LLL_reduce_basis: "LLL_reduce_basis = reduce_basis_mod" +proof (cases "m = 0") + case True + from LLL_invD[OF reduce_basis_mod_inv[OF refl]] True + have "reduce_basis_mod = []" by auto + thus ?thesis using True unfolding LLL_reduce_basis_def by auto +next + case False + hence idm: "(m = 0) = False" by auto + let ?first = False + obtain p1 mfs1 dmu1 g_idx1 where init: "compute_initial_state ?first = (p1, mfs1, dmu1,g_idx1)" + by (metis prod_cases3) + obtain p1' state1 g_idx1' where init': "LLL_initial ?first = (p1', state1, g_idx1')" + by (metis prod.exhaust) + from LLL_initial[OF init init' False] + have impl1: "state_impl_inv p1 mfs1 dmu1 state1" and id: "p1' = p1" "g_idx1' = g_idx1" by auto + from LLL_initial_invariant_mod[OF init] obtain fs1 b1 where + inv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 0" by auto + obtain p2 mfs2 dmu2 where main: "basis_reduction_mod_main p1 ?first mfs1 dmu1 g_idx1 0 0 = (p2, mfs2, dmu2)" + by (metis prod_cases3) + from basis_reduction_mod_main[OF inv1 main] obtain fs2 b2 where + inv2: " LLL_invariant_mod fs2 mfs2 dmu2 p2 ?first b2 m" by auto + obtain p2' state2 where main': "LLL_main p1 ?first state1 g_idx1 0 0 = (p2', state2)" + by (metis prod.exhaust) + from LLL_main[OF impl1 inv1 main, unfolded id, OF main'] + have impl2: "state_impl_inv p2 mfs2 dmu2 state2" and p2: "p2' = p2" by auto + obtain mfs3 dmu3 where outer: "basis_reduction_mod_add_rows_outer_loop p2 mfs2 dmu2 (m - 1) = (mfs3, dmu3)" by force + obtain mfsi3 dmui3 di3 mods3 where outer': "LLL_add_rows_outer_loop p2 state2 (m - 1) = (mfsi3, dmui3, di3, mods3)" + by (metis prod_cases4) + from LLL_add_rows_outer_loop[OF impl2 inv2 outer outer' le_refl] + have "state_impl_inv p2 mfs3 dmu3 (mfsi3, dmui3, di3, mods3)" . + hence identity: "mfs3 = mfsi3" unfolding state_impl_inv.simps by auto + note res = reduce_basis_mod_def[unfolded init main split Let_def outer] + note res' = LLL_reduce_basis_def[unfolded init' Let_def main' id split p2 outer' idm if_False] + show ?thesis unfolding res res' identity .. +qed + +lemma LLL_reduce_basis_iso: "LLL_reduce_basis_iso = reduce_basis_iso" +proof (cases "m = 0") + case True + from LLL_invD[OF reduce_basis_iso_inv[OF refl]] True + have "reduce_basis_iso = []" by auto + thus ?thesis using True unfolding LLL_reduce_basis_iso_def by auto +next + case False + hence idm: "(m = 0) = False" by auto + let ?first = False + obtain p1 mfs1 dmu1 g_idx1 where init: "compute_initial_state ?first = (p1, mfs1, dmu1, g_idx1)" + by (metis prod_cases3) + obtain p1' state1 g_idx1' where init': "LLL_initial ?first = (p1', state1, g_idx1')" + by (metis prod.exhaust) + from LLL_initial[OF init init' False] + have impl1: "state_impl_inv p1 mfs1 dmu1 state1" and id: "p1' = p1" "g_idx1' = g_idx1" by auto + from LLL_initial_invariant_mod[OF init] obtain fs1 b1 where + inv1: "LLL_invariant_mod_weak fs1 mfs1 dmu1 p1 ?first b1" + by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_mod_def) + obtain p2 mfs2 dmu2 where main: "basis_reduction_iso_main p1 ?first mfs1 dmu1 g_idx1 0 = (p2, mfs2, dmu2)" + by (metis prod_cases3) + from basis_reduction_iso_main[OF inv1 main] obtain fs2 b2 where + inv2: " LLL_invariant_mod fs2 mfs2 dmu2 p2 ?first b2 m" by auto + obtain p2' state2 where main': "LLL_iso_main p1 ?first state1 g_idx1 0 = (p2', state2)" + by (metis prod.exhaust) + from LLL_iso_main[OF impl1 inv1 main, unfolded id, OF main'] + have impl2: "state_impl_inv p2 mfs2 dmu2 state2" and p2: "p2' = p2" by auto + obtain mfs3 dmu3 where outer: "basis_reduction_mod_add_rows_outer_loop p2 mfs2 dmu2 (m - 1) = (mfs3, dmu3)" by force + obtain mfsi3 dmui3 di3 mods3 where outer': "LLL_add_rows_outer_loop p2 state2 (m - 1) = (mfsi3, dmui3, di3, mods3)" + by (metis prod_cases4) + from LLL_add_rows_outer_loop[OF impl2 inv2 outer outer' le_refl] + have "state_impl_inv p2 mfs3 dmu3 (mfsi3, dmui3, di3, mods3)" . + hence identity: "mfs3 = mfsi3" unfolding state_impl_inv.simps by auto + note res = reduce_basis_iso_def[unfolded init main split Let_def outer] + note res' = LLL_reduce_basis_iso_def[unfolded init' Let_def main' id split p2 outer' idm if_False] + show ?thesis unfolding res res' identity .. +qed + +lemma LLL_short_vector: assumes m: "m \ 0" + shows "LLL_short_vector = short_vector_mod" +proof - + let ?first = True + obtain p1 mfs1 dmu1 g_idx1 where init: "compute_initial_state ?first = (p1, mfs1, dmu1,g_idx1)" + by (metis prod_cases3) + obtain p1' state1 g_idx1' where init': "LLL_initial ?first = (p1', state1, g_idx1')" + by (metis prod.exhaust) + from LLL_initial[OF init init' m] + have impl1: "state_impl_inv p1 mfs1 dmu1 state1" and id: "p1' = p1" "g_idx1' = g_idx1" by auto + from LLL_initial_invariant_mod[OF init] obtain fs1 b1 where + inv1: "LLL_invariant_mod fs1 mfs1 dmu1 p1 ?first b1 0" by auto + obtain p2 mfs2 dmu2 where main: "basis_reduction_mod_main p1 ?first mfs1 dmu1 g_idx1 0 0 = (p2, mfs2, dmu2)" + by (metis prod_cases3) + from basis_reduction_mod_main[OF inv1 main] obtain fs2 b2 where + inv2: " LLL_invariant_mod fs2 mfs2 dmu2 p2 ?first b2 m" by auto + obtain p2' mfsi2 dmui2 di2 mods2 where main': "LLL_main p1 ?first state1 g_idx1 0 0 = (p2', (mfsi2, dmui2, di2, mods2))" + by (metis prod.exhaust) + from LLL_main[OF impl1 inv1 main, unfolded id, OF main'] + have impl2: "state_impl_inv p2 mfs2 dmu2 (mfsi2, dmui2, di2, mods2)" and p2: "p2' = p2" by auto + hence identity: "mfs2 = mfsi2" unfolding state_impl_inv.simps by auto + note res = short_vector_mod_def[unfolded init main split Let_def] + note res' = LLL_short_vector_def[unfolded init' Let_def main' id split p2] + show ?thesis unfolding res res' identity .. +qed + +lemma LLL_short_vector_iso: assumes m: "m \ 0" + shows "LLL_short_vector_iso = short_vector_iso" +proof - + let ?first = True + obtain p1 mfs1 dmu1 g_idx1 where init: "compute_initial_state ?first = (p1, mfs1, dmu1,g_idx1)" + by (metis prod_cases3) + obtain p1' state1 g_idx1' where init': "LLL_initial ?first = (p1', state1, g_idx1')" + by (metis prod.exhaust) + from LLL_initial[OF init init' m] + have impl1: "state_impl_inv p1 mfs1 dmu1 state1" and id: "p1' = p1" "g_idx1' = g_idx1" by auto + from LLL_initial_invariant_mod[OF init] obtain fs1 b1 where + inv1: "LLL_invariant_mod_weak fs1 mfs1 dmu1 p1 ?first b1" + by (auto simp: LLL_invariant_mod_weak_def LLL_invariant_mod_def) + obtain p2 mfs2 dmu2 where main: "basis_reduction_iso_main p1 ?first mfs1 dmu1 g_idx1 0 = (p2, mfs2, dmu2)" + by (metis prod_cases3) + from basis_reduction_iso_main[OF inv1 main] obtain fs2 b2 where + inv2: " LLL_invariant_mod fs2 mfs2 dmu2 p2 ?first b2 m" by auto + obtain p2' mfsi2 dmui2 di2 mods2 where main': "LLL_iso_main p1 ?first state1 g_idx1 0 = (p2', (mfsi2, dmui2, di2, mods2))" + by (metis prod.exhaust) + from LLL_iso_main[OF impl1 inv1 main, unfolded id, OF main'] + have impl2: "state_impl_inv p2 mfs2 dmu2 (mfsi2, dmui2, di2, mods2)" and p2: "p2' = p2" by auto + hence identity: "mfs2 = mfsi2" unfolding state_impl_inv.simps by auto + note res = short_vector_iso_def[unfolded init main split Let_def] + note res' = LLL_short_vector_iso_def[unfolded init' Let_def main' id split p2] + show ?thesis unfolding res res' identity .. +qed + +end + +end \ No newline at end of file diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Mod_Operation.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Mod_Operation.thy new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Storjohann_Mod_Operation.thy @@ -0,0 +1,906 @@ +section \Storjohann's Lemma 13\ + +text \This theory contains the result that one can always perform a mod-operation on + the entries of the $d\mu$-matrix.\ + +theory Storjohann_Mod_Operation + imports + LLL_Basis_Reduction.LLL_Certification + Signed_Modulo +begin + +lemma map_vec_map_vec: "map_vec f (map_vec g v) = map_vec (f o g) v" + by (intro eq_vecI, auto) + +context semiring_hom +begin + +(* TODO: move *) +lemma mat_hom_add: assumes A: "A \ carrier_mat nr nc" and B: "B \ carrier_mat nr nc" + shows "mat\<^sub>h (A + B) = mat\<^sub>h A + mat\<^sub>h B" + by (intro eq_matI, insert A B, auto simp: hom_add) +end + +text \We now start to prove lemma 13 of Storjohann's paper.\ +context + fixes A I :: "'a :: field mat" and n :: nat + assumes A: "A \ carrier_mat n n" + and det: "det A \ 0" + and I: "I = the (mat_inverse A)" +begin +lemma inverse_via_det: "I * A = 1\<^sub>m n" "A * I = 1\<^sub>m n" "I \ carrier_mat n n" + "I = mat n n (\ (i,j). det (replace_col A (unit_vec n j) i) / det A)" +proof - + from det_non_zero_imp_unit[OF A det] + have Unit: "A \ Units (ring_mat TYPE('a) n n)" . + from mat_inverse(1)[OF A, of n] Unit I have "mat_inverse A = Some I" + by (cases "mat_inverse A", auto) + from mat_inverse(2)[OF A this] + show left: "I * A = 1\<^sub>m n" and right: "A * I = 1\<^sub>m n" and I: "I \ carrier_mat n n" + by blast+ + { + fix i j + assume i: "i < n" and j: "j < n" + from I i j have cI: "col I j $ i = I $$ (i,j)" by simp + from j have uv: "unit_vec n j \ carrier_vec n" by auto + from j I have col: "col I j \ carrier_vec n" by auto + from col_mult2[OF A I j, unfolded right] j + have "A *\<^sub>v col I j = unit_vec n j" by simp + from cramer_lemma_mat[OF A col i, unfolded this cI] + have "I $$ (i,j) = det (replace_col A (unit_vec n j) i) / det A" using det by simp + } + thus "I = mat n n (\ (i,j). det (replace_col A (unit_vec n j) i) / det A)" + by (intro eq_matI, use I in auto) +qed + +lemma matrix_for_singleton_entry: assumes i: "i < n" and + j: "j < n" + and Rdef: "R = mat n n ( \ ij. if ij = (i,j) then c :: 'a else 0)" +shows "mat n n + (\(i', j'). if i' = i then c * det (replace_col A (unit_vec n j') j) / det A + else 0) * A = R" +proof - + note I = inverse_via_det(3) + have R: "R \ carrier_mat n n" unfolding Rdef by auto + have "(R * I) * A = R * (I * A)" using I A R by auto + also have "I * A = 1\<^sub>m n" unfolding inverse_via_det(1) .. + also have "R * \ = R" using R by simp + also have "R * I = mat n n (\ (i',j'). row R i' \ col I j')" + using I R unfolding times_mat_def by simp + also have "\ = mat n n ( \ (i',j'). if i' = i then c * I $$ (j, j') else 0)" + (is "mat n n ?f = mat n n ?g") + proof - + { + fix i' j' + assume i': "i' < n" and j': "j' < n" + have "?f (i',j') = ?g (i',j')" + proof (cases "i' = i") + case False + hence "row R i' = 0\<^sub>v n" unfolding Rdef using i' + by (intro eq_vecI, auto simp: Matrix.row_def) + thus ?thesis using False i' j' I by simp + next + case True + hence "row R i' = c \\<^sub>v unit_vec n j" unfolding Rdef using i' j' i j + by (intro eq_vecI, auto simp: Matrix.row_def) + with True show ?thesis using i' j' I j by simp + qed + } + thus ?thesis by auto + qed + finally show ?thesis unfolding inverse_via_det(4) using j + by (auto intro!: arg_cong[of _ _ "\ x. x * A"]) +qed +end + +lemma (in gram_schmidt_fs_Rn) det_M_1: "det (M m) = 1" +proof - + have "det (M m) = prod_list (diag_mat (M m))" + by (rule det_lower_triangular[of m], auto simp: \.simps) + also have "\ = 1" + by (rule prod_list_neutral, auto simp: diag_mat_def \.simps) + finally show ?thesis . +qed + +context gram_schmidt_fs_int +begin +lemma assumes IM: "IM = the (mat_inverse (M m))" + shows inv_mu_lower_triangular: "\ k i. k < i \ i < m \ IM $$ (k, i) = 0" + and inv_mu_diag: "\ k. k < m \ IM $$ (k, k) = 1" + and d_inv_mu_integer: "\ i j. i < m \ j < m \ d i * IM $$ (i,j) \ \" + and inv_mu_inverse: "IM * M m = 1\<^sub>m m" "M m * IM = 1\<^sub>m m" "IM \ carrier_mat m m" +proof - + note * = inverse_via_det[OF M_dim(3) _ IM, unfolded det_M_1] + from * show inv: "IM * M m = 1\<^sub>m m" "M m * IM = 1\<^sub>m m" + and IM: "IM \ carrier_mat m m" by auto + from * have IM_det: "IM = mat m m (\(i, j). det (replace_col (M m) ((unit_vec m) j) i))" + by auto + from matrix_equality have "IM * FF = IM * ((M m) * Fs)" by simp + also have "\ = (IM * M m) * Fs" using M_dim(3) IM Fs_dim(3) + by (metis assoc_mult_mat) + also have "\ = Fs" unfolding inv using Fs_dim(3) by simp + finally have equality: "IM * FF = Fs" . + { + fix i k + assume i: "k < i" "i < m" + show "IM $$ (k, i) = 0" using i M_dim unfolding IM_det + by (simp, subst det_lower_triangular[of m], auto simp: replace_col_def \.simps diag_mat_def) + } note IM_lower_triag = this + { + fix k + assume k: "k < m" + show "IM $$ (k,k) = 1" using k M_dim unfolding IM_det + by (simp, subst det_lower_triangular[of m], auto simp: replace_col_def \.simps diag_mat_def + intro!: prod_list_neutral) + } note IM_diag_1 = this + { + fix k + assume k: "k < m" + let ?f = "\ i. IM $$ (k, i) \\<^sub>v fs ! i" + let ?sum = "M.sumlist (map ?f [0.. carrier_vec n" using fs_carrier by auto + hence sum: "?sum \ carrier_vec n" by simp + from set k have setk: "set (map ?f [0.. carrier_vec n" by auto + hence sumk: "?sumk \ carrier_vec n" by simp + from sum have dim_sum: "dim_vec ?sum = n" by simp + have "gso k = row Fs k" using k by auto + also have "\ = row (IM * FF) k" unfolding equality .. + also have "IM * FF = mat m n (\ (i,j). row IM i \ col FF j)" + unfolding times_mat_def using IM FF_dim by auto + also have "row \ k = vec n (\ j. row IM k \ col FF j)" + unfolding Matrix.row_def using IM FF_dim k by auto + also have "\ = vec n (\ j. \ i < m. IM $$ (k, i) * fs ! i $ j)" + by (intro eq_vecI, insert IM k, auto simp: scalar_prod_def Matrix.row_def intro!: sum.cong) + also have "\ = ?sum" + by (intro eq_vecI, insert IM, unfold dim_sum, subst sumlist_vec_index, + auto simp: o_def sum_list_sum_nth intro!: sum.cong) + also have "[0..) = ?sumk + + (?f k + M.sumlist (map ?f [Suc k ..< m]))" + unfolding map_append + by (subst M.sumlist_append; (subst M.sumlist_append)?, insert k fs_carrier, auto) + also have "M.sumlist (map ?f [Suc k ..< m]) = 0\<^sub>v n" + by (rule sumlist_neutral, insert IM_lower_triag, auto) + also have "IM $$ (k,k) = 1" using IM_diag_1[OF k] . + finally have gso: "gso k = ?sumk + fs ! k" using k by simp + define b where "b = vec k (\ j. fs ! j \ fs ! k)" + { + fix j + assume jk: "j < k" + with k have j: "j < m" by auto + have "fs ! j \ gso k = fs ! j \ (?sumk + fs ! k)" + unfolding gso by simp + also have "fs ! j \ gso k = 0" using jk k + by (simp add: fi_scalar_prod_gso gram_schmidt_fs.\.simps) + also have "fs ! j \ (?sumk + fs ! k) + = fs ! j \ ?sumk + fs ! j \ fs ! k" + by (rule scalar_prod_add_distrib[OF _ sumk], insert j k, auto) + also have "fs ! j \ fs ! k = b $ j" unfolding b_def using jk by simp + finally have "b $ j = - (fs ! j \ ?sumk)" by linarith + } note b_index = this + let ?x = "vec k (\ i. - IM $$ (k, i))" + have x: "?x \ carrier_vec k" by auto + from k have km: "k \ m" by simp + have bGx: "b = Gramian_matrix fs k *\<^sub>v (vec k (\ i. - IM $$ (k, i)))" + unfolding Gramian_matrix_alt_alt_def[OF km] + proof (rule eq_vecI; simp) + fix i + assume i: "i < k" + have "b $ i = - (\x\[0.. (IM $$ (k, x) \\<^sub>v fs ! x))" + unfolding b_index[OF i] + by (subst scalar_prod_right_sum_distrib, insert setk i k, auto simp: o_def) + also have "\ = vec k (\j. fs ! i \ fs ! j) \ vec k (\i. - IM $$ (k, i))" + by (subst (3) scalar_prod_def, insert i k, auto simp: o_def sum_list_sum_nth simp flip: sum_negf + intro!: sum.cong) + finally show "b $ i = vec k (\j. fs ! i \ fs ! j) \ vec k (\i. - IM $$ (k, i))" . + qed (simp add: b_def) + have G: "Gramian_matrix fs k \ carrier_mat k k" + unfolding Gramian_matrix_alt_alt_def[OF km] by simp + from cramer_lemma_mat[OF G x, folded bGx Gramian_determinant_def] + have "i < k \ + d k * IM $$ (k, i) = - det (replace_col (Gramian_matrix fs k) (vec k (\ j. fs ! j \ fs ! k)) i)" + for i unfolding b_def by simp + } note IM_lower_values = this + { + fix i j + assume i: "i < m" and j: "j < m" + from i have im: "i \ m" by auto + consider (1) "j < i" | (2) "j = i" | (3) "i < j" by linarith + thus "d i * IM $$ (i,j) \ \" + proof cases + case 1 + show ?thesis unfolding IM_lower_values[OF i 1] replace_col_def Gramian_matrix_alt_alt_def[OF im] + by (intro Ints_minus Ints_det, insert i j, auto intro!: Ints_scalar_prod[of _ n] fs_int) + next + case 3 + show ?thesis unfolding IM_lower_triag[OF 3 j] by simp + next + case 2 + show ?thesis unfolding IM_diag_1[OF i] 2 using i unfolding Gramian_determinant_def + Gramian_matrix_alt_alt_def[OF im] + by (intro Ints_mult Ints_det, insert i j, auto intro!: Ints_scalar_prod[of _ n] fs_int) + qed + } +qed + +definition inv_mu_ij_mat :: "nat \ nat \ int \ int mat" where + "inv_mu_ij_mat i j c = (let + B = mat m m (\ ij. if ij = (i,j) then c else 0); + C = mat m m (\ (i,j). the_inv (of_int :: _ \ 'a) (d i * the (mat_inverse (M m)) $$ (i,j))) + in B * C + 1\<^sub>m m)" + +lemma inv_mu_ij_mat: assumes i: "i < m" and ji: "j < i" + shows +(* Effect on \ *) + "map_mat of_int (inv_mu_ij_mat i j c) * M m = + mat m m (\ij. if ij = (i, j) then of_int c * d j else 0) + M m" (* only change value of \_ij *) +(* Effect on A *) + "A \ carrier_mat m n \ c mod p = 0 \ map_mat (\ x. x mod p) (inv_mu_ij_mat i j c * A) = + (map_mat (\ x. x mod p) A)" (* no change (mod p) *) +(* The transformation-matrix is ... *) + "inv_mu_ij_mat i j c \ carrier_mat m m" (* ... of dimension m*m *) + "i' < j' \ j' < m \ inv_mu_ij_mat i j c $$ (i',j') = 0" (* ... lower triangular *) + "k < m \ inv_mu_ij_mat i j c $$ (k,k) = 1" (* ... with diagonal all 1 *) +proof - + obtain IM where IM: "IM = the (mat_inverse (M m))" by auto + let ?oi = "of_int :: _ \ 'a" + let ?C = "mat m m (\ ij. if ij = (i,j) then ?oi c else 0)" + let ?D = "mat m m (\ (i,j). d i * IM $$ (i,j))" + have oi: "inj ?oi" unfolding inj_on_def by auto + have C: "?C \ carrier_mat m m" by auto + from i ji have j: "j < m" by auto + from j have jm: "{0.. {j} \ {Suc j..m m" (is "?MM = _") + unfolding inv_mu_ij_mat_def Let_def IM[symmetric] + apply (subst of_int_hom.mat_hom_add, force, force) + apply (rule arg_cong2[of _ _ _ _ "(+)"]) + apply (subst of_int_hom.mat_hom_mult, force, force) + apply (rule arg_cong2[of _ _ _ _ "(*)"]) + apply force + apply (rule eq_matI, (auto)[3], goal_cases) + proof - + case (1 i j) + from IM_props(1)[OF 1] + show ?case unfolding Ints_def using the_inv_f_f[OF oi] by auto + qed auto + have "map_mat ?oi (inv_mu_ij_mat i j c) * M m = (?C * ?D) * M m + M m" unfolding mat_oi + by (subst add_mult_distrib_mat[of _ m m], auto) + also have "(?C * ?D) * M m = ?C * (?D * M m)" + by (rule assoc_mult_mat, auto) + also have "?D = mat m m (\ (i,j). if i = j then d j else 0) * IM" (is "_ = ?E * _") + proof (rule eq_matI, insert IM_props(4), auto simp: scalar_prod_def, goal_cases) + case (1 i j) + hence id: "{0.. {i} \ {Suc i .. * M m = ?E * (IM * M m)" + by (rule assoc_mult_mat[of _ m m], insert IM_props, auto) + also have "IM * M m = 1\<^sub>m m" by fact + also have "?E * 1\<^sub>m m = ?E" by simp + also have "?C * ?E = mat m m (\ ij. if ij = (i,j) then ?oi c * d j else 0)" + by (rule eq_matI, auto simp: scalar_prod_def, auto simp: jm sum.union_disjoint) + finally show "map_mat ?oi (inv_mu_ij_mat i j c) * M m = + mat m m (\ ij. if ij = (i,j) then ?oi c * d j else 0) + M m" . + show carr: "inv_mu_ij_mat i j c \ carrier_mat m m" + unfolding inv_mu_ij_mat_def by auto + { + assume k: "k < m" + have "of_int (inv_mu_ij_mat i j c $$ (k,k)) = ?MM $$ (k,k)" + using carr k by auto + also have "\ = (?C * ?D) $$ (k,k) + 1" unfolding mat_oi using k by simp + also have "(?C * ?D) $$ (k,k) = 0" using k + by (auto simp: scalar_prod_def, auto simp: jm sum.union_disjoint + inv_mu_lower_triangular[OF IM ji i]) + finally show "inv_mu_ij_mat i j c $$ (k,k) = 1" by simp + } + { + assume ij': "i' < j'" "j' < m" + have "of_int (inv_mu_ij_mat i j c $$ (i',j')) = ?MM $$ (i',j')" + using carr ij' by auto + also have "\ = (?C * ?D) $$ (i',j')" unfolding mat_oi using ij' by simp + also have "(?C * ?D) $$ (i',j') = (if i' = i then ?oi c * (d j * IM $$ (j, j')) else 0)" + using ij' i j by (auto simp: scalar_prod_def, auto simp: jm sum.union_disjoint) + also have "\ = 0" using inv_mu_lower_triangular[OF IM _ ij'(2), of j] ij' i ji by auto + finally show "inv_mu_ij_mat i j c $$ (i',j') = 0" by simp + } + { + assume A: "A \ carrier_mat m n" and c: "c mod p = 0" + let ?mod = "map_mat (\ x. x mod p)" + let ?C = "mat m m (\ ij. if ij = (i,j) then c else 0)" + let ?D = "mat m m (\ ij. if ij = (i,j) then 1 else (0 :: int))" + define B where "B = mat m m (\ (i,j). the_inv ?oi (d i * the (mat_inverse (M m)) $$ (i,j)))" + have B: "B \ carrier_mat m m" unfolding B_def by auto + define BA where "BA = B * A" + have BA: "BA \ carrier_mat m n" unfolding BA_def using A B by auto + define DBA where "DBA = ?D * BA" + have DBA: "DBA \ carrier_mat m n" unfolding DBA_def using BA by auto + have "?mod (inv_mu_ij_mat i j c * A) = + ?mod ((?C * B + 1\<^sub>m m) * A)" + unfolding inv_mu_ij_mat_def B_def by simp + also have "(?C * B + 1\<^sub>m m) * A = ?C * B * A + A" + by (subst add_mult_distrib_mat, insert A B, auto) + also have "?C * B * A = ?C * BA" + unfolding BA_def + by (rule assoc_mult_mat, insert A B, auto) + also have "?C = c \\<^sub>m ?D" + by (rule eq_matI, auto) + also have "\ * BA = c \\<^sub>m DBA" using BA unfolding DBA_def by auto + also have "?mod (\ + A) = ?mod A" + by (rule eq_matI, insert DBA A c, auto simp: mult.assoc) + finally show "?mod (inv_mu_ij_mat i j c * A) = ?mod A" . + } +qed +end + +lemma Gramian_determinant_of_int: assumes fs: "set fs \ carrier_vec n" + and j: "j \ length fs" +shows "of_int (gram_schmidt.Gramian_determinant n fs j) + = gram_schmidt.Gramian_determinant n (map (map_vec rat_of_int) fs) j" +proof - + from j have j: "k < j \ k < length fs" for k by auto + show ?thesis + unfolding gram_schmidt.Gramian_determinant_def + by (subst of_int_hom.hom_det[symmetric], rule arg_cong[of _ _ det], + unfold gram_schmidt.Gramian_matrix_def Let_def, subst of_int_hom.mat_hom_mult, force, force, + unfold map_mat_transpose[symmetric], + rule arg_cong2[of _ _ _ _ "\ x y. x * y\<^sup>T"], insert fs[unfolded set_conv_nth] + j, (fastforce intro!: eq_matI)+) +qed + +context LLL +begin + +(* this lemma might also be useful for swap/add-operation *) +lemma multiply_invertible_mat: assumes lin: "lin_indep fs" + and len: "length fs = m" + and A: "A \ carrier_mat m m" + and A_invertible: "\ B. B \ carrier_mat m m \ B * A = 1\<^sub>m m" + and fs'_prod: "fs' = Matrix.rows (A * mat_of_rows n fs)" +shows "lattice_of fs' = lattice_of fs" + "lin_indep fs'" + "length fs' = m" +proof - + let ?Mfs = "mat_of_rows n fs" + let ?Mfs' = "mat_of_rows n fs'" + from A_invertible obtain B where B: "B \ carrier_mat m m" and inv: "B * A = 1\<^sub>m m" by auto + from lin have fs: "set fs \ carrier_vec n" unfolding gs.lin_indpt_list_def by auto + with len have Mfs: "?Mfs \ carrier_mat m n" by auto + from A Mfs have prod: "A * ?Mfs \ carrier_mat m n" by auto + hence fs': "length fs' = m" "set fs' \ carrier_vec n" unfolding fs'_prod + by (auto simp: Matrix.rows_def Matrix.row_def) + have Mfs_prod': "?Mfs' = A * ?Mfs" + unfolding arg_cong[OF fs'_prod, of "mat_of_rows n"] + by (intro eq_matI, auto simp: mat_of_rows_def) + have "B * ?Mfs' = B * (A * ?Mfs)" + unfolding Mfs_prod' by simp + also have "\ = (B * A) * ?Mfs" + by (subst assoc_mult_mat[OF _ A Mfs], insert B, auto) + also have "B * A = 1\<^sub>m m" by fact + also have "\ * ?Mfs = ?Mfs" using Mfs by auto + finally have Mfs_prod: "?Mfs = B * ?Mfs'" .. + interpret LLL: LLL_with_assms n m fs 2 + by (unfold_locales, auto simp: len lin) + from LLL.LLL_change_basis[OF fs'(2,1) B A Mfs_prod Mfs_prod'] + show latt': "lattice_of fs' = lattice_of fs" and lin': "gs.lin_indpt_list (RAT fs')" + and len': "length fs' = m" + by (auto simp add: LLL_with_assms_def) +qed + +text \This is the key lemma.\ +lemma change_single_element: assumes lin: "lin_indep fs" + and len: "length fs = m" + and i: "i < m" and ji: "j < i" + and A: "A = gram_schmidt_fs_int.inv_mu_ij_mat n (RAT fs)" \ \the transformation matrix A\ + and fs'_prod: "fs' = Matrix.rows (A i j c * mat_of_rows n fs)" \ \fs' is the new basis\ + and latt: "lattice_of fs = L" +shows "lattice_of fs' = L" + "c mod p = 0 \ map (map_vec (\ x. x mod p)) fs' = map (map_vec (\ x. x mod p)) fs" + "lin_indep fs'" + "length fs' = m" + "\ k. k < m \ gso fs' k = gso fs k" + "\ k. k \ m \ d fs' k = d fs k" + "i' < m \ j' < m \ + \ fs' i' j' = (if (i',j') = (i,j) then rat_of_int (c * d fs j) + \ fs i' j' else \ fs i' j')" + "i' < m \ j' < m \ + d\ fs' i' j' = (if (i',j') = (i,j) then c * d fs j * d fs (Suc j) + d\ fs i' j' else d\ fs i' j')" +proof - + let ?A = "A i j c" + let ?Mfs = "mat_of_rows n fs" + let ?Mfs' = "mat_of_rows n fs'" + from lin have fs: "set fs \ carrier_vec n" unfolding gs.lin_indpt_list_def by auto + with len have Mfs: "?Mfs \ carrier_mat m n" by auto + interpret gsi: gram_schmidt_fs_int n "RAT fs" + rewrites "gsi.inv_mu_ij_mat = A" using lin unfolding A + by (unfold_locales, insert lin[unfolded gs.lin_indpt_list_def], auto simp: set_conv_nth) + note A = gsi.inv_mu_ij_mat[unfolded length_map len, OF i ji, where c = c] + from A(3) Mfs have prod: "?A * ?Mfs \ carrier_mat m n" by auto + hence fs': "length fs' = m" "set fs' \ carrier_vec n" unfolding fs'_prod + by (auto simp: Matrix.rows_def Matrix.row_def) + have Mfs_prod': "?Mfs' = ?A * ?Mfs" + unfolding arg_cong[OF fs'_prod, of "mat_of_rows n"] + by (intro eq_matI, auto simp: mat_of_rows_def) + have detA: "det ?A = 1" + by (subst det_lower_triangular[OF A(4) A(3)], insert A, auto intro!: prod_list_neutral + simp: diag_mat_def) + have "\ B. B \ carrier_mat m m \ B * ?A = 1\<^sub>m m" + by (intro exI[of _ "adj_mat ?A"], insert adj_mat[OF A(3)], auto simp: detA) + from multiply_invertible_mat[OF lin len A(3) this fs'_prod] latt + show latt': "lattice_of fs' = L" and lin': "gs.lin_indpt_list (RAT fs')" + and len': "length fs' = m" by auto + interpret LLL: LLL_with_assms n m fs 2 + by (unfold_locales, auto simp: len lin) + interpret fs: fs_int_indpt n fs + by (standard, auto simp: lin) + interpret fs': fs_int_indpt n fs' + by (standard, auto simp: lin') + { + assume c: "c mod p = 0" + have id: "rows (map_mat f A) = map (map_vec f) (rows A)" for f A + unfolding rows_def by auto + have rows_id: "set fs \ carrier_vec n \ rows (mat_of_rows n fs) = fs" for fs + unfolding mat_of_rows_def rows_def + by (force simp: Matrix.row_def set_conv_nth intro!: nth_equalityI) + from A(2)[OF Mfs c] + have "rows (map_mat (\x. x mod p) ?Mfs') = rows (map_mat (\x. x mod p) ?Mfs)" unfolding Mfs_prod' + by simp + from this[unfolded id rows_id[OF fs] rows_id[OF fs'(2)]] + show "map (map_vec (\ x. x mod p)) fs' = map (map_vec (\ x. x mod p)) fs" . + } + { + define B where "B = ?A" + have gs_eq: "k < m \ gso fs' k = gso fs k" for k + proof(induct rule: nat_less_induct) + case (1 k) + then show ?case + proof(cases "k = 0") + case True + then show ?thesis + proof - + have "row ?Mfs' 0 = row ?Mfs 0" + proof - + have 2: "0\ {0..j. row B 0 \ col ?Mfs j)" + using row_mult A(3) Mfs 1 Mfs_prod' unfolding B_def by simp + also have "\ = vec n (\j. (\l\{0.. = vec n (\j. B $$ (0, 0) * ?Mfs $$ (0, j) + + (\l\{1..\g. sum g {0..) + also have "\ = row ?Mfs 0" + using A(4-) 1 unfolding B_def[symmetric] by (simp add: row_def) + finally show ?thesis by (simp add: B_def Mfs_prod') + qed + then show ?thesis using True 1 fs'.f_carrier fs.f_carrier + fs'.gs.fs0_gso0 len' len gsi.fs0_gso0 by auto + qed + next + case False + then show ?thesis + proof - + have gso0kcarr: "gsi.gso ` {0 .. carrier_vec n" + using 1(2) gsi.gso_carrier len by auto + hence gsospancarr: "gs.span(gsi.gso ` {0 .. carrier_vec n " + using span_is_subset2 by auto + + have fs'_gs_diff_span: + "(RAT fs') ! k - fs'.gs.gso k \ gs.span (gsi.gso ` {0 ..ja. fs'.gs.\ k ja \\<^sub>v fs'.gs.gso ja) [0..ja. fs'.gs.\ k ja \\<^sub>v gsi.gso ja) [0..ja. fs'.gs.\ k ja \\<^sub>v gsi.gso ja) [0.. gs.span(gsi.gso ` {0 .. gs.span(gsi.gso ` {0 .. carrier_vec n" + using gsospancarr gssum_def by blast + have sumid: "gs'sum = gssum" + proof - + have "map (\ja. fs'.gs.\ k ja \\<^sub>v fs'.gs.gso ja) [0..ja. fs'.gs.\ k ja \\<^sub>v gsi.gso ja) [0..ja. B $$ (k, ja) \\<^sub>v fs ! ja) [0..< k])" + have v2carr: "v2 \ carrier_vec n" + proof - + have "set (map (\ja. B $$ (k, ja) \\<^sub>v fs ! ja) [0..< k]) \ carrier_vec n" + using len 1(2) fs.f_carrier by auto + thus ?thesis unfolding v2_def by simp + qed + define ratv2 where "ratv2 = (map_vec rat_of_int v2)" + have ratv2carr: "ratv2 \ carrier_vec n" + unfolding ratv2_def using v2carr by simp + have fs'id: "(RAT fs') ! k = (RAT fs) ! k + ratv2" + proof - + have zkm: "[0..ja. B $$ (k, ja) \\<^sub>v fs ! ja) [0.. carrier_vec n" + using len fs.f_carrier by auto + + have "fs' ! k = vec n (\j. row B k \ col ?Mfs j)" + using 1(2) Mfs B_def A(3) fs'_prod by simp + also have "\ = sumlist (map (\ja. B $$ (k, ja) \\<^sub>v fs ! ja) [0..j. row B k \ col ?Mfs j)) $ i = row B k \ col ?Mfs i" + using i by auto + also have "\ = (\j = 0.. = (\j = 0.. = + (\j = 0..ja. B $$ (k, ja) \\<^sub>v fs ! ja) [0..jija. B $$ (k, ja) \\<^sub>v fs ! ja) [0.. = sumlist (map (\ja. B $$ (k, ja) \\<^sub>v fs ! ja) [0..j. row B k \ col ?Mfs j)) $ i = + sumlist (map (\ja. B $$ (k, ja) \\<^sub>v fs ! ja) [0.. = sumlist (map (\ja. B $$ (k, ja) \\<^sub>v fs ! ja) + ([0..<(Suc k)] @ [(Suc k).. = sumlist (map (\ja. B $$ (k, ja) \\<^sub>v fs ! ja) [0..<(Suc k)]) + + sumlist (map (\ja. B $$ (k, ja) \\<^sub>v fs ! ja) [(Suc k).. = ?L2 + ?L3") + using fs.f_carrier len dim_sumlist sumlist_append prep zkm by auto + also have "?L3 = 0\<^sub>v n" + using A(4) fs.f_carrier len sumlist_nth carrier_vecD sumlist_carrier + prep zkm unfolding B_def[symmetric] by auto + also have "?L2 = sumlist (map (\ja. B $$ (k, ja) \\<^sub>v fs ! ja) [0..\<^sub>v fs ! k" using prep zkm sumlist_snoc by simp + also have "\ = sumlist (map (\ja. B $$ (k, ja) \\<^sub>v fs ! ja) [0..ja. B $$ (k, ja) \\<^sub>v fs ! ja) [0.. gs.span (gsi.gso ` {0 ..j. of_int (B $$ (k, j)) \\<^sub>v (RAT fs) ! j) [0..j. of_int (B $$ (k, j)) \\<^sub>v (RAT fs) ! j) [0.. carrier_vec n" + using fs.f_carrier 1(2) len by auto + hence carr: "gs.M.sumlist + (map (\j. of_int (B $$ (k, j)) \\<^sub>v (RAT fs) ! j) [0.. carrier_vec n" + by auto + have "set (map (\j. B $$ (k, j) \\<^sub>v fs ! j) [0.. carrier_vec n" + using fs.f_carrier 1(2) len by auto + hence "\i j. i < n \ j < k \ of_int ((B $$ (k, j) \\<^sub>v fs ! j) $ i) + = (of_int (B $$ (k, j)) \\<^sub>v (RAT fs) ! j) $ i" + using 1(2) len by fastforce + hence "\i. i < n \ ratv2 $ i = gs.M.sumlist + (map (\j. (of_int (B $$ (k, j)) \\<^sub>v (RAT fs) ! j)) [0..i. i < k \ (RAT fs) ! i = + gs.M.sumlist (map (\ j. gsi.\ i j \\<^sub>v gsi.gso j) [0 ..< Suc i])" + using gsi.fi_is_sum_of_mu_gso len 1(2) by auto + moreover have "\i. i < k \ (\ j. gsi.\ i j \\<^sub>v gsi.gso j) ` {0 ..< Suc i} + \ gs.span (gsi.gso ` {0 ..i. i < k \ (RAT fs) ! i \ gs.span (gsi.gso ` {0 .. gs.span (gsi.gso ` {0 .. gs.span (gsi.gso ` {0 .. gs.span(gsi.gso ` {0 .. gs.span (gsi.gso ` {0 .. fs'.gs.gso i = 0" using 1(2) fs'.gs.orthogonal len' by auto + hence "fs'.gs.gso k \ gsi.gso i = 0" using 1 i by simp + } + hence "\x. x \ gsi.gso ` {0.. fs'.gs.gso k \ x = 0" by auto + + then show ?thesis + using gsi.oc_projection_unique len len' fs_gs_diff_span 1(2) by auto + qed + qed + qed + + have "\ i' j'. i' < m \ j' < m \ \ fs' i' j' = + (map_mat of_int (A i j c) * gsi.M m) $$ (i',j')" and + "\ k. k < m \ gso fs' k = gso fs k" + proof - + define rB where "rB = map_mat rat_of_int B" + have rBcarr: "rB \ carrier_mat m m" using A(3) unfolding rB_def B_def by simp + define rfs where "rfs = mat_of_rows n (RAT fs)" + have rfscarr: "rfs \ carrier_mat m n" using Mfs unfolding rfs_def by simp + + { + fix i' + fix j' + assume i': "i' < m" + assume j': "j' < m" + have prep: + "of_int_hom.vec_hom (row (B * mat_of_rows n fs) i') = row (rB * rfs) i'" + using len i' B_def A(3) rB_def rfs_def by (auto simp: scalar_prod_def) + have prep2: "row (rB * rfs) i' = vec n (\l. row rB i' \ col rfs l)" + using len fs.f_carrier i' B_def A(3) scalar_prod_def rB_def + unfolding rfs_def by auto + have prep3: "(vec m (\ j1. row rfs j1 \ gsi.gso j' / \gsi.gso j'\\<^sup>2)) = + (vec m (\ j1. (gsi.M m) $$ (j1, j')))" + proof - + { + fix x y + assume x: "x < m" and y: "y < m" + have "(gsi.M m) $$ (x,y) = (if y < x then map of_int_hom.vec_hom fs ! x + \ fs'.gs.gso y / \fs'.gs.gso y\\<^sup>2 else if x = y then 1 else 0)" + using gsi.\.simps x y j' len gs_eq gsi.M_index by auto + hence "row rfs x \ gsi.gso y / \gsi.gso y\\<^sup>2 = (gsi.M m) $$ (x,y)" + unfolding rfs_def + by (metis carrier_matD(1) divide_eq_eq fs'.gs.\_zero fs'.gs.gso_norm_beta + gs_eq gsi.\.simps gsi.fi_scalar_prod_gso gsi.fs_carrier len len' + length_map nth_rows rfs_def rfscarr rows_mat_of_rows x y) + } + then show ?thesis using j' by auto + qed + have prep4: "(1 / \gsi.gso j'\\<^sup>2) \\<^sub>v (vec m (\j1. row rfs j1 \ gsi.gso j')) = + (vec m (\j1. row rfs j1 \ gsi.gso j' / \gsi.gso j'\\<^sup>2))" by auto + + have "map of_int_hom.vec_hom fs' ! i' \ fs'.gs.gso j' / \fs'.gs.gso j'\\<^sup>2 + = map of_int_hom.vec_hom fs' ! i' \ gsi.gso j' / \gsi.gso j'\\<^sup>2" + using gs_eq j' by simp + also have "\ = row (rB * rfs) i' \ gsi.gso j' / \gsi.gso j'\\<^sup>2" + using prep i' len' unfolding rB_def B_def by (simp add: fs'_prod) + also have "\ = + (vec n (\l. row rB i' \ col rfs l)) \ gsi.gso j' / \gsi.gso j'\\<^sup>2" + using prep2 by auto + also have "vec n (\l. row rB i' \ col rfs l) = + (vec n (\l. (\j1=0.. = + (vec n (\l. (\j1=0.. \ gsi.gso j' = + (\j2=0..l. (\j1=0.. = (\j2=0..j1=0.. = (\j2=0..j1=0.. = (\j1=0..j2=0.. = (\j1=0..j2=0.. = row rB i' \ (vec m (\ j1. (\j2=0.. j1. (\j2=0.. j1. row rfs j1 \ gsi.gso j'))" + using rfscarr gsi.gso_carrier len j' rfscarr by (auto simp add: scalar_prod_def) + also have "row rB i' \ \ / \gsi.gso j'\\<^sup>2 = + row rB i' \ vec m (\ j1. row rfs j1 \ gsi.gso j' / \gsi.gso j'\\<^sup>2)" + using prep4 scalar_prod_smult_right rBcarr carrier_matD(2) dim_vec row_def + by (smt gs.l_one times_divide_eq_left) + also have "\ = (rB * (gsi.M m)) $$ (i', j')" + using rBcarr i' j' prep3 gsi.M_def by (simp add: col_def) + finally have + "map of_int_hom.vec_hom fs' ! i' \ fs'.gs.gso j' / \fs'.gs.gso j'\\<^sup>2 = + (rB * (gsi.M m)) $$ (i', j')" by auto + } + then show "\ i' j'. i' < m \ j' < m \ \ fs' i' j' = + (map_mat of_int (A i j c) * gsi.M m) $$ (i',j')" + using B_def fs'.gs.\_zero fs'.gs.fi_scalar_prod_gso fs'.gs.gso_norm_beta + len' rB_def by auto + show "\ k. k < m \ gso fs' k = gso fs k" using gs_eq by auto + qed + } note mu_gso = this + + show "\ k. k < m \ gso fs' k = gso fs k" by fact + { + fix k + have "k \ m \ rat_of_int (d fs' k) = rat_of_int (d fs k)" for k + proof (induct k) + case 0 + show ?case by (simp add: d_def) + next + case (Suc k) + hence k: "k \ m" "k < m" by auto + show ?case + by (subst (1 2) LLL_d_Suc[OF _ k(2)], auto simp: Suc(1)[OF k(1)] mu_gso(2)[OF k(2)] + LLL_invariant_weak_def lin lin' len len' latt latt') + qed + thus "k \ m \ d fs' k = d fs k" by simp + } note d = this + { + assume i': "i' < m" and j': "j' < m" + have "\ fs' i' j' = (of_int_hom.mat_hom (A i j c) * gsi.M m) $$ (i',j')" by (rule mu_gso(1)[OF i' j']) + also have "\ = (if (i',j') = (i,j) then of_int c * gsi.d j else 0) + gsi.M m $$ (i',j')" + unfolding A(1) using i' j' by (auto simp: gsi.M_def) + also have "gsi.M m $$ (i',j') = \ fs i' j'" + unfolding gsi.M_def using i' j' by simp + also have "gsi.d j = of_int (d fs j)" + unfolding d_def by (subst Gramian_determinant_of_int[OF fs], insert ji i len, auto) + finally show mu: "\ fs' i' j' = (if (i',j') = (i,j) then rat_of_int (c * d fs j) + \ fs i' j' else \ fs i' j')" + by simp + let ?d = "d fs (Suc j')" + have d_fs: "of_int (d\ fs i' j') = rat_of_int ?d * \ fs i' j'" + unfolding d\_def + using fs.fs_int_mu_d_Z_m_m[unfolded len, OF i' j'] + by (metis LLL.LLL.d_def assms(2) fs.fs_int_mu_d_Z_m_m fs_int.d_def i' + int_of_rat(2) j') + have "rat_of_int (d\ fs' i' j') = rat_of_int (d fs' (Suc j')) * \ fs' i' j'" + unfolding d\_def + using fs'.fs_int_mu_d_Z_m_m[unfolded len', OF i' j'] + using LLL.LLL.d_def fs'(1) fs'.d\ fs'.d\_def fs_int.d_def i' j' by auto + also have "d fs' (Suc j') = ?d" by (rule d, insert j', auto) + also have "rat_of_int \ * \ fs' i' j' = + (if (i',j') = (i,j) then rat_of_int (c * d fs j * ?d) else 0) + of_int (d\ fs i' j')" + unfolding mu d_fs by (simp add: field_simps) + also have "\ = rat_of_int ((if (i',j') = (i,j) then c * d fs j * ?d else 0) + d\ fs i' j')" + by simp + also have "\ = rat_of_int ((if (i',j') = (i,j) then c * d fs j * d fs (Suc j) + d\ fs i' j' else d\ fs i' j'))" + by simp + finally show "d\ fs' i' j' = (if (i',j') = (i,j) then c * d fs j * d fs (Suc j) + d\ fs i' j' else d\ fs i' j')" + by simp + } +qed + +text \Eventually: Lemma 13 of Storjohann's paper.\ +lemma mod_single_element: assumes lin: "lin_indep fs" + and len: "length fs = m" + and i: "i < m" and ji: "j < i" + and latt: "lattice_of fs = L" + and pgtz: "p > 0" +shows "\ fs'. lattice_of fs' = L \ + map (map_vec (\ x. x mod p)) fs' = map (map_vec (\ x. x mod p)) fs \ + map (map_vec (\ x. x symmod p)) fs' = map (map_vec (\ x. x symmod p)) fs \ + lin_indep fs' \ + length fs' = m \ + (\ k < m. gso fs' k = gso fs k) \ + (\ k \ m. d fs' k = d fs k) \ + (\ i' < m. \ j' < m. d\ fs' i' j' = (if (i',j') = (i,j) then d\ fs i j' symmod (p * d fs j' * d fs (Suc j')) else d\ fs i' j'))" +proof - + have inv: "LLL_invariant_weak fs" using LLL_invariant_weak_def assms by simp + let ?mult = "d fs j * d fs (Suc j)" + define M where "M = ?mult" + define pM where "pM = p * M" + then have pMgtz: "pM > 0" using pgtz unfolding pM_def M_def using LLL_d_pos[OF inv] i ji by simp + let ?d = "d\ fs i j" + define c where "c = - (?d symdiv pM)" + have d_mod: "?d symmod pM = c * pM + ?d" unfolding c_def using pMgtz sym_mod_sym_div by simp + define A where "A = gram_schmidt_fs_int.inv_mu_ij_mat n (RAT fs)" + define fs' where fs': "fs' = Matrix.rows (A i j (c * p) * mat_of_rows n fs)" + note main = change_single_element[OF lin len i ji A_def fs' latt] + have "map (map_vec (\x. x mod p)) fs' = map (map_vec (\x. x mod p)) fs" + by (intro main, auto) + from arg_cong[OF this, of "map (map_vec (poly_mod.inv_M p))"] + have id: "map (map_vec (\x. x symmod p)) fs' = map (map_vec (\x. x symmod p)) fs" + unfolding map_map o_def sym_mod_def map_vec_map_vec . + show ?thesis + proof (intro exI[of _ fs'] conjI main allI impI id) + fix i' j' + assume ij: "i' < m" "j' < m" + have "d\ fs' i' j' = (if (i', j') = (i, j) then (c * p) * M + ?d else d\ fs i' j')" + unfolding main(8)[OF ij] M_def by simp + also have "(c * p) * M + ?d = ?d symmod pM" + unfolding d_mod by (simp add: pM_def) + finally show "d\ fs' i' j' = (if (i',j') = (i,j) then d\ fs i j' symmod (p * d fs j' * d fs (Suc j')) else d\ fs i' j')" + by (auto simp: pM_def M_def ac_simps) + qed auto +qed + +text \A slight generalization to perform modulo on arbitrary set of indices $I$.\ +lemma mod_finite_set: assumes lin: "lin_indep fs" + and len: "length fs = m" + and I: "I \ {(i,j). i < m \ j < i}" + and latt: "lattice_of fs = L" + and pgtz: "p > 0" +shows "\ fs'. lattice_of fs' = L \ + map (map_vec (\ x. x mod p)) fs' = map (map_vec (\ x. x mod p)) fs \ + map (map_vec (\ x. x symmod p)) fs' = map (map_vec (\ x. x symmod p)) fs \ + lin_indep fs' \ + length fs' = m \ + (\ k < m. gso fs' k = gso fs k) \ + (\ k \ m. d fs' k = d fs k) \ + (\ i' < m. \ j' < m. d\ fs' i' j' = + (if (i',j') \ I then d\ fs i' j' symmod (p * d fs j' * d fs (Suc j')) else d\ fs i' j'))" +proof - + let ?exp = "\ fs' I i' j'. + d\ fs' i' j' = (if (i',j') \ I then d\ fs i' j' symmod (p * d fs j' * d fs (Suc j')) else d\ fs i' j')" + let ?prop = "\ fs fs'. lattice_of fs' = L \ + map (map_vec (\ x. x mod p)) fs' = map (map_vec (\ x. x mod p)) fs \ + map (map_vec (\ x. x symmod p)) fs' = map (map_vec (\ x. x symmod p)) fs \ + lin_indep fs' \ + length fs' = m \ + (\ k < m. gso fs' k = gso fs k) \ + (\ k \ m. d fs' k = d fs k)" + have "finite I" + proof (rule finite_subset[OF I], rule finite_subset) + show "{(i, j). i < m \ j < i} \ {0..m} \ {0..m}" by auto + qed auto + from this I have "\ fs'. ?prop fs fs' \ (\ i' < m. \ j' < m. ?exp fs' I i' j')" + proof (induct I) + case empty + show ?case + by (intro exI[of _ fs], insert assms, auto) + next + case (insert ij I) + obtain i j where ij: "ij = (i,j)" by force + from ij insert(4) have i: "i < m" "j < i" by auto + from insert(3,4) obtain gs where gs: "?prop fs gs" + and exp: "\ i' j'. i' < m \ j' < m \ ?exp gs I i' j'" by auto + from gs have "lin_indep gs" "lattice_of gs = L" "length gs = m" by auto + from mod_single_element[OF this(1,3) i this(2), of p] + obtain hs where hs: "?prop gs hs" + and exp': "\ i' j'. i' < m \ j' < m \ + d\ hs i' j' = (if (i', j') = (i, j) + then d\ gs i j' symmod (p * d gs j' * d gs (Suc j')) else d\ gs i' j')" + using pgtz by auto + from gs i have id: "d gs j = d fs j" "d gs (Suc j) = d fs (Suc j)" by auto + show ?case + proof (intro exI[of _ hs], rule conjI; (intro allI impI)?) + show "?prop fs hs" using gs hs by auto + fix i' j' + assume *: "i' < m" "j' < m" + show "?exp hs (insert ij I) i' j'" unfolding exp'[OF *] ij using exp * i + by (auto simp: id) + qed + qed + thus ?thesis by auto +qed + +end + +end \ No newline at end of file diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite.thy new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite.thy @@ -0,0 +1,281 @@ +section \Generalization of the statement about the uniqueness of the Hermite normal form\ + +theory Uniqueness_Hermite +imports Hermite.Hermite +begin + +(*This file presents a generalized version of the theorem Hermite_unique when applied to integer +matrices. More concretely, instead of assuming invertibility over Z of the input matrix A, we now +assume invertibility over Q. Only some changes to adapt the original proof are required.*) + +instance int :: bezout_ring_div +proof qed + +lemma map_matrix_rat_of_int_mult: + shows "map_matrix rat_of_int (A**B) = (map_matrix rat_of_int A)**(map_matrix rat_of_int B)" + unfolding map_matrix_def matrix_matrix_mult_def by auto + +lemma det_map_matrix: + fixes A :: "int^'n::mod_type^'n::mod_type" + shows "det (map_matrix rat_of_int A) = rat_of_int (det A)" + unfolding map_matrix_def unfolding Determinants.det_def by auto + +lemma inv_Z_imp_inv_Q: + fixes A :: "int^'n::mod_type^'n::mod_type" + assumes inv_A: "invertible A" + shows "invertible (map_matrix rat_of_int A)" +proof - + have "is_unit (det A)" using inv_A invertible_iff_is_unit by blast + hence "is_unit (det (map_matrix rat_of_int A))" + by (simp add: det_map_matrix dvd_if_abs_eq) + thus ?thesis using invertible_iff_is_unit by blast +qed + +lemma upper_triangular_Z_eq_Q: + "upper_triangular (map_matrix rat_of_int A) = upper_triangular A" + unfolding upper_triangular_def by auto + +lemma invertible_and_upper_diagonal_not0: + fixes H :: "int^'n::mod_type^'n::mod_type" + assumes inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H" + shows "H $ i $ i \ 0" +proof - + let ?RAT_H = "(map_matrix rat_of_int H)" + have up_RAT_H: "upper_triangular ?RAT_H" + using up_H unfolding upper_triangular_def by auto + have "is_unit (det ?RAT_H)" using inv_H using invertible_iff_is_unit by blast + hence "?RAT_H $ i $ i \ 0" using inv_H up_RAT_H is_unit_diagonal + by (metis not_is_unit_0) + thus ?thesis by auto +qed + +lemma diagonal_least_nonzero: + fixes H :: "int^'n::mod_type^'n::mod_type" + assumes H: "Hermite associates residues H" + and inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H" + shows "(LEAST n. H $ i $ n \ 0) = i" +proof (rule Least_equality) + show "H $ i $ i \ 0" by (rule invertible_and_upper_diagonal_not0[OF inv_H up_H]) + fix y + assume Hiy: "H $ i $ y \ 0" + show "i \ y" + using up_H unfolding upper_triangular_def + by (metis (poly_guards_query) Hiy not_less) +qed + +lemma diagonal_in_associates: + fixes H :: "int^'n::mod_type^'n::mod_type" + assumes H: "Hermite associates residues H" + and inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H" + shows "H $ i $ i \ associates" +proof - + have "H $ i $ i \ 0" by (rule invertible_and_upper_diagonal_not0[OF inv_H up_H]) + hence "\ is_zero_row i H" unfolding is_zero_row_def is_zero_row_upt_k_def ncols_def by auto + thus ?thesis using H unfolding Hermite_def unfolding diagonal_least_nonzero[OF H inv_H up_H] + by auto +qed + +lemma above_diagonal_in_residues: + fixes H :: "int^'n::mod_type^'n::mod_type" + assumes H: "Hermite associates residues H" + and inv_H: "invertible (map_matrix rat_of_int H)" and up_H: "upper_triangular H" + and j_i: "j 0) \ residues (H $ i $ (LEAST n. H $ i $ n \ 0))" +proof - + have "H $ i $ i \ 0" by (rule invertible_and_upper_diagonal_not0[OF inv_H up_H]) + hence "\ is_zero_row i H" unfolding is_zero_row_def is_zero_row_upt_k_def ncols_def by auto + thus ?thesis using H j_i unfolding Hermite_def unfolding diagonal_least_nonzero[OF H inv_H up_H] + by auto +qed + + +lemma Hermite_unique_generalized: + fixes K::"int^'n::mod_type^'n::mod_type" + assumes A_PH: "A = P ** H" + and A_QK: "A = Q ** K" + and inv_A: "invertible (map_matrix rat_of_int A)" (*The original statement assumes "invertible A", + that is, invertibility over integers, which is + more restrictive.*) + and inv_P: "invertible P" + and inv_Q: "invertible Q" + and H: "Hermite associates residues H" + and K: "Hermite associates residues K" + shows "H = K" +proof - + let ?RAT = "map_matrix rat_of_int" + have cs_residues: "Complete_set_residues residues" using H unfolding Hermite_def by simp + have inv_H: "invertible (?RAT H)" + proof - + have "?RAT A = ?RAT P ** ?RAT H" using A_PH map_matrix_rat_of_int_mult by blast + thus ?thesis + by (metis inv_A invertible_left_inverse matrix_inv(1) matrix_mul_assoc) + qed + have inv_K: "invertible (?RAT K)" + proof - + have "?RAT A = ?RAT Q ** ?RAT K" using A_QK map_matrix_rat_of_int_mult by blast + thus ?thesis + by (metis inv_A invertible_left_inverse matrix_inv(1) matrix_mul_assoc) + qed + define U where "U = (matrix_inv P)**Q" + have inv_U: "invertible U" + by (metis U_def inv_P inv_Q invertible_def invertible_mult matrix_inv_left matrix_inv_right) + have H_UK: "H = U ** K" using A_PH A_QK inv_P + by (metis U_def matrix_inv_left matrix_mul_assoc matrix_mul_lid) + have "Determinants.det K *k U = H ** adjugate K" + unfolding H_UK matrix_mul_assoc[symmetric] mult_adjugate_det matrix_mul_mat .. + have upper_triangular_H: "upper_triangular H" + by (metis H Hermite_def echelon_form_imp_upper_triagular) + have upper_triangular_K: "upper_triangular K" + by (metis K Hermite_def echelon_form_imp_upper_triagular) + have upper_triangular_U: "upper_triangular U" + proof - + have U_H_K: "?RAT U = (?RAT H) ** (matrix_inv (?RAT K))" + by (metis H_UK inv_K map_matrix_rat_of_int_mult matrix_inv(2) matrix_mul_assoc matrix_mul_rid) + have up_inv_RAT_K: "upper_triangular (matrix_inv (?RAT K))" using upper_triangular_inverse + by (simp add: upper_triangular_inverse inv_K upper_triangular_K upper_triangular_Z_eq_Q) + have "upper_triangular (?RAT U)" unfolding U_H_K + by (rule upper_triangular_mult[OF _ up_inv_RAT_K], + auto simp add: upper_triangular_H upper_triangular_Z_eq_Q) + thus ?thesis using upper_triangular_Z_eq_Q by auto + qed + have unit_det_U: "is_unit (det U)" by (metis inv_U invertible_iff_is_unit) + have is_unit_diagonal_U: "(\i. is_unit (U $ i $ i))" + by (rule is_unit_diagonal[OF upper_triangular_U unit_det_U]) + have Uii_1: "(\i. (U $ i $ i) = 1)" and Hii_Kii: "(\i. (H $ i $ i) = (K $ i $ i))" + proof (auto) + fix i + have Hii: "H $ i $ i \ associates" + by (rule diagonal_in_associates[OF H inv_H upper_triangular_H]) + have Kii: "K $ i $ i \ associates" + by (rule diagonal_in_associates[OF K inv_K upper_triangular_K]) + have ass_Hii_Kii: "normalize (H $ i $ i) = normalize (K $ i $ i)" + by (metis H_UK is_unit_diagonal_U normalize_mult_unit_left upper_triangular_K upper_triangular_U upper_triangular_mult_diagonal) + show Hii_eq_Kii: "H $ i $ i = K $ i $ i" + by (metis Hermite_def Hii K Kii ass_Hii_Kii in_Ass_not_associated) + have "H $ i $ i = U $ i $ i * K $ i $ i" + by (metis H_UK upper_triangular_K upper_triangular_U upper_triangular_mult_diagonal) + thus "U $ i $ i = 1" unfolding Hii_eq_Kii mult_cancel_right1 + using inv_K invertible_and_upper_diagonal_not0 upper_triangular_K by blast + qed + have zero_above: "\j s. j\1 \ j < ncols A - to_nat s \ U $ s $ (s + from_nat j) = 0" + proof (clarify) + fix j s assume "1 \ j" and "j < ncols A - (to_nat (s::'n))" + thus "U $ s $ (s + from_nat j) = 0" + proof (induct j rule: less_induct) + fix p + assume induct_step: "(\y. y < p \ 1 \ y \ y < ncols A - to_nat s \ U $ s $ (s + from_nat y) = 0)" + and p1: "1 \ p" and p2: "p < ncols A - to_nat s" + have s_less: "s < s + from_nat p" using p1 p2 unfolding ncols_def + by (metis One_nat_def add.commute add_diff_cancel_right' add_lessD1 add_to_nat_def + from_nat_to_nat_id less_diff_conv neq_iff not_le + to_nat_from_nat_id to_nat_le zero_less_Suc) + show "U $ s $ (s + from_nat p) = 0" + proof - + have UNIV_rw: "UNIV = insert s (UNIV-{s})" by auto + have UNIV_s_rw: "UNIV-{s} = insert (s + from_nat p) ((UNIV-{s}) - {s + from_nat p})" + using p1 p2 s_less unfolding ncols_def by (auto simp: algebra_simps) + have sum_rw: "(\k\UNIV-{s}. U $ s $ k * K $ k $ (s + from_nat p)) + = U $ s $ (s + from_nat p) * K $ (s + from_nat p) $ (s + from_nat p) + + (\k\(UNIV-{s})-{s + from_nat p}. U $ s $ k * K $ k $ (s + from_nat p))" + using UNIV_s_rw sum.insert by (metis (erased, lifting) Diff_iff finite singletonI) + have sum_0: "(\k\(UNIV-{s})-{s + from_nat p}. U $ s $ k * K $ k $ (s + from_nat p)) = 0" + proof (rule sum.neutral, rule) + fix x assume x: "x \ UNIV - {s} - {s + from_nat p}" + show "U $ s $ x * K $ x $ (s + from_nat p) = 0" + proof (cases "xs" using x by (metis Diff_iff neq_iff singletonI) + show ?thesis + proof (cases "x a" + by (auto simp add: a_def p1 p2) (metis Suc_leI to_nat_mono x_g_s zero_less_diff) + show "a < ncols A - to_nat s" using a_p p2 by auto + qed + thus ?thesis by simp + next + case False + hence "x>s+from_nat p" using x_g_s x by auto + thus ?thesis using upper_triangular_K unfolding upper_triangular_def + by auto + qed + qed + qed + have "H $ s $ (s + from_nat p) = (\k\UNIV. U $ s $ k * K $ k $ (s + from_nat p))" + unfolding H_UK matrix_matrix_mult_def by auto + also have "... = (\k\insert s (UNIV-{s}). U $ s $ k * K $ k $ (s + from_nat p))" + using UNIV_rw by simp + also have "... = U $ s $ s * K $ s $ (s + from_nat p) + + (\k\UNIV-{s}. U $ s $ k * K $ k $ (s + from_nat p))" + by (rule sum.insert, simp_all) + also have "... = U $ s $ s * K $ s $ (s + from_nat p) + + U $ s $ (s + from_nat p) * K $ (s + from_nat p) $ (s + from_nat p)" + unfolding sum_rw sum_0 by simp + finally have H_s_sp: "H $ s $ (s + from_nat p) + = U $ s $ (s + from_nat p) * K $ (s + from_nat p) $ (s + from_nat p) + K $ s $ (s + from_nat p)" + using Uii_1 by auto + hence cong_HK: "cong (H $ s $ (s + from_nat p)) (K $ s $ (s + from_nat p)) (K $ (s+from_nat p) $ (s + from_nat p))" + unfolding cong_def by auto + have H_s_sp_residues: "(H $ s $ (s + from_nat p)) \ residues (K $ (s+from_nat p) $ (s + from_nat p))" + using above_diagonal_in_residues[OF H inv_H upper_triangular_H s_less] + unfolding diagonal_least_nonzero[OF H inv_H upper_triangular_H] + by (metis Hii_Kii) + have K_s_sp_residues: "(K $ s $ (s + from_nat p)) \ residues (K $ (s+from_nat p) $ (s + from_nat p))" + using above_diagonal_in_residues[OF K inv_K upper_triangular_K s_less] + unfolding diagonal_least_nonzero[OF K inv_K upper_triangular_K] . + have Hs_sp_Ks_sp: "(H $ s $ (s + from_nat p)) = (K $ s $ (s + from_nat p))" + using cong_HK in_Res_not_congruent[OF cs_residues H_s_sp_residues K_s_sp_residues] + by fast + have "K $ (s + from_nat p) $ (s + from_nat p) \ 0" + using inv_K invertible_and_upper_diagonal_not0 upper_triangular_K by blast + thus ?thesis unfolding from_nat_1 using H_s_sp unfolding Hs_sp_Ks_sp by auto + qed + qed + qed + have "U = mat 1" + proof (unfold mat_def vec_eq_iff, auto) + fix ia show "U $ ia $ ia = 1" using Uii_1 by simp + fix i assume i_ia: "i \ ia" + show "U $ i $ ia = 0" + proof (cases "ia a" unfolding a_def + by (metis diff_is_0_eq i_less_ia less_one not_less to_nat_mono) + moreover have "a < ncols A - to_nat i" + unfolding a_def ncols_def + by (metis False diff_less_mono not_less to_nat_less_card to_nat_mono') + ultimately show ?thesis using zero_above unfolding ia_eq by blast + qed + qed + thus ?thesis using H_UK matrix_mul_lid by fast +qed + +end \ No newline at end of file diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite_JNF.thy b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite_JNF.thy new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/Uniqueness_Hermite_JNF.thy @@ -0,0 +1,823 @@ +section \Uniqueness of Hermite normal form in JNF\ + +text \This theory contains the proof of the uniqueness theorem of the Hermite normal form in JNF, +moved from HOL Analysis.\ + +theory Uniqueness_Hermite_JNF + imports + Hermite.Hermite + Uniqueness_Hermite + Smith_Normal_Form.SNF_Missing_Lemmas + Smith_Normal_Form.Mod_Type_Connect + Smith_Normal_Form.Finite_Field_Mod_Type_Connection +begin + +hide_const (open) residues + +text \We first define some properties that currently exist in HOL Analysis, but not in +JNF, namely a predicate for being in echelon form, another one for being in Hermite normal form, +definition of a row of zeros up to a concrete position, and so on.\ + +definition is_zero_row_upt_k_JNF :: "nat => nat =>'a::{zero} mat => bool" + where "is_zero_row_upt_k_JNF i k A = (\j. j < k \ A $$ (i,j) = 0)" + +definition is_zero_row_JNF :: "nat =>'a::{zero} mat => bool" + where "is_zero_row_JNF i A = (\ji. is_zero_row i A \ \ (\j. j>i \ \ is_zero_row j A)) + \ + (\i j. i \ (is_zero_row i A) \ \ (is_zero_row j A) + \ ((LEAST n. A $ i $ n \ 0) < (LEAST n. A $ j $ n \ 0))))" + unfolding echelon_form_def echelon_form_upt_k_def unfolding is_zero_row_def by auto + +definition + echelon_form_JNF :: "'a::{bezout_ring} mat \ bool" + where + "echelon_form_JNF A = ( + (\i \ (\j. j < dim_row A \ j>i \ \ is_zero_row_JNF j A)) + \ + (\i j. i j \ (is_zero_row_JNF i A) \ \ (is_zero_row_JNF j A) + \ ((LEAST n. A $$ (i, n) \ 0) < (LEAST n. A $$ (j, n) \ 0))))" + + +text \Now, we connect the existing definitions in HOL Analysis to the ones just defined in JNF by +means of transfer rules.\ + +context includes lifting_syntax +begin + + +lemma HMA_is_zero_row_mod_type[transfer_rule]: + "((Mod_Type_Connect.HMA_I) ===> (Mod_Type_Connect.HMA_M :: _ \ 'a :: comm_ring_1 ^ 'n :: mod_type ^ 'm :: mod_type \ _) + ===> (=)) is_zero_row_JNF is_zero_row" +proof (intro rel_funI, goal_cases) + case (1 i i' A A') + note ii' = "1"(1)[transfer_rule] + note AA' = "1"(2)[transfer_rule] + have "(\jj. A' $h i' $h j = 0)" + proof (rule;rule+) + fix j'::'n assume Aij_0: "\jm_def + dim_col_mat(1) mod_type_class.to_nat_less_card) + hence "index_hma A' i' j' = 0" by transfer + thus "A' $h i' $h j' = 0" unfolding index_hma_def by simp + next + fix j assume 1: "\j'. A' $h i' $h j' = 0" and 2: "j < dim_col A" + define j'::'n where "j' = mod_type_class.from_nat j" + have [transfer_rule]: "Mod_Type_Connect.HMA_I j j'" unfolding Mod_Type_Connect.HMA_I_def j'_def + using Mod_Type.to_nat_from_nat_id[of j, where ?'a = 'n] 2 + using AA' Mod_Type_Connect.dim_col_transfer_rule by force + have "A' $h i' $h j' = 0" using 1 by auto + hence "index_hma A' i' j' = 0" unfolding index_hma_def by simp + thus "A $$ (i, j) = 0" by transfer + qed + thus ?case unfolding is_zero_row_def' is_zero_row_JNF_def by auto +qed + +lemma HMA_echelon_form_mod_type[transfer_rule]: + "((Mod_Type_Connect.HMA_M :: _ \ 'a ::bezout_ring ^ 'n :: mod_type ^ 'm :: mod_type \ _) ===> (=)) + echelon_form_JNF echelon_form" +proof (intro rel_funI, goal_cases) + case (1 A A') + note AA' = "1"(1)[transfer_rule] + have 1: "(\i \ (\j < dim_row A. j>i \ \ is_zero_row_JNF j A)) + = (\i. is_zero_row i A' \ \ (\j>i. \ is_zero_row j A'))" + proof (auto) + fix i' j' assume 1: "\i (\j>i. j < dim_row A \ is_zero_row_JNF j A)" + and 2: "is_zero_row i' A'" and 3: "i' < j'" + let ?i = "Mod_Type.to_nat i'" + let ?j = "Mod_Type.to_nat j'" + have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I ?i i'" and jj'[transfer_rule]: "Mod_Type_Connect.HMA_I ?j j'" + unfolding Mod_Type_Connect.HMA_I_def by auto + have "is_zero_row_JNF ?i A" using 2 by transfer' + hence "is_zero_row_JNF ?j A" using 1 3 to_nat_mono + by (metis AA' Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma\<^sub>m_def + dim_row_mat(1) mod_type_class.to_nat_less_card) + thus "is_zero_row j' A'" by transfer' + next + fix i j assume 1: "\i'. is_zero_row i' A' \ (\j'>i'. is_zero_row j' A')" + and 2: "is_zero_row_JNF i A" and 3: "i < j" and 4: "ji j. i \ (is_zero_row i A') \ \ (is_zero_row j A') + \ ((LEAST n. A' $h i $h n \ 0) < (LEAST n. A' $h j $h n \ 0)))) + = (\i j. i j \ (is_zero_row_JNF i A) \ \ (is_zero_row_JNF j A) + \ ((LEAST n. A $$ (i, n) \ 0) < (LEAST n. A $$ (j, n) \ 0)))" + proof (auto) + fix i j assume 1: "\i' j'. i' < j' \ \ is_zero_row i' A' \ \ is_zero_row j' A' + \ (LEAST n'. A' $h i' $h n' \ 0) < (LEAST n'. A' $h j' $h n' \ 0)" + and ij: "i < j" and j: "j < dim_row A" and i0: "\ is_zero_row_JNF i A" + and j0: "\ is_zero_row_JNF j A" + let ?i' = "Mod_Type.from_nat i::'m" + let ?j' = "Mod_Type.from_nat j::'m" + have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i ?i'" + unfolding Mod_Type_Connect.HMA_I_def using Mod_Type.to_nat_from_nat_id[of i] + using ij j AA' Mod_Type_Connect.dim_row_transfer_rule less_trans by fastforce + have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I j ?j'" + unfolding Mod_Type_Connect.HMA_I_def using Mod_Type.to_nat_from_nat_id[of j] + using ij j AA' Mod_Type_Connect.dim_row_transfer_rule less_trans by fastforce + have i'0: "\ is_zero_row ?i' A'" using i0 by transfer + have j'0: "\ is_zero_row ?j' A'" using j0 by transfer + have i'j': "?i' < ?j'" + using AA' Mod_Type_Connect.dim_row_transfer_rule from_nat_mono ij j by fastforce + have l1l2: "(LEAST n'. A' $h ?i' $h n' \ 0) < (LEAST n'. A' $h ?j' $h n' \ 0)" + using 1 i'0 j'0 i'j' by auto + define l1 where "l1 = (LEAST n'. A' $h ?i' $h n' \ 0)" + define l2 where "l2 = (LEAST n'. A' $h ?j' $h n' \ 0)" + let ?least_n1 = "Mod_Type.to_nat l1" + let ?least_n2 = "Mod_Type.to_nat l2" + have l1[transfer_rule]: "Mod_Type_Connect.HMA_I ?least_n1 l1" and [transfer_rule]: "Mod_Type_Connect.HMA_I ?least_n2 l2" + unfolding Mod_Type_Connect.HMA_I_def by auto + have "(LEAST n. A $$ (i, n) \ 0) = ?least_n1" + proof (rule Least_equality) + obtain n' where n'1: "A $$ (i,n') \ 0" and n'2: "n' 0" using n'1 by transfer + hence A'i'n': "A' $h ?i' $h ?n' \ 0" unfolding index_hma_def by simp + have least_le_n': "(LEAST n. A $$ (i, n) \ 0) \ n'" by (simp add: Least_le n'1) + have l1_le_n': "l1 \ ?n'" by (simp add: A'i'n' Least_le l1_def) + have "A $$ (i, ?least_n1) = index_hma A' ?i' l1" by (transfer, simp) + also have "... = A' $h mod_type_class.from_nat i $h l1" unfolding index_hma_def by simp + also have "... \ 0" unfolding l1_def by (metis (mono_tags, lifting) LeastI i'0 is_zero_row_def') + finally show "A $$ (i, mod_type_class.to_nat l1) \ 0" . + fix y assume Aiy: "A $$ (i, y) \ 0" + let ?y' = "Mod_Type.from_nat y::'n" + show "Mod_Type.to_nat l1 \ y" + proof (cases "y\n'") + case True + hence y: "y < dim_col A" using n'2 by auto + have yy'[transfer_rule]: "Mod_Type_Connect.HMA_I y ?y'" unfolding Mod_Type_Connect.HMA_I_def + apply (rule Mod_Type.to_nat_from_nat_id[symmetric]) + using y Mod_Type_Connect.dim_col_transfer_rule[OF AA'] by auto + have "Mod_Type.to_nat l1 \ Mod_Type.to_nat ?y'" + proof (rule to_nat_mono') + have "index_hma A' ?i' ?y' \ 0" using Aiy by transfer + hence "A' $h ?i' $h ?y' \ 0" unfolding index_hma_def by simp + thus "l1 \ ?y'" unfolding l1_def by (simp add: Least_le) + qed + then show ?thesis by (metis Mod_Type_Connect.HMA_I_def yy') + next + case False + hence "n' < y" by auto + then show ?thesis + by (metis False Mod_Type_Connect.HMA_I_def dual_order.trans l1_le_n' linear n'n' to_nat_mono') + qed + qed + moreover have "(LEAST n. A $$ (j, n) \ 0) = ?least_n2" + proof (rule Least_equality) + obtain n' where n'1: "A $$ (j,n') \ 0" and n'2: "n' 0" using n'1 by transfer + hence A'i'n': "A' $h ?j' $h ?n' \ 0" unfolding index_hma_def by simp + have least_le_n': "(LEAST n. A $$ (j, n) \ 0) \ n'" by (simp add: Least_le n'1) + have l1_le_n': "l2 \ ?n'" by (simp add: A'i'n' Least_le l2_def) + have "A $$ (j, ?least_n2) = index_hma A' ?j' l2" by (transfer, simp) + also have "... = A' $h ?j' $h l2" unfolding index_hma_def by simp + also have "... \ 0" unfolding l2_def by (metis (mono_tags, lifting) LeastI j'0 is_zero_row_def') + finally show "A $$ (j, mod_type_class.to_nat l2) \ 0" . + fix y assume Aiy: "A $$ (j, y) \ 0" + let ?y' = "Mod_Type.from_nat y::'n" + show "Mod_Type.to_nat l2 \ y" + proof (cases "y\n'") + case True + hence y: "y < dim_col A" using n'2 by auto + have yy'[transfer_rule]: "Mod_Type_Connect.HMA_I y ?y'" unfolding Mod_Type_Connect.HMA_I_def + apply (rule Mod_Type.to_nat_from_nat_id[symmetric]) + using y Mod_Type_Connect.dim_col_transfer_rule[OF AA'] by auto + have "Mod_Type.to_nat l2 \ Mod_Type.to_nat ?y'" + proof (rule to_nat_mono') + have "index_hma A' ?j' ?y' \ 0" using Aiy by transfer + hence "A' $h ?j' $h ?y' \ 0" unfolding index_hma_def by simp + thus "l2 \ ?y'" unfolding l2_def by (simp add: Least_le) + qed + then show ?thesis by (metis Mod_Type_Connect.HMA_I_def yy') + next + case False + hence "n' < y" by auto + then show ?thesis + by (metis False Mod_Type_Connect.HMA_I_def dual_order.trans l1_le_n' linear n'n' to_nat_mono') + qed + qed + ultimately show "(LEAST n. A $$ (i, n) \ 0) < (LEAST n. A $$ (j, n) \ 0)" + using l1l2 unfolding l1_def l2_def by (simp add: to_nat_mono) + next + fix i' j' assume 1: "\i j. i < j \ j < dim_row A \ \ is_zero_row_JNF i A \ \ is_zero_row_JNF j A + \ (LEAST n. A $$ (i, n) \ 0) < (LEAST n. A $$ (j, n) \ 0)" + and i'j': "i' < j'" and i': "\ is_zero_row i' A'" and j': "\ is_zero_row j' A'" + let ?i = "Mod_Type.to_nat i'" + let ?j = "Mod_Type.to_nat j'" + have [transfer_rule]: "Mod_Type_Connect.HMA_I ?i i'" + and [transfer_rule]: "Mod_Type_Connect.HMA_I ?j j'" + unfolding Mod_Type_Connect.HMA_I_def by auto + have i: "\ is_zero_row_JNF ?i A" using i' by transfer' + have j: "\ is_zero_row_JNF ?j A" using j' by transfer' + have ij: "?i < ?j" using i'j' to_nat_mono by blast + have j_dim_row: "?j < dim_row A" + using AA' Mod_Type_Connect.dim_row_transfer_rule mod_type_class.to_nat_less_card by fastforce + have least_ij: "(LEAST n. A $$ (?i, n) \ 0) < (LEAST n. A $$ (?j, n) \ 0)" + using i j ij j_dim_row 1 by auto + define l1 where "l1 = (LEAST n'. A $$ (?i, n') \ 0)" + define l2 where "l2 = (LEAST n'. A $$ (?j, n') \ 0)" + let ?least_n1 = "Mod_Type.from_nat l1::'n" + let ?least_n2 = "Mod_Type.from_nat l2::'n" + have l1_dim_col: "l1 < dim_col A" + by (smt is_zero_row_JNF_def j l1_def leI le_less_trans least_ij less_trans not_less_Least) + have l2_dim_col: "l2 < dim_col A" + by (metis (mono_tags, lifting) Least_le is_zero_row_JNF_def j l2_def le_less_trans) + have [transfer_rule]: "Mod_Type_Connect.HMA_I l1 ?least_n1" unfolding Mod_Type_Connect.HMA_I_def + using AA' Mod_Type_Connect.dim_col_transfer_rule l1_dim_col Mod_Type.to_nat_from_nat_id + by fastforce + have [transfer_rule]: "Mod_Type_Connect.HMA_I l2 ?least_n2" unfolding Mod_Type_Connect.HMA_I_def + using AA' Mod_Type_Connect.dim_col_transfer_rule l2_dim_col Mod_Type.to_nat_from_nat_id + by fastforce + have "(LEAST n. A' $h i' $h n \ 0) = ?least_n1" + proof (rule Least_equality) + obtain n' where n'1: "A' $h i' $h n' \ 0" using i' unfolding is_zero_row_def' by auto + have "A' $h i' $h ?least_n1 = index_hma A' i' ?least_n1" unfolding index_hma_def by simp + also have "... = A$$ (?i, l1)" by (transfer, simp) + also have "... \ 0" by (metis (mono_tags, lifting) LeastI i is_zero_row_JNF_def l1_def) + finally show "A' $h i' $h ?least_n1 \ 0" . + next + fix y assume y: "A' $h i' $h y \ 0" + let ?y' = "Mod_Type.to_nat y" + have [transfer_rule]: "Mod_Type_Connect.HMA_I ?y' y" unfolding Mod_Type_Connect.HMA_I_def by simp + have "?least_n1 \ Mod_Type.from_nat ?y'" + proof (unfold l1_def, rule from_nat_mono') + show "Mod_Type.to_nat y < CARD('n)" by (simp add: mod_type_class.to_nat_less_card) + have *: "A $$ (mod_type_class.to_nat i', mod_type_class.to_nat y) \ 0" + using y[unfolded index_hma_def[symmetric]] by transfer' + show "(LEAST n'. A $$ (mod_type_class.to_nat i', n') \ 0) \ mod_type_class.to_nat y" + by (rule Least_le, simp add: *) + qed + also have "... = y" by simp + finally show "?least_n1 \ y" . + qed + moreover have "(LEAST n. A' $h j' $h n \ 0) = ?least_n2" + proof (rule Least_equality) + obtain n' where n'1: "A' $h j' $h n' \ 0" using j' unfolding is_zero_row_def' by auto + have "A' $h j' $h ?least_n2 = index_hma A' j' ?least_n2" unfolding index_hma_def by simp + also have "... = A$$ (?j, l2)" by (transfer, simp) + also have "... \ 0" by (metis (mono_tags, lifting) LeastI j is_zero_row_JNF_def l2_def) + finally show "A' $h j' $h ?least_n2 \ 0" . + next + fix y assume y: "A' $h j' $h y \ 0" + let ?y' = "Mod_Type.to_nat y" + have [transfer_rule]: "Mod_Type_Connect.HMA_I ?y' y" unfolding Mod_Type_Connect.HMA_I_def by simp + have "?least_n2 \ Mod_Type.from_nat ?y'" + proof (unfold l2_def, rule from_nat_mono') + show "Mod_Type.to_nat y < CARD('n)" by (simp add: mod_type_class.to_nat_less_card) + have *: "A $$ (mod_type_class.to_nat j', mod_type_class.to_nat y) \ 0" + using y[unfolded index_hma_def[symmetric]] by transfer' + show "(LEAST n'. A $$ (mod_type_class.to_nat j', n') \ 0) \ mod_type_class.to_nat y" + by (rule Least_le, simp add: *) + qed + also have "... = y" by simp + finally show "?least_n2 \ y" . + qed + ultimately show "(LEAST n. A' $h i' $h n \ 0) < (LEAST n. A' $h j' $h n \ 0)" using least_ij + unfolding l1_def l2_def + using AA' Mod_Type_Connect.dim_col_transfer_rule from_nat_mono l2_def l2_dim_col + by fastforce + qed + show ?case unfolding echelon_form_JNF_def echelon_form_def' using 1 2 by auto +qed + + +definition Hermite_JNF :: "'a::{bezout_ring_div,normalization_semidom} set \ ('a \ 'a set) \ 'a mat \ bool" + where "Hermite_JNF associates residues A = ( + Complete_set_non_associates associates \ (Complete_set_residues residues) \ echelon_form_JNF A + \ (\i is_zero_row_JNF i A \ A $$ (i, LEAST n. A $$ (i, n) \ 0) \ associates) + \ (\i is_zero_row_JNF i A \ (\j. j A $$ (j, (LEAST n. A $$ (i, n) \ 0)) + \ residues (A $$ (i,(LEAST n. A $$ (i,n) \ 0))) + )))" + + +lemma HMA_LEAST[transfer_rule]: + assumes AA': "(Mod_Type_Connect.HMA_M :: _ \ 'a :: comm_ring_1 ^ 'n :: mod_type ^ 'm :: mod_type \ _) A A'" + and ii': "Mod_Type_Connect.HMA_I i i'" and zero_i: "\ is_zero_row_JNF i A" +shows "Mod_Type_Connect.HMA_I (LEAST n. A $$ (i, n) \ 0) (LEAST n. index_hma A' i' n \ 0)" +proof - + define l where "l = (LEAST n'. A' $h i' $h n' \ 0)" + let ?least_n2 = "Mod_Type.to_nat l" + note AA'[transfer_rule] ii'[transfer_rule] + have [transfer_rule]: "Mod_Type_Connect.HMA_I ?least_n2 l" + by (simp add: Mod_Type_Connect.HMA_I_def) + have zero_i': "\ is_zero_row i' A'" using zero_i by transfer + have "(LEAST n. A $$ (i, n) \ 0) = ?least_n2" + proof (rule Least_equality) + obtain n' where n'1: "A $$ (i,n') \ 0" and n'2: "n' 0" using n'1 by transfer + hence A'i'n': "A' $h i' $h ?n' \ 0" unfolding index_hma_def by simp + have least_le_n': "(LEAST n. A $$ (i, n) \ 0) \ n'" by (simp add: Least_le n'1) + have l1_le_n': "l \ ?n'" by (simp add: A'i'n' Least_le l_def) + have "A $$ (i, ?least_n2) = index_hma A' i' l" by (transfer, simp) + also have "... = A' $h i' $h l" unfolding index_hma_def by simp + also have "... \ 0" unfolding l_def by (metis (mono_tags) A'i'n' LeastI) + finally show "A $$ (i, mod_type_class.to_nat l) \ 0" . + fix y assume Aiy: "A $$ (i, y) \ 0" + let ?y' = "Mod_Type.from_nat y::'n" + show "Mod_Type.to_nat l \ y" + proof (cases "y\n'") + case True + hence y: "y < dim_col A" using n'2 by auto + have yy'[transfer_rule]: "Mod_Type_Connect.HMA_I y ?y'" unfolding Mod_Type_Connect.HMA_I_def + apply (rule Mod_Type.to_nat_from_nat_id[symmetric]) + using y Mod_Type_Connect.dim_col_transfer_rule[OF AA'] by auto + have "Mod_Type.to_nat l \ Mod_Type.to_nat ?y'" + proof (rule to_nat_mono') + have "index_hma A' i' ?y' \ 0" using Aiy by transfer + hence "A' $h i' $h ?y' \ 0" unfolding index_hma_def by simp + thus "l \ ?y'" unfolding l_def by (simp add: Least_le) + qed + then show ?thesis by (metis Mod_Type_Connect.HMA_I_def yy') + next + case False + hence "n' < y" by auto + then show ?thesis + by (metis False Mod_Type_Connect.HMA_I_def dual_order.trans l1_le_n' linear n'n' to_nat_mono') + qed + qed + thus ?thesis unfolding Mod_Type_Connect.HMA_I_def l_def index_hma_def by auto +qed + + +lemma element_least_not_zero_eq_HMA_JNF: + fixes A':: "'a :: comm_ring_1 ^ 'n :: mod_type ^ 'm :: mod_type" + assumes AA': "Mod_Type_Connect.HMA_M A A'" and jj': "Mod_Type_Connect.HMA_I j j'" + and ii': "Mod_Type_Connect.HMA_I i i'" and zero_i': "\ is_zero_row i' A'" + shows "A $$ (j, LEAST n. A $$ (i, n) \ 0) = A' $h j' $h (LEAST n. A' $h i' $h n \ 0)" +proof - + note AA'[transfer_rule] jj'[transfer_rule] ii'[transfer_rule] + have [transfer_rule]: "Mod_Type_Connect.HMA_I (LEAST n. A $$ (i, n) \ 0) (LEAST n. index_hma A' i' n \ 0)" + by (rule HMA_LEAST[OF AA' ii'], insert zero_i', transfer, simp) + have "A' $h j' $h (LEAST n. A' $h i' $h n \ 0) = index_hma A' j' (LEAST n. index_hma A' i' n \ 0)" + unfolding index_hma_def by simp + also have "... = A $$ (j, LEAST n. A $$ (i, n) \ 0)" by (transfer', simp) + finally show ?thesis by simp +qed + + +lemma HMA_Hermite[transfer_rule]: + shows "((Mod_Type_Connect.HMA_M :: _ \ 'a :: {bezout_ring_div,normalization_semidom} ^ 'n :: mod_type ^ 'm :: mod_type \ _) ===> (=)) + (Hermite_JNF associates residues) (Hermite associates residues)" +proof (intro rel_funI, goal_cases) + case (1 A A') + note AA' = "1"(1)[transfer_rule] + have 1: "echelon_form A' = echelon_form_JNF A" by (transfer, simp) + have 2: "(\i is_zero_row_JNF i A \ A $$ (i, LEAST n. A $$ (i, n) \ 0) \ associates) = + (\i. \ is_zero_row i A' \ A' $h i $h (LEAST n. A' $h i $h n \ 0) \ associates)" (is "?lhs = ?rhs") + proof + assume lhs: "?lhs" + show "?rhs" + proof (rule allI, rule impI) + fix i' assume zero_i': "\ is_zero_row i' A'" + let ?i = "Mod_Type.to_nat i'" + have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I ?i i'" unfolding Mod_Type_Connect.HMA_I_def by simp + have [simp]: "?i < dim_row A" using Mod_Type.to_nat_less_card[of i'] + using AA' Mod_Type_Connect.dim_row_transfer_rule by fastforce + have zero_i: "\ is_zero_row_JNF ?i A" using zero_i' by transfer + have [transfer_rule]: "Mod_Type_Connect.HMA_I (LEAST n. A $$ (?i, n) \ 0) (LEAST n. index_hma A' i' n \ 0)" + by (rule HMA_LEAST[OF AA' ii'], insert zero_i', transfer, simp) + have "A' $h i' $h (LEAST n. A' $h i' $h n \ 0) = A $$ (?i, LEAST n. A $$ (?i, n) \ 0)" + by (rule element_least_not_zero_eq_HMA_JNF[OF AA' ii' ii' zero_i', symmetric]) + also have "... \ associates" using lhs zero_i by simp + finally show "A' $h i' $h (LEAST n. A' $h i' $h n \ 0) \ associates" . + qed + next + assume rhs: "?rhs" + show "?lhs" + proof (rule allI, rule impI, rule impI) + fix i assume zero_i: "\ is_zero_row_JNF i A" and i: "i < dim_row A" + let ?i' = "Mod_Type.from_nat i :: 'm" + have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i ?i'" unfolding Mod_Type_Connect.HMA_I_def + using Mod_Type.to_nat_from_nat_id AA' Mod_Type_Connect.dim_row_transfer_rule i by fastforce + have zero_i': "\ is_zero_row ?i' A'" using zero_i by transfer + have "A $$ (i, LEAST n. A $$ (i, n) \ 0) = A' $h ?i' $h (LEAST n. A' $h ?i' $h n \ 0)" + by (rule element_least_not_zero_eq_HMA_JNF[OF AA' ii' ii' zero_i']) + also have "... \ associates" using rhs zero_i' i by simp + finally show "A $$ (i, LEAST n. A $$ (i, n) \ 0) \ associates" . + qed + qed + have 3: "(\i is_zero_row_JNF i A \ (\j 0) + \ residues (A $$ (i, LEAST n. A $$ (i, n) \ 0)))) = + (\i. \ is_zero_row i A' \ (\j 0) + \ residues (A' $h i $h (LEAST n. A' $h i $h n \ 0))))" (is "?lhs = ?rhs") + proof + assume lhs: "?lhs" + show "?rhs" + proof (rule allI, rule impI, rule allI, rule impI) + fix i' j' :: 'm + assume zero_i': "\ is_zero_row i' A'" and j'i': "j' < i'" + let ?i = "Mod_Type.to_nat i'" + have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I ?i i'" unfolding Mod_Type_Connect.HMA_I_def by simp + have i: "?i < dim_row A" + using AA' Mod_Type_Connect.dim_row_transfer_rule mod_type_class.to_nat_less_card + by fastforce + have zero_i: "\ is_zero_row_JNF ?i A" using zero_i' by transfer' + let ?j = "Mod_Type.to_nat j'" + have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I ?j j'" unfolding Mod_Type_Connect.HMA_I_def by simp + have ji: "?j 0) = A' $h j' $h (LEAST n. A' $h i' $h n \ 0)" + by (rule element_least_not_zero_eq_HMA_JNF[OF AA' jj' ii' zero_i']) + have eq2: "A $$ (?i, LEAST n. A $$ (?i, n) \ 0) = A' $h i' $h (LEAST n. A' $h i' $h n \ 0)" + by (rule element_least_not_zero_eq_HMA_JNF[OF AA' ii' ii' zero_i']) + show "A' $h j' $h (LEAST n. A' $h i' $h n \ 0) \ residues (A' $h i' $h (LEAST n. A' $h i' $h n \ 0))" + using lhs eq1 eq2 ji i zero_i by fastforce + qed + next + assume rhs: "?rhs" + show "?lhs" + proof (safe) + fix i j assume i: "i < dim_row A" and zero_i: "\ is_zero_row_JNF i A" and ji: "j < i" + let ?i' = "Mod_Type.from_nat i :: 'm" + have ii'[transfer_rule]: "Mod_Type_Connect.HMA_I i ?i'" unfolding Mod_Type_Connect.HMA_I_def + using Mod_Type.to_nat_from_nat_id AA' Mod_Type_Connect.dim_row_transfer_rule i by fastforce + have zero_i': "\ is_zero_row ?i' A'" using zero_i by transfer + let ?j' = "Mod_Type.from_nat j :: 'm" + have j'i': "?j' < ?i'" using AA' Mod_Type_Connect.dim_row_transfer_rule from_nat_mono i ji + by fastforce + have jj'[transfer_rule]: "Mod_Type_Connect.HMA_I j ?j'" unfolding Mod_Type_Connect.HMA_I_def + using Mod_Type.to_nat_from_nat_id[of j, where ?'a='m] AA' + Mod_Type_Connect.dim_row_transfer_rule[OF AA'] j'i' i ji by auto + have zero_i': "\ is_zero_row ?i' A'" using zero_i by transfer + have eq1: "A $$ (j, LEAST n. A $$ (i, n) \ 0) = A' $h ?j' $h (LEAST n. A' $h ?i' $h n \ 0)" + by (rule element_least_not_zero_eq_HMA_JNF[OF AA' jj' ii' zero_i']) + have eq2: "A $$ (i, LEAST n. A $$ (i, n) \ 0) = A' $h ?i' $h (LEAST n. A' $h ?i' $h n \ 0)" + by (rule element_least_not_zero_eq_HMA_JNF[OF AA' ii' ii' zero_i']) + show "A $$ (j, LEAST n. A $$ (i, n) \ 0) \ residues (A $$ (i, LEAST n. A $$ (i, n) \ 0))" + using rhs eq1 eq2 j'i' i zero_i' by fastforce + qed + qed + show "Hermite_JNF associates residues A = Hermite associates residues A'" + unfolding Hermite_def Hermite_JNF_def + using 1 2 3 by auto +qed + + +corollary HMA_Hermite2[transfer_rule]: + shows "((=) ===> (=) ===> (Mod_Type_Connect.HMA_M :: _ + \ 'a :: {bezout_ring_div,normalization_semidom} ^ 'n :: mod_type ^ 'm :: mod_type \ _) ===> (=)) + (Hermite_JNF) (Hermite)" + by (simp add: HMA_Hermite rel_funI) + + +text \Once the definitions of both libraries are connected, we start to move the theorem about +the uniqueness of the Hermite normal form (stated in HOL Analysis, named @{text "Hermite_unique"}) +to JNF.\ + + +text \Using the previous transfer rules, we get an statement in JNF. However, the matrices +have @{text "CARD('n::mod_type)"} rows and columns. We want to get rid of that type variable and +just state that they are of dimension $n \times n$ (expressed via the predicate @{text "carrier_mat"}\ + +lemma Hermite_unique_JNF': + fixes A::"'a::{bezout_ring_div,normalization_euclidean_semiring,unique_euclidean_ring} mat" + assumes "A \ carrier_mat CARD('n::mod_type) CARD('n::mod_type)" + "P \ carrier_mat CARD('n::mod_type) CARD('n::mod_type)" + "H \ carrier_mat CARD('n::mod_type) CARD('n::mod_type)" + "Q \ carrier_mat CARD('n::mod_type) CARD('n::mod_type)" + "K \ carrier_mat CARD('n::mod_type) CARD('n::mod_type)" + assumes "A = P * H" + and "A = Q * K" and "invertible_mat A" and "invertible_mat P" + and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K" +shows "H = K" +proof - + define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: 'a ^'n :: mod_type ^'n :: mod_type)" + define P' where "P' = (Mod_Type_Connect.to_hma\<^sub>m P :: 'a ^'n :: mod_type ^'n :: mod_type)" + define H' where "H' = (Mod_Type_Connect.to_hma\<^sub>m H :: 'a ^'n :: mod_type ^'n :: mod_type)" + define Q' where "Q' = (Mod_Type_Connect.to_hma\<^sub>m Q :: 'a ^'n :: mod_type ^'n :: mod_type)" + define K' where "K' = (Mod_Type_Connect.to_hma\<^sub>m K :: 'a ^'n :: mod_type ^'n :: mod_type)" + have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto + have PP'[transfer_rule]: "Mod_Type_Connect.HMA_M P P'" unfolding Mod_Type_Connect.HMA_M_def using assms P'_def by auto + have HH'[transfer_rule]: "Mod_Type_Connect.HMA_M H H'" unfolding Mod_Type_Connect.HMA_M_def using assms H'_def by auto + have QQ'[transfer_rule]: "Mod_Type_Connect.HMA_M Q Q'" unfolding Mod_Type_Connect.HMA_M_def using assms Q'_def by auto + have KK'[transfer_rule]: "Mod_Type_Connect.HMA_M K K'" unfolding Mod_Type_Connect.HMA_M_def using assms K'_def by auto + have A_PH: "A' = P' ** H'" using assms by transfer + moreover have A_QK: "A' = Q' ** K'" using assms by transfer + moreover have inv_A: "invertible A'" using assms by transfer + moreover have inv_P: "invertible P'" using assms by transfer + moreover have inv_Q: "invertible Q'" using assms by transfer + moreover have H: "Hermite associates res H'" using assms by transfer + moreover have K: "Hermite associates res K'" using assms by transfer + ultimately have "H' = K'" using Hermite_unique by blast + thus "H=K" by transfer +qed + + + + +text \Since the @{text "mod_type"} restriction relies on many things, the shortcut is to use +the @{text "mod_ring"} typedef developed in the Berlekamp-Zassenhaus development. +This type definition allows us to apply local type definitions easily. +Since @{text "mod_ring"} is just an instance of @{text "mod_type"}, it is straightforward to +obtain the following lemma, where @{text "CARD('n::mod_type)"} has now been substituted by +@{text "CARD('n::nontriv mod_ring)"}\ + +corollary Hermite_unique_JNF_with_nontriv_mod_ring: + fixes A::"'a::{bezout_ring_div,normalization_euclidean_semiring,unique_euclidean_ring} mat" + assumes "A \ carrier_mat CARD('n) CARD('n::nontriv mod_ring)" + "P \ carrier_mat CARD('n) CARD('n)" + "H \ carrier_mat CARD('n) CARD('n)" + "Q \ carrier_mat CARD('n) CARD('n)" + "K \ carrier_mat CARD('n) CARD('n)" + assumes "A = P * H" + and "A = Q * K" and "invertible_mat A" and "invertible_mat P" + and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K" +shows "H = K" using Hermite_unique_JNF' assms by (smt CARD_mod_ring) + +text \Now, we assume in a context that there exists a type text @{text "'b"} of cardinality $n$ +and we prove inside this context the lemma.\ + +context + fixes n::nat + assumes local_typedef: "\(Rep :: ('b \ int)) Abs. type_definition Rep Abs {0..1" +begin + +private lemma type_to_set: + shows "class.nontriv TYPE('b)" (is ?a) and "n=CARD('b)" (is ?b) +proof - + from local_typedef obtain Rep::"('b \ int)" and Abs + where t: "type_definition Rep Abs {0.. carrier_mat n n" + "P \ carrier_mat n n" + "H \ carrier_mat n n" + "Q \ carrier_mat n n " + "K \ carrier_mat n n" + assumes "A = P * H" + and "A = Q * K" and "invertible_mat A" and "invertible_mat P" + and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K" +shows "H = K" + using Hermite_unique_JNF_with_nontriv_mod_ring[unfolded CARD_mod_ring, + internalize_sort "'n::nontriv", where ?'a='b] + unfolding type_to_set(2)[symmetric] using type_to_set(1) assms by blast +end + +text \Now, we cancel the local type definition of the previous context. +Since the @{text "mod_type"} restriction imposes the type to have cardinality greater than 1, +the cases $n=0$ and $n=1$ must be proved separately (they are trivial)\ + +lemma Hermite_unique_JNF: + fixes A::"'a::{bezout_ring_div,normalization_euclidean_semiring,unique_euclidean_ring} mat" + assumes A: "A \ carrier_mat n n" and P: "P \ carrier_mat n n" and H: "H \ carrier_mat n n" + and Q: "Q \ carrier_mat n n" and K: "K \ carrier_mat n n" + assumes A_PH: "A = P * H" and A_QK: "A = Q * K" + and inv_A: "invertible_mat A" and inv_P: "invertible_mat P" and inv_Q: "invertible_mat Q" + and HNF_H: "Hermite_JNF associates res H" and HNF_K: "Hermite_JNF associates res K" + shows "H = K" +proof (cases "n=0 \ n=1") + case True note zero_or_one = True + show ?thesis + proof (cases "n=0") + case True + then show ?thesis using assms by auto + next + case False + have CS_A: "Complete_set_non_associates associates" using HNF_H unfolding Hermite_JNF_def by simp + have H: "H \ carrier_mat 1 1" and K: "K\ carrier_mat 1 1" using False zero_or_one assms by auto + have det_P_dvd_1: "Determinant.det P dvd 1" using invertible_iff_is_unit_JNF inv_P P by blast + have det_Q_dvd_1: "Determinant.det Q dvd 1" using invertible_iff_is_unit_JNF inv_Q Q by blast + have PH_QK: "Determinant.det P * Determinant.det H = Determinant.det Q * Determinant.det K" + using Determinant.det_mult assms by metis + hence "Determinant.det P * H $$ (0,0) = Determinant.det Q * K $$ (0,0)" + by (metis H K determinant_one_element) + obtain u where uH_K: "u * H $$(0,0) = K $$ (0,0)" and unit_u: "is_unit u" + by (metis (no_types, hide_lams) H K PH_QK algebraic_semidom_class.dvd_mult_unit_iff det_P_dvd_1 + det_Q_dvd_1 det_singleton dvdE dvd_mult_cancel_left mult.commute mult.right_neutral one_dvd) + have H00_not_0: "H $$ (0,0) \ 0" + by (metis A A_PH Determinant.det_mult False H P determinant_one_element inv_A + invertible_iff_is_unit_JNF mult_not_zero not_is_unit_0 zero_or_one) + hence LEAST_H: "(LEAST n. H $$ (0,n) \ 0) = 0" by simp + have H00: "H $$ (0,0) \ associates" using HNF_H LEAST_H H H00_not_0 + unfolding Hermite_JNF_def is_zero_row_JNF_def by auto + have K00_not_0: "K $$ (0,0) \ 0" + by (metis A A_QK Determinant.det_mult False K Q determinant_one_element inv_A + invertible_iff_is_unit_JNF mult_not_zero not_is_unit_0 zero_or_one) + hence LEAST_K: "(LEAST n. K $$ (0,n) \ 0) = 0" by simp + have K00: "K $$ (0,0) \ associates" using HNF_K LEAST_K K K00_not_0 + unfolding Hermite_JNF_def is_zero_row_JNF_def by auto + have ass_H00_K00: "normalize (H $$ (0,0)) = normalize (K $$ (0,0))" + by (metis normalize_mult_unit_left uH_K unit_u) + have H00_eq_K00: "H $$ (0,0) = K $$ (0,0)" + using in_Ass_not_associated[OF CS_A H00 K00] ass_H00_K00 by auto + show ?thesis by (rule eq_matI, insert H K H00_eq_K00, auto) + qed +next + case False + hence "{0.. {}" by auto + moreover have "n>1" using False by simp + ultimately show ?thesis using Hermite_unique_JNF_aux[cancel_type_definition] assms by metis (*Cancel local type definition*) +qed + +end + +text \From here on, we apply the same approach to move the new generalized statement about +the uniqueness Hermite normal form, i.e., the version restricted to integer matrices, but imposing +invertibility over the rationals.\ + +(*TODO: move to Mod_Type_Connect in SNF development. + There are two definitions of map_matrix, one in HMA_Connect and one in Finite_Cartesian_Product, + but they are the same.*) +lemma HMA_map_matrix [transfer_rule]: + "((=) ===> Mod_Type_Connect.HMA_M ===> Mod_Type_Connect.HMA_M) map_mat map_matrix" + unfolding map_vector_def map_matrix_def[abs_def] map_mat_def[abs_def] + Mod_Type_Connect.HMA_M_def Mod_Type_Connect.from_hma\<^sub>m_def + by auto + + + +lemma Hermite_unique_generalized_JNF': + fixes A::"int mat" + assumes "A \ carrier_mat CARD('n::mod_type) CARD('n::mod_type)" + "P \ carrier_mat CARD('n::mod_type) CARD('n::mod_type)" + "H \ carrier_mat CARD('n::mod_type) CARD('n::mod_type)" + "Q \ carrier_mat CARD('n::mod_type) CARD('n::mod_type)" + "K \ carrier_mat CARD('n::mod_type) CARD('n::mod_type)" + assumes "A = P * H" + and "A = Q * K" and "invertible_mat (map_mat rat_of_int A)" and "invertible_mat P" + and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K" +shows "H = K" +proof - + define A' where "A' = (Mod_Type_Connect.to_hma\<^sub>m A :: int ^'n :: mod_type ^'n :: mod_type)" + define P' where "P' = (Mod_Type_Connect.to_hma\<^sub>m P :: int ^'n :: mod_type ^'n :: mod_type)" + define H' where "H' = (Mod_Type_Connect.to_hma\<^sub>m H :: int ^'n :: mod_type ^'n :: mod_type)" + define Q' where "Q' = (Mod_Type_Connect.to_hma\<^sub>m Q :: int ^'n :: mod_type ^'n :: mod_type)" + define K' where "K' = (Mod_Type_Connect.to_hma\<^sub>m K :: int ^'n :: mod_type ^'n :: mod_type)" + have AA'[transfer_rule]: "Mod_Type_Connect.HMA_M A A'" unfolding Mod_Type_Connect.HMA_M_def using assms A'_def by auto + have PP'[transfer_rule]: "Mod_Type_Connect.HMA_M P P'" unfolding Mod_Type_Connect.HMA_M_def using assms P'_def by auto + have HH'[transfer_rule]: "Mod_Type_Connect.HMA_M H H'" unfolding Mod_Type_Connect.HMA_M_def using assms H'_def by auto + have QQ'[transfer_rule]: "Mod_Type_Connect.HMA_M Q Q'" unfolding Mod_Type_Connect.HMA_M_def using assms Q'_def by auto + have KK'[transfer_rule]: "Mod_Type_Connect.HMA_M K K'" unfolding Mod_Type_Connect.HMA_M_def using assms K'_def by auto + have A_PH: "A' = P' ** H'" using assms by transfer + moreover have A_QK: "A' = Q' ** K'" using assms by transfer + moreover have inv_A: "invertible (map_matrix rat_of_int A')" using assms by transfer + moreover have "invertible (Finite_Cartesian_Product.map_matrix rat_of_int A')" + using inv_A unfolding Finite_Cartesian_Product.map_matrix_def map_matrix_def map_vector_def + by simp + moreover have inv_P: "invertible P'" using assms by transfer + moreover have inv_Q: "invertible Q'" using assms by transfer + moreover have H: "Hermite associates res H'" using assms by transfer + moreover have K: "Hermite associates res K'" using assms by transfer + ultimately have "H' = K'" using Hermite_unique_generalized by blast + thus "H=K" by transfer +qed + + +corollary Hermite_unique_generalized_JNF_with_nontriv_mod_ring: + fixes A::"int mat" + assumes "A \ carrier_mat CARD('n) CARD('n::nontriv mod_ring)" + "P \ carrier_mat CARD('n) CARD('n)" + "H \ carrier_mat CARD('n) CARD('n)" + "Q \ carrier_mat CARD('n) CARD('n)" + "K \ carrier_mat CARD('n) CARD('n)" + assumes "A = P * H" + and "A = Q * K" and "invertible_mat (map_mat rat_of_int A)" and "invertible_mat P" + and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K" +shows "H = K" using Hermite_unique_generalized_JNF' assms by (smt CARD_mod_ring) + + + + +context + fixes p::nat + assumes local_typedef: "\(Rep :: ('b \ int)) Abs. type_definition Rep Abs {0..

1" +begin + +private lemma type_to_set2: + shows "class.nontriv TYPE('b)" (is ?a) and "p=CARD('b)" (is ?b) +proof - + from local_typedef obtain Rep::"('b \ int)" and Abs + where t: "type_definition Rep Abs {0..

carrier_mat p p" + "P \ carrier_mat p p" + "H \ carrier_mat p p" + "Q \ carrier_mat p p" + "K \ carrier_mat p p" + assumes "A = P * H" + and "A = Q * K" and "invertible_mat (map_mat rat_of_int A)" and "invertible_mat P" + and "invertible_mat Q" and "Hermite_JNF associates res H" and "Hermite_JNF associates res K" +shows "H = K" + using Hermite_unique_generalized_JNF_with_nontriv_mod_ring[unfolded CARD_mod_ring, + internalize_sort "'n::nontriv", where ?'a='b] + unfolding type_to_set2(2)[symmetric] using type_to_set2(1) assms by blast +end + + +lemma HNF_unique_generalized_JNF: + fixes A::"int mat" + assumes A: "A \ carrier_mat n n" and P: "P \ carrier_mat n n" and H: "H \ carrier_mat n n" + and Q: "Q \ carrier_mat n n" and K: "K \ carrier_mat n n" + assumes A_PH: "A = P * H" and A_QK: "A = Q * K" + and inv_A: "invertible_mat (map_mat rat_of_int A)" and inv_P: "invertible_mat P" and inv_Q: "invertible_mat Q" + and HNF_H: "Hermite_JNF associates res H" and HNF_K: "Hermite_JNF associates res K" + shows "H = K" +proof (cases "n=0 \ n=1") + case True note zero_or_one = True + show ?thesis + proof (cases "n=0") + case True + then show ?thesis using assms by auto + next + let ?RAT = "map_mat rat_of_int" + case False + hence n: "n=1" using zero_or_one by auto + have CS_A: "Complete_set_non_associates associates" using HNF_H unfolding Hermite_JNF_def by simp + have H: "H \ carrier_mat 1 1" and K: "K\ carrier_mat 1 1" using False zero_or_one assms by auto + have det_P_dvd_1: "Determinant.det P dvd 1" using invertible_iff_is_unit_JNF inv_P P by blast + have det_Q_dvd_1: "Determinant.det Q dvd 1" using invertible_iff_is_unit_JNF inv_Q Q by blast + have PH_QK: "Determinant.det P * Determinant.det H = Determinant.det Q * Determinant.det K" + using Determinant.det_mult assms by metis + hence "Determinant.det P * H $$ (0,0) = Determinant.det Q * K $$ (0,0)" + by (metis H K determinant_one_element) + obtain u where uH_K: "u * H $$(0,0) = K $$ (0,0)" and unit_u: "is_unit u" + by (metis (no_types, hide_lams) H K PH_QK algebraic_semidom_class.dvd_mult_unit_iff det_P_dvd_1 + det_Q_dvd_1 det_singleton dvdE dvd_mult_cancel_left mult.commute mult.right_neutral one_dvd) + have H00_not_0: "H $$ (0,0) \ 0" + proof - + have "?RAT A = ?RAT P * ?RAT H" using A_PH + using P H n of_int_hom.mat_hom_mult by blast + hence "det (?RAT H) \ 0" + by (metis A Determinant.det_mult False H P inv_A invertible_iff_is_unit_JNF + map_carrier_mat mult_eq_0_iff not_is_unit_0 zero_or_one) + thus ?thesis + using H determinant_one_element by force + qed + hence LEAST_H: "(LEAST n. H $$ (0,n) \ 0) = 0" by simp + have H00: "H $$ (0,0) \ associates" using HNF_H LEAST_H H H00_not_0 + unfolding Hermite_JNF_def is_zero_row_JNF_def by auto + have K00_not_0: "K $$ (0,0) \ 0" + proof - + have "?RAT A = ?RAT Q * ?RAT K" using A_QK + using Q K n of_int_hom.mat_hom_mult by blast + hence "det (?RAT K) \ 0" + by (metis A Determinant.det_mult False Q K inv_A invertible_iff_is_unit_JNF + map_carrier_mat mult_eq_0_iff not_is_unit_0 zero_or_one) + thus ?thesis + using K determinant_one_element by force + qed + hence LEAST_K: "(LEAST n. K $$ (0,n) \ 0) = 0" by simp + have K00: "K $$ (0,0) \ associates" using HNF_K LEAST_K K K00_not_0 + unfolding Hermite_JNF_def is_zero_row_JNF_def by auto + have ass_H00_K00: "normalize (H $$ (0,0)) = normalize (K $$ (0,0))" + by (metis normalize_mult_unit_left uH_K unit_u) + have H00_eq_K00: "H $$ (0,0) = K $$ (0,0)" + using in_Ass_not_associated[OF CS_A H00 K00] ass_H00_K00 by auto + show ?thesis by (rule eq_matI, insert H K H00_eq_K00, auto) + qed +next + case False + hence "{0.. {}" by auto + moreover have "n>1" using False by simp + ultimately show ?thesis + using Hermite_unique_generalized_JNF_aux[cancel_type_definition] assms by metis (*Cancel local type definition*) +qed + +end diff --git a/thys/Modular_arithmetic_LLL_and_HNF_algorithms/document/root.tex b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Modular_arithmetic_LLL_and_HNF_algorithms/document/root.tex @@ -0,0 +1,66 @@ +\documentclass[11pt,a4paper]{article} +\usepackage{isabelle,isabellesym} + +% further packages required for unusual symbols (see also +% isabellesym.sty), use only when needed + +%\usepackage{amssymb} + %for \, \, \, \, \, \, + %\, \, \, \, \, + %\, \, \ + +%\usepackage{eurosym} + %for \ + +%\usepackage[only,bigsqcap]{stmaryrd} + %for \ + +%\usepackage{eufrak} + %for \ ... \, \ ... \ (also included in amssymb) + +%\usepackage{textcomp} + %for \, \, \, \, \, + %\ + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + +% for uniform font size +%\renewcommand{\isastyle}{\isastyleminor} + + +\begin{document} + +\title{Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation\footnote{Supported +by FWF (Austrian Science Fund) project Y757 +and by project MTM2017-88804-P (Spanish Ministry of Science and Innovation).}} +%\title{Modulo arithmetic-based algorithms for lattice basis reduction and for computing the Hermite normal form} +\author{Ralph Bottesch \and Jose Divas\'on \and Ren\'e Thiemann} +\maketitle + +\begin{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. +\end{abstract} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +% optional bibliography +%\bibliographystyle{abbrv} +%\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/Ordinal_Partitions/Erdos_Milner.thy b/thys/Ordinal_Partitions/Erdos_Milner.thy --- a/thys/Ordinal_Partitions/Erdos_Milner.thy +++ b/thys/Ordinal_Partitions/Erdos_Milner.thy @@ -1,1349 +1,1320 @@ theory Erdos_Milner imports Partitions begin subsection \Erdős-Milner theorem\ text \P. Erdős and E. C. Milner, A Theorem in the Partition Calculus. Canadian Math. Bull. 15:4 (1972), 501-505. Corrigendum, Canadian Math. Bull. 17:2 (1974), 305.\ text \The paper defines strong types as satisfying the criteria below. It remarks that ordinals satisfy those criteria. Here is a (too complicated) proof.\ proposition strong_ordertype_eq: assumes D: "D \ elts \" and "Ord \" obtains L where "\(List.set L) = D" "\X. X \ List.set L \ indecomposable (tp X)" and "\M. \M \ D; \X. X \ List.set L \ tp (M \ X) \ tp X\ \ tp M = tp D" proof - define \ where "\ \ inv_into D (ordermap D VWF)" then have bij_\: "bij_betw \ (elts (tp D)) D" using D bij_betw_inv_into down ordermap_bij by blast have \_cancel_left: "\d. d \ D \ \ (ordermap D VWF d) = d" by (metis D \_def bij_betw_inv_into_left down_raw ordermap_bij small_iff_range total_on_VWF wf_VWF) have \_cancel_right: "\\. \ \ elts (tp D) \ ordermap D VWF (\ \) = \" by (metis \_def f_inv_into_f ordermap_surj subsetD) have "small D" "D \ ON" using assms down elts_subset_ON [of \] by auto then have \_less_iff: "\\ \. \\ \ elts (tp D); \ \ elts (tp D)\ \ \ \ < \ \ \ \ < \" using ordermap_mono_less [of _ _ VWF D] bij_betw_apply [OF bij_\] VWF_iff_Ord_less \_cancel_right trans_VWF wf_VWF by (metis ON_imp_Ord Ord_linear2 less_V_def order.asym) obtain \s where "List.set \s \ ON" and "\_dec \s" and tpD_eq: "tp D = \_sum \s" using Ord_ordertype \_nf_exists by blast \ \Cantor normal form of the ordertype\ have ord [simp]: "Ord (\s ! k)" "Ord (\_sum (take k \s))" if "k < length \s" for k using that \list.set \s \ ON\ by (auto simp: dual_order.trans set_take_subset elim: ON_imp_Ord) define E where "E \ \k. lift (\_sum (take k \s)) (\\(\s!k))" define L where "L \ map (\k. \ ` (elts (E k))) [0..s]" have [simp]: "length L = length \s" by (simp add: L_def) have in_elts_E_less: "x' < x" if "x' \ elts (E k')" "x \ elts (E k)" "k's" for k k' x' x \ \The ordinals have been partitioned into disjoint intervals\ proof - have ord\: "Ord (\ \ \s ! k')" using that by auto from that id_take_nth_drop [of k' "take k \s"] obtain l where "take k \s = take k' \s @ (\s!k') # l" by (simp add: min_def) then show ?thesis using that by (auto simp: E_def lift_def add.assoc dest!: OrdmemD [OF ord\] intro: less_le_trans) qed have elts_E: "elts (E k) \ elts (\_sum \s)" if "k < length \s" for k proof - have "\ \ (\s!k) \ \_sum (drop k \s)" by (metis that Cons_nth_drop_Suc \_sum_Cons add_le_cancel_left0) then have "(+) (\_sum (take k \s)) ` elts (\ \ (\s!k)) \ elts (\_sum (take k \s) + \_sum (drop k \s))" by blast also have "\ = elts (\_sum \s)" using \_sum_take_drop by auto finally show ?thesis by (simp add: lift_def E_def) qed have \_sum_in_tpD: "\_sum (take k \s) + \ \ elts (tp D)" if "\ \ elts (\ \ \s!k)" "k < length \s" for \ k using elts_E lift_def that tpD_eq by (auto simp: E_def) have Ord_\: "Ord (\ (\_sum (take k \s) + \))" if "\ \ elts (\ \ \s!k)" "k < length \s" for \ k using \_sum_in_tpD \D \ ON\ bij_\ bij_betw_imp_surj_on that by fastforce define \ where "\ \ \k. ((\y. odiff y (\_sum (take k \s))) \ ordermap D VWF)" \ \mapping the segments of @{term D} into some power of @{term \}\ have bij_\: "bij_betw (\ k) (\ ` elts (E k)) (elts (\ \ (\s!k)))" if "k < length \s" for k using that by (auto simp: bij_betw_def \_def E_def inj_on_def lift_def image_comp \_sum_in_tpD \_cancel_right that) have \_iff: "\ k x < \ k y \ (x,y) \ VWF" if "x \ \ ` elts (E k)" "y \ \ ` elts (E k)" "k < length \s" for k x y using that by (auto simp: \_def E_def lift_def \_sum_in_tpD \_cancel_right Ord_\ \_less_iff) have tp_E_eq [simp]: "tp (\ ` elts (E k)) = \\(\s!k)" if k: "k < length \s" for k using ordertype_eq_iff \_iff bij_\ that by (meson Ord_\ Ord_oexp ord(1) ordertype_VWF_eq_iff replacement small_elts) have tp_L_eq [simp]: "tp (L!k) = \\(\s!k)" if "k < length \s" for k by (simp add: L_def that) have UL_eq_D: "\ (list.set L) = D" proof (rule antisym) show "\ (list.set L) \ D" by (force simp: L_def tpD_eq bij_betw_apply [OF bij_\] dest: elts_E) show "D \ \ (list.set L)" proof fix \ assume "\ \ D" then have "ordermap D VWF \ \ elts (\_sum \s)" by (metis \small D\ ordermap_in_ordertype tpD_eq) then show "\ \ \ (list.set L)" using \\ \ D\ \_cancel_left in_elts_\_sum by (fastforce simp: L_def E_def image_iff lift_def) qed qed show thesis proof show "indecomposable (tp X)" if "X \ list.set L" for X using that by (auto simp: L_def indecomposable_\_power) next fix M assume "M \ D" and *: "\X. X \ list.set L \ tp X \ tp (M \ X)" show "tp M = tp D" proof (rule antisym) show "tp M \ tp D" by (simp add: \M \ D\ \small D\ ordertype_VWF_mono) define \ where "\ \ \X. inv_into (M \ X) (ordermap (M \ X) VWF)" \ \The bijection from an @{term \}-power into the appropriate segment of @{term M}\ have bij_\: "bij_betw (\ X) (elts (tp (M \ X))) (M \ X)" for X unfolding \_def by (metis (no_types) \M \ D\ \small D\ bij_betw_inv_into inf_le1 ordermap_bij subset_iff_less_eq_V total_on_VWF wf_VWF) have Ord_\: "Ord (\ X \)" if "\ \ elts (tp (M \ X))" for \ X using \D \ ON\ \M \ D\ bij_betw_apply [OF bij_\] that by blast have \_cancel_right: "\\ X. \ \ elts (tp (M \ X)) \ ordermap (M \ X) VWF (\ X \) = \" by (metis \_def f_inv_into_f ordermap_surj subsetD) have smM: "small (M \ X)" for X by (meson \M \ D\ \small D\ inf_le1 subset_iff_less_eq_V) then have \_less: "\X \ \. \\ < \; \ \ elts (tp (M \ X)); \ \ elts (tp (M \ X))\ \ \ X \ < \ X \" using ordermap_mono_less bij_betw_apply [OF bij_\] VWF_iff_Ord_less \_cancel_right trans_VWF wf_VWF by (metis Ord_\ Ord_linear_lt less_imp_not_less ordermap_mono_less) have "\k < length \s. \ \ elts (E k)" if \: "\ \ elts (tp D)" for \ proof - obtain X where "X \ set L" and X: "\ \ \ X" by (metis UL_eq_D \ Union_iff \_def in_mono inv_into_into ordermap_surj) then have "\k < length \s. \ \ elts (E k) \ X = \ ` elts (E k)" apply (clarsimp simp: L_def) by (metis \ \_cancel_right elts_E in_mono tpD_eq) then show ?thesis by blast qed then obtain K where K: "\\. \ \ elts (tp D) \ K \ < length \s \ \ \ elts (E (K \))" by metis \ \The index from @{term "tp D"} to the appropriate segment number\ define \ where "\ \ \d. \ (L ! K (ordermap D VWF d)) (\ (K (ordermap D VWF d)) d)" show "tp D \ tp M" proof (rule ordertype_inc_le) show "small D" "small M" using \M \ D\ \small D\ subset_iff_less_eq_V by auto next fix d' d assume xy: "d' \ D" "d \ D" and "(d',d) \ VWF" then have "d' < d" using ON_imp_Ord \D \ ON\ by auto define \' where "\' \ ordermap D VWF d'" define \ where "\ \ ordermap D VWF d" have len': "K \' < length \s" and elts': "\' \ elts (E (K \'))" and len: "K \ < length \s" and elts: "\ \ elts (E (K \))" using K \d' \ D\ \d \ D\ by (auto simp: \'_def \_def \small D\ ordermap_in_ordertype) have **: "\X w. \X \ list.set L; w \ elts (tp X)\ \ w \ elts (tp (M \ X))" using "*" by blast have Ord_\L: "Ord (\ (L!k) (\ k d))" if "d \ \ ` elts (E k)" "k < length \s" for k d by (metis "**" Ord_\ \length L = length \s\ bij_\ bij_betw_imp_surj_on imageI nth_mem that tp_L_eq) have "\' < \" by (metis \'_def \_def \d' < d\ \small D\ \_cancel_left \_less_iff ordermap_in_ordertype xy) then have "K \' \ K \" using elts' elts by (meson in_elts_E_less leI len' less_asym) then consider (less) "K \' < K \" | (equal) "K \' = K \" by linarith then have "\ (L ! K \') (\ (K \') d') < \ (L ! K \) (\ (K \) d)" proof cases case less obtain \: "\ (L ! K \') (\ (K \') d') \ M \ L ! K \'" "\ (L ! K \) (\ (K \) d) \ M \ L ! K \" using elts' elts len' len unfolding \'_def \_def by (metis "**" \length L = length \s\ \_cancel_left bij_\ bij_\ bij_betw_imp_surj_on imageI nth_mem tp_L_eq xy) then have "ordermap D VWF (\ (L ! K \') (\ (K \') d')) \ elts (E (K \'))" "ordermap D VWF (\ (L ! K \) (\ (K \) d)) \ elts (E (K \))" using len' len elts_E tpD_eq by (fastforce simp: L_def \'_def \_def \_cancel_right)+ then have "ordermap D VWF (\ (L ! K \') (\ (K \') d')) < ordermap D VWF (\ (L ! K \) (\ (K \) d))" using in_elts_E_less len less by blast moreover have "\ (L ! K \') (\ (K \') d') \ D" "\ (L ! K \) (\ (K \) d) \ D" using \M \ D\ \ by auto ultimately show ?thesis by (metis \small D\ \_cancel_left \_less_iff ordermap_in_ordertype) next case equal show ?thesis unfolding equal proof (rule \_less) show "\ (K \) d' < \ (K \) d" by (metis equal \'_def \_def \(d', d) \ VWF\ \_cancel_left \_iff elts elts' imageI len xy) have "\ (K \) d' \ elts (tp (L ! K \))" "\ (K \) d \ elts (tp (L ! K \))" using equal \_cancel_left \'_def elts' len' \_def elts len xy by (force intro: bij_betw_apply [OF bij_\])+ then show "\ (K \) d' \ elts (tp (M \ L ! K \))" "\ (K \) d \ elts (tp (M \ L ! K \))" by (simp_all add: "**" len) qed qed moreover have "Ord (\ (L ! K \') (\ (K \') d'))" using Ord_\L \'_def \_cancel_left elts' len' xy(1) by fastforce moreover have "Ord (\ (L ! K \) (\ (K \) d))" using Ord_\L \_def \_cancel_left elts len xy by fastforce ultimately show "(\ d', \ d) \ VWF" by (simp add: \_def \'_def \_def) next show "\ ` D \ M" proof (clarsimp simp: \_def) fix d assume "d \ D" define \ where "\ \ ordermap D VWF d" have len: "K \ < length \s" and elts: "\ \ elts (E (K \))" using K \d \ D\ by (auto simp: \_def \small D\ ordermap_in_ordertype) have "\ (K \) d \ elts (tp (L! (K \)))" using bij_\ [OF len] \d \ D\ apply (simp add: L_def len) by (metis \_def \_cancel_left bij_betw_imp_surj_on elts imageI) then have "\ (L! (K \)) (\ (K \) d) \ M \ (L! (K \))" using smM bij_betw_imp_surj_on [OF ordermap_bij] \length L = length \s\ unfolding \_def by (metis (no_types) "*" inv_into_into len nth_mem vsubsetD total_on_VWF wf_VWF) then show "\ (L ! K (ordermap D VWF d)) (\ (K (ordermap D VWF d)) d) \ M" using \_def by blast qed qed auto qed qed (simp add: UL_eq_D) qed text \The ``remark'' of Erdős and E. C. Milner, Canad. Math. Bull. Vol. 17 (2), 1974\ proposition indecomposable_imp_Ex_less_sets: - assumes indec: "indecomposable \" and "\ > 1" "Ord \" and A: "tp A = \" "A \ elts (\*\)" + assumes indec: "indecomposable \" and "\ > 1" and A: "tp A = \" "small A" "A \ ON" and "x \ A" and A1: "tp A1 = \" "A1 \ A" obtains A2 where "tp A2 = \" "A2 \ A1" "less_sets {x} A2" proof - have "Ord \" using indec indecomposable_imp_Ord by blast have "Limit \" by (simp add: assms indecomposable_imp_Limit) - have "small A" - by (meson A small_elts smaller_than_small) define \ where "\ \ inv_into A (ordermap A VWF)" then have bij_\: "bij_betw \ (elts \) A" using A bij_betw_inv_into down ordermap_bij by blast have bij_om: "bij_betw (ordermap A VWF) A (elts \)" using A down ordermap_bij by blast define \ where "\ \ ordermap A VWF x" have \: "\ \ elts \" unfolding \_def using A \x \ A\ down by auto then have "Ord \" using Ord_in_Ord \Ord \\ by blast - have "A \ ON" - by (meson Ord_mult \Ord \\ \Ord \\ A dual_order.trans elts_subset_ON) define B where "B \ \ ` (elts (succ \))" show thesis proof have "small A1" by (meson \small A\ A1 smaller_than_small) then have "tp (A1 - B) \ tp A1" unfolding B_def by (auto intro!: ordertype_VWF_mono del: vsubsetI) moreover have "tp (A1 - B) \ \" proof - have "\ (\ \ tp B)" unfolding B_def proof (subst ordertype_VWF_inc_eq) show "elts (succ \) \ ON" by (auto simp: \_def ordertype_VWF_inc_eq intro: Ord_in_Ord) - have "elts (succ \) \ elts \" + have sub: "elts (succ \) \ elts \" using Ord_trans \ \Ord \\ by auto then show "\ ` elts (succ \) \ ON" using \A \ ON\ bij_\ bij_betw_imp_surj_on by blast - show "\ u < \ v" + have "succ \ \ elts \" + using \ Limit_def \Limit \\ by blast + with A sub show "\ u < \ v" if "u \ elts (succ \)" and "v \ elts (succ \)" and "u < v" for u v - proof - - have "succ \ \ elts \" - using \ Limit_def \Limit \\ by blast - then have "u \ elts \" "v \ elts \" - using Ord_trans \Ord \\ that by blast+ - then show ?thesis - using that \Limit \\ \small A\ A bij_betwE [OF bij_\] - by (metis ON_imp_Ord Ord_linear2 \A \ ON\ \_def inv_ordermap_VWF_mono_le leD) - qed + by (metis ON_imp_Ord Ord_not_le \A \ ON\ \small A\ \_def bij_\ bij_betw_apply inv_ordermap_VWF_mono_le leD subsetD that) show "\ \ \ tp (elts (succ \))" - proof (subst ordertype_eq_Ord) - show "\ \ \ succ \" - by (meson \ \Limit \\ less_eq_V_def mem_not_refl subsetD succ_in_Limit_iff) - qed (use \Ord \\ in blast) + by (metis Limit_def Ord_succ \ \Limit \\ \Ord \\ mem_not_refl ordertype_eq_Ord vsubsetD) qed auto then show ?thesis using indecomposable_ordertype_ge [OF indec, of A1 B] \small A1\ A1 by (auto simp: B_def) qed ultimately show "tp (A1 - B) = \" using A1 by blast show "less_sets {x} (A1 - B)" proof (clarsimp simp: less_sets_def B_def simp del: elts_succ) fix y assume "y \ A1" and y: "y \ \ ` elts (succ \)" obtain "Ord x" "Ord y" using \A \ ON\ \x \ A\ \y \ A1\ A1 by auto have "y \ \ ` elts (succ \)" if "y \ elts (succ x)" proof - have "ordermap A VWF y \ elts (ZFC_in_HOL.succ (ordermap A VWF x))" using A1 by (metis insert_iff ordermap_mono subset_iff that wf_VWF OrdmemD VWF_iff_Ord_less \Ord x\ \Ord y\ \small A\ \y \ A1\ elts_succ) then show ?thesis using that A1 unfolding \_def by (metis \y \ A1\ \_def bij_betw_inv_into_left bij_om imageI subsetD) qed then show "x < y" by (meson Ord_linear2 Ord_mem_iff_lt Ord_succ \Ord x\ \Ord y\ y succ_le_iff) qed qed auto qed text \the main theorem, from which they derive the headline result\ theorem Erdos_Milner_aux: - fixes k::nat and \::V assumes part: "partn_lst_VWF \ [ord_of_nat k, \] 2" and indec: "indecomposable \" and "k > 1" "Ord \" and \: "\ \ elts \1" shows "partn_lst_VWF (\*\) [ord_of_nat (2*k), min \ (\*\)] 2" proof (cases "\=1 \ \=0") case True - have "Ord \" - using Ord_\1 Ord_in_Ord \ by blast show ?thesis proof (cases "\=0") case True moreover have "min \ 0 = 0" by (simp add: min_def) ultimately show ?thesis by (simp add: partn_lst_triv0 [where i=1]) next case False - then have "\=1" - using True by blast + then obtain "\=1" "Ord \" + by (meson ON_imp_Ord Ord_\1 True \ elts_subset_ON) then obtain i where "i < Suc (Suc 0)" "[ord_of_nat k, \] ! i \ \" using partn_lst_VWF_nontriv [OF part] by auto then have "\ \ 1" using \\=1\ \k > 1\ by (fastforce simp: less_Suc_eq) then have "min \ (\*\) \ 1" by (metis Ord_1 Ord_\ Ord_linear_le Ord_mult \Ord \\ min_def order_trans) moreover have "elts \ \ {}" using False by auto ultimately show ?thesis by (auto simp: True \Ord \\ \\\0\ \\=1\ intro!: partn_lst_triv1 [where i=1]) qed next case False then have "\ \ 1" "\ \ 0" by auto then have "0 \ elts \" using Ord_\1 Ord_in_Ord \ mem_0_Ord by blast show ?thesis proof (cases "\=0") case True have \: "[ord_of_nat (2 * k), 0] ! 1 = 0" by simp show ?thesis using True assms by (force simp: partn_lst_def nsets_empty_iff simp flip: numeral_2_eq_2 dest!: less_2_cases intro: \) next case False then have "\ \ \" using indec \\ \ 1\ by (metis Ord_\ indecomposable_is_\_power le_oexp oexp_0_right) then have "\ > 1" using \_gt1 dual_order.strict_trans1 by blast show ?thesis unfolding partn_lst_def proof clarsimp fix f assume "f \ [elts (\*\)]\<^bsup>2\<^esup> \ {.. [elts (\*\)]\<^bsup>2\<^esup> \ {..<2::nat}" by (simp add: eval_nat_numeral) obtain ord [iff]: "Ord \" "Ord \" "Ord (\*\)" using Ord_\1 Ord_in_Ord \ indec indecomposable_imp_Ord Ord_mult by blast have *: False - if i [rule_format]: "\H. tp H = ord_of_nat (2*k) \ H \ elts (\*\) \ \ f ` [H]\<^bsup>2\<^esup> \ {0}" + if i [rule_format]: "\H. tp H = ord_of_nat (2*k) \ H \ elts (\*\) \ \ f ` [H]\<^bsup>2\<^esup> \ {0}" and ii [rule_format]: "\H. tp H = \ \ H \ elts (\*\) \ \ f ` [H]\<^bsup>2\<^esup> \ {1}" and iii [rule_format]: "\H. tp H = (\*\) \ H \ elts (\*\) \ \ f ` [H]\<^bsup>2\<^esup> \ {1}" proof - have Ak0: "\X \ [A]\<^bsup>k\<^esup>. f ` [X]\<^bsup>2\<^esup> \ {0}" \\remark (8) about @{term"A \ S"}\ if A_\\: "A \ elts (\*\)" and ot: "tp A \ \" for A proof - let ?g = "inv_into A (ordermap A VWF)" have "small A" using down that by auto then have inj_g: "inj_on ?g (elts \)" by (meson inj_on_inv_into less_eq_V_def ordermap_surj ot subset_trans) have Aless: "\x y. \x \ A; y \ A; x < y\ \ (x,y) \ VWF" by (meson Ord_in_Ord VWF_iff_Ord_less \Ord(\*\)\ subsetD that(1)) then have om_A_less: "\x y. \x \ A; y \ A; x < y\ \ ordermap A VWF x < ordermap A VWF y" by (auto simp: \small A\ ordermap_mono_less) have \_sub: "elts \ \ ordermap A VWF ` A" by (metis \small A\ elts_of_set less_eq_V_def ordertype_def ot replacement) - have g_less: "?g x < ?g y" if "x < y" "x \ elts \" "y \ elts \" for x y - proof - - have "?g x \ A" "?g y \ A" - using that by (meson \_sub inv_into_into subsetD)+ - moreover have "x \ ordermap A VWF ` A" "y \ ordermap A VWF ` A" - using \_sub that by blast+ - moreover have "A \ ON" - using A_\\ elts_subset_ON \Ord(\*\)\ by blast - ultimately show ?thesis - by (metis ON_imp_Ord Ord_linear_lt f_inv_into_f less_not_sym om_A_less \x < y\) - qed - have "?g \ elts \ \ elts (\ * \)" + have g: "?g \ elts \ \ elts (\ * \)" by (meson A_\\ Pi_I' \_sub inv_into_into subset_eq) then have fg: "f \ (\X. ?g ` X) \ [elts \]\<^bsup>2\<^esup> \ {..<2}" by (rule nsets_compose_image_funcset [OF f _ inj_g]) + have g_less: "?g x < ?g y" if "x < y" "x \ elts \" "y \ elts \" for x y + using Pi_mem [OF g] + by (meson A_\\ Ord_in_Ord Ord_not_le ord \small A\ dual_order.trans elts_subset_ON inv_ordermap_VWF_mono_le ot that vsubsetD) obtain i H where "i < 2" "H \ elts \" and ot_eq: "tp H = [k,\]!i" "(f \ (\X. ?g ` X)) ` (nsets H 2) \ {i}" using ii partn_lst_E [OF part fg] by (auto simp: eval_nat_numeral) then consider (0) "i=0" | (1) "i=1" by linarith then show ?thesis proof cases case 0 then have "f ` [inv_into A (ordermap A VWF) ` H]\<^bsup>2\<^esup> \ {0}" using ot_eq \H \ elts \\ \_sub by (auto simp: nsets_def [of _ k] inj_on_inv_into elim!: nset_image_obtains) moreover have "finite H \ card H = k" using 0 ot_eq \H \ elts \\ down by (simp add: finite_ordertype_eq_card) then have "inv_into A (ordermap A VWF) ` H \ [A]\<^bsup>k\<^esup>" using \H \ elts \\ \_sub by (auto simp: nsets_def [of _ k] card_image inj_on_inv_into inv_into_into) ultimately show ?thesis by blast next case 1 have gH: "?g ` H \ elts (\ * \)" by (metis A_\\ \_sub \H \ elts \\ image_subsetI inv_into_into subset_eq) have [simp]: "tp (?g ` H) = tp H" - proof (rule ordertype_VWF_inc_eq) - show "?g ` H \ ON" - using elts_subset_ON gH ord(3) by auto - show "?g x < inv_into A (ordermap A VWF) y" if "x \ H" "y \ H" "x < y" for x y - using that \H \ elts \\ g_less by blast - qed (use \H \ elts \\ elts_subset_ON ord down in auto) + by (meson \H \ elts \\ ord down dual_order.trans elts_subset_ON gH g_less ordertype_VWF_inc_eq subsetD) show ?thesis using ii [of "?g ` H"] ot_eq 1 apply (auto simp: gH elim!: nset_image_obtains) apply (meson \H \ elts \\ inj_g bij_betw_def inj_on_subset) done qed qed define K where "K \ \i x. {y \ elts (\*\). x \ y \ f{x,y} = i}" have small_K: "small (K i x)" for i x by (simp add: K_def) define KI where "KI \ \i X. (\x\X. K i x)" have KI_disj_self: "X \ KI i X = {}" for i X by (auto simp: KI_def K_def) define M where "M \ \D \ x. {\::V. \ \ D \ tp (K 1 x \ \ \) \ \}" have M_sub_D: "M D \ x \ D" for D \ x by (auto simp: M_def) have small_M [simp]: "small (M D \ x)" if "small D" for D \ x by (simp add: M_def that) have 9: "tp {x \ A. tp (M D \ x) \ tp D} \ \" (is "ordertype ?AD _ \ \") if inD: "indecomposable (tp D)" and D: "D \ elts \" and A: "A \ elts (\*\)" and tpA: "tp A = \" and \: "\ \ D \ {X. X \ elts (\*\) \ tp X = \}" for D A \ \\remark (9), assuming an indecomposable order type\ proof (rule ccontr) define A' where "A' \ {x \ A. \ tp (M D \ x) \ tp D}" have small [iff]: "small A" "small D" using A D down by (auto simp: M_def) have small_\: "small (\ \)" if "\ \ D" for \ using that \ by (auto simp: Pi_iff subset_iff_less_eq_V) assume not_\_le: "\ \ \ tp {x \ A. tp (M D \ x) \ tp D}" moreover obtain "small A" "small A'" "A' \ A" and A'_sub: "A' \ elts (\ * \)" using A'_def A down by auto moreover have "A' = A - ?AD" by (force simp: A'_def) ultimately have A'_ge: "tp A' \ \" by (metis (no_types, lifting) dual_order.refl indec indecomposable_ordertype_eq mem_Collect_eq subsetI tpA) obtain X where "X \ A'" "finite X" "card X = k" and fX0: "f ` [X]\<^bsup>2\<^esup> \ {0}" using Ak0 [OF A'_sub A'_ge] by (auto simp: nsets_def [of _ k]) then have \: "\ tp (M D \ x) \ tp D" if "x \ X" for x using that by (auto simp: A'_def) obtain x where "x \ X" using \card X = k\ \k>1\ by fastforce have "\ D \ (\ x\X. M D \ x)" proof assume not: "D \ (\x\X. M D \ x)" have "\X\M D \ ` X. tp D \ tp X" proof (rule indecomposable_ordertype_finite_ge [OF inD]) show "M D \ ` X \ {}" using A'_def A'_ge not not_\_le by auto show "small (\ (M D \ ` X))" using \finite X\ by (simp add: finite_imp_small) qed (use \finite X\ not in auto) then show False by (simp add: \) qed then obtain \ where "\ \ D" and \: "\ \ (\ x\X. M D \ x)" by blast define \ where "\ \ {KI 0 X \ \ \, \x\X. K 1 x \ \ \, X \ \ \}" have \\: "X \ elts (\*\)" "\ \ \ elts (\*\)" using A'_sub \X \ A'\ \ \\ \ D\ by auto then have "KI 0 X \ (\x\X. K 1 x) \ X = elts (\*\)" using \x \ X\ f by (force simp: K_def KI_def Pi_iff less_2_cases_iff) with \\ have \\_\: "finite \" "\ \ \ \\" by (auto simp: \_def) then have "\ tp (K 1 x \ \ \) \ \" if "x \ X" for x using that \\ \ D\ \ \k > 1\ \card X = k\ by (fastforce simp: M_def) moreover have sm_K1: "small (\x\X. K 1 x \ \ \)" by (meson Finite_V Int_lower2 \\ \ D\ \finite X\ small_\ small_UN smaller_than_small) ultimately have not1: "\ tp (\x\X. K 1 x \ \ \) \ \" using \finite X\ \x \ X\ indecomposable_ordertype_finite_ge [OF indec, of "(\x. K 1 x \ \ \) ` X"] by blast moreover have "\ tp (X \ \ \) \ \" using \finite X\ \\ \ \\ by (meson finite_Int mem_not_refl ordertype_VWF_\ vsubsetD) moreover have "\ \ tp (\ \)" using \ \\ \ D\ small_\ by fastforce+ moreover have "small (\ \)" using \\ \ D\ small_\ by (fastforce simp: \_def intro: smaller_than_small sm_K1) ultimately have K0\_ge: "tp (KI 0 X \ \ \) \ \" using indecomposable_ordertype_finite_ge [OF indec \\_\] by (auto simp: \_def) have \\: "\ \ \ elts (\ * \)" "tp (\ \) = \" using \\ \ D\ \ by blast+ then obtain Y where Ysub: "Y \ KI 0 X \ \ \" and "finite Y" "card Y = k" and fY0: "f ` [Y]\<^bsup>2\<^esup> \ {0}" using Ak0 [OF _ K0\_ge] by (auto simp: nsets_def [of _ k]) have \: "X \ Y = {}" using Ysub KI_disj_self by blast then have "card (X \ Y) = 2*k" by (simp add: \card X = k\ \card Y = k\ \finite X\ \finite Y\ card_Un_disjoint) moreover have "X \ Y \ elts (\ * \)" using A'_sub \X \ A'\ \\(1) \Y \ KI 0 X \ \ \\ by auto moreover have "f ` [X \ Y]\<^bsup>2\<^esup> \ {0}" using fX0 fY0 Ysub by (auto simp: \ nsets_disjoint_2 image_Un image_UN KI_def K_def) ultimately show False using i \finite X\ \finite Y\ ordertype_VWF_finite_nat by auto qed have IX: "tp {x \ A. tp (M D \ x) \ tp D} \ \" if D: "D \ elts \" and A: "A \ elts (\*\)" and tpA: "tp A = \" and \: "\ \ D \ {X. X \ elts (\*\) \ tp X = \}" for D A \ \\remark (9) for any order type\ proof - obtain L where UL: "\(List.set L) \ D" and indL: "\X. X \ List.set L \ indecomposable (tp X)" and eqL: "\M. \M \ D; \X. X \ List.set L \ tp (M \ X) \ tp X\ \ tp M = tp D" using ord by (metis strong_ordertype_eq D order_refl) obtain A'' where A'': "A'' \ A" "tp A'' \ \" and "\x X. \x \ A''; X \ List.set L\ \ tp (M D \ x \ X) \ tp X" using UL indL proof (induction L arbitrary: thesis) case (Cons X L) then obtain A'' where A'': "A'' \ A" "tp A'' \ \" and "X \ D" and ge_X: "\x X. \x \ A''; X \ List.set L\ \ tp (M D \ x \ X) \ tp X" by auto then have tp_A'': "tp A'' = \" by (metis A antisym down ordertype_VWF_mono tpA) have ge_\: "tp {x \ A''. tp (M X \ x) \ tp X} \ \" by (rule 9) (use A A'' tp_A'' Cons.prems \D \ elts \\ \X \ D\ \ in auto) let ?A = "{x \ A''. tp (M D \ x \ X) \ tp X}" have M_eq: "M D \ x \ X = M X \ x" if "x \ A''" for x using that \X \ D\ by (auto simp: M_def) show thesis proof (rule Cons.prems) show "\ \ tp ?A" using ge_\ by (simp add: M_eq cong: conj_cong) show "tp Y \ tp (M D \ x \ Y)" if "x \ ?A" "Y \ list.set (X # L)" for x Y using that ge_X by force qed (use A'' in auto) qed (use tpA in auto) then have tp_M_ge: "tp (M D \ x) \ tp D" if "x \ A''" for x using eqL that by (auto simp: M_def) have "\ \ tp A''" by (simp add: A'') also have "\ \ tp {x \ A''. tp (M D \ x) \ tp D}" by (metis (mono_tags, lifting) tp_M_ge eq_iff mem_Collect_eq subsetI) also have "\ \ tp {x \ A. tp D \ tp (M D \ x)}" by (rule ordertype_mono) (use A'' A down in auto) finally show ?thesis . qed have [simp]: "tp {0} = 1" using ordertype_eq_Ord by fastforce have IX': "tp {x \ A'. tp (K 1 x \ A) \ \} \ \" if A: "A \ elts (\*\)" "tp A = \" and A': "A' \ elts (\*\)" "tp A' = \" for A A' proof - have \: "\ \ tp (K 1 t \ A)" if "t \ A'" "1 \ tp {\. \ = 0 \ \ \ tp (K 1 t \ A)}" for t using that by (metis Collect_empty_eq less_eq_V_0_iff ordertype_empty zero_neq_one) have "tp {x \ A'. 1 \ tp {\. \ = 0 \ \ \ tp (K 1 x \ A)}} \ tp {x \ A'. \ \ tp (K 1 x \ A)}" by (rule ordertype_mono) (use "\" A' in \auto simp: down\) then show ?thesis using IX [of "{0}" A' "\x. A"] that \0 \ elts \\ by (simp add: M_def cong: conj_cong) qed have 10: "\x0 \ A. \g \ elts \ \ elts \. strict_mono_on g (elts \) \ (\\ \ F. g \ = \) \ (\\ \ elts \. tp (K 1 x0 \ \ (g \)) \ \)" if F: "finite F" "F \ elts \" and A: "A \ elts (\*\)" "tp A = \" and \: "\ \ elts \ \ {X. X \ elts (\ * \) \ tp X = \}" for F A \ proof - define p where "p \ card F" have "\ \ F" using that by auto then obtain \ :: "nat \ V" where bij\: "bij_betw \ {..p} (insert \ F)" and mon\: "strict_mono_on \ {..p}" using ZFC_Cardinals.ex_bij_betw_strict_mono_card [of "insert \ F"] elts_subset_ON \Ord \\ F by (simp add: p_def lessThan_Suc_atMost) blast have less_\_I: "\ k < \ l" if "k < l" "l \ p" for k l using mon\ that by (auto simp: strict_mono_on_def) then have less_\_D: "k < l" if "\ k < \ l" "k \ p" for k l by (metis less_asym linorder_neqE_nat that) have Ord_\: "Ord (\ k)" if "k \ p" for k by (metis (no_types, lifting) ON_imp_Ord atMost_iff insert_subset mem_Collect_eq order_trans \F \ elts \\ bij\ bij_betwE elts_subset_ON \Ord \\ that) have le_\0 [simp]: "\j. j \ p \ \ 0 \ \ j" by (metis eq_refl leI le_0_eq less_\_I less_imp_le) have le_\: "\ i \ \ (j - Suc 0)" if "i < j" "j \ p" for i j proof (cases i) case 0 then show ?thesis using le_\0 that by auto next case (Suc i') then show ?thesis by (metis (no_types, hide_lams) Suc_pred le_less less_Suc_eq less_Suc_eq_0_disj less_\_I not_less_eq that) qed have [simp]: "\ p = \" proof - obtain k where k: "\ k = \" "k \ p" by (meson atMost_iff bij\ bij_betw_iff_bijections insertI1) then have "k = p \ k < p" by linarith then show ?thesis using bij\ ord k that(2) by (metis OrdmemD atMost_iff bij_betw_iff_bijections insert_iff leD less_\_D order_refl subsetD) qed have F_imp_Ex: "\k < p. \ = \ k" if "\ \ F" for \ proof - obtain k where k: "k \ p" "\ = \ k" by (metis \\ \ F\ atMost_iff bij\ bij_betw_def imageE insert_iff) then have "k \ p" using that F by auto with k show ?thesis using le_neq_implies_less by blast qed have F_imp_ge: "\ \ \ 0" if "\ \ F" for \ using F_imp_Ex [OF that] by (metis dual_order.order_iff_strict le0 less_\_I) define D where "D \ \k. (if k=0 then {..<\ 0} else {\ (k-1)<..<\ k}) \ elts \" have D\: "D k \ elts \" for k by (auto simp: D_def) then have small_D [simp]: "small (D k)" for k by (meson down) have M_Int_D: "M (elts \) \ x \ D k = M (D k) \ x" if "k \ p" for x k using D\ by (auto simp: M_def) have \_le_if_D: "\ k \ \" if "\ \ D (Suc k)" for \ k using that by (simp add: D_def order.order_iff_strict split: if_split_asm) have "disjnt (D i) (D j)" if "i < j" "j \ p" for i j proof (cases j) case (Suc j') then show ?thesis using that apply (auto simp: disjnt_def D_def) using not_less_eq by (blast intro: less_\_D less_trans Suc_leD)+ qed (use that in auto) then have disjnt_DD: "disjnt (D i) (D j)" if "i \ j" "i \ p" "j \ p" for i j using disjnt_sym nat_neq_iff that by auto have UN_D_eq: "(\l \ k. D l) = {..<\ k} \ (elts \ - F)" if "k \ p" for k using that proof (induction k) case 0 then show ?case by (auto simp: D_def F_imp_ge leD) next case (Suc k) have "D (Suc k) \ {..<\ k} \ (elts \ - F) = {..<\ (Suc k)} \ (elts \ - F)" (is "?lhs = ?rhs") proof show "?lhs \ ?rhs" using Suc.prems by (auto simp: D_def if_split_mem2 intro: less_\_I less_trans dest!: less_\_D F_imp_Ex) have "\x. \x < \ (Suc k); x \ elts \; x \ F; \ k \ x\ \ \ k < x" using Suc.prems \F \ elts \\ bij\ le_imp_less_or_eq by (fastforce simp: bij_betw_iff_bijections) then show "?rhs \ ?lhs" using Suc.prems by (auto simp: D_def Ord_not_less Ord_in_Ord [OF \Ord \\] Ord_\ if_split_mem2) qed then show ?case using Suc by (simp add: atMost_Suc) qed have \_decomp: "elts \ = F \ (\k \ p. D k)" using \F \ elts \\ OrdmemD [OF \Ord \\] by (auto simp: UN_D_eq) define \idx where "\idx \ \\. @k. \ \ D k \ k \ p" have \idx: "\ \ D (\idx \) \ \idx \ \ p" if "\ \ elts \ - F" for \ using that by (force simp: \idx_def \_decomp intro: someI_ex del: conjI) have any_imp_\idx: "k = \idx \" if "\ \ D k" "k \ p" for k \ proof (rule ccontr) assume non: "k \ \idx \" have "\ \ F" using that UN_D_eq by auto then show False using disjnt_DD [OF non] by (metis D\ Diff_iff \idx disjnt_iff subsetD that) qed have "\A'. A' \ A \ tp A' = \ \ (\x \ A'. F \ M (elts \) \ x)" using F proof induction case (insert \ F) then obtain A' where "A' \ A" and A': "A' \ elts (\*\)" "tp A' = \" and FN: "\x. x \ A' \ F \ M (elts \) \ x" using A(1) by auto define A'' where "A'' \ {x \ A'. \ \ tp (K 1 x \ \ \)}" have "\ \ elts \" "F \ elts \" using insert by auto note ordertype_eq_Ord [OF \Ord \\, simp] show ?case proof (intro exI conjI) show "A'' \ A" using \A' \ A\ by (auto simp: A''_def) have "tp A'' \ \" using \A'' \ A\ down ordertype_VWF_mono A by blast moreover have "\ \ \ elts (\*\)" "tp (\ \) = \" using \ \\ \ elts \\ by auto then have "\ \ tp A''" using IX' [OF _ _ A'] by (simp add: A''_def) ultimately show "tp A'' = \" by (rule antisym) have "\ \ M (elts \) \ x" "F \ M (elts \) \ x" if "x \ A''" for x proof - show "F \ M (elts \) \ x" using A''_def FN that by blast show "\ \ M (elts \) \ x" using \\ \ elts \\ that by (simp add: M_def A''_def) qed then show "\x\A''. insert \ F \ M (elts \) \ x" by blast qed qed (use A in auto) then obtain A' where A': "A' \ A" "tp A' = \" and FN: "\x. x \ A' \ F \ M (elts \) \ x" by metis have False if *: "\x0 g. \x0 \ A; g \ elts \ \ elts \; strict_mono_on g (elts \)\ \ (\\\F. g \ \ \) \ (\\\elts \. tp (K 1 x0 \ \ (g \)) < \)" proof - { fix x \ \construction of the monotone map @{term g} mentioned above\ assume "x \ A'" with A' have "x \ A" by blast have "\k. k \ p \ tp (M (D k) \ x) < tp (D k)" (is "?P") proof (rule ccontr) assume "\ ?P" then have le: "tp (D k) \ tp (M (D k) \ x)" if "k \ p" for k by (meson Ord_linear2 Ord_ordertype that) have "\f\D k \ M (D k) \ x. inj_on f (D k) \ (strict_mono_on f (D k))" if "k \ p" for k using le [OF that] that VWF_iff_Ord_less apply (clarsimp simp: ordertype_le_ordertype strict_mono_on_def) by (metis (full_types) D\ M_sub_D Ord_in_Ord PiE VWF_iff_Ord_less ord(2) subsetD) then obtain h where fun_h: "\k. k \ p \ h k \ D k \ M (D k) \ x" and inj_h: "\k. k \ p \ inj_on (h k) (D k)" and mono_h: "\k x y. k \ p \ strict_mono_on (h k) (D k)" by metis then have fun_hD: "\k. k \ p \ h k \ D k \ D k" by (auto simp: M_def) have h_increasing: "\ \ h k \" if "k \ p" and \: "\ \ D k" for k \ proof (rule Ord_mono_imp_increasing) show "h k \ D k \ D k" by (simp add: fun_hD that(1)) show "D k \ ON" using D\ elts_subset_ON ord(2) by blast qed (auto simp: that mono_h) define g where "g \ \\. if \ \ F then \ else h (\idx \) \" have [simp]: "g \ = \" if "\ \ F" for \ using that by (auto simp: g_def) have fun_g: "g \ elts \ \ elts \" proof (rule Pi_I) fix x assume "x \ elts \" then have "x \ D (\idx x)" "\idx x \ p" if "x \ F" using that by (auto simp: \idx) then show "g x \ elts \" using fun_h D\ M_sub_D \x \ elts \\ by (simp add: g_def) blast qed have h_in_D: "h (\idx \) \ \ D (\idx \)" if "\ \ F" "\ \ elts \" for \ using \idx fun_hD that by fastforce have 1: "\ k < h (\idx \) \" if "k < p" and \: "\ \ F" "\ \ elts \" and "\ k < \" for k \ using that h_in_D [OF \] \idx by (fastforce simp: D_def dest: h_increasing split: if_split_asm) moreover have 2: "h (\idx \) \ < \ k" if \: "\ \ F" "\ \ elts \" and "k < p" "\ < \ k" for \ k proof - have "\idx \ \ k" proof (rule ccontr) assume "\ \idx \ \ k" then have "k < \idx \" by linarith then show False using \_le_if_D \idx by (metis Diff_iff Suc_pred le0 leD le_\ le_less_trans \ \\ < \ k\) qed then show ?thesis using that h_in_D [OF \] apply (simp add: D_def split: if_split_asm) apply (metis (no_types) dual_order.order_iff_strict le0 less_\_I less_trans) by (metis (no_types) dual_order.order_iff_strict less_\_I less_trans) qed moreover have "h (\idx \) \ < h (\idx \) \" if \: "\ \ F" "\ \ elts \" and \: "\ \ F" "\ \ elts \" and "\ < \" for \ \ proof - have le: "\idx \ \ \idx \" if "\ (\idx \ - Suc 0) < h (\idx \) \" "h (\idx \) \ < \ (\idx \)" by (metis 2 that Diff_iff \idx \ \ \\ < \\ dual_order.strict_implies_order dual_order.strict_trans1 h_increasing leI le_\ less_asym) have "h 0 \ < h 0 \" if "\idx \ = 0" "\idx \ = 0" using that mono_h unfolding strict_mono_on_def by (metis Diff_iff \idx \ \ \\ < \\) moreover have "h 0 \ < h (\idx \) \" if "0 < \idx \" "h 0 \ < \ 0" and "\ (\idx \ - Suc 0) < h (\idx \) \" by (meson DiffI \idx \ le_\ le_less_trans less_le_not_le that) moreover have "\idx \ \ 0" if "0 < \idx \" "h 0 \ < \ 0" "\ (\idx \ - Suc 0) < h (\idx \) \" using le le_0_eq that by fastforce moreover have "h (\idx \) \ < h (\idx \) \" if "\ (\idx \ - Suc 0) < h (\idx \) \" "h (\idx \) \ < \ (\idx \)" "h (\idx \) \ < \ (\idx \)" "\ (\idx \ - Suc 0) < h (\idx \) \" using mono_h unfolding strict_mono_on_def by (metis le Diff_iff \idx \ \ \\ < \\ le_\ le_less le_less_trans that) ultimately show ?thesis using h_in_D [OF \] h_in_D [OF \] by (simp add: D_def split: if_split_asm) qed ultimately have sm_g: "strict_mono_on g (elts \)" by (auto simp: g_def strict_mono_on_def dest!: F_imp_Ex) show False using * [OF \x \ A\ fun_g sm_g] proof safe fix \ assume "\ \ elts \" and \: "tp (K 1 x \ \ (g \)) < \" have FM: "F \ M (elts \) \ x" by (meson FN \x \ A'\) have False if "tp (K (Suc 0) x \ \ \) < \" "\ \ F" using that FM by (auto simp: M_def) moreover have False if "tp (K (Suc 0) x \ \ (g \)) < \" "\ \ D k" "k \ p" "\ \ F" for k proof - have "h (\idx \) \ \ M (D (\idx \)) \ x" using fun_h \idx \\ \ elts \\ \\ \ F\ by auto then show False using that by (simp add: M_def g_def leD) qed ultimately show False using \\ \ elts \\ \ by (force simp: \_decomp) qed auto qed then have "\l. l \ p \ tp (M (elts \) \ x \ D l) < tp (D l)" using M_Int_D by auto } then obtain l where lp: "\x. x \ A'\ l x \ p" and lless: "\x. x \ A'\ tp (M (elts \) \ x \ D (l x)) < tp (D (l x))" by metis obtain A'' L where "A'' \ A'" and A'': "A'' \ elts (\ * \)" "tp A'' = \" and lL: "\x. x \ A'' \ l x = L" proof - have eq: "A' = (\i\p. {x \ A'. l x = i})" using lp by auto have "\X\(\i. {x \ A'. l x = i}) ` {..p}. \ \ tp X" proof (rule indecomposable_ordertype_finite_ge [OF indec]) show "small (\i\p. {x \ A'. l x = i})" by (metis A'(1) A(1) eq down smaller_than_small) qed (use A' eq in auto) then show thesis proof fix A'' assume A'': "A'' \ (\i. {x \ A'. l x = i}) ` {..p}" and "\ \ tp A''" then obtain L where L: "\x. x \ A'' \ l x = L" by auto have "A'' \ A'" using A'' by force then have "tp A'' \ tp A'" by (meson A' A down order_trans ordertype_VWF_mono) with \\ \ tp A''\ have "tp A'' = \" using A'(2) by auto moreover have "A'' \ elts (\ * \)" using A' A \A'' \ A'\ by auto ultimately show thesis using L that [OF \A'' \ A'\] by blast qed qed have \D: "\ \ D L \ {X. X \ elts (\ * \) \ tp X = \}" using \ D\ by blast have "M (elts \) \ x \ D L = M (D L) \ x" for x using D\ by (auto simp: M_def) then have "tp (M (D L) \ x) < tp (D L)" if "x \ A''" for x using lless that \A'' \ A'\ lL by force then have \: "{x \ A''. tp (D L) \ tp (M (D L) \ x)} = {}" using leD by blast have "\ \ tp {x \ A''. tp (D L) \ tp (M (D L) \ x)}" using IX [OF D\ A'' \D] by simp then show False using \\ \ 0\ by (simp add: \) qed then show ?thesis by (meson Ord_linear2 Ord_ordertype \Ord \\) qed let ?U = "UNIV :: nat set" define \ where "\ \ fst \ from_nat_into (elts \ \ ?U)" define q where "q \ to_nat_on (elts \ \ ?U)" have co_\U: "countable (elts \ \ ?U)" by (simp add: \ less_\1_imp_countable) moreover have "elts \ \ ?U \ {}" using \0 \ elts \\ by blast ultimately have "range (from_nat_into (elts \ \ ?U)) = (elts \ \ ?U)" by (metis range_from_nat_into) then have \_in_\ [simp]: "\ i \ elts \" for i by (metis SigmaE \_def comp_apply fst_conv range_eqI) then have Ord_\ [simp]: "Ord (\ i)" for i using Ord_in_Ord by blast have inf_\U: "infinite (elts \ \ ?U)" using \0 \ elts \\ finite_cartesian_productD2 by auto have 11 [simp]: "\ (q (\,n)) = \" if "\ \ elts \" for \ n by (simp add: \_def q_def that co_\U) have range_\ [simp]: "range \ = elts \" by (auto simp: image_iff) (metis 11) have [simp]: "KI i {} = UNIV" "KI i (insert a X) = K i a \ KI i X" for i a X by (auto simp: KI_def) define \ where "\ \ \n::nat. \\ x. (\\ \ elts \. \ \ \ elts (\*\) \ tp (\ \) = \) \ x ` {.. elts (\*\) \ (\\ \ elts \. \ \) \ KI 1 (x ` {.. strict_mono_sets (elts \) \" define \ where "\ \ \n::nat. \g \ \' xn. g \ elts \ \ elts \ \ strict_mono_on g (elts \) \ (\i\n. g (\ i) = \ i) \ (\\ \ elts \. \' \ \ K 1 xn \ \ (g \)) \ less_sets {xn} (\' (\ n)) \ xn \ \ (\ n)" let ?\0 = "\\. plus (\ * \) ` elts \" have base: "\ 0 ?\0 x" for x by (auto simp: \_def add_mult_less add_mult_less_add_mult ordertype_image_plus strict_mono_sets_def less_sets_def) have step: "Ex (\(g,\',xn). \ n g \ \' xn \ \ (Suc n) \' (x(n:=xn)))" if "\ n \ x" for n \ x proof - have \: "\\. \ \ elts \ \ \ \ \ elts (\ * \) \ tp (\ \) = \" and x: "x ` {.. elts (\ * \)" and sub: "\ (\ ` elts \) \ KI (Suc 0) (x ` {..) \" using that by (auto simp: \_def) have \\: "\ ` {..n} \ elts \" and \sub: "\ (\ n) \ elts (\ * \)" by (auto simp: \) have \fun: "\ \ elts \ \ {X. X \ elts (\ * \) \ tp X = \}" by (simp add: \) then obtain xn g where xn: "xn \ \ (\ n)" and g: "g \ elts \ \ elts \" and sm_g: "strict_mono_on g (elts \)" and g_\: "\\ \ \`{..n}. g \ = \" and g_\: "\\ \ elts \. \ \ tp (K 1 xn \ \ (g \))" using 10 [OF _ \\ \sub _ \fun] by (auto simp: \) have tp1: "tp (K 1 xn \ \ (g \)) = \" if "\ \ elts \" for \ proof (rule antisym) have "tp (K 1 xn \ \ (g \)) \ tp (\ (g \))" proof (rule ordertype_VWF_mono) show "small (\ (g \))" by (metis PiE \ down g that) qed auto also have "\ = \" using \ g that by force finally show "tp (K 1 xn \ \ (g \)) \ \" . qed (use that g_\ in auto) have tp2: "tp (\ (\ n)) = \" by (auto simp: \) - obtain A2 where A2: "tp A2 = \" "A2 \ K 1 xn \ \ (\ n)" "less_sets {xn} A2" - using indecomposable_imp_Ex_less_sets [OF indec \\ > 1\ \Ord \\ tp2] - by (metis \sub \_in_\ atMost_iff image_eqI inf_le2 le_refl xn tp1 g_\) + obtain "small (\ (\ n))" "\ (\ n) \ ON" + by (meson \sub ord down elts_subset_ON subset_trans) + then obtain A2 where A2: "tp A2 = \" "A2 \ K 1 xn \ \ (\ n)" "less_sets {xn} A2" + using indecomposable_imp_Ex_less_sets [OF indec \\ > 1\ tp2] + by (metis \_in_\ atMost_iff image_eqI inf_le2 le_refl xn tp1 g_\) then have A2_sub: "A2 \ \ (\ n)" by simp let ?\ = "\\. if \ = \ n then A2 else K 1 xn \ \ (g \)" have [simp]: "({.. {x. x \ n}) = ({.. (\x\elts \ \ {\. \ \ \ n}. \ (g x)) \ KI (Suc 0) (x ` {.. KI (Suc 0) (x ` {.. elts (\ * \)" using \sub sub A2 by fastforce+ moreover have "xn \ elts (\ * \)" using \sub xn by blast moreover have "strict_mono_sets (elts \) ?\" using sm sm_g g g_\ A2_sub unfolding strict_mono_sets_def strict_mono_on_def less_sets_def Pi_iff subset_iff Ball_def Bex_def image_iff by (simp (no_asm_use) add: if_split_mem2) (smt order_refl) ultimately have "\ (Suc n) ?\ (x(n := xn))" using tp1 x A2 by (auto simp: \_def K_def) with A2 show ?thesis by (rule_tac x="(g,?\,xn)" in exI) (simp add: \_def g sm_g g_\ xn) qed define G where "G \ \n \ x. @(g,\',x'). \xn. \ n g \ \' xn \ x' = (x(n:=xn)) \ \ (Suc n) \' x'" have G\: "(\(g,\',x'). \ (Suc n) \' x') (G n \ x)" and G\: "(\(g,\',x'). \ n g \ \' (x' n)) (G n \ x)" if "\ n \ x" for n \ x using step [OF that] by (force simp: G_def dest: some_eq_imp)+ define H where "H \ rec_nat (id,?\0,undefined) (\n (g0,\,x0). G n \ x0)" have H_Suc: "H (Suc n) = (case H n of (g0, xa, xb) \ G n xa xb)" for n by (simp add: H_def) have "(\(g,\,x). \ n \ x) (H n)" for n proof (induction n) case 0 show ?case by (simp add: H_def base) next case (Suc n) then show ?case using G\ by (fastforce simp: H_Suc) qed then have H_imp_\: "\ n \ x" if "H n = (g,\,x)" for g \ x n by (metis case_prodD that) then have H_imp_\: "(\(g,\',x'). let (g0,\,x) = H n in \ n g \ \' (x' n)) (H (Suc n))" for n using G\ by (fastforce simp: H_Suc split: prod.split) define g where "g \ \n. (\(g,\,x). g) (H (Suc n))" have g: "g n \ elts \ \ elts \" and sm_g: "strict_mono_on (g n) (elts \)" and 13: "\i. i\n \ g n (\ i) = \ i" for n using H_imp_\ [of n] by (auto simp: g_def \_def) define \ where "\ \ \n. (\(g,\,x). \) (H n)" define x where "x \ \n. (\(g,\,x). x n) (H (Suc n))" have 14: "\ (Suc n) \ \ K 1 (x n) \ \ n (g n \)" if "\ \ elts \" for \ n using H_imp_\ [of n] that by (force simp: \_def \_def x_def g_def) then have x14: "\ (Suc n) \ \ \ n (g n \)" if "\ \ elts \" for \ n using that by blast have 15: "x n \ \ n (\ n)" and 16: "less_sets {x n} (\ (Suc n) (\ n))" for n using H_imp_\ [of n] by (force simp: \_def \_def x_def)+ have \_\\: "\ n \ \ elts (\ * \)" if "\ \ elts \" for \ n using H_imp_\ [of n] that by (auto simp: \_def \_def split: prod.split) have 12: "strict_mono_sets (elts \) (\ n)" for n using H_imp_\ [of n] that by (auto simp: \_def \_def split: prod.split) have tp_\: "tp (\ n \) = \" if "\ \ elts \" for \ n using H_imp_\ [of n] that by (auto simp: \_def \_def split: prod.split) let ?Z = "range x" have S_dec: "\ (\ (m+k) ` elts \) \ \ (\ m ` elts \)" for k m by (induction k) (use 14 g in \fastforce+\) have "x n \ K 1 (x m)" if "m (\\ \ elts \. \ n \)" by (meson "15" UN_I \_in_\) also have "\ \ (\\ \ elts \. \ (Suc m) \)" using S_dec [of "Suc m"] less_iff_Suc_add that by auto also have "\ \ K 1 (x m)" using 14 by auto finally show ?thesis . qed then have "f{x m, x n} = 1" if "m2\<^esup> \ {1}" by (clarsimp simp: nsets_2_eq) (metis insert_commute less_linear) moreover have Z_sub: "?Z \ elts (\ * \)" using "15" \_\\ \_in_\ by blast moreover have "tp ?Z \ \ * \" proof - define \ where "\ \ \i j x. wfrec (measure (\k. j-k)) (\\ k. if k (Suc k)) else x) i" have \: "\ i j x = (if i (Suc i) j x) else x)" for i j x by (simp add: \_def wfrec cut_apply) have 17: "\ k j (\ i) = \ i" if "i \ k" for i j k using wf_measure [of "\k. j-k"] that by (induction k rule: wf_induct_rule) (simp add: "13" \ le_imp_less_Suc) have \_in_\: "\ i j \ \ elts \" if "\ \ elts \" for i j \ using wf_measure [of "\k. j-k"] that proof (induction i rule: wf_induct_rule) case (less i) with g show ?case by (force simp: \ [of i]) qed then have \_fun: "\ i j \ elts \ \ elts \" for i j by simp have sm_\: "strict_mono_on (\ i j) (elts \)" for i j using wf_measure [of "\k. j-k"] proof (induction i rule: wf_induct_rule) case (less i) with sm_g show ?case by (auto simp: \ [of i] strict_mono_on_def \_in_\) qed have *: "\ j (\ j) \ \ i (\ i j (\ j))" if "i < j" for i j using wf_measure [of "\k. j-k"] that proof (induction i rule: wf_induct_rule) case (less i) then have "j - Suc i < j - i" by (metis (no_types) Suc_diff_Suc lessI) with less \_in_\ show ?case by (simp add: \ [of i]) (metis 17 Suc_lessI \_in_\ order_refl order_trans x14) qed have le: "\ i j (\ j) \ \ i \ \ j \ \ i" for i j using sm_\ unfolding strict_mono_on_def by (metis "17" Ord_in_Ord Ord_linear2 \_in_\ leD le_refl less_V_def \Ord \\) then have less: "\ i j (\ j) < \ i \ \ j < \ i" for i j by (metis (no_types, lifting) "17" \_in_\ less_V_def order_refl sm_\ strict_mono_on_def) have eq: "\ i j (\ j) = \ i \ \ j = \ i" for i j by (metis eq_refl le less less_le) have 18: "less_sets (\ m (\ m)) (\ n (\ n)) \ \ m < \ n" for m n proof (cases n m rule: linorder_cases) case less show ?thesis proof (intro iffI) assume "less_sets (\ m (\ m)) (\ n (\ n))" moreover have "\ less_sets (\ m (\ m)) (\ n (\ n))" if "\ n = \ m" by (metis "*" "15" eq less less_V_def less_sets_def less_sets_weaken2 that) moreover have "\ less_sets (\ m (\ m)) (\ n (\ n))" if "\ n < \ m" using that 12 15 * [OF less] apply (clarsimp simp: less_sets_def strict_mono_sets_def) by (metis Ord_in_Ord Ord_linear2 \_in_\ \_in_\ \Ord \\ le leD less_asym subsetD) ultimately show "\ m < \ n" by (meson Ord_in_Ord Ord_linear_lt \_in_\ \Ord \\) next assume "\ m < \ n" then have "less_sets (\ n (\ n m (\ m))) (\ n (\ n))" by (metis "12" \_in_\ \_in_\ eq le less_V_def strict_mono_sets_def) then show "less_sets (\ m (\ m)) (\ n (\ n))" by (meson *[OF less] less_sets_weaken1) qed next case equal with 15 show ?thesis by auto next case greater show ?thesis proof (intro iffI) assume "less_sets (\ m (\ m)) (\ n (\ n))" moreover have "\ less_sets (\ m (\ m)) (\ n (\ n))" if "\ n = \ m" by (metis "*" "15" disjnt_iff eq greater in_mono less_sets_imp_disjnt that) moreover have "\ less_sets (\ m (\ m)) (\ n (\ n))" if "\ n < \ m" using that 12 15 * [OF greater] apply (clarsimp simp: less_sets_def strict_mono_sets_def) by (meson \_in_\ \_in_\ in_mono less less_asym) ultimately show "\ m < \ n" by (meson Ord_\ Ord_linear_lt) next assume "\ m < \ n" then have "less_sets (\ m (\ m)) (\ m (\ m n (\ n)))" by (meson 12 Ord_in_Ord Ord_linear2 \_in_\ \_in_\ le leD ord(2) strict_mono_sets_def) then show "less_sets (\ m (\ m)) (\ n (\ n))" by (meson "*" greater less_sets_weaken2) qed qed have \_increasing_\: "\ n (\ n) \ \ m (\ m)" if "m \ n" "\ m = \ n" for m n by (metis "*" "17" dual_order.order_iff_strict that) moreover have INF: "infinite {n. n \ m \ \ m = \ n}" for m proof - have "infinite (range (\n. q (\ m, n)))" unfolding q_def using to_nat_on_infinite [OF co_\U inf_\U] finite_image_iff by (simp add: finite_image_iff inj_on_def) moreover have "(range (\n. q (\ m, n))) \ {n. \ m = \ n}" using 11 [of "\ m"] by auto ultimately have "infinite {n. \ m = \ n}" using finite_subset by auto then have "infinite ({n. \ m = \ n} - {.. n" "\ p = \ n" "\ m = \ n" "n < p" with 16 [of n] show "x n < x p" by (simp add: less_sets_def) (metis "*" "15" "17" Suc_lessI le_SucI subsetD) qed then have inj_x: "inj_on x (?eqv m)" for m using strict_mono_on_imp_inj_on by blast define ZA where "ZA \ \m. ?Z \ \ m (\ m)" have small_ZA [simp]: "small (ZA m)" for m by (metis ZA_def inf_le1 small_image_nat smaller_than_small) have 19: "tp (ZA m) \ \" for m proof - have "x ` {n. m \ n \ \ m = \ n} \ ZA m" unfolding ZA_def using "15" \_increasing_\ by blast then have "infinite (ZA m)" using INF [of m] finite_image_iff [OF inj_x] by (meson finite_subset) then show ?thesis by (simp add: ordertype_infinite_ge_\) qed have "\f \ elts \ \ ZA m. strict_mono_on f (elts \)" for m proof - obtain Z where "Z \ ZA m" "tp Z = \" by (meson 19 Ord_\ le_ordertype_obtains_subset small_ZA) moreover have "ZA m \ ON" using Ord_in_Ord \_\\ \_in_\ unfolding ZA_def by blast ultimately show ?thesis by (metis strict_mono_on_ordertype Pi_mono small_ZA smaller_than_small subset_iff) qed then obtain \ where \: "\m. \ m \ elts \ \ ZA m" and sm_\: "\m. strict_mono_on (\ m) (elts \)" by metis have "Ex(\(m,\). \ \ elts \ \ \ = \ * \ + ord_of_nat m)" if "\ \ elts (\ * \)" for \ using that by (auto simp: mult [of \ \] lift_def elts_\) then obtain split where split: "\\. \ \ elts (\ * \) \ (\(m,\). \ \ elts \ \ \ = \ * \ + ord_of_nat m)(split \)" by meson have split_eq [simp]: "split (\ * \ + ord_of_nat m) = (m,\)" if "\ \ elts \" for \ m proof - have [simp]: "\ * \ + ord_of_nat m = \ * \ + ord_of_nat n \ \ = \ \ n = m" if "\ \ elts \" for \ n by (metis Ord_\ that Ord_mem_iff_less_TC mult_cancellation_lemma ord_of_nat_\ ord_of_nat_inject) show ?thesis using split [of "\*\ + m"] that by (auto simp: mult [of \ \] lift_def cong: conj_cong) qed define \ where "\ \ \\. (\(m,\). \ (q(\,0)) m)(split \)" have \_Pi: "\ \ elts (\ * \) \ (\m. ZA m)" using \ by (fastforce simp: \_def mult [of \ \] lift_def elts_\) moreover have "(\m. ZA m) \ ON" unfolding ZA_def using \_\\ \_in_\ elts_subset_ON by blast ultimately have Ord_\_Pi: "\ \ elts (\ * \) \ ON" by fastforce show "tp ?Z \ \ * \" proof - have \: "(\m. ZA m) = ?Z" using "15" by (force simp: ZA_def) moreover have "tp (elts (\ * \)) \ tp (\m. ZA m)" proof (rule ordertype_inc_le) show "\ ` elts (\ * \) \ (\m. ZA m)" using \_Pi by blast next fix u v assume x: "u \ elts (\ * \)" and y: "v \ elts (\ * \)" and "(u,v) \ VWF" then have "u Ord_in_Ord Ord_mult VWF_iff_Ord_less ord(2)) moreover obtain m \ n \ where ueq: "u = \ * \ + ord_of_nat m" and \: "\ \ elts \" and veq: "v = \ * \ + ord_of_nat n" and \: "\ \ elts \" using x y by (auto simp: mult [of \ \] lift_def elts_\) ultimately have "\ \ \" by (meson Ord_\ Ord_in_Ord Ord_linear2 \Ord \\ add_mult_less_add_mult less_asym ord_of_nat_\) consider (eq) "\ = \" | (lt) "\ < \" using \\ \ \\ le_neq_trans by blast then have "\ u < \ v" proof cases case eq then have "m < n" using ueq veq \u by simp then have "\ (q (\, 0)) m < \ (q (\, 0)) n" using sm_\ strict_mono_onD by blast then show ?thesis using eq ueq veq \ \m < n\ by (simp add: \_def) next case lt have "\ (q(\,0)) m \ \ (q(\,0)) (\(q(\,0)))" "\ (q (\,0)) n \ \ (q(\,0)) (\(q(\,0)))" using \ unfolding ZA_def by blast+ then show ?thesis using lt ueq veq \ \ 18 [of "q(\,0)" "q(\,0)"] by (simp add: \_def less_sets_def) qed then show "(\ u, \ v) \ VWF" using \_Pi by (metis Ord_\_Pi PiE VWF_iff_Ord_less x y mem_Collect_eq) qed (use \ in auto) ultimately show ?thesis by simp qed qed then obtain Z where "Z \ ?Z" "tp Z = \ * \" by (meson Ord_\ Ord_mult ord Z_sub down le_ordertype_obtains_subset) ultimately show False using iii [of Z] by (meson dual_order.trans image_mono nsets_mono) qed have False if 0: "\H. tp H = ord_of_nat (2*k) \ H \ elts (\*\) \ \ f ` [H]\<^bsup>2\<^esup> \ {0}" and 1: "\H. tp H = min \ (\ * \) \ H \ elts (\*\) \ \ f ` [H]\<^bsup>2\<^esup> \ {1}" proof (cases "\*\ \ \") case True then have \: "\H'\H. tp H' = \ * \" if "tp H = \" "small H" for H by (metis Ord_\ Ord_\1 Ord_in_Ord Ord_mult \ le_ordertype_obtains_subset that) have [simp]: "min \ (\*\) = \*\" by (simp add: min_absorb2 that True) then show ?thesis using * [OF 0] 1 True by simp (meson \ down image_mono nsets_mono subset_trans) next case False then have \: "\H'\H. tp H' = \" if "tp H = \ * \" "small H" for H by (metis Ord_linear_le Ord_ordertype \Ord \\ le_ordertype_obtains_subset that) then have "\ \ \*\" by (meson Ord_\ Ord_\1 Ord_in_Ord Ord_linear_le Ord_mult \ \Ord \\ False) then have [simp]: "min \ (\*\) = \" by (simp add: min_absorb1) then show ?thesis using * [OF 0] 1 False by simp (meson \ down image_mono nsets_mono subset_trans) qed then show "\iH\elts (\*\). tp H = [ord_of_nat (2*k), min \ (\*\)] ! i \ f ` [H]\<^bsup>2\<^esup> \ {i}" by force qed qed qed theorem Erdos_Milner: assumes \: "\ \ elts \1" shows "partn_lst_VWF (\\(1 + \ * ord_of_nat n)) [ord_of_nat (2^n), \\(1+\)] 2" proof (induction n) case 0 then show ?case using partn_lst_VWF_degenerate [of 1 2] by simp next case (Suc n) have "Ord \" using Ord_\1 Ord_in_Ord assms by blast have "1+\ \ \+1" by (simp add: \Ord \\ one_V_def plus_Ord_le) then have [simp]: "min (\ \ (1 + \)) (\ * \ \ \) = \ \ (1+\)" by (simp add: \Ord \\ oexp_add min_def) have ind: "indecomposable (\ \ (1 + \ * ord_of_nat n))" by (simp add: \Ord \\ indecomposable_\_power) show ?case proof (cases "n = 0") case True then show ?thesis using partn_lst_VWF_\_2 \Ord \\ one_V_def by auto next case False then have "Suc 0 < 2 ^ n" using less_2_cases not_less_eq by fastforce then have "partn_lst_VWF (\ \ (1 + \ * n) * \ \ \) [ord_of_nat (2 * 2 ^ n), \ \ (1 + \)] 2" using Erdos_Milner_aux [OF Suc ind, where \ = "\\\"] \Ord \\ \ by (auto simp: countable_oexp) then show ?thesis using \Ord \\ by (simp add: mult_succ mult.assoc oexp_add) qed qed corollary remark_3: "partn_lst_VWF (\\(Suc(4*k))) [4, \\(Suc(2*k))] 2" using Erdos_Milner [of "2*k" 2] apply (simp flip: ord_of_nat_mult ord_of_nat.simps) by (simp add: one_V_def) text \Theorem 3.2 of Jean A. Larson, ibid.\ corollary Theorem_3_2: fixes k n::nat shows "partn_lst_VWF (\\(n*k)) [\\n, ord_of_nat k] 2" proof (cases "n=0 \ k=0") case True then show ?thesis - by (auto intro: partn_lst_triv0 [where i=1] partn_lst_triv1 [where i=0] simp add:) + by (auto intro: partn_lst_triv0 [where i=1] partn_lst_triv1 [where i=0]) next case False then have "n > 0" "k > 0" by auto have PV: "partn_lst_VWF (\ \ (1 + ord_of_nat (n-1) * ord_of_nat (k-1))) [ord_of_nat (2 ^ (k-1)), \ \ (1 + ord_of_nat (n-1))] 2" using Erdos_Milner [of "ord_of_nat (n-1)" "k-1"] Ord_\1 Ord_mem_iff_lt less_imp_le by blast have "k+n \ Suc (Suc(k-1) * Suc(n-1))" by simp also have "\ \ Suc (k * n)" using False by auto finally have "1 + (n - 1) * (k - 1) \ (n*k)" using False by (auto simp: algebra_simps) then have "(1 + ord_of_nat (n - 1) * ord_of_nat (k - 1)) \ ord_of_nat(n*k)" by (metis (mono_tags, lifting) One_nat_def one_V_def ord_of_nat.simps ord_of_nat_add ord_of_nat_mono_iff ord_of_nat_mult) then have x: "\ \ (1 + ord_of_nat (n - 1) * ord_of_nat (k - 1)) \ \\(n*k)" by (simp add: oexp_mono_le) - then have "partn_lst_VWF (\\(n*k)) [ord_of_nat (2 ^ (k-1)), \ \ (1 + ord_of_nat (n-1))] 2" - using Partitions.partn_lst_greater_resource PV x by blast then have "partn_lst_VWF (\\(n*k)) [\ \ (1 + ord_of_nat (n-1)), ord_of_nat (2 ^ (k-1))] 2" - using partn_lst_two_swap by blast + by (metis PV partn_lst_two_swap Partitions.partn_lst_greater_resource less_eq_V_def) moreover have "(1 + ord_of_nat (n-1)) = ord_of_nat n" using ord_of_minus_1 [OF \n > 0\] by (simp add: one_V_def) ultimately have "partn_lst_VWF (\\(n*k)) [\ \ n, ord_of_nat (2 ^ (k-1))] 2" by simp then show ?thesis using power_gt_expt [of 2 "k-1"] by (force simp: less_Suc_eq intro: partn_lst_less) qed end diff --git a/thys/Projective_Measurements/CHSH_Inequality.thy b/thys/Projective_Measurements/CHSH_Inequality.thy new file mode 100644 --- /dev/null +++ b/thys/Projective_Measurements/CHSH_Inequality.thy @@ -0,0 +1,1457 @@ +(* +Author: + Mnacho Echenim, Université Grenoble Alpes +*) + +theory CHSH_Inequality imports + Projective_Measurements + + +begin + + +section \The CHSH inequality\ + +text \The local hidden variable assumption for quantum mechanics was developed to make the case +that quantum theory was incomplete. In this part we formalize the CHSH inequality, which provides +an upper-bound of a quantity involving expectations in a probability space, and exploit this +inequality to show that the local hidden variable assumption does not hold.\ + +subsection \Inequality statement\ + +lemma chsh_real: + fixes A0::real + assumes "\A0 * B1\ \ 1" + and "\A0 * B0\ \ 1" + and "\A1 * B0\ \ 1" + and "\A1 * B1\ \ 1" + shows "\A0 * B1 - A0 * B0 + A1 * B0 + A1*B1\ \ 2" +proof - + have "A0 * B1 - A0 * B0 = A0 * B1 - A0 * B0 + A0 * B1 * A1 * B0 - A0 * B1 * A1 * B0" by simp + also have "... = A0 * B1 * (1 + A1*B0) - A0 * B0 * (1 + A1* B1)" + by (metis (no_types, hide_lams) add_diff_cancel_right calculation diff_add_eq + group_cancel.sub1 mult.commute mult.right_neutral + vector_space_over_itself.scale_left_commute + vector_space_over_itself.scale_right_diff_distrib + vector_space_over_itself.scale_right_distrib + vector_space_over_itself.scale_scale) + finally have "A0 * B1 - A0 * B0 = A0 * B1 * (1 + A1*B0) - A0 * B0 * (1 + A1* B1)" . + hence "\A0 * B1 - A0 * B0\ \ \A0 * B1 * (1 + A1*B0)\ + \A0 * B0 * (1 + A1* B1)\" by simp + also have "... = \A0 * B1\ * \(1 + A1*B0)\ + \A0 * B0\ * \(1 + A1* B1)\" by (simp add: abs_mult) + also have "... \ \(1 + A1*B0)\ + \(1 + A1* B1)\" + proof- + have "\A0 * B1\ * \(1 + A1*B0)\ \ \(1 + A1*B0)\" + using assms(1) mult_left_le_one_le[of "\(1 + A1*B0)\"] by simp + moreover have "\A0 * B0\ *\(1 + A1* B1)\ \ \(1 + A1* B1)\" + using assms mult_left_le_one_le[of "\(1 + A1*B1)\"] by simp + ultimately show ?thesis by simp + qed + also have "... = 1 + A1*B0 + 1 + A1* B1" using assms by (simp add: abs_le_iff) + also have "... = 2 + A1 * B0 + A1 * B1" by simp + finally have pls: "\A0 * B1 - A0 * B0\ \ 2 + A1 * B0 + A1 * B1" . + have "A0 * B1 - A0 * B0 = A0 * B1 - A0 * B0 + A0 * B1 * A1 * B0 - A0 * B1 * A1 * B0" by simp + also have "... = A0 * B1 * (1 - A1*B0) - A0 * B0 * (1 - A1* B1)" + proof - + have "A0 * (B1 - (B0 - A1 * (B1 * B0)) - A1 * (B1 * B0)) = A0 * (B1 - B0)" + by fastforce + then show ?thesis + by (metis (no_types) add.commute calculation diff_diff_add mult.right_neutral + vector_space_over_itself.scale_left_commute + vector_space_over_itself.scale_right_diff_distrib vector_space_over_itself.scale_scale) + qed + finally have "A0 * B1 - A0 * B0 = A0 * B1 * (1 - A1*B0) - A0 * B0 * (1 - A1* B1)" . + hence "\A0 * B1 - A0 * B0\ \ \A0 * B1 * (1 - A1*B0)\ + \A0 * B0 * (1 - A1* B1)\" by simp + also have "... = \A0 * B1\ * \(1 - A1*B0)\ + \A0 * B0\ * \(1 - A1* B1)\" by (simp add: abs_mult) + also have "... \ \(1 - A1*B0)\ + \(1 - A1* B1)\" + proof- + have "\A0 * B1\ * \(1 - A1*B0)\ \ \(1 - A1*B0)\" + using assms(1) mult_left_le_one_le[of "\(1 - A1*B0)\"] by simp + moreover have "\A0 * B0\ *\(1 - A1* B1)\ \ \(1 - A1* B1)\" + using assms mult_left_le_one_le[of "\(1 - A1*B1)\"] by simp + ultimately show ?thesis by simp + qed + also have "... = 1 - A1*B0 + 1 - A1* B1" using assms by (simp add: abs_le_iff) + also have "... = 2 - A1 * B0 - A1 * B1" by simp + finally have mns: "\A0 * B1 - A0 * B0\ \ 2 - (A1 * B0 + A1 * B1)" by simp + have ls: "\A0 * B1 - A0 * B0\ \ 2 - \A1 * B0 + A1 * B1\" + proof (cases "0 \ A1 * B0 + A1 * B1") + case True + then show ?thesis using mns by simp + next + case False + then show ?thesis using pls by simp + qed + have "\A0 * B1 - A0 * B0 + A1 * B0 + A1 * B1\ \ \A0 * B1 - A0 * B0\ + \A1 * B0 + A1 * B1\" + by simp + also have "... \ 2" using ls by simp + finally show ?thesis . +qed + +lemma (in prob_space) chsh_expect: + fixes A0::"'a \ real" + assumes "AE w in M. \A0 w\ \ 1" + and "AE w in M. \A1 w\ \ 1" + and "AE w in M. \B0 w\ \ 1" + and "AE w in M. \B1 w\ \ 1" +and "integrable M (\w. A0 w * B1 w)" +and "integrable M (\w. A1 w * B1 w)" +and "integrable M (\w. A1 w * B0 w)" +and "integrable M (\w. A0 w * B0 w)" +shows "\expectation (\w. A1 w * B0 w) + expectation (\w. A0 w *B1 w) + + expectation (\w. A1 w * B1 w) - expectation (\w. A0 w * B0 w)\ \ 2" +proof - + have exeq: "expectation (\w. A1 w * B0 w) + expectation (\w. A0 w * B1 w) + + expectation (\w. A1 w * B1 w) - expectation (\w. A0 w * B0 w) = + expectation (\w. A0 w * B1 w - A0 w * B0 w + A1 w * B0 w + A1 w * B1 w)" + using assms by auto + have "\expectation (\w. A0 w * B1 w - A0 w * B0 w + A1 w * B0 w + A1 w * B1 w)\ \ + expectation (\w. \A0 w * B1 w - A0 w * B0 w + A1 w * B0 w + A1 w * B1 w\)" + using integral_abs_bound by blast + also have "... \ 2" + proof (rule integral_le_const) + show "AE w in M. \A0 w * B1 w - A0 w * B0 w + A1 w * B0 w + A1 w * B1 w\ \ (2::real)" + proof (rule AE_mp) + show "AE w in M. \A0 w\ \ 1 \ \A1 w\ \ 1 \ \B0 w\ \ 1 \ \B1 w\ \ 1" + using assms by simp + show "AE w in M. \A0 w\ \ 1 \ \A1 w\ \ 1 \ \B0 w\ \ 1 \ \B1 w\ \ 1 \ + \A0 w * B1 w - A0 w * B0 w + A1 w * B0 w + A1 w * B1 w\ \ 2" + proof + fix w + assume "w\ space M" + show "\A0 w\ \ 1 \ \A1 w\ \ 1 \ \B0 w\ \ 1 \ \B1 w\ \ 1 \ + \A0 w * B1 w - A0 w * B0 w + A1 w * B0 w + A1 w * B1 w\ \ 2" + proof + assume ineq: "\A0 w\ \ 1 \ \A1 w\ \ 1 \ \B0 w\ \ 1 \ \B1 w\ \ 1" + show "\A0 w * B1 w - A0 w * B0 w + A1 w * B0 w + A1 w * B1 w\ \ 2" + proof (rule chsh_real) + show "\A0 w * B1 w\ \ 1" using ineq by (simp add: abs_mult mult_le_one) + show "\A0 w * B0 w\ \ 1" using ineq by (simp add: abs_mult mult_le_one) + show "\A1 w * B1 w\ \ 1" using ineq by (simp add: abs_mult mult_le_one) + show "\A1 w * B0 w\ \ 1" using ineq by (simp add: abs_mult mult_le_one) + qed + qed + qed + qed + show "integrable M (\x. \A0 x * B1 x - A0 x * B0 x + A1 x * B0 x + A1 x * B1 x\)" + proof (rule Bochner_Integration.integrable_abs) + show "integrable M (\x. A0 x * B1 x - A0 x * B0 x + A1 x * B0 x + A1 x * B1 x)" + using assms by auto + qed + qed + finally show ?thesis using exeq by simp +qed + +text \The local hidden variable assumption states that separated quantum measurements are +independent. It is standard for this assumption to be stated in a context where the hidden +variable admits a density; it is stated here in a more general contest involving expectations, +with no assumption on the existence of a density.\ + +definition pos_rv:: "'a measure \ ('a \ real) \ bool" where +"pos_rv M Xr \ Xr \ borel_measurable M \ (AE w in M. (0::real) \ Xr w)" + +definition prv_sum:: "'a measure \ complex Matrix.mat \ (complex \ 'a \ real) \ bool" where +"prv_sum M A Xr \ (AE w in M. (\ a\ spectrum A. Xr a w) = 1)" + +definition (in cpx_sq_mat) lhv where +"lhv M A B R XA XB \ + prob_space M \ + (\a \spectrum A. pos_rv M (XA a)) \ + (prv_sum M A XA) \ + (\b \spectrum B. pos_rv M (XB b)) \ + (prv_sum M B XB) \ + (\a \spectrum A . \b \ spectrum B. + (integrable M (\w. XA a w * XB b w)) \ + integral\<^sup>L M (\w. XA a w * XB b w) = + Re (Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R)))" + +(*definition (in cpx_sq_mat) lhv where +"lhv M A B R XA XB \ + prob_space M \ + (\a \spectrum A. (XA a \ borel_measurable M) \ + (AE w in M. ((0::real) \ XA a w))) \ + (AE w in M. (\ a\ spectrum A. XA a w) = 1) \ + (\b \spectrum B. (XB b \ borel_measurable M) \ + (AE w in M. (0 \ XB b w))) \ + (AE w in M. (\ b\ spectrum B. XB b w) = 1) \ + (\a \spectrum A . \b \ spectrum B. + (integrable M (\w. XA a w * XB b w)) \ + integral\<^sup>L M (\w. XA a w * XB b w) = + Re (Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R)))"*) + +lemma (in cpx_sq_mat) lhv_posl: + assumes "lhv M A B R XA XB" + shows "AE w in M. (\ a \ spectrum A. 0 \ XA a w)" +proof (rule AE_ball_countable[THEN iffD2]) + show "countable (spectrum A)" using spectrum_finite[of A] + by (simp add: countable_finite) + show "\a\spectrum A. AE w in M. 0 \ XA a w" using assms unfolding lhv_def pos_rv_def by simp +qed + +lemma (in cpx_sq_mat) lhv_lt1_l: + assumes "lhv M A B R XA XB" + shows "AE w in M. (\ a \ spectrum A. XA a w \ 1)" +proof (rule AE_mp) + show "AE w in M. (\ a \ spectrum A. 0 \ XA a w) \ (\ a\ spectrum A. XA a w) = 1" + using lhv_posl assms unfolding lhv_def pos_rv_def prv_sum_def by simp + show "AE w in M. (\a\spectrum A. 0 \ XA a w) \ (\a\spectrum A. XA a w) = 1 \ + (\a\spectrum A. XA a w \ 1)" + proof + fix w + assume "w\ space M" + show "(\a\spectrum A. 0 \ XA a w) \ (\a\spectrum A. XA a w) = 1 \ + (\a\spectrum A. XA a w \ 1)" + proof (rule impI) + assume pr: "(\a\spectrum A. 0 \ XA a w) \ (\a\spectrum A. XA a w) = 1" + show "\a\spectrum A. XA a w \ 1" + proof + fix a + assume "a\ spectrum A" + show "XA a w \ 1" + proof (rule pos_sum_1_le[of "spectrum A"]) + show "finite (spectrum A)" using spectrum_finite[of A] by simp + show "a \ spectrum A" using \a \ spectrum A\ . + show " \i\spectrum A. 0 \ XA i w" using pr by simp + show "(\i\spectrum A. XA i w) = 1" using pr by simp + qed + qed + qed + qed +qed + +lemma (in cpx_sq_mat) lhv_posr: + assumes "lhv M A B R XA XB" + shows "AE w in M. (\ b \ spectrum B. 0 \ XB b w)" +proof (rule AE_ball_countable[THEN iffD2]) + show "countable (spectrum B)" using spectrum_finite[of B] + by (simp add: countable_finite) + show "\b\spectrum B. AE w in M. 0 \ XB b w" using assms unfolding lhv_def pos_rv_def by simp +qed + +lemma (in cpx_sq_mat) lhv_lt1_r: + assumes "lhv M A B R XA XB" + shows "AE w in M. (\ a \ spectrum B. XB a w \ 1)" +proof (rule AE_mp) + show "AE w in M. (\ a \ spectrum B. 0 \ XB a w) \ (\ a\ spectrum B. XB a w) = 1" + using lhv_posr assms unfolding lhv_def prv_sum_def pos_rv_def by simp + show "AE w in M. (\a\spectrum B. 0 \ XB a w) \ (\a\spectrum B. XB a w) = 1 \ + (\a\spectrum B. XB a w \ 1)" + proof + fix w + assume "w\ space M" + show "(\a\spectrum B. 0 \ XB a w) \ (\a\spectrum B. XB a w) = 1 \ + (\a\spectrum B. XB a w \ 1)" + proof (rule impI) + assume pr: "(\a\spectrum B. 0 \ XB a w) \ (\a\spectrum B. XB a w) = 1" + show "\a\spectrum B. XB a w \ 1" + proof + fix a + assume "a\ spectrum B" + show "XB a w \ 1" + proof (rule pos_sum_1_le[of "spectrum B"]) + show "finite (spectrum B)" using spectrum_finite[of B] by simp + show "a \ spectrum B" using \a \ spectrum B\ . + show " \i\spectrum B. 0 \ XB i w" using pr by simp + show "(\i\spectrum B. XB i w) = 1" using pr by simp + qed + qed + qed + qed +qed + +lemma (in cpx_sq_mat) lhv_AE_propl: + assumes "lhv M A B R XA XB" + shows "AE w in M. (\ a \ spectrum A. 0 \ XA a w \ XA a w \ 1) \ (\ a\ spectrum A. XA a w) = 1" +proof (rule AE_conjI) + show "AE w in M. \a\spectrum A. 0 \ XA a w \ XA a w \ 1" + proof (rule AE_mp) + show "AE w in M. (\ a \ spectrum A. 0 \ XA a w) \ (\ a \ spectrum A. XA a w \ 1)" + using assms lhv_posl[of M A] lhv_lt1_l[of M A] by simp + show "AE w in M. (\a\spectrum A. 0 \ XA a w) \ (\a\spectrum A. XA a w \ 1) \ + (\a\spectrum A. 0 \ XA a w \ XA a w \ 1)" by auto + qed + show "AE w in M. (\a\spectrum A. XA a w) = 1" using assms unfolding lhv_def prv_sum_def + by simp +qed + +lemma (in cpx_sq_mat) lhv_AE_propr: + assumes "lhv M A B R XA XB" + shows "AE w in M. (\ a \ spectrum B. 0 \ XB a w \ XB a w \ 1) \ (\ a\ spectrum B. XB a w) = 1" +proof (rule AE_conjI) + show "AE w in M. \a\spectrum B. 0 \ XB a w \ XB a w \ 1" + proof (rule AE_mp) + show "AE w in M. (\ a \ spectrum B. 0 \ XB a w) \ (\ a \ spectrum B. XB a w \ 1)" + using assms lhv_posr[of M _ B] lhv_lt1_r[of M _ B] by simp + show "AE w in M. (\a\spectrum B. 0 \ XB a w) \ (\a\spectrum B. XB a w \ 1) \ + (\a\spectrum B. 0 \ XB a w \ XB a w \ 1)" by auto + qed + show "AE w in M. (\a\spectrum B. XB a w) = 1" using assms unfolding lhv_def prv_sum_def + by simp +qed + +lemma (in cpx_sq_mat) lhv_integral_eq: + fixes c::real + assumes "lhv M A B R XA XB" + and "a\ spectrum A" +and "b\ spectrum B" +shows "integral\<^sup>L M (\w. XA a w * XB b w) = + Re (Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R))" + using assms unfolding lhv_def by simp + +lemma (in cpx_sq_mat) lhv_integrable: + fixes c::real + assumes "lhv M A B R XA XB" + and "a\ spectrum A" +and "b\ spectrum B" +shows "integrable M (\w. XA a w * XB b w)" using assms unfolding lhv_def by simp + +lemma (in cpx_sq_mat) lhv_scal_integrable: + fixes c::real + assumes "lhv M A B R XA XB" + and "a\ spectrum A" +and "b\ spectrum B" +shows "integrable M (\w. c *XA a w * d * XB b w)" +proof - + { + fix x + assume "x\ space M" + have "c * d * (XA a x * XB b x) = c * XA a x * d * XB b x" by simp + } note eq = this + have "integrable M (\w. XA a w * XB b w)" using assms unfolding lhv_def by simp + hence g:"integrable M (\w. c * d * (XA a w * XB b w))" using integrable_real_mult_right by simp + show ?thesis + proof (rule Bochner_Integration.integrable_cong[THEN iffD2], simp) + show "integrable M (\w. c * d * (XA a w * XB b w))" using g . + show "\x. x \ space M \ c * XA a x * d * XB b x = c * d * (XA a x * XB b x)" using eq by simp + qed +qed + +lemma (in cpx_sq_mat) lhv_lsum_scal_integrable: + assumes "lhv M A B R XA XB" + and "a\ spectrum A" +shows "integrable M (\x. \b\spectrum B. c * XA a x * (f b) * XB b x)" +proof (rule Bochner_Integration.integrable_sum) + fix b + assume "b\ spectrum B" + thus "integrable M (\x. c * XA a x * f b *XB b x)" using \a\ spectrum A\ assms + lhv_scal_integrable[of M] by simp +qed + +lemma (in cpx_sq_mat) lhv_sum_integrable: + assumes "lhv M A B R XA XB" +shows "integrable M (\w. (\ a \ spectrum A. (\ b \ spectrum B. f a * XA a w * g b * XB b w)))" +proof (rule Bochner_Integration.integrable_sum) + fix a + assume "a\ spectrum A" + thus "integrable M (\x. \b\spectrum B. f a * XA a x * g b * XB b x)" + using assms lhv_lsum_scal_integrable[of M] + by simp +qed + +lemma (in cpx_sq_mat) spectrum_abs_1_weighted_suml: + assumes "lhv M A B R Va Vb" +and "{Re x |x. x \ spectrum A} \ {}" + and "{Re x |x. x \ spectrum A} \ {- 1, 1}" +and "hermitian A" + and "A\ fc_mats" +shows "AE w in M. \(\a\spectrum A. Re a * Va a w)\ \ 1" +proof (rule AE_mp) + show "AE w in M. (\a\spectrum A. 0 \ Va a w \ Va a w \ 1) \ (\a\spectrum A. Va a w) = 1" + using assms lhv_AE_propl[of M A B _ Va] by simp + show "AE w in M. (\a\spectrum A. 0 \ Va a w \ Va a w \ 1) \ (\a\spectrum A. Va a w) = 1 \ + \\a\spectrum A. Re a * Va a w\ \ 1" + proof + fix w + assume "w\ space M" + show "(\a\spectrum A. 0 \ Va a w \ Va a w \ 1) \ (\a\spectrum A. Va a w) = 1 \ + \\a\spectrum A. Re a * Va a w\ \ 1" + proof (intro impI) + assume pr: "(\a\spectrum A. 0 \ Va a w \ Va a w \ 1) \ (\a\spectrum A. Va a w) = 1" + show "\(\a\spectrum A. Re a * Va a w)\ \ 1" + proof (cases "{Re x |x. x \ spectrum A} = {- 1, 1}") + case True + hence sp: "spectrum A = {-1, 1}" using hermitian_Re_spectrum[of A] assms by simp + hence scsum: "(\a\spectrum A. Re a * Va a w) = Va 1 w - Va (-1) w" + using sum_2_elems by simp + have sum: "(\a\spectrum A. Va a w) = Va (-1) w + Va 1 w" + using sp sum_2_elems by simp + have "\Va 1 w - Va (-1) w\ \ 1" + proof (rule fct_bound') + have "1 \ spectrum A" using sp by simp + thus "0 \ Va 1 w" using pr by simp + have "-1 \ spectrum A" using sp by simp + thus "0 \ Va (- 1) w" using pr by simp + show "Va (- 1) w + Va 1 w = 1" using pr sum by simp + qed + thus ?thesis using scsum by simp + next + case False + then show ?thesis + proof (cases "{Re x |x. x \ spectrum A} = {- 1}") + case True + hence "spectrum A = {-1}" using hermitian_Re_spectrum[of A] assms by simp + hence "(\a\spectrum A. Re a * Va a w) = - Va (-1) w" by simp + moreover have "-1 \ spectrum A" using \spectrum A = {-1}\ by simp + ultimately show ?thesis using pr by simp + next + case False + hence "{Re x |x. x \ spectrum A} = {1}" using assms \{Re x |x. x \ spectrum A} \ {-1, 1}\ + last_subset[of "{Re x |x. x \ spectrum A}"] by simp + hence "spectrum A = {1}" using hermitian_Re_spectrum[of A] assms by simp + hence "(\a\spectrum A. Re a * Va a w) = Va 1 w" by simp + moreover have "1 \ spectrum A" using \spectrum A = {1}\ by simp + ultimately show ?thesis using pr by simp + qed + qed + qed + qed +qed + +lemma (in cpx_sq_mat) spectrum_abs_1_weighted_sumr: + assumes "lhv M B A R Vb Va" +and "{Re x |x. x \ spectrum A} \ {}" + and "{Re x |x. x \ spectrum A} \ {- 1, 1}" +and "hermitian A" + and "A\ fc_mats" +shows "AE w in M. \(\a\spectrum A. Re a * Va a w)\ \ 1" +proof (rule AE_mp) + show "AE w in M. (\a\spectrum A. 0 \ Va a w \ Va a w \ 1) \ (\a\spectrum A. Va a w) = 1" + using assms lhv_AE_propr[of M B A _ Vb] by simp + show "AE w in M. (\a\spectrum A. 0 \ Va a w \ Va a w \ 1) \ (\a\spectrum A. Va a w) = 1 \ + \\a\spectrum A. Re a * Va a w\ \ 1" + proof + fix w + assume "w\ space M" + show "(\a\spectrum A. 0 \ Va a w \ Va a w \ 1) \ (\a\spectrum A. Va a w) = 1 \ + \\a\spectrum A. Re a * Va a w\ \ 1" + proof (intro impI) + assume pr: "(\a\spectrum A. 0 \ Va a w \ Va a w \ 1) \ (\a\spectrum A. Va a w) = 1" + show "\(\a\spectrum A. Re a * Va a w)\ \ 1" + proof (cases "{Re x |x. x \ spectrum A} = {- 1, 1}") + case True + hence sp: "spectrum A = {-1, 1}" using hermitian_Re_spectrum[of A] assms by simp + hence scsum: "(\a\spectrum A. Re a * Va a w) = Va 1 w - Va (-1) w" + using sum_2_elems by simp + have sum: "(\a\spectrum A. Va a w) = Va (-1) w + Va 1 w" + using sp sum_2_elems by simp + have "\Va 1 w - Va (-1) w\ \ 1" + proof (rule fct_bound') + have "1 \ spectrum A" using sp by simp + thus "0 \ Va 1 w" using pr by simp + have "-1 \ spectrum A" using sp by simp + thus "0 \ Va (- 1) w" using pr by simp + show "Va (- 1) w + Va 1 w = 1" using pr sum by simp + qed + thus ?thesis using scsum by simp + next + case False + then show ?thesis + proof (cases "{Re x |x. x \ spectrum A} = {- 1}") + case True + hence "spectrum A = {-1}" using hermitian_Re_spectrum[of A] assms by simp + hence "(\a\spectrum A. Re a * Va a w) = - Va (-1) w" by simp + moreover have "-1 \ spectrum A" using \spectrum A = {-1}\ by simp + ultimately show ?thesis using pr by simp + next + case False + hence "{Re x |x. x \ spectrum A} = {1}" using assms \{Re x |x. x \ spectrum A} \ {-1, 1}\ + last_subset[of "{Re x |x. x \ spectrum A}"] by simp + hence "spectrum A = {1}" using hermitian_Re_spectrum[of A] assms by simp + hence "(\a\spectrum A. Re a * Va a w) = Va 1 w" by simp + moreover have "1 \ spectrum A" using \spectrum A = {1}\ by simp + ultimately show ?thesis using pr by simp + qed + qed + qed + qed +qed + +definition qt_expect where +"qt_expect A Va = (\w. (\a\spectrum A. Re a * Va a w))" + +lemma (in cpx_sq_mat) spectr_sum_integrable: +assumes "lhv M A B R Va Vb" +shows "integrable M (\w. qt_expect A Va w * qt_expect B Vb w)" +proof (rule Bochner_Integration.integrable_cong[THEN iffD2]) + show "M = M" by simp + show "\w. w \ space M \ qt_expect A Va w * qt_expect B Vb w = + (\a\spectrum A. (\b\spectrum B. Re a * Va a w * Re b * Vb b w))" + proof - + fix w + assume "w\ space M" + show "qt_expect A Va w * qt_expect B Vb w = + (\a\spectrum A. (\b\spectrum B. Re a * Va a w * Re b * Vb b w))" unfolding qt_expect_def + by (metis (mono_tags, lifting) Finite_Cartesian_Product.sum_cong_aux sum_product + vector_space_over_itself.scale_scale) + qed + show "integrable M (\w. \a\spectrum A. (\b\spectrum B. Re a * Va a w * Re b * Vb b w))" + using lhv_sum_integrable[of M] assms by simp +qed + +lemma (in cpx_sq_mat) lhv_sum_integral': + assumes "lhv M A B R XA XB" +shows "integral\<^sup>L M (\w. (\ a \ spectrum A. f a * XA a w) * (\ b \ spectrum B. g b * XB b w)) = + (\ a \ spectrum A. f a * (\ b \ spectrum B. g b * integral\<^sup>L M (\w. XA a w * XB b w)))" +proof - + have "integral\<^sup>L M (\w. (\ a \ spectrum A. f a * XA a w) * (\ b \ spectrum B. g b * XB b w)) = + integral\<^sup>L M (\w. (\ a \ spectrum A. (\ b \ spectrum B. f a * XA a w * g b * XB b w)))" + proof (rule Bochner_Integration.integral_cong, simp) + fix w + assume "w\ space M" + show "(\a\spectrum A. f a * XA a w) * (\b\spectrum B. g b * XB b w) = + (\a\spectrum A. (\b\spectrum B. f a * XA a w * (g b) * XB b w))" + by (simp add: sum_product vector_space_over_itself.scale_scale) + qed + also have "... = (\ a \ spectrum A. + integral\<^sup>L M (\w. (\ b \ spectrum B. f a * XA a w * g b * XB b w)))" + proof (rule Bochner_Integration.integral_sum) + fix a + assume "a\ spectrum A" + thus "integrable M (\x. \b\spectrum B. f a * XA a x * g b * XB b x)" + using lhv_lsum_scal_integrable[of M] assms by simp + qed + also have "... = (\ a \ spectrum A. f a * + integral\<^sup>L M (\w. (\ b \ spectrum B. XA a w * g b * XB b w)))" + proof - + have "\ a\ spectrum A. integral\<^sup>L M (\w. (\ b \ spectrum B. f a * XA a w * g b * XB b w)) = + f a * integral\<^sup>L M (\w. (\ b \ spectrum B. XA a w * g b * XB b w))" + proof + fix a + assume "a\ spectrum A" + have "(LINT w|M. (\b\spectrum B. f a * XA a w * g b * XB b w)) = + (LINT w|M. f a* (\b\spectrum B. XA a w * g b * XB b w))" + proof (rule Bochner_Integration.integral_cong, simp) + fix x + assume "x \ space M" + show "(\b\spectrum B. f a * XA a x * g b * XB b x) = + f a * (\b\spectrum B. XA a x * g b * XB b x)" + by (metis (no_types, lifting) Finite_Cartesian_Product.sum_cong_aux + vector_space_over_itself.scale_scale vector_space_over_itself.scale_sum_right) + qed + also have "... = f a * (LINT w|M. (\b\spectrum B. XA a w * g b * XB b w))" by simp + finally show "(LINT w|M. (\b\spectrum B. f a * XA a w * g b * XB b w)) = + f a * (LINT w|M. (\b\spectrum B. XA a w * g b * XB b w))" . + qed + thus ?thesis by simp + qed + also have "... = (\ a \ spectrum A. f a * (\ b \ spectrum B. g b * + integral\<^sup>L M (\w. XA a w * XB b w)))" + proof (rule sum.cong, simp) + fix a + assume "a\ spectrum A" + have "integral\<^sup>L M (\w. (\ b \ spectrum B. XA a w * g b * XB b w)) = (\ b \ spectrum B. + integral\<^sup>L M (\w. XA a w * g b * XB b w))" + proof (rule Bochner_Integration.integral_sum) + show "\b. b \ spectrum B \ integrable M (\x. XA a x * g b * XB b x)" + proof - + fix b + assume "b\ spectrum B" + thus "integrable M (\x. XA a x * g b * XB b x)" + using assms lhv_scal_integrable[of M _ _ _ _ _ a b 1] \a\ spectrum A\ by simp + qed + qed + also have "... = (\ b \ spectrum B. g b * integral\<^sup>L M (\w. XA a w * XB b w))" + proof (rule sum.cong, simp) + fix x + assume "x\ spectrum B" + have "LINT w|M. XA a w * g x * XB x w = LINT w|M. g x * (XA a w * XB x w)" + by (rule Bochner_Integration.integral_cong, auto) + also have "... = g x * (LINT w|M. XA a w * XB x w)" + using Bochner_Integration.integral_mult_right_zero[of M "g x" "\w. XA a w * XB x w"] + by simp + finally show "LINT w|M. XA a w * g x * XB x w = g x * (LINT w|M. XA a w * XB x w)" . + qed + finally have "integral\<^sup>L M (\w. (\ b \ spectrum B. XA a w * g b * XB b w)) = + (\ b \ spectrum B. g b * integral\<^sup>L M (\w. XA a w * XB b w))" . + thus "f a * (LINT w|M. (\b\spectrum B. XA a w * g b * XB b w)) = + f a * (\ b \ spectrum B. g b * integral\<^sup>L M (\w. XA a w * XB b w))" by simp + qed + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) sum_qt_expect_trace: + assumes "lhv M A B R XA XB" + shows "(\ a \ spectrum A. f a * (\ b \ spectrum B. g b * integral\<^sup>L M (\w. XA a w * XB b w))) = + (\ a \ spectrum A. f a * (\ b \ spectrum B. g b * + Re (Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R))))" +proof (rule sum.cong, simp) + fix a + assume "a\ spectrum A" + have "(\b\spectrum B. g b * (LINT w|M. XA a w * XB b w)) = + (\b\spectrum B. g b * + Re (Complex_Matrix.trace (eigen_projector A a * eigen_projector B b * R)))" + proof (rule sum.cong, simp) + fix b + assume "b\ spectrum B" + show "g b * (LINT w|M. XA a w * XB b w) = + g b * Re (Complex_Matrix.trace (eigen_projector A a * eigen_projector B b * R))" + using lhv_integral_eq[of M] assms \a \ spectrum A\ \b \ spectrum B\ by simp + qed + thus "f a * (\b\spectrum B. g b * (LINT w|M. XA a w * XB b w)) = + f a * (\b\spectrum B. g b * + Re (Complex_Matrix.trace (eigen_projector A a * eigen_projector B b * R)))" by simp +qed + +lemma (in cpx_sq_mat) sum_eigen_projector_trace_dist: + assumes "hermitian B" +and "A\ fc_mats" +and "B\ fc_mats" +and "R\ fc_mats" + shows "(\ b \ spectrum B. (b * + Complex_Matrix.trace(A * (eigen_projector B b) * R))) = Complex_Matrix.trace(A * B * R)" +proof - + have "(\b\spectrum B. b * Complex_Matrix.trace (A * eigen_projector B b * R)) = + (\b\spectrum B. Complex_Matrix.trace (A * (b \\<^sub>m (eigen_projector B b)) * R))" + proof (rule sum.cong, simp) + fix b + assume "b\ spectrum B" + have "b * Complex_Matrix.trace (A * eigen_projector B b * R) = + Complex_Matrix.trace (b \\<^sub>m (A * eigen_projector B b * R))" + proof (rule trace_smult[symmetric]) + show "A * eigen_projector B b * R \ carrier_mat dimR dimR" using eigen_projector_carrier + assms fc_mats_carrier dim_eq \b \ spectrum B\ cpx_sq_mat_mult by meson + qed + also have "... = Complex_Matrix.trace (A * (b \\<^sub>m eigen_projector B b) * R)" + proof - + have "b \\<^sub>m (A * eigen_projector B b * R) = b \\<^sub>m (A * (eigen_projector B b * R))" + proof - + have "A * eigen_projector B b * R = A * (eigen_projector B b * R)" + by (metis \b \ spectrum B\ assms(1) assms(2) assms(3) assms(4) assoc_mult_mat dim_eq + fc_mats_carrier eigen_projector_carrier) + thus ?thesis by simp + qed + also have "... = A * (b \\<^sub>m (eigen_projector B b * R))" + proof (rule mult_smult_distrib[symmetric]) + show "A \ carrier_mat dimR dimR" using eigen_projector_carrier assms + fc_mats_carrier dim_eq by simp + show "eigen_projector B b * R \ carrier_mat dimR dimR" using eigen_projector_carrier + \b \ spectrum B\ assms fc_mats_carrier dim_eq cpx_sq_mat_mult by blast + qed + also have "... = A * ((b \\<^sub>m eigen_projector B b) * R)" + proof - + have "b \\<^sub>m (eigen_projector B b * R) = (b \\<^sub>m eigen_projector B b) * R" + proof (rule mult_smult_assoc_mat[symmetric]) + show "eigen_projector B b \ carrier_mat dimR dimR" using eigen_projector_carrier + \b \ spectrum B\ assms fc_mats_carrier dim_eq by simp + show "R \ carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp + qed + thus ?thesis by simp + qed + also have "... = A * (b \\<^sub>m eigen_projector B b) * R" + by (metis \b \ spectrum B\ assms(1) assms(2) assms(3) assms(4) assoc_mult_mat + cpx_sq_mat_smult dim_eq fc_mats_carrier eigen_projector_carrier) + finally have "b \\<^sub>m (A * eigen_projector B b * R) = A * (b \\<^sub>m eigen_projector B b) * R" . + then show ?thesis by simp + qed + finally show "b * Complex_Matrix.trace (A * eigen_projector B b * R) = + Complex_Matrix.trace (A * (b \\<^sub>m eigen_projector B b) * R)" . + qed + also have "... = Complex_Matrix.trace (A * + (sum_mat (\b. b \\<^sub>m eigen_projector B b) (spectrum B)) * R)" + proof (rule trace_sum_mat_mat_distrib, (auto simp add: assms)) + show "finite (spectrum B)" using spectrum_finite[of B] by simp + fix b + assume "b\ spectrum B" + show "b \\<^sub>m eigen_projector B b \ fc_mats" + by (simp add: \b \ spectrum B\ assms(1) assms(3) cpx_sq_mat_smult eigen_projector_carrier) + qed + also have "... = Complex_Matrix.trace (A * B * R)" + proof - + have "sum_mat (\b. b \\<^sub>m eigen_projector B b) (spectrum B) = B" using make_pm_sum' assms by simp + thus ?thesis by simp + qed + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) sum_eigen_projector_trace_right: + assumes "hermitian A" +and "A\ fc_mats" +and "B\ fc_mats" +shows "(\ a \ spectrum A. Complex_Matrix.trace (a \\<^sub>m eigen_projector A a * B)) = + Complex_Matrix.trace (A * B)" +proof - + have "sum_mat (\a. a \\<^sub>m eigen_projector A a * B) (spectrum A) = + sum_mat (\a. a \\<^sub>m eigen_projector A a) (spectrum A) * B" + proof (rule mult_sum_mat_distrib_right) + show "finite (spectrum A)" using spectrum_finite[of A] by simp + show "\a. a \ spectrum A \ a \\<^sub>m eigen_projector A a \ fc_mats" + using assms(1) assms(2) cpx_sq_mat_smult eigen_projector_carrier by blast + show "B\ fc_mats" using assms by simp + qed + also have "... = A * B" using make_pm_sum' assms by simp + finally have seq: "sum_mat (\a. a \\<^sub>m eigen_projector A a * B) (spectrum A) = A * B" . + have "(\ a \ spectrum A. Complex_Matrix.trace (a \\<^sub>m eigen_projector A a * B)) = + Complex_Matrix.trace (sum_mat (\a. a \\<^sub>m eigen_projector A a * B) (spectrum A))" + proof (rule trace_sum_mat[symmetric]) + show "finite (spectrum A)" using spectrum_finite[of A] by simp + show "\a. a \ spectrum A \ a \\<^sub>m eigen_projector A a * B \ fc_mats" + by (simp add: assms(1) assms(2) assms(3) cpx_sq_mat_mult cpx_sq_mat_smult + eigen_projector_carrier) + qed + also have "... = Complex_Matrix.trace (A * B)" using seq by simp + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) sum_eigen_projector_trace: + assumes "hermitian A" + and "hermitian B" + and "A\ fc_mats" + and "B\ fc_mats" +and "R\ fc_mats" + shows "(\ a \ spectrum A. a * (\ b \ spectrum B. (b * + Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R)))) = + Complex_Matrix.trace(A * B * R)" +proof - + have "(\ a \ spectrum A. a * (\ b \ spectrum B. (b * + Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R)))) = (\ a \ spectrum A. + Complex_Matrix.trace (a \\<^sub>m eigen_projector A a * (B * R)))" + proof (rule sum.cong, simp) + fix a + assume "a\ spectrum A" + hence "(\b\spectrum B. b * + Complex_Matrix.trace (eigen_projector A a * eigen_projector B b * R)) = + Complex_Matrix.trace (eigen_projector A a * B * R)" using + sum_eigen_projector_trace_dist[of B "eigen_projector A a" R] assms eigen_projector_carrier + by blast + hence "a * (\ b \ spectrum B. (b * + Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R))) = + a * Complex_Matrix.trace (eigen_projector A a * B * R)" by simp + also have "... = Complex_Matrix.trace (a \\<^sub>m (eigen_projector A a * B * R))" + using trace_smult[symmetric, of "eigen_projector A a * B * R" dimR a] assms + \a \ spectrum A\ cpx_sq_mat_mult dim_eq fc_mats_carrier eigen_projector_carrier by force + also have "... = Complex_Matrix.trace (a \\<^sub>m eigen_projector A a * (B * R))" + proof - + have "a \\<^sub>m (eigen_projector A a * B * R) = a \\<^sub>m (eigen_projector A a * B) * R" + proof (rule mult_smult_assoc_mat[symmetric]) + show "R\ carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp + show "eigen_projector A a * B \ carrier_mat dimR dimR" using assms eigen_projector_carrier + cpx_sq_mat_mult fc_mats_carrier dim_eq \a \ spectrum A\ by blast + qed + also have "... = a \\<^sub>m eigen_projector A a * B * R" + proof - + have "a \\<^sub>m (eigen_projector A a * B) = a \\<^sub>m eigen_projector A a * B" + using mult_smult_assoc_mat[symmetric] + proof - + show ?thesis + by (metis \\nr nc n k B A. \A \ carrier_mat nr n; B \ carrier_mat n nc\ \ + k \\<^sub>m (A * B) = k \\<^sub>m A * B\ \a \ spectrum A\ assms(1) assms(3) assms(4) dim_eq + fc_mats_carrier eigen_projector_carrier) + qed + thus ?thesis by simp + qed + also have "... = a \\<^sub>m eigen_projector A a * (B * R)" + by (metis \a \ spectrum A\ assms(1) assms(3) assms(4) assms(5) assoc_mult_mat + cpx_sq_mat_smult dim_eq fc_mats_carrier eigen_projector_carrier) + finally show ?thesis by simp + qed + finally show "a * (\ b \ spectrum B. (b * + Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R))) = + Complex_Matrix.trace (a \\<^sub>m eigen_projector A a * (B * R))" . + qed + also have "... = Complex_Matrix.trace (A * (B * R))" + using sum_eigen_projector_trace_right[of A "B * R"] assms by (simp add: cpx_sq_mat_mult) + also have "... = Complex_Matrix.trace (A * B * R)" + proof - + have "A * (B * R) = A * B * R" + proof (rule assoc_mult_mat[symmetric]) + show "A\ carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp + show "B\ carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp + show "R\ carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp + qed + thus ?thesis by simp + qed + finally show ?thesis . +qed + +text \We obtain the main result of this part, which relates the quantum expectation value of a +joint measurement with an expectation.\ + +lemma (in cpx_sq_mat) sum_qt_expect: + assumes "lhv M A B R XA XB" + and "A\ fc_mats" + and "B\ fc_mats" + and "R\ fc_mats" + and "hermitian A" + and "hermitian B" + shows "integral\<^sup>L M (\w. (qt_expect A XA w) * (qt_expect B XB w)) = + Re (Complex_Matrix.trace(A * B * R))" +proof - + have br: "\ b \ spectrum B. b\ Reals" using assms hermitian_spectrum_real[of B] by auto + have ar: "\a \ spectrum A. a\ Reals" using hermitian_spectrum_real[of A] assms by auto + have "integral\<^sup>L M (\w. (\ a \ spectrum A. Re a* XA a w) * (\ b \ spectrum B. Re b *XB b w)) = + (\ a \ spectrum A. Re a * (\ b \ spectrum B. Re b * integral\<^sup>L M (\w. XA a w * XB b w)))" + using lhv_sum_integral'[of M] assms by simp + also have "... = (\ a \ spectrum A. Re a * (\ b \ spectrum B. Re b * + Re (Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R))))" + using assms sum_qt_expect_trace[of M] by simp + also have "... = (\ a \ spectrum A. Re a * Re (\ b \ spectrum B. (b * + Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R))))" + proof (rule sum.cong, simp) + fix a + assume "a\ spectrum A" + have "(\b\spectrum B. Re b * + Re (Complex_Matrix.trace (eigen_projector A a * eigen_projector B b * R))) = + (\ b \ spectrum B. Re (b * + Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R)))" + proof (rule sum.cong, simp) + fix b + assume "b\ spectrum B" + hence "b\ Reals" using hermitian_spectrum_real[of B] assms by simp + hence "Re b = b" by simp + thus "Re b * Re (Complex_Matrix.trace (eigen_projector A a * eigen_projector B b * R)) = + Re (b * Complex_Matrix.trace (eigen_projector A a * eigen_projector B b * R))" + using hermitian_spectrum_real using \b \ \\ mult_real_cpx by auto + qed + also have "... = + Re (\ b \ spectrum B. b * + Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R))" by simp + finally have "(\b\spectrum B. Re b * + Re (Complex_Matrix.trace (eigen_projector A a * eigen_projector B b * R))) = + Re (\ b \ spectrum B. b * + Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R))" . + thus "Re a * (\b\spectrum B. Re b * + Re (Complex_Matrix.trace (eigen_projector A a * eigen_projector B b * R))) = + Re a * Re (\b\spectrum B. + (b * Complex_Matrix.trace (eigen_projector A a * eigen_projector B b * R)))" + by simp + qed + also have "... = (\ a \ spectrum A. Re (a * (\ b \ spectrum B. (b * + Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R)))))" + proof (rule sum.cong, simp) + fix x + assume "x\ spectrum A" + hence "Re x = x" using ar by simp + thus "Re x * Re (\b\spectrum B. b * + Complex_Matrix.trace (eigen_projector A x * eigen_projector B b * R)) = + Re (x * (\b\spectrum B. b * + Complex_Matrix.trace (eigen_projector A x * eigen_projector B b * R)))" + using \x \ spectrum A\ ar mult_real_cpx by auto + qed + also have "... = Re (\ a \ spectrum A. a * (\ b \ spectrum B. (b * + Complex_Matrix.trace(eigen_projector A a * (eigen_projector B b) * R))))" by simp + also have "... = Re (Complex_Matrix.trace(A *B * R))" using assms + sum_eigen_projector_trace[of A B] by simp + finally show ?thesis unfolding qt_expect_def . +qed + + +subsection \Properties of specific observables\ + +text \In this part we consider a specific density operator and specific observables corresponding +to joint bipartite measurements. We will compute the quantum expectation value of this system and +prove that it violates the CHSH inequality, thus proving that the local hidden variable assumption +cannot hold.\ + +subsubsection \Ket 0, Ket 1 and the corresponding projectors\ + +definition ket_0::"complex Matrix.vec" where +"ket_0 = unit_vec 2 0" + +lemma ket_0_dim: + shows "dim_vec ket_0 = 2" unfolding ket_0_def by simp + +lemma ket_0_norm: + shows "\ket_0\ = 1" using unit_cpx_vec_length unfolding ket_0_def by simp + +lemma ket_0_mat: + shows "ket_vec ket_0 = Matrix.mat_of_cols_list 2 [[1, 0]]" + by (auto simp add: ket_vec_def Matrix.mat_of_cols_list_def ket_0_def) + +definition ket_1::"complex Matrix.vec" where +"ket_1 = unit_vec 2 1" + +lemma ket_1_dim: + shows "dim_vec ket_1 = 2" unfolding ket_1_def by simp + +lemma ket_1_norm: + shows "\ket_1\ = 1" using unit_cpx_vec_length unfolding ket_1_def by simp + +definition ket_01 + where "ket_01 = tensor_vec ket_0 ket_1" + +lemma ket_01_dim: + shows "dim_vec ket_01 = 4" unfolding ket_01_def + by (simp add: ket_0_dim ket_1_dim) + +definition ket_10 + where "ket_10 = tensor_vec ket_1 ket_0" + +lemma ket_10_dim: + shows "dim_vec ket_10 = 4" unfolding ket_10_def by (simp add: ket_0_dim ket_1_dim) + +text \We define \verb+ket_psim+, one of the Bell states (or EPR pair).\ + +definition ket_psim where +"ket_psim = 1/(sqrt 2) \\<^sub>v (ket_01 - ket_10)" + +lemma ket_psim_dim: + shows "dim_vec ket_psim = 4" using ket_01_dim ket_10_dim unfolding ket_psim_def by simp + +lemma ket_psim_norm: + shows "\ket_psim\ = 1" +proof - + have "dim_vec ket_psim = 2\<^sup>2" unfolding ket_psim_def ket_01_def ket_10_def ket_0_def ket_1_def + by simp + moreover have "(\i<4. (cmod (vec_index ket_psim i))\<^sup>2) = 1" + apply (auto simp add: ket_psim_def ket_01_def ket_10_def ket_0_def ket_1_def) + apply (simp add: sum_4_elems) + done + ultimately show ?thesis by (simp add: cpx_vec_length_def) +qed + +text \\verb+rho_psim+ represents the density operator associated with the quantum +state \verb+ket_psim+.\ + +definition rho_psim where +"rho_psim = rank_1_proj ket_psim" + +lemma rho_psim_carrier: + shows "rho_psim \ carrier_mat 4 4" using rank_1_proj_carrier[of ket_psim] ket_psim_dim + rho_psim_def by simp + +lemma rho_psim_dim_row: + shows "dim_row rho_psim = 4" using rho_psim_carrier by simp + +lemma rho_psim_density: + shows "density_operator rho_psim" unfolding density_operator_def +proof + show "Complex_Matrix.positive rho_psim" using rank_1_proj_positive[of ket_psim] ket_psim_norm + rho_psim_def by simp + show "Complex_Matrix.trace rho_psim = 1" using rank_1_proj_trace[of ket_psim] ket_psim_norm + rho_psim_def by simp +qed + + +subsubsection \The X and Z matrices and two of their combinations\ + +text \In this part we prove properties of two standard matrices in quantum theory, $X$ and $Z$, +as well as two of their combinations: $\frac{X+Z}{\sqrt{2}}$ and $\frac{Z - X}{\sqrt{2}}$. +Note that all of these matrices are observables, they will be used to violate the CHSH inequality.\ + +lemma Z_carrier: shows "Z \ carrier_mat 2 2" unfolding Z_def by simp + +lemma Z_hermitian: + shows "hermitian Z" using dagger_adjoint dagger_of_Z unfolding hermitian_def by simp + +lemma unitary_Z: + shows "Complex_Matrix.unitary Z" +proof - + have "Complex_Matrix.adjoint Z * Z = (1\<^sub>m 2)" using dagger_adjoint[of Z] by simp + thus ?thesis unfolding unitary_def + by (metis Complex_Matrix.adjoint_adjoint Complex_Matrix.unitary_def Z_carrier adjoint_dim + carrier_matD(1) inverts_mat_def unitary_adjoint) +qed + +lemma X_carrier: shows "X \ carrier_mat 2 2" unfolding X_def by simp + +lemma X_hermitian: + shows "hermitian X" using dagger_adjoint dagger_of_X unfolding hermitian_def by simp + +lemma unitary_X: + shows "Complex_Matrix.unitary X" +proof - + have "Complex_Matrix.adjoint X * X = (1\<^sub>m 2)" using dagger_adjoint[of X] by simp + thus ?thesis unfolding unitary_def + by (metis Complex_Matrix.adjoint_adjoint Complex_Matrix.unitary_def X_carrier adjoint_dim + carrier_matD(1) inverts_mat_def unitary_adjoint) +qed + +definition XpZ + where "XpZ = -1/sqrt(2) \\<^sub>m (X + Z)" + +lemma XpZ_carrier: + shows "XpZ \ carrier_mat 2 2" unfolding XpZ_def X_def Z_def by simp + +lemma XpZ_hermitian: + shows "hermitian XpZ" +proof - + have "X + Z \ carrier_mat 2 2" using Z_carrier X_carrier by simp + moreover have "hermitian (X + Z)" using X_hermitian Z_hermitian hermitian_add Matrix.mat_carrier + unfolding X_def Z_def by blast + ultimately show ?thesis using hermitian_smult[of "X + Z" 2 "- 1 / sqrt 2"] unfolding XpZ_def + by auto +qed + +lemma XpZ_inv: + "XpZ * XpZ = 1\<^sub>m 2" unfolding XpZ_def X_def Z_def times_mat_def one_mat_def + apply (rule cong_mat, simp+) + apply (auto simp add: Matrix.scalar_prod_def) + apply (auto simp add: Gates.csqrt_2_sq) + done + +lemma unitary_XpZ: + shows "Complex_Matrix.unitary XpZ" +proof - + have "Complex_Matrix.adjoint XpZ * XpZ = (1\<^sub>m 2)" using XpZ_inv XpZ_hermitian + unfolding hermitian_def by simp + thus ?thesis unfolding unitary_def + by (metis Complex_Matrix.adjoint_adjoint Complex_Matrix.unitary_def XpZ_carrier adjoint_dim + carrier_matD(1) inverts_mat_def unitary_adjoint) +qed + +definition ZmX + where "ZmX = 1/sqrt(2) \\<^sub>m (Z - X)" + +lemma ZmX_carrier: + shows "ZmX \ carrier_mat 2 2" unfolding ZmX_def X_def Z_def + by (simp add: minus_carrier_mat') + +lemma ZmX_hermitian: + shows "hermitian ZmX" +proof - + have "Z - X \ carrier_mat 2 2" unfolding X_def Z_def + by (simp add: minus_carrier_mat) + moreover have "hermitian (Z - X)" using X_hermitian Z_hermitian hermitian_minus Matrix.mat_carrier + unfolding X_def Z_def by blast + ultimately show ?thesis using hermitian_smult[of "Z - X" 2 "1 / sqrt 2"] unfolding ZmX_def + by auto +qed + +lemma ZmX_inv: + "ZmX * ZmX = 1\<^sub>m 2" unfolding ZmX_def X_def Z_def times_mat_def one_mat_def + apply (rule cong_mat, simp+) + apply (auto simp add: Matrix.scalar_prod_def) + apply (auto simp add: Gates.csqrt_2_sq) + done + +lemma unitary_ZmX: + shows "Complex_Matrix.unitary ZmX" +proof - + have "Complex_Matrix.adjoint ZmX * ZmX = (1\<^sub>m 2)" using ZmX_inv ZmX_hermitian + unfolding hermitian_def by simp + thus ?thesis unfolding unitary_def + by (metis Complex_Matrix.adjoint_adjoint Complex_Matrix.unitary_def ZmX_carrier adjoint_dim + carrier_matD(1) inverts_mat_def unitary_adjoint) +qed + +definition Z_XpZ + where "Z_XpZ = tensor_mat Z XpZ" + +lemma Z_XpZ_carrier: + shows "Z_XpZ \ carrier_mat 4 4" unfolding Z_XpZ_def using tensor_mat_carrier XpZ_carrier + Z_carrier by auto + +definition X_XpZ + where "X_XpZ = tensor_mat X XpZ" + +lemma X_XpZ_carrier: + shows "X_XpZ \ carrier_mat 4 4" using tensor_mat_carrier XpZ_carrier X_carrier + unfolding X_XpZ_def by auto + +definition Z_ZmX + where "Z_ZmX = tensor_mat Z ZmX" + +lemma Z_ZmX_carrier: + shows "Z_ZmX \ carrier_mat 4 4" using tensor_mat_carrier ZmX_carrier Z_carrier + unfolding Z_ZmX_def by auto + +definition X_ZmX + where "X_ZmX = tensor_mat X ZmX" + +lemma X_ZmX_carrier: + shows "X_ZmX \ carrier_mat 4 4" using tensor_mat_carrier X_carrier ZmX_carrier + unfolding X_ZmX_def by auto + +lemma X_ZmX_rho_psim[simp]: + shows "Complex_Matrix.trace (rho_psim * X_ZmX) = 1/ (sqrt 2)" + apply (auto simp add: ket_10_def ket_1_def X_ZmX_def ZmX_def X_def ket_01_def + Z_def rho_psim_def ket_psim_def rank_1_proj_def outer_prod_def ket_0_def) + apply (auto simp add: Complex_Matrix.trace_def) + apply (simp add: sum_4_elems) + apply (simp add: csqrt_2_sq) + done + +lemma Z_ZmX_rho_psim[simp]: + shows "Complex_Matrix.trace (rho_psim * Z_ZmX) = -1/ (sqrt 2)" + apply (auto simp add: rho_psim_def ket_psim_def ket_10_def) + apply (auto simp add: Z_ZmX_def Z_def ZmX_def X_def) + apply (auto simp add: rank_1_proj_def outer_prod_def ket_01_def ket_1_def ket_0_def) + apply (auto simp add: Complex_Matrix.trace_def sum_4_elems) + apply (simp add: csqrt_2_sq) + done + +lemma X_XpZ_rho_psim[simp]: + shows "Complex_Matrix.trace (rho_psim * X_XpZ) =1/ (sqrt 2)" + apply (auto simp add: rho_psim_def ket_psim_def ket_10_def) + apply (auto simp add: X_XpZ_def Z_def XpZ_def X_def) + apply (auto simp add: rank_1_proj_def outer_prod_def ket_01_def ket_1_def ket_0_def) + apply (auto simp add: Complex_Matrix.trace_def sum_4_elems) + apply (simp add: csqrt_2_sq) + done + +lemma Z_XpZ_rho_psim[simp]: + shows "Complex_Matrix.trace (rho_psim * Z_XpZ) =1/ (sqrt 2)" + apply (auto simp add: rho_psim_def ket_psim_def ket_10_def) + apply (auto simp add: Z_XpZ_def XpZ_def X_def Z_def) + apply (auto simp add: rank_1_proj_def outer_prod_def ket_01_def ket_1_def ket_0_def) + apply (auto simp add: Complex_Matrix.trace_def sum_4_elems) + apply (simp add: csqrt_2_sq) + done + +definition Z_I where +"Z_I = tensor_mat Z (1\<^sub>m 2)" + +lemma Z_I_carrier: + shows "Z_I \ carrier_mat 4 4" using tensor_mat_carrier Z_carrier unfolding Z_I_def by auto + +lemma Z_I_hermitian: + shows "hermitian Z_I" unfolding Z_I_def using tensor_mat_hermitian[of Z 2 "1\<^sub>m 2" 2] + by (simp add: Z_carrier Z_hermitian hermitian_one) + +lemma Z_I_unitary: + shows "unitary Z_I" unfolding Z_I_def using tensor_mat_unitary[of Z "1\<^sub>m 2"] Z_carrier unitary_Z + using unitary_one by auto + +lemma Z_I_spectrum: + shows "{Re x |x. x \ spectrum Z_I} \ {- 1, 1}" using unitary_hermitian_Re_spectrum Z_I_hermitian + Z_I_unitary Z_I_carrier by simp + +definition X_I where +"X_I = tensor_mat X (1\<^sub>m 2)" + +lemma X_I_carrier: + shows "X_I \ carrier_mat 4 4" using tensor_mat_carrier X_carrier unfolding X_I_def by auto + +lemma X_I_hermitian: + shows "hermitian X_I" unfolding X_I_def using tensor_mat_hermitian[of X 2 "1\<^sub>m 2" 2] + by (simp add: X_carrier X_hermitian hermitian_one) + +lemma X_I_unitary: + shows "unitary X_I" unfolding X_I_def using tensor_mat_unitary[of X "1\<^sub>m 2"] X_carrier unitary_X + using unitary_one by auto + +lemma X_I_spectrum: + shows "{Re x |x. x \ spectrum X_I} \ {- 1, 1}" using unitary_hermitian_Re_spectrum X_I_hermitian + X_I_unitary X_I_carrier by simp + +definition I_XpZ where +"I_XpZ = tensor_mat (1\<^sub>m 2) XpZ" + +lemma I_XpZ_carrier: + shows "I_XpZ \ carrier_mat 4 4" using tensor_mat_carrier XpZ_carrier unfolding I_XpZ_def by auto + +lemma I_XpZ_hermitian: + shows "hermitian I_XpZ" unfolding I_XpZ_def using tensor_mat_hermitian[of "1\<^sub>m 2" 2 XpZ 2] + by (simp add: XpZ_carrier XpZ_hermitian hermitian_one) + +lemma I_XpZ_unitary: + shows "unitary I_XpZ" unfolding I_XpZ_def using tensor_mat_unitary[of "1\<^sub>m 2" XpZ] XpZ_carrier + unitary_XpZ using unitary_one by auto + +lemma I_XpZ_spectrum: + shows "{Re x |x. x \ spectrum I_XpZ} \ {- 1, 1}" using unitary_hermitian_Re_spectrum + I_XpZ_hermitian I_XpZ_unitary I_XpZ_carrier by simp + +definition I_ZmX where +"I_ZmX = tensor_mat (1\<^sub>m 2) ZmX" + +lemma I_ZmX_carrier: + shows "I_ZmX \ carrier_mat 4 4" using tensor_mat_carrier ZmX_carrier unfolding I_ZmX_def by auto + +lemma I_ZmX_hermitian: + shows "hermitian I_ZmX" unfolding I_ZmX_def using tensor_mat_hermitian[of "1\<^sub>m 2" 2 ZmX 2] + by (simp add: ZmX_carrier ZmX_hermitian hermitian_one) + +lemma I_ZmX_unitary: + shows "unitary I_ZmX" unfolding I_ZmX_def using tensor_mat_unitary[of "1\<^sub>m 2" ZmX] ZmX_carrier + unitary_ZmX using unitary_one by auto + +lemma I_ZmX_spectrum: + shows "{Re x |x. x \ spectrum I_ZmX} \ {- 1, 1}" using unitary_hermitian_Re_spectrum I_ZmX_hermitian + I_ZmX_unitary I_ZmX_carrier by simp + +lemma X_I_ZmX_eq: + shows "X_I * I_ZmX = X_ZmX" unfolding X_I_def I_ZmX_def X_ZmX_def using mult_distr_tensor + by (metis (no_types, lifting) X_inv ZmX_inv index_mult_mat(2) index_mult_mat(3) index_one_mat(2) + index_one_mat(3) left_mult_one_mat' pos2 right_mult_one_mat') + +lemma X_I_XpZ_eq: + shows "X_I * I_XpZ = X_XpZ" unfolding X_I_def I_XpZ_def X_XpZ_def using mult_distr_tensor + by (metis (no_types, lifting) X_inv XpZ_inv index_mult_mat(2) index_mult_mat(3) index_one_mat(2) + index_one_mat(3) left_mult_one_mat' pos2 right_mult_one_mat') + +lemma Z_I_XpZ_eq: + shows "Z_I * I_XpZ = Z_XpZ" unfolding Z_I_def I_XpZ_def Z_XpZ_def using mult_distr_tensor + by (metis (no_types, lifting) Z_inv XpZ_inv index_mult_mat(2) index_mult_mat(3) index_one_mat(2) + index_one_mat(3) left_mult_one_mat' pos2 right_mult_one_mat') + +lemma Z_I_ZmX_eq: + shows "Z_I * I_ZmX = Z_ZmX" unfolding Z_I_def I_ZmX_def Z_ZmX_def using mult_distr_tensor + by (metis (no_types, lifting) Z_inv ZmX_inv index_mult_mat(2) index_mult_mat(3) index_one_mat(2) + index_one_mat(3) left_mult_one_mat' pos2 right_mult_one_mat') + + +subsubsection \No local hidden variable\ + +text \We show that the local hidden variable hypothesis cannot hold by exhibiting a quantum +expectation value that is greater than the upper-bound givven by the CHSH inequality.\ + +locale bin_cpx = cpx_sq_mat + + assumes dim4: "dimR = 4" + +lemma (in bin_cpx) X_I_XpZ_trace: + assumes "lhv M X_I I_XpZ R Vx Vp" + and "R\ fc_mats" + shows "LINT w|M. (qt_expect X_I Vx w) * (qt_expect I_XpZ Vp w) = + Re (Complex_Matrix.trace (R * X_XpZ))" +proof - + have "LINT w|M. (qt_expect X_I Vx w) * (qt_expect I_XpZ Vp w) = + Re (Complex_Matrix.trace (X_I * I_XpZ * R))" + proof (rule sum_qt_expect, (simp add: assms)) + show "X_I \ fc_mats" using X_I_carrier dim4 fc_mats_carrier dim_eq by simp + show "R\ fc_mats" using assms by simp + show "I_XpZ \ fc_mats" using I_XpZ_carrier dim4 fc_mats_carrier dim_eq by simp + show "hermitian X_I" using X_I_hermitian . + show "hermitian I_XpZ" using I_XpZ_hermitian . + qed + also have "... = Re (Complex_Matrix.trace (X_XpZ * R))" using X_I_XpZ_eq by simp + also have "... = Re (Complex_Matrix.trace (R * X_XpZ))" + proof - + have "Complex_Matrix.trace (X_XpZ * R) = Complex_Matrix.trace (R * X_XpZ)" + using trace_comm[of X_XpZ 4 R] X_XpZ_carrier assms dim4 fc_mats_carrier dim_eq by simp + thus ?thesis by simp + qed + finally show ?thesis . +qed + +lemma (in bin_cpx) X_I_XpZ_chsh: + assumes "lhv M X_I I_XpZ rho_psim Vx Vp" + shows "LINT w|M. (qt_expect X_I Vx w) * (qt_expect I_XpZ Vp w) = + 1/sqrt 2" +proof - + have "LINT w|M. (qt_expect X_I Vx w) * (qt_expect I_XpZ Vp w) = + Re (Complex_Matrix.trace (rho_psim * X_XpZ))" + proof (rule X_I_XpZ_trace, (simp add: assms)) + show "rho_psim \ fc_mats" using rho_psim_carrier fc_mats_carrier dim_eq dim4 by simp + qed + also have "... = 1/sqrt 2" using X_XpZ_rho_psim by simp + finally show ?thesis . +qed + +lemma (in bin_cpx) Z_I_XpZ_trace: + assumes "lhv M Z_I I_XpZ R Vz Vp" + and "R\ fc_mats" + shows "LINT w|M. (qt_expect Z_I Vz w) * (qt_expect I_XpZ Vp w) = + Re (Complex_Matrix.trace (R * Z_XpZ))" +proof - + have "LINT w|M. (qt_expect Z_I Vz w) * (qt_expect I_XpZ Vp w) = + Re (Complex_Matrix.trace (Z_I * I_XpZ * R))" + proof (rule sum_qt_expect, (simp add: assms)) + show "Z_I \ fc_mats" using Z_I_carrier dim4 fc_mats_carrier dim_eq by simp + show "R\ fc_mats" using assms by simp + show "I_XpZ \ fc_mats" using I_XpZ_carrier dim4 fc_mats_carrier dim_eq by simp + show "hermitian Z_I" using Z_I_hermitian . + show "hermitian I_XpZ" using I_XpZ_hermitian . + qed + also have "... = Re (Complex_Matrix.trace (Z_XpZ * R))" using Z_I_XpZ_eq by simp + also have "... = Re (Complex_Matrix.trace (R * Z_XpZ))" + proof - + have "Complex_Matrix.trace (Z_XpZ * R) = Complex_Matrix.trace (R * Z_XpZ)" + using trace_comm[of Z_XpZ 4 R] Z_XpZ_carrier assms dim4 fc_mats_carrier dim_eq by simp + thus ?thesis by simp + qed + finally show ?thesis . +qed + +lemma (in bin_cpx) Z_I_XpZ_chsh: + assumes "lhv M Z_I I_XpZ rho_psim Vz Vp" + shows "LINT w|M. (qt_expect Z_I Vz w) * (qt_expect I_XpZ Vp w) = + 1/sqrt 2" +proof - + have "LINT w|M. (qt_expect Z_I Vz w) * (qt_expect I_XpZ Vp w) = + Re (Complex_Matrix.trace (rho_psim * Z_XpZ))" + proof (rule Z_I_XpZ_trace, (simp add: assms)) + show "rho_psim \ fc_mats" using rho_psim_carrier fc_mats_carrier dim_eq dim4 by simp + qed + also have "... = 1/sqrt 2" using Z_XpZ_rho_psim by simp + finally show ?thesis unfolding qt_expect_def . +qed + +lemma (in bin_cpx) X_I_ZmX_trace: + assumes "lhv M X_I I_ZmX R Vx Vp" + and "R\ fc_mats" + shows "LINT w|M. (qt_expect X_I Vx w) * (qt_expect I_ZmX Vp w) = + Re (Complex_Matrix.trace (R * X_ZmX))" +proof - + have "LINT w|M. (qt_expect X_I Vx w) * (qt_expect I_ZmX Vp w) = + Re (Complex_Matrix.trace (X_I * I_ZmX * R))" + proof (rule sum_qt_expect, (simp add: assms)) + show "X_I \ fc_mats" using X_I_carrier dim4 fc_mats_carrier dim_eq by simp + show "R\ fc_mats" using assms by simp + show "I_ZmX \ fc_mats" using I_ZmX_carrier dim4 fc_mats_carrier dim_eq by simp + show "hermitian X_I" using X_I_hermitian . + show "hermitian I_ZmX" using I_ZmX_hermitian . + qed + also have "... = Re (Complex_Matrix.trace (X_ZmX * R))" using X_I_ZmX_eq by simp + also have "... = Re (Complex_Matrix.trace (R * X_ZmX))" + proof - + have "Complex_Matrix.trace (X_ZmX * R) = Complex_Matrix.trace (R * X_ZmX)" + using trace_comm[of X_ZmX 4 R] X_ZmX_carrier assms dim4 fc_mats_carrier dim_eq by simp + thus ?thesis by simp + qed + finally show ?thesis . +qed + +lemma (in bin_cpx) X_I_ZmX_chsh: + assumes "lhv M X_I I_ZmX rho_psim Vx Vp" + shows "LINT w|M. (qt_expect X_I Vx w) * (qt_expect I_ZmX Vp w) = + 1/sqrt 2" +proof - + have "LINT w|M. (qt_expect X_I Vx w) * (qt_expect I_ZmX Vp w) = + Re (Complex_Matrix.trace (rho_psim * X_ZmX))" + proof (rule X_I_ZmX_trace, (simp add: assms)) + show "rho_psim \ fc_mats" using rho_psim_carrier fc_mats_carrier dim_eq dim4 by simp + qed + also have "... = 1/sqrt 2" using X_ZmX_rho_psim by simp + finally show ?thesis unfolding qt_expect_def . +qed + +lemma (in bin_cpx) Z_I_ZmX_trace: + assumes "lhv M Z_I I_ZmX R Vz Vp" + and "R\ fc_mats" + shows "LINT w|M. (qt_expect Z_I Vz w) * (qt_expect I_ZmX Vp w) = + Re (Complex_Matrix.trace (R * Z_ZmX))" +proof - + have "LINT w|M. (qt_expect Z_I Vz w) * (qt_expect I_ZmX Vp w) = + Re (Complex_Matrix.trace (Z_I * I_ZmX * R))" + proof (rule sum_qt_expect, (simp add: assms)) + show "Z_I \ fc_mats" using Z_I_carrier dim4 fc_mats_carrier dim_eq by simp + show "R\ fc_mats" using assms by simp + show "I_ZmX \ fc_mats" using I_ZmX_carrier dim4 fc_mats_carrier dim_eq by simp + show "hermitian Z_I" using Z_I_hermitian . + show "hermitian I_ZmX" using I_ZmX_hermitian . + qed + also have "... = Re (Complex_Matrix.trace (Z_ZmX * R))" using Z_I_ZmX_eq by simp + also have "... = Re (Complex_Matrix.trace (R * Z_ZmX))" + proof - + have "Complex_Matrix.trace (Z_ZmX * R) = Complex_Matrix.trace (R * Z_ZmX)" + using trace_comm[of Z_ZmX 4 R] Z_ZmX_carrier assms dim4 fc_mats_carrier dim_eq by simp + thus ?thesis by simp + qed + finally show ?thesis . +qed + +lemma (in bin_cpx) Z_I_ZmX_chsh: + assumes "lhv M Z_I I_ZmX rho_psim Vz Vp" +shows "LINT w|M. (qt_expect Z_I Vz w) * (qt_expect I_ZmX Vp w) = + -1/sqrt 2" +proof - + have "LINT w|M. (qt_expect Z_I Vz w) * (qt_expect I_ZmX Vp w) = + Re (Complex_Matrix.trace (rho_psim * Z_ZmX))" + proof (rule Z_I_ZmX_trace, (simp add: assms)) + show "rho_psim \ fc_mats" using rho_psim_carrier fc_mats_carrier dim_eq dim4 by simp + qed + also have "... = -1/sqrt 2" using Z_ZmX_rho_psim by simp + finally show ?thesis unfolding qt_expect_def . +qed + +lemma (in bin_cpx) chsh_upper_bound: + assumes "prob_space M" + and "lhv M X_I I_XpZ rho_psim Vx Vp" + and "lhv M Z_I I_XpZ rho_psim Vz Vp" + and "lhv M X_I I_ZmX rho_psim Vx Vm" + and "lhv M Z_I I_ZmX rho_psim Vz Vm" +shows "\(LINT w|M. qt_expect X_I Vx w * qt_expect I_ZmX Vm w) + + (LINT w|M. qt_expect Z_I Vz w * qt_expect I_XpZ Vp w) + + (LINT w|M. qt_expect X_I Vx w * qt_expect I_XpZ Vp w) - + (LINT w|M. qt_expect Z_I Vz w * qt_expect I_ZmX Vm w)\ + \ 2" +proof (rule prob_space.chsh_expect) + show "AE w in M. \qt_expect X_I Vx w\ \ 1" unfolding qt_expect_def + proof (rule spectrum_abs_1_weighted_suml) + show "X_I \ fc_mats" using X_I_carrier fc_mats_carrier dim_eq dim4 by simp + show "hermitian X_I" using X_I_hermitian . + show "lhv M X_I I_XpZ rho_psim Vx Vp" using assms by simp + show "{Re x |x. x \ spectrum X_I} \ {- 1, 1}" using X_I_spectrum by simp + show "{Re x |x. x \ spectrum X_I} \ {}" using spectrum_ne X_I_hermitian \X_I \ fc_mats\ by auto + qed + show "AE w in M. \qt_expect Z_I Vz w\ \ 1" unfolding qt_expect_def + proof (rule spectrum_abs_1_weighted_suml) + show "Z_I \ fc_mats" using Z_I_carrier fc_mats_carrier dim_eq dim4 by simp + show "hermitian Z_I" using Z_I_hermitian . + show "lhv M Z_I I_XpZ rho_psim Vz Vp" using assms by simp + show "{Re x |x. x \ spectrum Z_I} \ {- 1, 1}" using Z_I_spectrum by simp + show "{Re x |x. x \ spectrum Z_I} \ {}" using spectrum_ne Z_I_hermitian \Z_I \ fc_mats\ by auto + qed + show "AE w in M. \qt_expect I_XpZ Vp w\ \ 1" unfolding qt_expect_def + proof (rule spectrum_abs_1_weighted_sumr) + show "I_XpZ \ fc_mats" using I_XpZ_carrier fc_mats_carrier dim_eq dim4 by simp + show "hermitian I_XpZ" using I_XpZ_hermitian . + show "lhv M Z_I I_XpZ rho_psim Vz Vp" using assms by simp + show "{Re x |x. x \ spectrum I_XpZ} \ {- 1, 1}" using I_XpZ_spectrum by simp + show "{Re x |x. x \ spectrum I_XpZ} \ {}" using spectrum_ne I_XpZ_hermitian \I_XpZ \ fc_mats\ + by auto + qed + show "AE w in M. \qt_expect I_ZmX Vm w\ \ 1" unfolding qt_expect_def + proof (rule spectrum_abs_1_weighted_sumr) + show "I_ZmX \ fc_mats" using I_ZmX_carrier fc_mats_carrier dim_eq dim4 by simp + show "hermitian I_ZmX" using I_ZmX_hermitian . + show "lhv M Z_I I_ZmX rho_psim Vz Vm" using assms by simp + show "{Re x |x. x \ spectrum I_ZmX} \ {- 1, 1}" using I_ZmX_spectrum by simp + show "{Re x |x. x \ spectrum I_ZmX} \ {}" using spectrum_ne I_ZmX_hermitian \I_ZmX \ fc_mats\ + by auto + qed + show "prob_space M" using assms by simp + show "integrable M (\w. qt_expect X_I Vx w * qt_expect I_ZmX Vm w)" + using spectr_sum_integrable[of M] assms by simp + show "integrable M (\w. qt_expect Z_I Vz w * qt_expect I_ZmX Vm w)" + using spectr_sum_integrable[of M] assms by simp + show "integrable M (\w. qt_expect X_I Vx w * qt_expect I_XpZ Vp w)" + using spectr_sum_integrable[of M] assms by simp + show "integrable M (\w. qt_expect Z_I Vz w * qt_expect I_XpZ Vp w)" + using spectr_sum_integrable[of M] assms by simp +qed + +lemma (in bin_cpx) quantum_value: + assumes "lhv M X_I I_XpZ rho_psim Vx Vp" + and "lhv M Z_I I_XpZ rho_psim Vz Vp" + and "lhv M X_I I_ZmX rho_psim Vx Vm" + and "lhv M Z_I I_ZmX rho_psim Vz Vm" +shows "\(LINT w|M. qt_expect X_I Vx w * qt_expect I_ZmX Vm w) + + (LINT w|M. qt_expect Z_I Vz w * qt_expect I_XpZ Vp w) + + (LINT w|M. qt_expect X_I Vx w * qt_expect I_XpZ Vp w) - + (LINT w|M. qt_expect Z_I Vz w * qt_expect I_ZmX Vm w)\ + = 2* sqrt 2" +proof - + have "LINT w|M. qt_expect X_I Vx w * qt_expect I_ZmX Vm w = 1/sqrt 2" + using X_I_ZmX_chsh[of M] assms unfolding qt_expect_def by simp + moreover have b: "LINT w|M. qt_expect X_I Vx w * qt_expect I_XpZ Vp w = 1/sqrt 2" + using X_I_XpZ_chsh[of M] assms unfolding qt_expect_def by simp + moreover have c: "LINT w|M. qt_expect Z_I Vz w * qt_expect I_XpZ Vp w = 1/sqrt 2" + using Z_I_XpZ_chsh[of M] assms unfolding qt_expect_def by simp + moreover have "LINT w|M. qt_expect Z_I Vz w * qt_expect I_ZmX Vm w = -1/sqrt 2" + using Z_I_ZmX_chsh[of M] assms unfolding qt_expect_def by simp + ultimately have "(LINT w|M. qt_expect X_I Vx w * qt_expect I_ZmX Vm w) + + (LINT w|M. qt_expect X_I Vx w * qt_expect I_XpZ Vp w) + + (LINT w|M. qt_expect Z_I Vz w * qt_expect I_XpZ Vp w) - + (LINT w|M. qt_expect Z_I Vz w * qt_expect I_ZmX Vm w) = 4/(sqrt 2)" by simp + also have "... = (4 * (sqrt 2))/(sqrt 2 * (sqrt 2))" + by (metis mult_numeral_1_right real_divide_square_eq times_divide_eq_right) + also have "... = (4 * (sqrt 2)) / 2" by simp + also have "... = 2 * (sqrt 2)" by simp + finally have "(LINT w|M. qt_expect X_I Vx w * qt_expect I_ZmX Vm w) + + (LINT w|M. qt_expect X_I Vx w * qt_expect I_XpZ Vp w) + + (LINT w|M. qt_expect Z_I Vz w * qt_expect I_XpZ Vp w) - + (LINT w|M. qt_expect Z_I Vz w * qt_expect I_ZmX Vm w) = 2 * sqrt 2" . + thus ?thesis by (simp add: b c) +qed + +lemma (in bin_cpx) no_lhv: + assumes "lhv M X_I I_XpZ rho_psim Vx Vp" + and "lhv M Z_I I_XpZ rho_psim Vz Vp" + and "lhv M X_I I_ZmX rho_psim Vx Vm" + and "lhv M Z_I I_ZmX rho_psim Vz Vm" +shows False +proof - + have "prob_space M" using assms unfolding lhv_def by simp + have "2 * sqrt 2 = \(LINT w|M. qt_expect X_I Vx w * qt_expect I_ZmX Vm w) + + (LINT w|M. qt_expect Z_I Vz w * qt_expect I_XpZ Vp w) + + (LINT w|M. qt_expect X_I Vx w * qt_expect I_XpZ Vp w) - + (LINT w|M. qt_expect Z_I Vz w * qt_expect I_ZmX Vm w)\" + using assms quantum_value[of M] by simp + also have "... \ 2" using chsh_upper_bound[of M] assms \prob_space M\ by simp + finally have "2 * sqrt 2 \ 2" . + thus False by simp +qed + + +end \ No newline at end of file diff --git a/thys/Projective_Measurements/Linear_Algebra_Complements.thy b/thys/Projective_Measurements/Linear_Algebra_Complements.thy new file mode 100644 --- /dev/null +++ b/thys/Projective_Measurements/Linear_Algebra_Complements.thy @@ -0,0 +1,2269 @@ +(* +Author: + Mnacho Echenim, Université Grenoble Alpes +*) + +theory Linear_Algebra_Complements imports + "Isabelle_Marries_Dirac.Tensor" + "Isabelle_Marries_Dirac.More_Tensor" + "QHLProver.Gates" + "HOL-Types_To_Sets.Group_On_With" + "HOL-Probability.Probability" + + +begin +hide_const(open) S +section \Preliminaries\ + + +subsection \Misc\ + +lemma mult_real_cpx: + fixes a::complex + fixes b::complex + assumes "a\ Reals" + shows "a* (Re b) = Re (a * b)" using assms + by (metis Reals_cases complex.exhaust complex.sel(1) complex_of_real_mult_Complex of_real_mult) + +lemma fct_bound: + fixes f::"complex\ real" + assumes "f(-1) + f 1 = 1" +and "0 \ f 1" +and "0 \ f (-1)" +shows "-1 \ f 1 - f(-1) \ f 1 - f(-1) \ 1" +proof + have "f 1 - f(-1) = 1 - f(-1) - f(-1)" using assms by simp + also have "...\ -1" using assms by simp + finally show "-1 \ f 1 - f(-1)" . +next + have "f(-1) - f 1 = 1 - f 1 - f 1 " using assms by simp + also have "... \ -1" using assms by simp + finally have "-1 \ f(-1) - f 1" . + thus "f 1 - f (-1) \ 1" by simp +qed + +lemma fct_bound': + fixes f::"complex\ real" + assumes "f(-1) + f 1 = 1" +and "0 \ f 1" +and "0 \ f (-1)" +shows "\f 1 - f(-1)\ \ 1" using assms fct_bound by auto + +lemma pos_sum_1_le: + assumes "finite I" +and "\ i \ I. (0::real) \ f i" +and "(\i\ I. f i) = 1" +and "j\ I" +shows "f j \ 1" +proof (rule ccontr) + assume "\ f j \ 1" + hence "1 < f j" by simp + hence "1 < (\i\ I. f i)" using assms by (metis \\ f j \ 1\ sum_nonneg_leq_bound) + thus False using assms by simp +qed + +lemma last_subset: + assumes "A \ {a,b}" + and "a\ b" +and "A \ {a, b}" +and "A\ {}" +and "A \ {a}" +shows "A = {b}" using assms by blast + +lemma disjoint_Un: + assumes "disjoint_family_on A (insert x F)" + and "x\ F" +shows "(A x) \ (\ a\ F. A a) = {}" +proof - + have "(A x) \ (\ a\ F. A a) = (\i\F. (A x) \ A i)" using Int_UN_distrib by simp + also have "... = (\i\F. {})" using assms disjoint_family_onD by fastforce + also have "... = {}" using SUP_bot_conv(2) by simp + finally show ?thesis . +qed + +lemma sum_but_one: + assumes "\j < (n::nat). j \i \ f j = (0::'a::ring)" + and "i < n" + shows "(\ j \ {0 ..< n}. f j * g j) = f i * g i" +proof - + have "sum (\x. f x * g x) (({0 ..< n} - {i}) \ {i}) = sum (\x. f x * g x) ({0 ..< n} - {i}) + + sum (\x. f x * g x) {i}" by (rule sum.union_disjoint, auto) + also have "... = sum (\x. f x * g x) {i}" using assms by auto + also have "... = f i * g i" by simp + finally have "sum (\x. f x * g x) (({0 ..< n} - {i}) \ {i}) = f i * g i" . + moreover have "{0 ..< n} = ({0 ..< n} - {i}) \ {i}" using assms by auto + ultimately show ?thesis by simp +qed + +lemma sum_2_elems: + assumes "I = {a,b}" + and "a\ b" + shows "(\a\I. f a) = f a + f b" +proof - + have "(\a\I. f a) = (\a\(insert a {b}). f a)" using assms by simp + also have "... = f a + (\a\{b}. f a)" + proof (rule sum.insert) + show "finite {b}" by simp + show "a\ {b}" using assms by simp + qed + also have "... = f a + f b" by simp + finally show ?thesis . +qed + +lemma sum_4_elems: + shows "(\i<(4::nat). f i) = f 0 + f 1 + f 2 + f 3" +proof - + have "(\i<(4::nat). f i) = (\i<(3::nat). f i) + f 3" + by (metis Suc_numeral semiring_norm(2) semiring_norm(8) sum.lessThan_Suc) + moreover have "(\i<(3::nat). f i) = (\i<(2::nat). f i) + f 2" + by (metis Suc_1 add_2_eq_Suc' nat_1_add_1 numeral_code(3) numerals(1) + one_plus_numeral_commute sum.lessThan_Suc) + moreover have "(\i<(2::nat). f i) = (\i<(1::nat). f i) + f 1" + by (metis Suc_1 sum.lessThan_Suc) + ultimately show ?thesis by simp +qed + +lemma disj_family_sum: + shows "finite I \ disjoint_family_on A I \ (\i. i \ I \ finite (A i)) \ + (\ i \ (\n \ I. A n). f i) = (\ n\ I. (\ i \ A n. f i))" +proof (induct rule:finite_induct) + case empty + then show ?case by simp +next + case (insert x F) + hence "disjoint_family_on A F" + by (meson disjoint_family_on_mono subset_insertI) + have "(\n \ (insert x F). A n) = A x \ (\n \ F. A n)" using insert by simp + hence "(\ i \ (\n \ (insert x F). A n). f i) = (\ i \ (A x \ (\n \ F. A n)). f i)" by simp + also have "... = (\ i \ A x. f i) + (\ i \ (\n \ F. A n). f i)" + by (rule sum.union_disjoint, (simp add: insert disjoint_Un)+) + also have "... = (\ i \ A x. f i) + (\n\F. sum f (A n))" using \disjoint_family_on A F\ + by (simp add: insert) + also have "... = (\n\(insert x F). sum f (A n))" using insert by simp + finally show ?case . +qed + +lemma integrable_real_mult_right: + fixes c::real + assumes "integrable M f" + shows "integrable M (\w. c * f w)" +proof (cases "c = 0") + case True + thus ?thesis by simp +next + case False + thus ?thesis using integrable_mult_right[of c] assms by simp +qed + + +subsection \Unifying notions between Isabelle Marries Dirac and QHLProver\ + +lemma mult_conj_cmod_square: + fixes z::complex + shows "z * conjugate z = (cmod z)\<^sup>2" +proof - + have "z * conjugate z = (Re z)\<^sup>2 + (Im z)\<^sup>2" using complex_mult_cnj by auto + also have "... = (cmod z)\<^sup>2" unfolding cmod_def by simp + finally show ?thesis . +qed + +lemma vec_norm_sq_cpx_vec_length_sq: + shows "(vec_norm v)\<^sup>2 = (cpx_vec_length v)\<^sup>2" +proof - + have "(vec_norm v)\<^sup>2 = inner_prod v v" unfolding vec_norm_def using power2_csqrt by blast + also have "... = (\i2)" unfolding Matrix.scalar_prod_def + proof - + have "\i. i < dim_vec v \ Matrix.vec_index v i * conjugate (Matrix.vec_index v i) = + (cmod (Matrix.vec_index v i))\<^sup>2" using mult_conj_cmod_square by simp + thus "(\i = 0..i2)" + by (simp add: lessThan_atLeast0) + qed + finally show "(vec_norm v)\<^sup>2 = (cpx_vec_length v)\<^sup>2" unfolding cpx_vec_length_def + by (simp add: sum_nonneg) +qed + +lemma vec_norm_eq_cpx_vec_length: + shows "vec_norm v = cpx_vec_length v" using vec_norm_sq_cpx_vec_length_sq +by (metis cpx_vec_length_inner_prod inner_prod_csqrt power2_csqrt vec_norm_def) + +lemma cpx_vec_length_square: + shows "\v\\<^sup>2 = (\i = 0..2)" unfolding cpx_vec_length_def + by (simp add: lessThan_atLeast0 sum_nonneg) + +lemma state_qbit_norm_sq: + assumes "v\ state_qbit n" + shows "(cpx_vec_length v)\<^sup>2 = 1" +proof - + have "cpx_vec_length v = 1" using assms unfolding state_qbit_def by simp + thus ?thesis by simp +qed + +lemma dagger_adjoint: +shows "dagger M = Complex_Matrix.adjoint M" unfolding dagger_def Complex_Matrix.adjoint_def + by (simp add: cong_mat) + + +subsection \Types to sets lemmata transfers\ + +context ab_group_add_on_with begin + +context includes lifting_syntax assumes ltd: "\(Rep::'s \ 'a) (Abs::'a \ 's). + type_definition Rep Abs S" begin +interpretation local_typedef_ab_group_add_on_with pls z mns um S "TYPE('s)" by unfold_locales fact + +lemmas lt_sum_union_disjoint = sum.union_disjoint + [var_simplified explicit_ab_group_add, + unoverload_type 'c, + OF type.comm_monoid_add_axioms, + untransferred] + +lemmas lt_disj_family_sum = disj_family_sum + [var_simplified explicit_ab_group_add, + unoverload_type 'd, +OF type.comm_monoid_add_axioms, + untransferred] + +lemmas lt_sum_reindex_cong = sum.reindex_cong + [var_simplified explicit_ab_group_add, + unoverload_type 'd, +OF type.comm_monoid_add_axioms, + untransferred] +end + +lemmas sum_with_union_disjoint = + lt_sum_union_disjoint + [cancel_type_definition, + OF carrier_ne, + simplified pred_fun_def, simplified] + +lemmas disj_family_sum_with = + lt_disj_family_sum + [cancel_type_definition, + OF carrier_ne, + simplified pred_fun_def, simplified] + +lemmas sum_with_reindex_cong = + lt_sum_reindex_cong + [cancel_type_definition, + OF carrier_ne, + simplified pred_fun_def, simplified] + +end + +lemma (in comm_monoid_add_on_with) sum_with_cong': + shows "finite I \ (\i. i\ I \ A i = B i) \ (\i. i\ I \ A i \ S) \ + (\i. i\ I \ B i \ S) \ sum_with pls z A I = sum_with pls z B I" +proof (induct rule: finite_induct) + case empty + then show ?case by simp +next + case (insert x F) + have "sum_with pls z A (insert x F) = pls (A x) (sum_with pls z A F)" using insert + sum_with_insert[of A] by (simp add: image_subset_iff) + also have "... = pls (B x) (sum_with pls z B F)" using insert by simp + also have "... = sum_with pls z B (insert x F)" using insert sum_with_insert[of B] + by (simp add: image_subset_iff) + finally show ?case . +qed + + +section \Linear algebra complements\ + +subsection \Additional properties of matrices\ + +lemma smult_one: + shows "(1::'a::monoid_mult) \\<^sub>m A = A" by (simp add:eq_matI) + +lemma times_diag_index: + fixes A::"'a::comm_ring Matrix.mat" + assumes "A \ carrier_mat n n" +and "B\ carrier_mat n n" +and "diagonal_mat B" +and "j < n" +and "i < n" +shows "Matrix.vec_index (Matrix.row (A*B) j) i = diag_mat B ! i *A $$ (j, i)" +proof - + have "Matrix.vec_index (Matrix.row (A*B) j) i = (A*B) $$ (j,i)" + using Matrix.row_def[of "A*B" ] assms by simp + also have "... = Matrix.scalar_prod (Matrix.row A j) (Matrix.col B i)" using assms + times_mat_def[of A] by simp + also have "... = Matrix.scalar_prod (Matrix.col B i) (Matrix.row A j)" + using comm_scalar_prod[of "Matrix.row A j" n] assms by auto + also have "... = (Matrix.vec_index (Matrix.col B i) i) * (Matrix.vec_index (Matrix.row A j) i)" + unfolding Matrix.scalar_prod_def + proof (rule sum_but_one) + show "i < dim_vec (Matrix.row A j)" using assms by simp + show "\ia i \ Matrix.vec_index (Matrix.col B i) ia = 0" using assms + by (metis carrier_matD(1) carrier_matD(2) diagonal_mat_def index_col index_row(2)) + qed + also have "... = B $$(i,i) * (Matrix.vec_index (Matrix.row A j) i)" using assms by auto + also have "... = diag_mat B ! i * (Matrix.vec_index (Matrix.row A j) i)" unfolding diag_mat_def + using assms by simp + also have "... = diag_mat B ! i * A $$ (j, i)" using assms by simp + finally show ?thesis . +qed + +lemma inner_prod_adjoint_comp: + assumes "(U::'a::conjugatable_field Matrix.mat) \ carrier_mat n n" +and "(V::'a::conjugatable_field Matrix.mat) \ carrier_mat n n" +and "i < n" +and "j < n" +shows "Complex_Matrix.inner_prod (Matrix.col V i) (Matrix.col U j) = + ((Complex_Matrix.adjoint V) * U) $$ (i, j)" +proof - + have "Complex_Matrix.inner_prod (Matrix.col V i) (Matrix.col U j) = + Matrix.scalar_prod (Matrix.col U j) (Matrix.row (Complex_Matrix.adjoint V) i)" + using adjoint_row[of i V] assms by simp + also have "... = Matrix.scalar_prod (Matrix.row (Complex_Matrix.adjoint V) i) (Matrix.col U j)" + by (metis adjoint_row assms(1) assms(2) assms(3) carrier_matD(1) carrier_matD(2) Matrix.col_dim + conjugate_vec_sprod_comm) + also have "... = ((Complex_Matrix.adjoint V) * U) $$ (i, j)" using assms + by (simp add:times_mat_def) + finally show ?thesis . +qed + +lemma mat_unit_vec_col: + assumes "(A::'a::conjugatable_field Matrix.mat) \ carrier_mat n n" +and "i < n" +shows "A *\<^sub>v (unit_vec n i) = Matrix.col A i" +proof + show "dim_vec (A *\<^sub>v unit_vec n i) = dim_vec (Matrix.col A i)" using assms by simp + show "\j. j < dim_vec (Matrix.col A i) \ Matrix.vec_index (A *\<^sub>v unit_vec n i) j = + Matrix.vec_index (Matrix.col A i) j" + proof - + fix j + assume "j < dim_vec (Matrix.col A i)" + hence "Matrix.vec_index (A *\<^sub>v unit_vec n i) j = + Matrix.scalar_prod (Matrix.row A j) (unit_vec n i)" unfolding mult_mat_vec_def by simp + also have "... = Matrix.scalar_prod (unit_vec n i) (Matrix.row A j)" using comm_scalar_prod + assms by auto + also have "... = (Matrix.vec_index (unit_vec n i) i) * (Matrix.vec_index (Matrix.row A j) i)" + unfolding Matrix.scalar_prod_def + proof (rule sum_but_one) + show "i < dim_vec (Matrix.row A j)" using assms by auto + show "\ia i \ Matrix.vec_index (unit_vec n i) ia = 0" + using assms unfolding unit_vec_def by auto + qed + also have "... = (Matrix.vec_index (Matrix.row A j) i)" using assms by simp + also have "... = A $$ (j, i)" using assms \j < dim_vec (Matrix.col A i)\ by simp + also have "... = Matrix.vec_index (Matrix.col A i) j" using assms \j < dim_vec (Matrix.col A i)\ by simp + finally show "Matrix.vec_index (A *\<^sub>v unit_vec n i) j = + Matrix.vec_index (Matrix.col A i) j" . + qed +qed + +lemma mat_prod_unit_vec_cong: + assumes "(A::'a::conjugatable_field Matrix.mat) \ carrier_mat n n" +and "B\ carrier_mat n n" +and "\i. i < n \ A *\<^sub>v (unit_vec n i) = B *\<^sub>v (unit_vec n i)" +shows "A = B" +proof + show "dim_row A = dim_row B" using assms by simp + show "dim_col A = dim_col B" using assms by simp + show "\i j. i < dim_row B \ j < dim_col B \ A $$ (i, j) = B $$ (i, j)" + proof - + fix i j + assume ij: "i < dim_row B" "j < dim_col B" + hence "A $$ (i,j) = Matrix.vec_index (Matrix.col A j) i" using assms by simp + also have "... = Matrix.vec_index (A *\<^sub>v (unit_vec n j)) i" using mat_unit_vec_col[of A] ij assms + by simp + also have "... = Matrix.vec_index (B *\<^sub>v (unit_vec n j)) i" using assms ij by simp + also have "... = Matrix.vec_index (Matrix.col B j) i" using mat_unit_vec_col ij assms by simp + also have "... = B $$ (i,j)" using assms ij by simp + finally show "A $$ (i, j) = B $$ (i, j)" . + qed +qed + +lemma smult_smult_times: + fixes a::"'a::semigroup_mult" + shows "a\\<^sub>m (k \\<^sub>m A) = (a * k)\\<^sub>m A" +proof + show r:"dim_row (a \\<^sub>m (k \\<^sub>m A)) = dim_row (a * k \\<^sub>m A)" by simp + show c:"dim_col (a \\<^sub>m (k \\<^sub>m A)) = dim_col (a * k \\<^sub>m A)" by simp + show "\i j. i < dim_row (a * k \\<^sub>m A) \ + j < dim_col (a * k \\<^sub>m A) \ (a \\<^sub>m (k \\<^sub>m A)) $$ (i, j) = (a * k \\<^sub>m A) $$ (i, j)" + proof - + fix i j + assume "i < dim_row (a * k \\<^sub>m A)" and "j < dim_col (a * k \\<^sub>m A)" note ij = this + hence "(a \\<^sub>m (k \\<^sub>m A)) $$ (i, j) = a * (k \\<^sub>m A) $$ (i, j)" by simp + also have "... = a * (k * A $$ (i,j))" using ij by simp + also have "... = (a * k) * A $$ (i,j)" + by (simp add: semigroup_mult_class.mult.assoc) + also have "... = (a * k \\<^sub>m A) $$ (i, j)" using r c ij by simp + finally show "(a \\<^sub>m (k \\<^sub>m A)) $$ (i, j) = (a * k \\<^sub>m A) $$ (i, j)" . + qed +qed + +lemma mat_minus_minus: + fixes A :: "'a :: ab_group_add Matrix.mat" + assumes "A \ carrier_mat n m" + and "B\ carrier_mat n m" + and "C\ carrier_mat n m" +shows "A - (B - C) = A - B + C" +proof + show "dim_row (A - (B - C)) = dim_row (A - B + C)" using assms by simp + show "dim_col (A - (B - C)) = dim_col (A - B + C)" using assms by simp + show "\i j. i < dim_row (A - B + C) \ j < dim_col (A - B + C) \ + (A - (B - C)) $$ (i, j) = (A - B + C) $$ (i, j)" + proof - + fix i j + assume "i < dim_row (A - B + C)" and "j < dim_col (A - B + C)" note ij = this + have "(A - (B - C)) $$ (i, j) = (A $$ (i,j) - B $$ (i,j) + C $$ (i,j))" using ij assms by simp + also have "... = (A - B + C) $$ (i, j)" using assms ij by simp + finally show "(A - (B - C)) $$ (i, j) = (A - B + C) $$ (i, j)" . + qed +qed + + +subsection \Complements on complex matrices\ + +lemma hermitian_square: + assumes "hermitian M" + shows "M \ carrier_mat (dim_row M) (dim_row M)" +proof - + have "dim_col M = dim_row M" using assms unfolding hermitian_def adjoint_def + by (metis adjoint_dim_col) + thus ?thesis by auto +qed + +lemma hermitian_add: + assumes "A\ carrier_mat n n" + and "B\ carrier_mat n n" +and "hermitian A" +and "hermitian B" +shows "hermitian (A + B)" unfolding hermitian_def + by (metis adjoint_add assms hermitian_def) + +lemma hermitian_minus: + assumes "A\ carrier_mat n n" + and "B\ carrier_mat n n" +and "hermitian A" +and "hermitian B" +shows "hermitian (A - B)" unfolding hermitian_def + by (metis adjoint_minus assms hermitian_def) + +lemma hermitian_smult: + fixes a::real + fixes A::"complex Matrix.mat" + assumes "A \ carrier_mat n n" +and "hermitian A" +shows "hermitian (a \\<^sub>m A)" +proof - + have dim: "Complex_Matrix.adjoint A \ carrier_mat n n" using assms by (simp add: adjoint_dim) + { + fix i j + assume "i < n" and "j < n" + hence "Complex_Matrix.adjoint (a \\<^sub>m A) $$ (i,j) = a * (Complex_Matrix.adjoint A $$ (i,j))" + using adjoint_scale[of a A] assms by simp + also have "... = a * (A $$ (i,j))" using assms unfolding hermitian_def by simp + also have "... = (a \\<^sub>m A) $$ (i,j)" using \i < n\ \j < n\ assms by simp + finally have "Complex_Matrix.adjoint (a \\<^sub>m A) $$ (i,j) = (a \\<^sub>m A) $$ (i,j)" . + } + thus ?thesis using dim assms unfolding hermitian_def by auto +qed + +lemma unitary_eigenvalues_norm_square: + fixes U::"complex Matrix.mat" + assumes "unitary U" + and "U \ carrier_mat n n" + and "eigenvalue U k" +shows "conjugate k * k = 1" +proof - + have "\v. eigenvector U v k" using assms unfolding eigenvalue_def by simp + from this obtain v where "eigenvector U v k" by auto + define vn where "vn = vec_normalize v" + have "eigenvector U vn k" using normalize_keep_eigenvector \eigenvector U v k\ + using assms(2) eigenvector_def vn_def by blast + have "vn \ carrier_vec n" + using \eigenvector U v k\ assms(2) eigenvector_def normalized_vec_dim vn_def by blast + have "Complex_Matrix.inner_prod vn vn = 1" using \vn = vec_normalize v\ \eigenvector U v k\ + eigenvector_def normalized_vec_norm by blast + hence "conjugate k * k = conjugate k * k * Complex_Matrix.inner_prod vn vn" by simp + also have "... = conjugate k * Complex_Matrix.inner_prod vn (k \\<^sub>v vn)" + proof - + have "k * Complex_Matrix.inner_prod vn vn = Complex_Matrix.inner_prod vn (k \\<^sub>v vn)" + using inner_prod_smult_left[of vn n vn k] \vn \ carrier_vec n\ by simp + thus ?thesis by simp + qed + also have "... = Complex_Matrix.inner_prod (k \\<^sub>v vn) (k \\<^sub>v vn)" + using inner_prod_smult_right[of vn n _ k] by (simp add: \vn \ carrier_vec n\) + also have "... = Complex_Matrix.inner_prod (U *\<^sub>v vn) (U *\<^sub>v vn)" + using \eigenvector U vn k\ unfolding eigenvector_def by simp + also have "... = + Complex_Matrix.inner_prod (Complex_Matrix.adjoint U *\<^sub>v (U *\<^sub>v vn)) vn" + using adjoint_def_alter[of "U *\<^sub>v vn" n vn n U] assms + by (metis \eigenvector U vn k\ carrier_matD(1) carrier_vec_dim_vec dim_mult_mat_vec + eigenvector_def) + also have "... = Complex_Matrix.inner_prod vn vn" + proof - + have "Complex_Matrix.adjoint U *\<^sub>v (U *\<^sub>v vn) = (Complex_Matrix.adjoint U * U) *\<^sub>v vn" + using assms + by (metis \eigenvector U vn k\ adjoint_dim assoc_mult_mat_vec carrier_matD(1) eigenvector_def) + also have "... = vn" using assms unfolding unitary_def inverts_mat_def + by (metis \eigenvector U vn k\ assms(1) eigenvector_def one_mult_mat_vec unitary_simps(1)) + finally show ?thesis by simp + qed + also have "... = 1" using \vn = vec_normalize v\ \eigenvector U v k\ eigenvector_def + normalized_vec_norm by blast + finally show ?thesis . +qed + +lemma outer_prod_smult_left: + fixes v::"complex Matrix.vec" + shows "outer_prod (a \\<^sub>v v) w = a \\<^sub>m outer_prod v w" +proof - + define paw where "paw = outer_prod (a \\<^sub>v v) w" + define apw where "apw = a \\<^sub>m outer_prod v w" + have "paw = apw" + proof + have "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim + by (metis carrier_matD(1) carrier_vec_dim_vec index_smult_vec(2)) + also have "... = dim_row apw" unfolding apw_def using outer_prod_dim + by (metis carrier_matD(1) carrier_vec_dim_vec index_smult_mat(2)) + finally show dr: "dim_row paw = dim_row apw" . + have "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim + using carrier_vec_dim_vec by blast + also have "... = dim_col apw" unfolding apw_def using outer_prod_dim + by (metis apw_def carrier_matD(2) carrier_vec_dim_vec smult_carrier_mat) + finally show dc: "dim_col paw = dim_col apw" . + show "\i j. i < dim_row apw \ j < dim_col apw \ paw $$ (i, j) = apw $$ (i, j)" + proof - + fix i j + assume "i < dim_row apw" and "j < dim_col apw" note ij = this + hence "paw $$ (i,j) = a * (Matrix.vec_index v i) * cnj (Matrix.vec_index w j)" + using dr dc unfolding paw_def outer_prod_def by simp + also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp + finally show "paw $$ (i, j) = apw $$ (i, j)" . + qed + qed + thus ?thesis unfolding paw_def apw_def by simp +qed + +lemma outer_prod_smult_right: + fixes v::"complex Matrix.vec" + shows "outer_prod v (a \\<^sub>v w) = (conjugate a) \\<^sub>m outer_prod v w" +proof - + define paw where "paw = outer_prod v (a \\<^sub>v w)" + define apw where "apw = (conjugate a) \\<^sub>m outer_prod v w" + have "paw = apw" + proof + have "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim + by (metis carrier_matD(1) carrier_vec_dim_vec) + also have "... = dim_row apw" unfolding apw_def using outer_prod_dim + by (metis carrier_matD(1) carrier_vec_dim_vec index_smult_mat(2)) + finally show dr: "dim_row paw = dim_row apw" . + have "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim + using carrier_vec_dim_vec by (metis carrier_matD(2) index_smult_vec(2)) + also have "... = dim_col apw" unfolding apw_def using outer_prod_dim + by (metis apw_def carrier_matD(2) carrier_vec_dim_vec smult_carrier_mat) + finally show dc: "dim_col paw = dim_col apw" . + show "\i j. i < dim_row apw \ j < dim_col apw \ paw $$ (i, j) = apw $$ (i, j)" + proof - + fix i j + assume "i < dim_row apw" and "j < dim_col apw" note ij = this + hence "paw $$ (i,j) = (conjugate a) * (Matrix.vec_index v i) * cnj (Matrix.vec_index w j)" + using dr dc unfolding paw_def outer_prod_def by simp + also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp + finally show "paw $$ (i, j) = apw $$ (i, j)" . + qed + qed + thus ?thesis unfolding paw_def apw_def by simp +qed + +lemma outer_prod_add_left: + fixes v::"complex Matrix.vec" + assumes "dim_vec v = dim_vec x" + shows "outer_prod (v + x) w = outer_prod v w + (outer_prod x w)" +proof - + define paw where "paw = outer_prod (v+x) w" + define apw where "apw = outer_prod v w + (outer_prod x w)" + have "paw = apw" + proof + have rv: "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim assms + by (metis carrier_matD(1) carrier_vec_dim_vec index_add_vec(2) paw_def) + also have "... = dim_row apw" unfolding apw_def using outer_prod_dim assms + by (metis carrier_matD(1) carrier_vec_dim_vec index_add_mat(2)) + finally show dr: "dim_row paw = dim_row apw" . + have cw: "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim assms + using carrier_vec_dim_vec by (metis carrier_matD(2)) + also have "... = dim_col apw" unfolding apw_def using outer_prod_dim + by (metis apw_def carrier_matD(2) carrier_vec_dim_vec add_carrier_mat) + finally show dc: "dim_col paw = dim_col apw" . + show "\i j. i < dim_row apw \ j < dim_col apw \ paw $$ (i, j) = apw $$ (i, j)" + proof - + fix i j + assume "i < dim_row apw" and "j < dim_col apw" note ij = this + hence "paw $$ (i,j) = (Matrix.vec_index v i + Matrix.vec_index x i) * + cnj (Matrix.vec_index w j)" + using dr dc unfolding paw_def outer_prod_def by simp + also have "... = Matrix.vec_index v i * cnj (Matrix.vec_index w j) + + Matrix.vec_index x i * cnj (Matrix.vec_index w j)" + by (simp add: ring_class.ring_distribs(2)) + also have "... = (outer_prod v w) $$ (i,j) + (outer_prod x w) $$ (i,j)" + using rv cw dr dc ij assms unfolding outer_prod_def by auto + also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp + finally show "paw $$ (i, j) = apw $$ (i, j)" . + qed + qed + thus ?thesis unfolding paw_def apw_def by simp +qed + +lemma outer_prod_add_right: + fixes v::"complex Matrix.vec" + assumes "dim_vec w = dim_vec x" + shows "outer_prod v (w + x) = outer_prod v w + (outer_prod v x)" +proof - + define paw where "paw = outer_prod v (w+x)" + define apw where "apw = outer_prod v w + (outer_prod v x)" + have "paw = apw" + proof + have rv: "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim assms + by (metis carrier_matD(1) carrier_vec_dim_vec index_add_vec(2) paw_def) + also have "... = dim_row apw" unfolding apw_def using outer_prod_dim assms + by (metis carrier_matD(1) carrier_vec_dim_vec index_add_mat(2)) + finally show dr: "dim_row paw = dim_row apw" . + have cw: "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim assms + using carrier_vec_dim_vec + by (metis carrier_matD(2) index_add_vec(2) paw_def) + also have "... = dim_col apw" unfolding apw_def using outer_prod_dim + by (metis assms carrier_matD(2) carrier_vec_dim_vec index_add_mat(3)) + finally show dc: "dim_col paw = dim_col apw" . + show "\i j. i < dim_row apw \ j < dim_col apw \ paw $$ (i, j) = apw $$ (i, j)" + proof - + fix i j + assume "i < dim_row apw" and "j < dim_col apw" note ij = this + hence "paw $$ (i,j) = Matrix.vec_index v i * + (cnj (Matrix.vec_index w j + (Matrix.vec_index x j)))" + using dr dc unfolding paw_def outer_prod_def by simp + also have "... = Matrix.vec_index v i * cnj (Matrix.vec_index w j) + + Matrix.vec_index v i * cnj (Matrix.vec_index x j)" + by (simp add: ring_class.ring_distribs(1)) + also have "... = (outer_prod v w) $$ (i,j) + (outer_prod v x) $$ (i,j)" + using rv cw dr dc ij assms unfolding outer_prod_def by auto + also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp + finally show "paw $$ (i, j) = apw $$ (i, j)" . + qed + qed + thus ?thesis unfolding paw_def apw_def by simp +qed + +lemma outer_prod_minus_left: + fixes v::"complex Matrix.vec" + assumes "dim_vec v = dim_vec x" + shows "outer_prod (v - x) w = outer_prod v w - (outer_prod x w)" +proof - + define paw where "paw = outer_prod (v-x) w" + define apw where "apw = outer_prod v w - (outer_prod x w)" + have "paw = apw" + proof + have rv: "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim assms + by (metis carrier_matD(1) carrier_vec_dim_vec index_minus_vec(2) paw_def) + also have "... = dim_row apw" unfolding apw_def using outer_prod_dim assms + by (metis carrier_matD(1) carrier_vec_dim_vec index_minus_mat(2)) + finally show dr: "dim_row paw = dim_row apw" . + have cw: "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim assms + using carrier_vec_dim_vec by (metis carrier_matD(2)) + also have "... = dim_col apw" unfolding apw_def using outer_prod_dim + by (metis apw_def carrier_matD(2) carrier_vec_dim_vec minus_carrier_mat) + finally show dc: "dim_col paw = dim_col apw" . + show "\i j. i < dim_row apw \ j < dim_col apw \ paw $$ (i, j) = apw $$ (i, j)" + proof - + fix i j + assume "i < dim_row apw" and "j < dim_col apw" note ij = this + hence "paw $$ (i,j) = (Matrix.vec_index v i - Matrix.vec_index x i) * + cnj (Matrix.vec_index w j)" + using dr dc unfolding paw_def outer_prod_def by simp + also have "... = Matrix.vec_index v i * cnj (Matrix.vec_index w j) - + Matrix.vec_index x i * cnj (Matrix.vec_index w j)" + by (simp add: ring_class.ring_distribs) + also have "... = (outer_prod v w) $$ (i,j) - (outer_prod x w) $$ (i,j)" + using rv cw dr dc ij assms unfolding outer_prod_def by auto + also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp + finally show "paw $$ (i, j) = apw $$ (i, j)" . + qed + qed + thus ?thesis unfolding paw_def apw_def by simp +qed + +lemma outer_prod_minus_right: + fixes v::"complex Matrix.vec" + assumes "dim_vec w = dim_vec x" + shows "outer_prod v (w - x) = outer_prod v w - (outer_prod v x)" +proof - + define paw where "paw = outer_prod v (w-x)" + define apw where "apw = outer_prod v w - (outer_prod v x)" + have "paw = apw" + proof + have rv: "dim_row paw = dim_vec v" unfolding paw_def using outer_prod_dim assms + by (metis carrier_matD(1) carrier_vec_dim_vec paw_def) + also have "... = dim_row apw" unfolding apw_def using outer_prod_dim assms + by (metis carrier_matD(1) carrier_vec_dim_vec index_minus_mat(2)) + finally show dr: "dim_row paw = dim_row apw" . + have cw: "dim_col paw = dim_vec w" unfolding paw_def using outer_prod_dim assms + using carrier_vec_dim_vec + by (metis carrier_matD(2) index_minus_vec(2) paw_def) + also have "... = dim_col apw" unfolding apw_def using outer_prod_dim + by (metis assms carrier_matD(2) carrier_vec_dim_vec index_minus_mat(3)) + finally show dc: "dim_col paw = dim_col apw" . + show "\i j. i < dim_row apw \ j < dim_col apw \ paw $$ (i, j) = apw $$ (i, j)" + proof - + fix i j + assume "i < dim_row apw" and "j < dim_col apw" note ij = this + hence "paw $$ (i,j) = Matrix.vec_index v i * + (cnj (Matrix.vec_index w j - (Matrix.vec_index x j)))" + using dr dc unfolding paw_def outer_prod_def by simp + also have "... = Matrix.vec_index v i * cnj (Matrix.vec_index w j) - + Matrix.vec_index v i * cnj (Matrix.vec_index x j)" + by (simp add: ring_class.ring_distribs) + also have "... = (outer_prod v w) $$ (i,j) - (outer_prod v x) $$ (i,j)" + using rv cw dr dc ij assms unfolding outer_prod_def by auto + also have "... = apw $$ (i,j)" using dr dc ij unfolding apw_def outer_prod_def by simp + finally show "paw $$ (i, j) = apw $$ (i, j)" . + qed + qed + thus ?thesis unfolding paw_def apw_def by simp +qed + +lemma outer_minus_minus: + fixes a::"complex Matrix.vec" + assumes "dim_vec a = dim_vec b" + and "dim_vec u = dim_vec v" + shows "outer_prod (a - b) (u - v) = outer_prod a u - outer_prod a v - + outer_prod b u + outer_prod b v" +proof - + have "outer_prod (a - b) (u - v) = outer_prod a (u - v) + - outer_prod b (u - v)" using outer_prod_minus_left assms by simp + also have "... = outer_prod a u - outer_prod a v - + outer_prod b (u - v)" using assms outer_prod_minus_right by simp + also have "... = outer_prod a u - outer_prod a v - + (outer_prod b u - outer_prod b v)" using assms outer_prod_minus_right by simp + also have "... = outer_prod a u - outer_prod a v - + outer_prod b u + outer_prod b v" + proof (rule mat_minus_minus) + show "outer_prod b u \ carrier_mat (dim_vec b) (dim_vec u)" by simp + show "outer_prod b v \ carrier_mat (dim_vec b) (dim_vec u)" using assms by simp + show "outer_prod a u - outer_prod a v \ carrier_mat (dim_vec b) (dim_vec u)" using assms + by (metis carrier_vecI minus_carrier_mat outer_prod_dim) + qed + finally show ?thesis . +qed + +lemma outer_trace_inner: + assumes "A \ carrier_mat n n" + and "dim_vec u = n" +and "dim_vec v = n" + shows "Complex_Matrix.trace (outer_prod u v * A) = Complex_Matrix.inner_prod v (A *\<^sub>v u)" +proof - + have "Complex_Matrix.trace (outer_prod u v * A) = Complex_Matrix.trace (A * outer_prod u v)" + proof (rule trace_comm) + show "A \ carrier_mat n n" using assms by simp + show "outer_prod u v \ carrier_mat n n" using assms + by (metis carrier_vec_dim_vec outer_prod_dim) + qed + also have "... = Complex_Matrix.inner_prod v (A *\<^sub>v u)" using trace_outer_prod_right[of A n u v] + assms carrier_vec_dim_vec by metis + finally show ?thesis . +qed + +lemma zero_hermitian: + shows "hermitian (0\<^sub>m n n)" unfolding hermitian_def + by (metis adjoint_minus hermitian_def hermitian_one minus_r_inv_mat one_carrier_mat) + +lemma trace_1: + shows "Complex_Matrix.trace ((1\<^sub>m n)::complex Matrix.mat) =(n::complex)" using one_mat_def + by (simp add: Complex_Matrix.trace_def Matrix.mat_def) + +lemma trace_add: + assumes "square_mat A" + and "square_mat B" + and "dim_row A = dim_row B" + shows "Complex_Matrix.trace (A + B) = Complex_Matrix.trace A + Complex_Matrix.trace B" + using assms by (simp add: Complex_Matrix.trace_def sum.distrib) + +lemma bra_vec_carrier: + shows "bra_vec v \ carrier_mat 1 (dim_vec v)" +proof - + have "dim_row (ket_vec v) = dim_vec v" unfolding ket_vec_def by simp + thus ?thesis using bra_bra_vec[of v] bra_def[of "ket_vec v"] by simp +qed + +lemma mat_mult_ket_carrier: + assumes "A\ carrier_mat n m" +shows "A * |v\ \ carrier_mat n 1" using assms + by (metis bra_bra_vec bra_vec_carrier carrier_matD(1) carrier_matI dagger_of_ket_is_bra + dim_row_of_dagger index_mult_mat(2) index_mult_mat(3)) + +lemma mat_mult_ket: + assumes "A \ carrier_mat n m" +and "dim_vec v = m" +shows "A * |v\ = |A *\<^sub>v v\" +proof - + have rn: "dim_row (A * |v\) = n" unfolding times_mat_def using assms by simp + have co: "dim_col |A *\<^sub>v v\ = 1" using assms unfolding ket_vec_def by simp + have cov: "dim_col |v\ = 1" using assms unfolding ket_vec_def by simp + have er: "dim_row (A * |v\) = dim_row |A *\<^sub>v v\" using assms + by (metis bra_bra_vec bra_vec_carrier carrier_matD(2) dagger_of_ket_is_bra dim_col_of_dagger + dim_mult_mat_vec index_mult_mat(2)) + have ec: "dim_col (A * |v\) = dim_col |A *\<^sub>v v\" using assms + by (metis carrier_matD(2) index_mult_mat(3) mat_mult_ket_carrier) + { + fix i::nat + fix j::nat + assume "i < n" + and "j < 1" + hence "j = 0" by simp + have "(A * |v\) $$ (i,0) = Matrix.scalar_prod (Matrix.row A i) (Matrix.col |v\ 0)" + using times_mat_def[of A] \i < n\ rn cov by simp + also have "... = Matrix.scalar_prod (Matrix.row A i) v" using ket_vec_col by simp + also have "... = |A *\<^sub>v v\ $$ (i,j)" unfolding mult_mat_vec_def + using \i < n\ \j = 0\ assms(1) by auto + } note idx = this + have "A * |v\ = Matrix.mat n 1 (\(i, j). Matrix.scalar_prod (Matrix.row A i) (Matrix.col |v\ j))" + using assms unfolding times_mat_def ket_vec_def by simp + also have "... = |A *\<^sub>v v\" using er ec idx rn co by auto + finally show ?thesis . +qed + +lemma unitary_density: + assumes "density_operator R" + and "unitary U" + and "R\ carrier_mat n n" + and "U\ carrier_mat n n" +shows "density_operator (U * R * (Complex_Matrix.adjoint U))" unfolding density_operator_def +proof (intro conjI) + show "Complex_Matrix.positive (U * R * Complex_Matrix.adjoint U)" + proof (rule positive_close_under_left_right_mult_adjoint) + show "U \ carrier_mat n n" using assms by simp + show "R \ carrier_mat n n" using assms by simp + show "Complex_Matrix.positive R" using assms unfolding density_operator_def by simp + qed + have "Complex_Matrix.trace (U * R * Complex_Matrix.adjoint U) = + Complex_Matrix.trace (Complex_Matrix.adjoint U * U * R)" + using trace_comm[of "U * R" n "Complex_Matrix.adjoint U"] assms + by (metis adjoint_dim mat_assoc_test(10)) + also have "... = Complex_Matrix.trace R" using assms by simp + also have "... = 1" using assms unfolding density_operator_def by simp + finally show "Complex_Matrix.trace (U * R * Complex_Matrix.adjoint U) = 1" . +qed + + +subsection \Tensor product complements\ + +lemma tensor_vec_dim[simp]: + shows "dim_vec (tensor_vec u v) = dim_vec u * (dim_vec v)" +proof - + have "length (mult.vec_vec_Tensor (*) (list_of_vec u) (list_of_vec v)) = + length (list_of_vec u) * length (list_of_vec v)" + using mult.vec_vec_Tensor_length[of "1::real" "(*)" "list_of_vec u" "list_of_vec v"] + by (simp add: Matrix_Tensor.mult_def) + thus ?thesis unfolding tensor_vec_def by simp +qed + +lemma index_tensor_vec[simp]: + assumes "0 < dim_vec v" + and "i < dim_vec u * dim_vec v" +shows "vec_index (tensor_vec u v) i = + vec_index u (i div (dim_vec v)) * vec_index v (i mod dim_vec v)" +proof - + have m: "Matrix_Tensor.mult (1::complex) (*)" by (simp add: Matrix_Tensor.mult_def) + have "length (list_of_vec v) = dim_vec v" using assms by simp + hence "vec_index (tensor_vec u v) i = (*) (vec_index u (i div dim_vec v)) (vec_index v (i mod dim_vec v))" + unfolding tensor_vec_def using mult.vec_vec_Tensor_elements assms m + by (metis (mono_tags, lifting) length_greater_0_conv length_list_of_vec list_of_vec_index + mult.vec_vec_Tensor_elements vec_of_list_index) + thus ?thesis by simp +qed + +lemma outer_prod_tensor_comm: + fixes a::"complex Matrix.vec" + fixes u::"complex Matrix.vec" + assumes "0 < dim_vec a" + and "0 < dim_vec b" +shows "outer_prod (tensor_vec u v) (tensor_vec a b) = tensor_mat (outer_prod u a) (outer_prod v b)" +proof - + define ot where "ot = outer_prod (tensor_vec u v) (tensor_vec a b)" + define to where "to = tensor_mat (outer_prod u a) (outer_prod v b)" + define dv where "dv = dim_vec v" + define db where "db = dim_vec b" + have "ot = to" + proof + have ro: "dim_row ot = dim_vec u * dim_vec v" unfolding ot_def outer_prod_def by simp + have "dim_row to = dim_row (outer_prod u a) * dim_row (outer_prod v b)" + unfolding to_def by simp + also have "... = dim_vec u * dim_vec v" using outer_prod_dim + by (metis carrier_matD(1) carrier_vec_dim_vec) + finally have rt: "dim_row to = dim_vec u * dim_vec v" . + show "dim_row ot = dim_row to" using ro rt by simp + have co: "dim_col ot = dim_vec a * dim_vec b" unfolding ot_def outer_prod_def by simp + have "dim_col to = dim_col (outer_prod u a) * dim_col (outer_prod v b)" unfolding to_def by simp + also have "... = dim_vec a * dim_vec b" using outer_prod_dim + by (metis carrier_matD(2) carrier_vec_dim_vec) + finally have ct: "dim_col to = dim_vec a * dim_vec b" . + show "dim_col ot = dim_col to" using co ct by simp + show "\i j. i < dim_row to \ j < dim_col to \ ot $$ (i, j) = to $$ (i, j)" + proof - + fix i j + assume "i < dim_row to" and "j < dim_col to" note ij = this + have "ot $$ (i,j) = Matrix.vec_index (tensor_vec u v) i * + (conjugate (Matrix.vec_index (tensor_vec a b) j))" + unfolding ot_def outer_prod_def using ij rt ct by simp + also have "... = vec_index u (i div dv) * vec_index v (i mod dv) * + (conjugate (Matrix.vec_index (tensor_vec a b) j))" using ij rt assms + unfolding dv_def + by (metis index_tensor_vec less_nat_zero_code nat_0_less_mult_iff neq0_conv) + also have "... = vec_index u (i div dv) * vec_index v (i mod dv) * + (conjugate (vec_index a (j div db) * vec_index b (j mod db)))" using ij ct assms + unfolding db_def by simp + also have "... = vec_index u (i div dv) * vec_index v (i mod dv) * + (conjugate (vec_index a (j div db))) * (conjugate (vec_index b (j mod db)))" by simp + also have "... = vec_index u (i div dv) * (conjugate (vec_index a (j div db))) * + vec_index v (i mod dv) * (conjugate (vec_index b (j mod db)))" by simp + also have "... = (outer_prod u a) $$ (i div dv, j div db) * + vec_index v (i mod dv) * (conjugate (vec_index b (j mod db)))" + proof - + have "i div dv < dim_vec u" using ij rt unfolding dv_def + by (simp add: less_mult_imp_div_less) + moreover have "j div db < dim_vec a" using ij ct assms unfolding db_def + by (simp add: less_mult_imp_div_less) + ultimately have "vec_index u (i div dv) * (conjugate (vec_index a (j div db))) = + (outer_prod u a) $$ (i div dv, j div db)" unfolding outer_prod_def by simp + thus ?thesis by simp + qed + also have "... = (outer_prod u a) $$ (i div dv, j div db) * + (outer_prod v b) $$ (i mod dv, j mod db)" + proof - + have "i mod dv < dim_vec v" using ij rt unfolding dv_def + using assms mod_less_divisor + by (metis less_nat_zero_code mult.commute neq0_conv times_nat.simps(1)) + moreover have "j mod db < dim_vec b" using ij ct assms unfolding db_def + by (simp add: less_mult_imp_div_less) + ultimately have "vec_index v (i mod dv) * (conjugate (vec_index b (j mod db))) = + (outer_prod v b) $$ (i mod dv, j mod db)" unfolding outer_prod_def by simp + thus ?thesis by simp + qed + also have "... = tensor_mat (outer_prod u a) (outer_prod v b) $$ (i, j)" + proof (rule index_tensor_mat[symmetric]) + show "dim_row (outer_prod u a) = dim_vec u" unfolding outer_prod_def by simp + show "dim_row (outer_prod v b) = dv" unfolding outer_prod_def dv_def by simp + show "dim_col (outer_prod v b) = db" unfolding db_def outer_prod_def by simp + show "i < dim_vec u * dv" unfolding dv_def using ij rt by simp + show "dim_col (outer_prod u a) = dim_vec a" unfolding outer_prod_def by simp + show "j < dim_vec a * db" unfolding db_def using ij ct by simp + show "0 < dim_vec a" using assms by simp + show "0 < db" unfolding db_def using assms by simp + qed + finally show "ot $$ (i, j) = to $$ (i, j)" unfolding to_def . + qed + qed + thus ?thesis unfolding ot_def to_def by simp +qed + +lemma tensor_mat_adjoint: + assumes "m1 \ carrier_mat r1 c1" + and "m2 \ carrier_mat r2 c2" + and "0 < c1" + and "0 < c2" +and "0 < r1" +and "0 < r2" + shows "Complex_Matrix.adjoint (tensor_mat m1 m2) = + tensor_mat (Complex_Matrix.adjoint m1) (Complex_Matrix.adjoint m2)" + apply (rule eq_matI, auto) +proof - + fix i j + assume "i < dim_col m1 * dim_col m2" and "j < dim_row m1 * dim_row m2" note ij = this + have c1: "dim_col m1 = c1" using assms by simp + have r1: "dim_row m1 = r1" using assms by simp + have c2: "dim_col m2 = c2" using assms by simp + have r2: "dim_row m2 = r2" using assms by simp + have "Complex_Matrix.adjoint (m1 \ m2) $$ (i, j) = conjugate ((m1 \ m2) $$ (j, i))" + using ij by (simp add: adjoint_eval) + also have "... = conjugate (m1 $$ (j div r2, i div c2) * m2 $$ (j mod r2, i mod c2))" + proof - + have "(m1 \ m2) $$ (j, i) = m1 $$ (j div r2, i div c2) * m2 $$ (j mod r2, i mod c2)" + proof (rule index_tensor_mat[of m1 r1 c1 m2 r2 c2 j i], (auto simp add: assms ij c1 c2 r1 r2)) + show "j < r1 * r2" using ij r1 r2 by simp + show "i < c1 * c2" using ij c1 c2 by simp + qed + thus ?thesis by simp + qed + also have "... = conjugate (m1 $$ (j div r2, i div c2)) * conjugate ( m2 $$ (j mod r2, i mod c2))" + by simp + also have "... = (Complex_Matrix.adjoint m1) $$ (i div c2, j div r2) * + conjugate ( m2 $$ (j mod r2, i mod c2))" + by (metis adjoint_eval c2 ij less_mult_imp_div_less r2) + also have "... = (Complex_Matrix.adjoint m1) $$ (i div c2, j div r2) * + (Complex_Matrix.adjoint m2) $$ (i mod c2, j mod r2)" + by (metis Euclidean_Division.div_eq_0_iff adjoint_eval assms(4) bits_mod_div_trivial c2 + gr_implies_not_zero ij(2) mult_not_zero r2) + also have "... = (tensor_mat (Complex_Matrix.adjoint m1) (Complex_Matrix.adjoint m2)) $$ (i,j)" + proof (rule index_tensor_mat[symmetric], (simp add: ij c1 c2 r1 r2) +) + show "i < c1 * c2" using ij c1 c2 by simp + show "j < r1 * r2" using ij r1 r2 by simp + show "0 < r1" using assms by simp + show "0 < r2" using assms by simp + qed + finally show "Complex_Matrix.adjoint (m1 \ m2) $$ (i, j) = + (Complex_Matrix.adjoint m1 \ Complex_Matrix.adjoint m2) $$ (i, j)" . +qed + +lemma index_tensor_mat': + assumes "0 < dim_col A" + and "0 < dim_col B" + and "i < dim_row A * dim_row B" + and "j < dim_col A * dim_col B" + shows "(A \ B) $$ (i, j) = + A $$ (i div (dim_row B), j div (dim_col B)) * B $$ (i mod (dim_row B), j mod (dim_col B))" + by (rule index_tensor_mat, (simp add: assms)+) + +lemma tensor_mat_carrier: + shows "tensor_mat U V \ carrier_mat (dim_row U * dim_row V) (dim_col U * dim_col V)" by auto + +lemma tensor_mat_id: + assumes "0 < d1" + and "0 < d2" +shows "tensor_mat (1\<^sub>m d1) (1\<^sub>m d2) = 1\<^sub>m (d1 * d2)" +proof (rule eq_matI, auto) + show "tensor_mat (1\<^sub>m d1) (1\<^sub>m d2) $$ (i, i) = 1" if "i < (d1 * d2)" for i + using that index_tensor_mat'[of "1\<^sub>m d1" "1\<^sub>m d2"] + by (simp add: assms less_mult_imp_div_less) +next + show "tensor_mat (1\<^sub>m d1) (1\<^sub>m d2) $$ (i, j) = 0" if "i < d1 * d2" "j < d1 * d2" "i \ j" for i j + using that index_tensor_mat[of "1\<^sub>m d1" d1 d1 "1\<^sub>m d2" d2 d2 i j] + by (metis assms(1) assms(2) index_one_mat(1) index_one_mat(2) index_one_mat(3) + less_mult_imp_div_less mod_less_divisor mult_div_mod_eq mult_not_zero) +qed + +lemma tensor_mat_hermitian: + assumes "A \ carrier_mat n n" + and "B \ carrier_mat n' n'" + and "0 < n" + and "0 < n'" + and "hermitian A" + and "hermitian B" + shows "hermitian (tensor_mat A B)" using assms by (metis hermitian_def tensor_mat_adjoint) + +lemma tensor_mat_unitary: + assumes "Complex_Matrix.unitary U" + and "Complex_Matrix.unitary V" +and "0 < dim_row U" +and "0 < dim_row V" +shows "Complex_Matrix.unitary (tensor_mat U V)" +proof - + define UI where "UI = tensor_mat U V" + have "Complex_Matrix.adjoint UI = + tensor_mat (Complex_Matrix.adjoint U) (Complex_Matrix.adjoint V)" unfolding UI_def + proof (rule tensor_mat_adjoint) + show "U \ carrier_mat (dim_row U) (dim_row U)" using assms unfolding Complex_Matrix.unitary_def + by simp + show "V \ carrier_mat (dim_row V) (dim_row V)" using assms unfolding Complex_Matrix.unitary_def + by simp + show "0 < dim_row V" using assms by simp + show "0 < dim_row U" using assms by simp + show "0 < dim_row V" using assms by simp + show "0 < dim_row U" using assms by simp + qed + hence "UI * (Complex_Matrix.adjoint UI) = + tensor_mat (U * Complex_Matrix.adjoint U) (V * Complex_Matrix.adjoint V)" + using mult_distr_tensor[of U "Complex_Matrix.adjoint U" "V" "Complex_Matrix.adjoint V"] + unfolding UI_def + by (metis (no_types, lifting) Complex_Matrix.unitary_def adjoint_dim_col adjoint_dim_row + assms carrier_matD(2) ) + also have "... = tensor_mat (1\<^sub>m (dim_row U)) (1\<^sub>m (dim_row V))" using assms unitary_simps(2) + by (metis Complex_Matrix.unitary_def) + also have "... = (1\<^sub>m (dim_row U * dim_row V))" using tensor_mat_id assms by simp + finally have "UI * (Complex_Matrix.adjoint UI) = (1\<^sub>m (dim_row U * dim_row V))" . + hence "inverts_mat UI (Complex_Matrix.adjoint UI)" unfolding inverts_mat_def UI_def by simp + thus ?thesis using assms unfolding Complex_Matrix.unitary_def UI_def + by (metis carrier_matD(2) carrier_matI dim_col_tensor_mat dim_row_tensor_mat) +qed + + +subsection \Fixed carrier matrices locale\ + +text \We define a locale for matrices with a fixed number of rows and columns, and define a +finite sum operation on this locale. The \verb+Type_To_Sets+ transfer tools then permits to obtain +lemmata on the locale for free. \ + +locale fixed_carrier_mat = + fixes fc_mats::"'a::field Matrix.mat set" + fixes dimR dimC + assumes fc_mats_carrier: "fc_mats = carrier_mat dimR dimC" +begin + +sublocale semigroup_add_on_with fc_mats "(+)" +proof (unfold_locales) + show "\a b. a \ fc_mats \ b \ fc_mats \ a + b \ fc_mats" using fc_mats_carrier by simp + show "\a b c. a \ fc_mats \ b \ fc_mats \ c \ fc_mats \ a + b + c = a + (b + c)" + using fc_mats_carrier by simp +qed + +sublocale ab_semigroup_add_on_with fc_mats "(+)" +proof (unfold_locales) + show "\a b. a \ fc_mats \ b \ fc_mats \ a + b = b + a" using fc_mats_carrier + by (simp add: comm_add_mat) +qed + +sublocale comm_monoid_add_on_with fc_mats "(+)" "0\<^sub>m dimR dimC" +proof (unfold_locales) + show "0\<^sub>m dimR dimC \ fc_mats" using fc_mats_carrier by simp + show "\a. a \ fc_mats \ 0\<^sub>m dimR dimC + a = a" using fc_mats_carrier by simp +qed + +sublocale ab_group_add_on_with fc_mats "(+)" "0\<^sub>m dimR dimC" "(-)" "uminus" +proof (unfold_locales) + show "\a. a \ fc_mats \ - a + a = 0\<^sub>m dimR dimC" using fc_mats_carrier by simp + show "\a b. a \ fc_mats \ b \ fc_mats \ a - b = a + - b" using fc_mats_carrier + by (simp add: add_uminus_minus_mat) + show "\a. a \ fc_mats \ - a \ fc_mats" using fc_mats_carrier by simp +qed +end + +lemma (in fixed_carrier_mat) smult_mem: + assumes "A \ fc_mats" + shows "a \\<^sub>m A \ fc_mats" using fc_mats_carrier assms by auto + +definition (in fixed_carrier_mat) sum_mat where +"sum_mat A I = sum_with (+) (0\<^sub>m dimR dimC) A I" + +lemma (in fixed_carrier_mat) sum_mat_empty[simp]: + shows "sum_mat A {} = 0\<^sub>m dimR dimC" unfolding sum_mat_def by simp + +lemma (in fixed_carrier_mat) sum_mat_carrier: + shows "(\i. i \ I \ (A i)\ fc_mats) \ sum_mat A I \ carrier_mat dimR dimC" + unfolding sum_mat_def using sum_with_mem[of A I] fc_mats_carrier by auto + +lemma (in fixed_carrier_mat) sum_mat_insert: + assumes "A x \ fc_mats" "A ` I \ fc_mats" + and A: "finite I" and x: "x \ I" + shows "sum_mat A (insert x I) = A x + sum_mat A I" unfolding sum_mat_def + using assms sum_with_insert[of A x I] by simp + + +subsection \A locale for square matrices\ + +locale cpx_sq_mat = fixed_carrier_mat "fc_mats::complex Matrix.mat set" for fc_mats + + assumes dim_eq: "dimR = dimC" + and npos: "0 < dimR" + +lemma (in cpx_sq_mat) one_mem: + shows "1\<^sub>m dimR \ fc_mats" using fc_mats_carrier dim_eq by simp + +lemma (in cpx_sq_mat) square_mats: + assumes "A \ fc_mats" + shows "square_mat A" using fc_mats_carrier dim_eq assms by simp + +lemma (in cpx_sq_mat) cpx_sq_mat_mult: + assumes "A \ fc_mats" + and "B \ fc_mats" +shows "A * B \ fc_mats" +proof - + have "dim_row (A * B) = dimR" using assms fc_mats_carrier by simp + moreover have "dim_col (A * B) = dimR" using assms fc_mats_carrier dim_eq by simp + ultimately show ?thesis using fc_mats_carrier carrier_mat_def dim_eq by auto +qed + +lemma (in cpx_sq_mat) sum_mat_distrib_left: + shows "finite I \ R\ fc_mats \ (\i. i \ I \ (A i)\ fc_mats) \ + sum_mat (\i. R * (A i)) I = R * (sum_mat A I)" +proof (induct rule: finite_induct) + case empty + hence a: "sum_mat (\i. R * (A i)) {} = 0\<^sub>m dimR dimC" unfolding sum_mat_def by simp + have "sum_mat A {} = 0\<^sub>m dimR dimC" unfolding sum_mat_def by simp + hence "R * (sum_mat A {}) = 0\<^sub>m dimR dimC" using fc_mats_carrier + right_mult_zero_mat[of R dimR dimC dimC] empty dim_eq by simp + thus ?case using a by simp +next + case (insert x F) + hence "sum_mat (\i. R * A i) (insert x F) = R * (A x) + sum_mat (\i. R * A i) F" + using sum_mat_insert[of "\i. R * A i" x F] by (simp add: image_subsetI fc_mats_carrier dim_eq) + also have "... = R * (A x) + R * (sum_mat A F)" using insert by simp + also have "... = R * (A x + (sum_mat A F))" + by (metis dim_eq fc_mats_carrier insert.prems(1) insert.prems(2) insertCI mult_add_distrib_mat + sum_mat_carrier) + also have "... = R * sum_mat A (insert x F)" + proof - + have "A x + (sum_mat A F) = sum_mat A (insert x F)" + by (rule sum_mat_insert[symmetric], (auto simp add: insert)) + thus ?thesis by simp + qed + finally show ?case . +qed + +lemma (in cpx_sq_mat) sum_mat_distrib_right: + shows "finite I \ R\ fc_mats \ (\i. i \ I \ (A i)\ fc_mats) \ + sum_mat (\i. (A i) * R) I = (sum_mat A I) * R" +proof (induct rule: finite_induct) + case empty + hence a: "sum_mat (\i. (A i) * R) {} = 0\<^sub>m dimR dimC" unfolding sum_mat_def by simp + have "sum_mat A {} = 0\<^sub>m dimR dimC" unfolding sum_mat_def by simp + hence "(sum_mat A {}) * R = 0\<^sub>m dimR dimC" using fc_mats_carrier right_mult_zero_mat[of R ] + dim_eq empty by simp + thus ?case using a by simp +next + case (insert x F) + have a: "(\i. A i * R) ` F \ fc_mats" using insert cpx_sq_mat_mult + by (simp add: image_subsetI) + have "A x * R \ fc_mats" using insert + by (metis insertI1 local.fc_mats_carrier mult_carrier_mat dim_eq) + hence "sum_mat (\i. A i * R) (insert x F) = (A x) * R + sum_mat (\i. A i * R) F" using insert a + using sum_mat_insert[of "\i. A i * R" x F] by (simp add: image_subsetI local.fc_mats_carrier) + also have "... = (A x) * R + (sum_mat A F) * R" using insert by simp + also have "... = (A x + (sum_mat A F)) * R" + proof (rule add_mult_distrib_mat[symmetric]) + show "A x \ carrier_mat dimR dimC" using insert fc_mats_carrier by simp + show "sum_mat A F \ carrier_mat dimR dimC" using insert fc_mats_carrier sum_mat_carrier by blast + show "R \ carrier_mat dimC dimC" using insert fc_mats_carrier dim_eq by simp + qed + also have "... = sum_mat A (insert x F) * R" + proof - + have "A x + (sum_mat A F) = sum_mat A (insert x F)" + by (rule sum_mat_insert[symmetric], (auto simp add: insert)) + thus ?thesis by simp + qed + finally show ?case . +qed + +lemma (in cpx_sq_mat) trace_sum_mat: + fixes A::"'b \ complex Matrix.mat" + shows "finite I \ (\i. i \ I \ (A i)\ fc_mats) \ + Complex_Matrix.trace (sum_mat A I) = (\ i\ I. Complex_Matrix.trace (A i))" unfolding sum_mat_def +proof (induct rule: finite_induct) + case empty + then show ?case using trace_zero dim_eq by simp +next + case (insert x F) + have "Complex_Matrix.trace (sum_with (+) (0\<^sub>m dimR dimC) A (insert x F)) = + Complex_Matrix.trace (A x + sum_with (+) (0\<^sub>m dimR dimC) A F)" + using sum_with_insert[of A x F] insert by (simp add: image_subset_iff dim_eq) + also have "... = Complex_Matrix.trace (A x) + + Complex_Matrix.trace (sum_with (+) (0\<^sub>m dimR dimC) A F)" using trace_add square_mats insert + by (metis carrier_matD(1) fc_mats_carrier image_subset_iff insert_iff sum_with_mem) + also have "... = Complex_Matrix.trace (A x) + (\ i\ F. Complex_Matrix.trace (A i))" + using insert by simp + also have "... = (\ i\ (insert x F). Complex_Matrix.trace (A i))" + using sum_with_insert[of A x F] insert by (simp add: image_subset_iff) + finally show ?case . +qed + +lemma (in cpx_sq_mat) cpx_sq_mat_smult: + assumes "A \ fc_mats" + shows "x \\<^sub>m A \ fc_mats" + using assms fc_mats_carrier by auto + +lemma (in cpx_sq_mat) mult_add_distrib_right: + assumes "A\ fc_mats" "B\ fc_mats" "C\ fc_mats" + shows "A * (B + C) = A * B + A * C" + using assms fc_mats_carrier mult_add_distrib_mat dim_eq by simp + +lemma (in cpx_sq_mat) mult_add_distrib_left: + assumes "A\ fc_mats" "B\ fc_mats" "C\ fc_mats" + shows "(B + C) * A = B * A + C * A" + using assms fc_mats_carrier add_mult_distrib_mat dim_eq by simp + +lemma (in cpx_sq_mat) mult_sum_mat_distrib_left: + shows "finite I \ (\i. i \ I \ (A i)\ fc_mats) \ B \ fc_mats \ + (sum_mat (\i. B * (A i)) I) = B * (sum_mat A I)" +proof (induct rule: finite_induct) + case empty + hence "sum_mat A {} = 0\<^sub>m dimR dimC" using sum_mat_empty by simp + hence "B * (sum_mat A {}) = 0\<^sub>m dimR dimC" using empty by (simp add: fc_mats_carrier dim_eq) + moreover have "sum_mat (\i. B * (A i)) {} = 0\<^sub>m dimR dimC" using sum_mat_empty[of "\i. B * (A i)"] + by simp + ultimately show ?case by simp +next + case (insert x F) + have "sum_mat (\i. B * (A i)) (insert x F) = B * (A x) + sum_mat (\i. B * (A i)) F" + using sum_with_insert[of "\i. B * (A i)" x F] insert + by (simp add: image_subset_iff local.sum_mat_def cpx_sq_mat_mult) + also have "... = B * (A x) + B * (sum_mat A F)" using insert by simp + also have "... = B * (A x + (sum_mat A F))" + proof (rule mult_add_distrib_right[symmetric]) + show "B\ fc_mats" using insert by simp + show "A x \ fc_mats" using insert by simp + show "sum_mat A F \ fc_mats" using insert by (simp add: fc_mats_carrier sum_mat_carrier) + qed + also have "... = B * (sum_mat A (insert x F))" using sum_with_insert[of A x F] insert + by (simp add: image_subset_iff sum_mat_def) + finally show ?case . +qed + +lemma (in cpx_sq_mat) mult_sum_mat_distrib_right: + shows "finite I \ (\i. i \ I \ (A i)\ fc_mats) \ B \ fc_mats \ + (sum_mat (\i. (A i) * B) I) = (sum_mat A I) * B" +proof (induct rule: finite_induct) + case empty + hence "sum_mat A {} = 0\<^sub>m dimR dimC" using sum_mat_empty by simp + hence "(sum_mat A {}) * B = 0\<^sub>m dimR dimC" using empty by (simp add: fc_mats_carrier dim_eq) + moreover have "sum_mat (\i. (A i) * B) {} = 0\<^sub>m dimR dimC" by simp + ultimately show ?case by simp +next + case (insert x F) + have "sum_mat (\i. (A i) * B) (insert x F) = (A x) * B + sum_mat (\i. (A i) * B) F" + using sum_with_insert[of "\i. (A i) * B" x F] insert + by (simp add: image_subset_iff local.sum_mat_def cpx_sq_mat_mult) + also have "... = (A x) * B + (sum_mat A F) * B" using insert by simp + also have "... = (A x + (sum_mat A F)) * B" + proof (rule mult_add_distrib_left[symmetric]) + show "B\ fc_mats" using insert by simp + show "A x \ fc_mats" using insert by simp + show "sum_mat A F \ fc_mats" using insert by (simp add: fc_mats_carrier sum_mat_carrier) + qed + also have "... = (sum_mat A (insert x F)) * B" using sum_with_insert[of A x F] insert + by (simp add: image_subset_iff sum_mat_def) + finally show ?case . +qed + +lemma (in cpx_sq_mat) trace_sum_mat_mat_distrib: + assumes "finite I" +and "\i. i\ I \ B i \ fc_mats" +and "A\ fc_mats" +and "C \ fc_mats" +shows "(\ i\ I. Complex_Matrix.trace(A * (B i) * C)) = + Complex_Matrix.trace (A * (sum_mat B I) * C)" +proof - + have seq: "sum_mat (\i. A * (B i) * C) I = A * (sum_mat B I) * C" + proof - + have "sum_mat (\i. A * (B i) * C) I = (sum_mat (\i. A * (B i)) I) * C" + proof (rule mult_sum_mat_distrib_right) + show "finite I" using assms by simp + show "C\ fc_mats" using assms by simp + show "\i. i \ I \ A * B i \ fc_mats" using assms cpx_sq_mat_mult by simp + qed + moreover have "sum_mat (\i. A * (B i)) I = A * (sum_mat B I)" + by (rule mult_sum_mat_distrib_left, (auto simp add: assms)) + ultimately show "sum_mat (\i. A * (B i) * C) I = A * (sum_mat B I) * C" by simp + qed + have "(\ i\ I. Complex_Matrix.trace(A * (B i) * C)) = + Complex_Matrix.trace (sum_mat (\i. A * (B i) * C) I)" + proof (rule trace_sum_mat[symmetric]) + show "finite I" using assms by simp + fix i + assume "i\ I" + thus "A * B i * C \ fc_mats" using assms by (simp add: cpx_sq_mat_mult) + qed + also have "... = Complex_Matrix.trace (A * (sum_mat B I) * C)" using seq by simp + finally show ?thesis . +qed + +definition (in cpx_sq_mat) zero_col where +"zero_col U = (\i. if i < dimR then Matrix.col U i else 0\<^sub>v dimR)" + +lemma (in cpx_sq_mat) zero_col_dim: + assumes "U \ fc_mats" + shows "dim_vec (zero_col U i) = dimR" using assms fc_mats_carrier unfolding zero_col_def by simp + +lemma (in cpx_sq_mat) zero_col_col: + assumes "i < dimR" + shows "zero_col U i = Matrix.col U i" using assms unfolding zero_col_def by simp + +lemma (in cpx_sq_mat) sum_mat_index: + shows "finite I \ (\i. i \ I \ (A i)\ fc_mats) \ i < dimR \ j < dimC \ + (sum_mat (\k. (A k)) I) $$ (i,j) = (\ k\I. (A k) $$ (i,j))" +proof (induct rule: finite_induct) + case empty + thus ?case unfolding sum_mat_def by simp +next + case (insert x F) + hence "(sum_mat (\k. (A k)) (insert x F)) $$ (i,j) = + (A x + (sum_mat (\k. (A k)) F)) $$ (i,j)" using insert sum_mat_insert[of A] + by (simp add: image_subsetI local.fc_mats_carrier) + also have "... = (A x) $$ (i,j) + (sum_mat (\k. (A k)) F) $$ (i,j)" using insert + sum_mat_carrier[of F A] fc_mats_carrier by simp + also have "... = (A x) $$ (i,j) + (\ k\F. (A k) $$ (i,j))" using insert by simp + also have "... = (\ k\(insert x F). (A k) $$ (i,j))" using insert by simp + finally show ?case . +qed + +lemma (in cpx_sq_mat) sum_mat_cong: + shows "finite I \ (\i. i\ I \ A i = B i) \ (\i. i\ I \ A i \ fc_mats) \ + (\i. i\ I \ B i \ fc_mats) \ sum_mat A I = sum_mat B I" +proof (induct rule: finite_induct) + case empty + then show ?case by simp +next + case (insert x F) + have "sum_mat A (insert x F) = A x + sum_mat A F" using insert sum_mat_insert[of A] + by (simp add: image_subset_iff) + also have "... = B x + sum_mat B F" using insert by simp + also have "... = sum_mat B (insert x F)" using insert sum_mat_insert[of B] + by (simp add: image_subset_iff) + finally show ?case . +qed + +lemma (in cpx_sq_mat) smult_sum_mat: + shows "finite I \ (\i. i\ I \ A i \ fc_mats) \ a \\<^sub>m sum_mat A I = sum_mat (\i. a \\<^sub>m (A i)) I" +proof (induct rule: finite_induct) + case empty + then show ?case by simp +next + case (insert x F) + have "a \\<^sub>m sum_mat A (insert x F) = a \\<^sub>m (A x + sum_mat A F)" using insert sum_mat_insert[of A] + by (simp add: image_subset_iff) + also have "... = a \\<^sub>m A x + a \\<^sub>m (sum_mat A F)" using insert + by (metis add_smult_distrib_left_mat fc_mats_carrier insert_iff sum_mat_carrier) + also have "... = a \\<^sub>m A x + sum_mat (\i. a \\<^sub>m (A i)) F" using insert by simp + also have "... = sum_mat (\i. a \\<^sub>m (A i)) (insert x F)" using insert + sum_mat_insert[of "(\i. a \\<^sub>m (A i))"] by (simp add: image_subset_iff cpx_sq_mat_smult) + finally show ?case . +qed + +lemma (in cpx_sq_mat) zero_sum_mat: + shows "finite I \ sum_mat (\i. ((0\<^sub>m dimR dimR)::complex Matrix.mat)) I = ((0\<^sub>m dimR dimR)::complex Matrix.mat)" +proof (induct rule:finite_induct) + case empty + then show ?case using dim_eq sum_mat_empty by auto +next + case (insert x F) + have "sum_mat (\i. ((0\<^sub>m dimR dimR)::complex Matrix.mat)) (insert x F) = + 0\<^sub>m dimR dimR + sum_mat (\i. 0\<^sub>m dimR dimR) F" + using insert dim_eq zero_mem sum_mat_insert[of "\i. ((0\<^sub>m dimR dimR)::complex Matrix.mat)"] + by fastforce + also have "... = ((0\<^sub>m dimR dimR)::complex Matrix.mat)" using insert by auto + finally show ?case . +qed + +lemma (in cpx_sq_mat) sum_mat_adjoint: + shows "finite I \ (\i. i\ I \ A i \ fc_mats) \ + Complex_Matrix.adjoint (sum_mat A I) = sum_mat (\i. Complex_Matrix.adjoint (A i)) I" +proof (induct rule: finite_induct) + case empty + then show ?case using zero_hermitian[of dimR] + by (metis (no_types) dim_eq hermitian_def sum_mat_empty) +next + case (insert x F) + have "Complex_Matrix.adjoint (sum_mat A (insert x F)) = + Complex_Matrix.adjoint (A x + sum_mat A F)" using insert sum_mat_insert[of A] + by (simp add: image_subset_iff) + also have "... = Complex_Matrix.adjoint (A x) + Complex_Matrix.adjoint (sum_mat A F)" + proof (rule adjoint_add) + show "A x \ carrier_mat dimR dimC" using insert fc_mats_carrier by simp + show "sum_mat A F \ carrier_mat dimR dimC" using insert fc_mats_carrier sum_mat_carrier[of F] + by simp + qed + also have "... = Complex_Matrix.adjoint (A x) + sum_mat (\i. Complex_Matrix.adjoint (A i)) F" + using insert by simp + also have "... = sum_mat (\i. Complex_Matrix.adjoint (A i)) (insert x F)" + proof (rule sum_mat_insert[symmetric], (auto simp add: insert)) + show "Complex_Matrix.adjoint (A x) \ fc_mats" using insert fc_mats_carrier dim_eq + by (simp add: adjoint_dim) + show "\i. i \ F \ Complex_Matrix.adjoint (A i) \ fc_mats" using insert fc_mats_carrier dim_eq + by (simp add: adjoint_dim) + qed + finally show ?case . +qed + +lemma (in cpx_sq_mat) sum_mat_hermitian: + assumes "finite I" +and "\i\ I. hermitian (A i)" +and "\i\ I. A i\ fc_mats" +shows "hermitian (sum_mat A I)" +proof - + have "Complex_Matrix.adjoint (sum_mat A I) = sum_mat (\i. Complex_Matrix.adjoint (A i)) I" + using assms sum_mat_adjoint[of I] by simp + also have "... = sum_mat A I" + proof (rule sum_mat_cong, (auto simp add: assms)) + show "\i. i \ I \ Complex_Matrix.adjoint (A i) = A i" using assms + unfolding hermitian_def by simp + show "\i. i \ I \ Complex_Matrix.adjoint (A i) \ fc_mats" using assms fc_mats_carrier dim_eq + by (simp add: adjoint_dim) + qed + finally show ?thesis unfolding hermitian_def . +qed + +lemma (in cpx_sq_mat) sum_mat_positive: +shows "finite I \ (\i. i\ I \ Complex_Matrix.positive (A i)) \ + (\i. i \ I \ A i \ fc_mats) \ Complex_Matrix.positive (sum_mat A I)" +proof (induct rule: finite_induct) + case empty + then show ?case using positive_zero[of dimR] by (metis (no_types) dim_eq sum_mat_empty) +next + case (insert x F) + hence "sum_mat A (insert x F) = A x + (sum_mat A F)" using sum_mat_insert[of A] + by (simp add: image_subset_iff) + moreover have "Complex_Matrix.positive (A x + (sum_mat A F))" + proof (rule positive_add, (auto simp add: insert)) + show "A x \ carrier_mat dimR dimR" using insert fc_mats_carrier dim_eq by simp + show "sum_mat A F \ carrier_mat dimR dimR" using insert sum_mat_carrier dim_eq + by (metis insertCI) + qed + ultimately show "Complex_Matrix.positive (sum_mat A (insert x F))" by simp +qed + +lemma (in cpx_sq_mat) sum_mat_left_ortho_zero: + shows "finite I \ + (\i. i\ I \ A i \ fc_mats) \ (B \ fc_mats) \ + (\ i. i\ I \ A i * B = (0\<^sub>m dimR dimR)) \ + (sum_mat A I) * B = 0\<^sub>m dimR dimR" +proof (induct rule:finite_induct) + case empty + then show ?case using dim_eq + by (metis finite.intros(1) sum_mat_empty mult_sum_mat_distrib_right) +next + case (insert x F) + have "(sum_mat A (insert x F)) * B = + (A x + sum_mat A F) * B" using insert sum_mat_insert[of A] + by (simp add: image_subset_iff) + also have "... = A x * B + sum_mat A F * B" + proof (rule add_mult_distrib_mat) + show "A x \ carrier_mat dimR dimC" using insert fc_mats_carrier by simp + show "sum_mat A F \ carrier_mat dimR dimC" using insert + by (metis insert_iff local.fc_mats_carrier sum_mat_carrier) + show "B \ carrier_mat dimC dimR" using insert fc_mats_carrier dim_eq by simp + qed + also have "... = A x * B + (0\<^sub>m dimR dimR)" using insert by simp + also have "... = 0\<^sub>m dimR dimR" using insert by simp + finally show ?case . +qed + +lemma (in cpx_sq_mat) sum_mat_right_ortho_zero: + shows "finite I \ + (\i. i\ I \ A i \ fc_mats) \ (B \ fc_mats) \ + (\ i. i\ I \ B * A i = (0\<^sub>m dimR dimR)) \ + B * (sum_mat A I) = 0\<^sub>m dimR dimR" +proof (induct rule:finite_induct) + case empty + then show ?case using dim_eq + by (metis finite.intros(1) sum_mat_empty mult_sum_mat_distrib_left) +next + case (insert x F) + have "B * (sum_mat A (insert x F)) = + B * (A x + sum_mat A F)" using insert sum_mat_insert[of A] + by (simp add: image_subset_iff) + also have "... = B * A x + B * sum_mat A F" + proof (rule mult_add_distrib_mat) + show "A x \ carrier_mat dimR dimC" using insert fc_mats_carrier by simp + show "sum_mat A F \ carrier_mat dimR dimC" using insert + by (metis insert_iff local.fc_mats_carrier sum_mat_carrier) + show "B \ carrier_mat dimC dimR" using insert fc_mats_carrier dim_eq by simp + qed + also have "... = B * A x + (0\<^sub>m dimR dimR)" using insert by simp + also have "... = 0\<^sub>m dimR dimR" using insert by simp + finally show ?case . +qed + +lemma (in cpx_sq_mat) sum_mat_ortho_square: + shows "finite I \ (\i. i\ I \ ((A i)::complex Matrix.mat) * (A i) = A i) \ + (\i. i\ I \ A i \ fc_mats) \ + (\ i j. i\ I \ j\ I \ i\ j \ A i * (A j) = (0\<^sub>m dimR dimR)) \ + (sum_mat A I) * (sum_mat A I) = (sum_mat A I)" +proof (induct rule:finite_induct) + case empty + then show ?case using dim_eq + by (metis fc_mats_carrier right_mult_zero_mat sum_mat_empty zero_mem) +next + case (insert x F) + have "(sum_mat A (insert x F)) * (sum_mat A (insert x F)) = + (A x + sum_mat A F) * (A x + sum_mat A F)" using insert sum_mat_insert[of A] + by (simp add: \\i. i \ insert x F \ A i * A i = A i\ image_subset_iff) + also have "... = A x * (A x + sum_mat A F) + sum_mat A F * (A x + sum_mat A F)" + proof (rule add_mult_distrib_mat) + show "A x \ carrier_mat dimR dimC" using insert fc_mats_carrier by simp + show "sum_mat A F \ carrier_mat dimR dimC" using insert + by (metis insert_iff local.fc_mats_carrier sum_mat_carrier) + thus "A x + sum_mat A F \ carrier_mat dimC dimC" using insert dim_eq by simp + qed + also have "... = A x * A x + A x * (sum_mat A F) + sum_mat A F * (A x + sum_mat A F)" + proof - + have "A x * (A x + sum_mat A F) = A x * A x + A x * (sum_mat A F)" + using dim_eq insert.prems(2) mult_add_distrib_right sum_mat_carrier + by (metis fc_mats_carrier insertI1 subsetD subset_insertI) + thus ?thesis by simp + qed + also have "... = A x * A x + A x * (sum_mat A F) + sum_mat A F * A x + + sum_mat A F * (sum_mat A F)" + proof - + have "sum_mat A F * (A x + local.sum_mat A F) = + sum_mat A F * A x + local.sum_mat A F * local.sum_mat A F" + using insert dim_eq add_assoc add_mem mult_add_distrib_right cpx_sq_mat_mult sum_mat_carrier + by (metis fc_mats_carrier insertI1 subsetD subset_insertI) + hence "A x * A x + A x * sum_mat A F + sum_mat A F * (A x + sum_mat A F) = + A x * A x + A x * sum_mat A F + (sum_mat A F * A x + sum_mat A F * sum_mat A F)" by simp + also have "... = A x * A x + A x * sum_mat A F + sum_mat A F * A x + sum_mat A F * sum_mat A F" + proof (rule assoc_add_mat[symmetric]) + show "A x * A x + A x * sum_mat A F \ carrier_mat dimR dimR" using sum_mat_carrier insert + dim_eq fc_mats_carrier by (metis add_mem cpx_sq_mat_mult insertCI) + show "sum_mat A F * A x \ carrier_mat dimR dimR" using sum_mat_carrier insert + dim_eq fc_mats_carrier by (metis cpx_sq_mat_mult insertCI) + show "sum_mat A F * sum_mat A F \ carrier_mat dimR dimR" using sum_mat_carrier insert + dim_eq fc_mats_carrier by (metis cpx_sq_mat_mult insertCI) + qed + finally show ?thesis . + qed + also have "... = A x + sum_mat A F" + proof - + have "A x * A x = A x" using insert by simp + moreover have "sum_mat A F * sum_mat A F = sum_mat A F" using insert by simp + moreover have "A x * (sum_mat A F) = 0\<^sub>m dimR dimR" + proof - + have "A x * (sum_mat A F) = sum_mat (\i. A x * (A i)) F" + by (rule sum_mat_distrib_left[symmetric], (simp add: insert)+) + also have "... = sum_mat (\i. 0\<^sub>m dimR dimR) F" + proof (rule sum_mat_cong, (auto simp add: insert zero_mem)) + show "\i. i \ F \ A x * A i = 0\<^sub>m dimR dimR" using insert by auto + show "\i. i \ F \ A x * A i \ fc_mats" using insert cpx_sq_mat_mult by auto + show "\i. i \ F \ 0\<^sub>m dimR dimR \ fc_mats" using zero_mem dim_eq by simp + qed + also have "... = 0\<^sub>m dimR dimR" using zero_sum_mat insert by simp + finally show ?thesis . + qed + moreover have "sum_mat A F * A x = 0\<^sub>m dimR dimR" + proof - + have "sum_mat A F * A x = sum_mat (\i. A i * (A x)) F" + by (rule sum_mat_distrib_right[symmetric], (simp add: insert)+) + also have "... = sum_mat (\i. 0\<^sub>m dimR dimR) F" + proof (rule sum_mat_cong, (auto simp add: insert zero_mem)) + show "\i. i \ F \ A i * A x = 0\<^sub>m dimR dimR" using insert by auto + show "\i. i \ F \ A i * A x \ fc_mats" using insert cpx_sq_mat_mult by auto + show "\i. i \ F \ 0\<^sub>m dimR dimR \ fc_mats" using zero_mem dim_eq by simp + qed + also have "... = 0\<^sub>m dimR dimR" using zero_sum_mat insert by simp + finally show ?thesis . + qed + ultimately show ?thesis using add_commute add_zero insert.prems(2) zero_mem dim_eq by auto + qed + also have "... = sum_mat A (insert x F)" using insert sum_mat_insert[of A x F] + by (simp add: \\i. i \ insert x F \ A i * A i = A i\ image_subsetI) + finally show ?case . +qed + +lemma diagonal_unit_vec: + assumes "B \ carrier_mat n n" +and "diagonal_mat (B::complex Matrix.mat)" +shows "B *\<^sub>v (unit_vec n i) = B $$ (i,i) \\<^sub>v (unit_vec n i)" +proof - + define v::"complex Matrix.vec" where "v = unit_vec n i" + have "B *\<^sub>v v = Matrix.vec n (\ i. Matrix.scalar_prod (Matrix.row B i) v)" + using assms unfolding mult_mat_vec_def by simp + also have "... = Matrix.vec n (\ i. B $$(i,i) * Matrix.vec_index v i)" + proof - + have "\i < n. (Matrix.scalar_prod (Matrix.row B i) v = B $$(i,i) * Matrix.vec_index v i)" + proof (intro allI impI) + fix i + assume "i < n" + have "(Matrix.scalar_prod (Matrix.row B i) v) = + (\ j \ {0 ..< n}. Matrix.vec_index (Matrix.row B i) j * Matrix.vec_index v j)" using assms + unfolding Matrix.scalar_prod_def v_def by simp + also have "... = Matrix.vec_index (Matrix.row B i) i * Matrix.vec_index v i" + proof (rule sum_but_one) + show "\j < n. j \ i \ Matrix.vec_index (Matrix.row B i) j = 0" + proof (intro allI impI) + fix j + assume "j < n" and "j \ i" + hence "Matrix.vec_index (Matrix.row B i) j = B $$ (i,j)" using \i < n\ \j < n\ assms + by auto + also have "... = 0" using assms \i < n\ \j < n\ \j\ i\ unfolding diagonal_mat_def by simp + finally show "Matrix.vec_index (Matrix.row B i) j = 0" . + qed + show "i < n" using \i < n\ . + qed + also have "... = B $$(i,i) * Matrix.vec_index v i" using assms \i < n\ by auto + finally show "(Matrix.scalar_prod (Matrix.row B i) v) = B $$(i,i) * Matrix.vec_index v i" . + qed + thus ?thesis by auto + qed + also have "... = B $$ (i,i) \\<^sub>v v" unfolding v_def unit_vec_def by auto + finally have "B *\<^sub>v v = B $$ (i,i) \\<^sub>v v" . + thus ?thesis unfolding v_def by simp +qed + +lemma mat_vec_mult_assoc: + assumes "A \ carrier_mat n p" +and "B\ carrier_mat p q" +and "dim_vec v = q" +shows "A *\<^sub>v (B *\<^sub>v v) = (A * B) *\<^sub>v v" using assms by auto + +lemma (in cpx_sq_mat) similar_eigenvectors: + assumes "A\ fc_mats" + and "B\ fc_mats" + and "P\ fc_mats" + and "similar_mat_wit A B P (Complex_Matrix.adjoint P)" + and "diagonal_mat B" + and "i < n" +shows "A *\<^sub>v (P *\<^sub>v (unit_vec dimR i)) = B $$ (i,i) \\<^sub>v (P *\<^sub>v (unit_vec dimR i))" +proof - + have "A *\<^sub>v (P *\<^sub>v (unit_vec dimR i)) = + (P * B * (Complex_Matrix.adjoint P)) *\<^sub>v (P *\<^sub>v (unit_vec dimR i))" + using assms unfolding similar_mat_wit_def by metis + also have "... = P * B * (Complex_Matrix.adjoint P) * P *\<^sub>v (unit_vec dimR i)" + proof (rule mat_vec_mult_assoc[of _ dimR dimR], (auto simp add: assms fc_mats_carrier)) + show "P \ carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp + show "P * B * Complex_Matrix.adjoint P \ carrier_mat dimR dimR" + using assms fc_mats_carrier by auto + qed + also have "... = P * B * ((Complex_Matrix.adjoint P) * P) *\<^sub>v (unit_vec dimR i)" using assms dim_eq + by (smt fc_mats_carrier mat_assoc_test(1) similar_mat_witD2(6) similar_mat_wit_sym) + also have "... = P * B *\<^sub>v (unit_vec dimR i)" + proof - + have "(Complex_Matrix.adjoint P) * P = 1\<^sub>m dimR" using assms dim_eq unfolding similar_mat_wit_def + by (simp add: fc_mats_carrier) + thus ?thesis using assms(2) local.fc_mats_carrier dim_eq by auto + qed + also have "... = P *\<^sub>v (B *\<^sub>v (unit_vec dimR i))" using mat_vec_mult_assoc assms fc_mats_carrier + dim_eq by simp + also have "... = P *\<^sub>v (B $$ (i,i) \\<^sub>v (unit_vec dimR i))" using assms diagonal_unit_vec + fc_mats_carrier dim_eq by simp + also have "... = B $$ (i,i) \\<^sub>v (P *\<^sub>v (unit_vec dimR i))" + proof (rule mult_mat_vec) + show "P \ carrier_mat dimR dimC" using assms fc_mats_carrier by simp + show "unit_vec dimR i \ carrier_vec dimC" using dim_eq by simp + qed + finally show ?thesis . +qed + + +subsection \Projectors\ + +definition projector where +"projector M \ (hermitian M \ M * M = M)" + +lemma projector_hermitian: + assumes "projector M" + shows "hermitian M" using assms unfolding projector_def by simp + +lemma zero_projector[simp]: + shows "projector (0\<^sub>m n n)" unfolding projector_def +proof + show "hermitian (0\<^sub>m n n)" using zero_hermitian[of n] by simp + show "0\<^sub>m n n * 0\<^sub>m n n = 0\<^sub>m n n" by simp +qed + +lemma projector_square_eq: + assumes "projector M" + shows "M * M = M" using assms unfolding projector_def by simp + +lemma projector_positive: + assumes "projector M" + shows "Complex_Matrix.positive M" +proof (rule positive_if_decomp) + show "M \ carrier_mat (dim_row M) (dim_row M)" using assms projector_hermitian hermitian_square + by auto +next + have "M = Complex_Matrix.adjoint M" using assms projector_hermitian[of M] + unfolding hermitian_def by simp + hence "M * Complex_Matrix.adjoint M = M * M" by simp + also have "... = M" using assms projector_square_eq by auto + finally have "M * Complex_Matrix.adjoint M = M" . + thus "\Ma. Ma * Complex_Matrix.adjoint Ma = M" by auto +qed + +lemma projector_collapse_trace: + assumes "projector (P::complex Matrix.mat)" + and "P \ carrier_mat n n" + and "R\ carrier_mat n n" +shows "Complex_Matrix.trace (P * R * P) = Complex_Matrix.trace (R * P)" +proof - + have "Complex_Matrix.trace (R * P) = Complex_Matrix.trace (P * R)" using trace_comm assms by auto + also have "... = Complex_Matrix.trace ((P * P) * R)" using assms projector_square_eq[of P] by simp + also have "... = Complex_Matrix.trace (P * (P * R))" using assms by auto + also have "... = Complex_Matrix.trace (P * R * P)" using trace_comm[of P n "P * R"] assms by auto + finally have "Complex_Matrix.trace (R * P) = Complex_Matrix.trace (P * R * P)" . + thus ?thesis by simp +qed + +lemma positive_proj_trace: + assumes "projector (P::complex Matrix.mat)" + and "Complex_Matrix.positive R" + and "P \ carrier_mat n n" + and "R\ carrier_mat n n" +shows "Complex_Matrix.trace (R * P) \ 0" +proof - + have "Complex_Matrix.trace (R * P) = Complex_Matrix.trace ((P * R) * P)" + using assms projector_collapse_trace by auto + also have "... = Complex_Matrix.trace ((P * R) * (Complex_Matrix.adjoint P))" + using assms projector_hermitian[of P] + unfolding hermitian_def by simp + also have "... \ 0" + proof (rule positive_trace) + show " P * R * Complex_Matrix.adjoint P \ carrier_mat n n" using assms by auto + show "Complex_Matrix.positive (P * R * Complex_Matrix.adjoint P)" + by (rule positive_close_under_left_right_mult_adjoint[of _ n], (auto simp add: assms)) + qed + finally show ?thesis . +qed + +lemma trace_proj_pos_real: + assumes "projector (P::complex Matrix.mat)" + and "Complex_Matrix.positive R" + and "P \ carrier_mat n n" + and "R\ carrier_mat n n" +shows "Re (Complex_Matrix.trace (R * P)) = Complex_Matrix.trace (R * P)" +proof - + have "Complex_Matrix.trace (R * P) \ 0" using assms positive_proj_trace by simp + thus ?thesis by (simp add: complex_eqI) +qed + +lemma (in cpx_sq_mat) trace_sum_mat_proj_pos_real: + fixes f::"'a \ real" + assumes "finite I" + and "\ i\ I. projector (P i)" + and "Complex_Matrix.positive R" + and "\i\ I. P i \ fc_mats" + and "R \ fc_mats" +shows "Complex_Matrix.trace (R * (sum_mat (\i. f i \\<^sub>m (P i)) I)) = + Re (Complex_Matrix.trace (R * (sum_mat (\i. f i \\<^sub>m (P i)) I)))" +proof - + have sm: "\x. x \ I \ Complex_Matrix.trace (f x \\<^sub>m (R * P x)) = + f x * Complex_Matrix.trace (R * P x)" + proof - + fix i + assume "i\ I" + show "Complex_Matrix.trace (f i \\<^sub>m (R * P i)) = f i * Complex_Matrix.trace (R * P i)" + proof (rule trace_smult) + show "R * P i \ carrier_mat dimR dimR" using assms cpx_sq_mat_mult fc_mats_carrier \i\ I\ + dim_eq by simp + qed + qed + have sw: "\x. x \ I \ R * (f x \\<^sub>m P x) = f x \\<^sub>m (R * P x)" + proof - + fix i + assume "i \ I" + show "R * (f i \\<^sub>m P i) = f i \\<^sub>m (R * P i)" + proof (rule mult_smult_distrib) + show "R\ carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp + show "P i \ carrier_mat dimR dimR" using assms \i\ I\ fc_mats_carrier dim_eq by simp + qed + qed + have dr: "Complex_Matrix.trace (R * (sum_mat (\i. f i \\<^sub>m (P i)) I)) = + Complex_Matrix.trace (sum_mat (\i. (R * (f i \\<^sub>m (P i)))) I)" + using sum_mat_distrib_left[of I] assms by (simp add: cpx_sq_mat_smult) + also have trs: "... = (\ i\ I. Complex_Matrix.trace (R * (f i \\<^sub>m (P i))))" + proof (rule trace_sum_mat, (simp add: assms)) + show "\i. i \ I \ R * (f i \\<^sub>m P i) \ fc_mats" using assms + by (simp add: cpx_sq_mat_smult cpx_sq_mat_mult) + qed + also have "... = (\ i\ I. Complex_Matrix.trace (f i \\<^sub>m (R * (P i))))" + by (rule sum.cong, (simp add: sw)+) + also have "... = (\ i\ I. f i * Complex_Matrix.trace (R * (P i)))" + by (rule sum.cong, (simp add: sm)+) + also have "... = (\ i\ I. complex_of_real (f i * Re (Complex_Matrix.trace (R * (P i)))))" + proof (rule sum.cong, simp) + show "\x. x \ I \ + complex_of_real (f x) * Complex_Matrix.trace (R * P x) = + complex_of_real (f x * Re (Complex_Matrix.trace (R * P x)))" + proof - + fix x + assume "x\ I" + have "complex_of_real (f x) * Complex_Matrix.trace (R * P x) = + complex_of_real (f x) * complex_of_real (Re (Complex_Matrix.trace (R * P x)))" + using assms sum.cong[of I I] fc_mats_carrier trace_proj_pos_real \x \ I\ dim_eq by auto + also have "... = complex_of_real (f x * Re (Complex_Matrix.trace (R * P x)))" by simp + finally show "complex_of_real (f x) * Complex_Matrix.trace (R * P x) = + complex_of_real (f x * Re (Complex_Matrix.trace (R * P x)))" . + qed + qed + also have "... = (\ i\ I. f i * Re (Complex_Matrix.trace (R * (P i))))" by simp + also have "... = (\ i\ I. Re (Complex_Matrix.trace (f i \\<^sub>m (R * (P i)))))" + proof - + have "(\ i\ I. f i * Re (Complex_Matrix.trace (R * (P i)))) = + (\ i\ I. Re (Complex_Matrix.trace (f i \\<^sub>m (R * (P i)))))" + by (rule sum.cong, (simp add: sm)+) + thus ?thesis by simp + qed + also have "... = (\ i\ I. Re (Complex_Matrix.trace (R * (f i \\<^sub>m (P i)))))" + proof - + have "\i. i \ I \ f i \\<^sub>m (R * (P i)) = R * (f i \\<^sub>m (P i))" using sw by simp + thus ?thesis by simp + qed + also have "... = Re (\ i\ I. (Complex_Matrix.trace (R * (f i \\<^sub>m (P i)))))" by simp + also have "... = Re (Complex_Matrix.trace (sum_mat (\i. R * (f i \\<^sub>m (P i))) I))" using trs by simp + also have "... = Re (Complex_Matrix.trace (R * (sum_mat (\i. f i \\<^sub>m (P i))) I))" using dr by simp + finally show ?thesis . +qed + + +subsection \Rank 1 projection\ + +definition rank_1_proj where +"rank_1_proj v = outer_prod v v" + +lemma rank_1_proj_square_mat: + shows "square_mat (rank_1_proj v)" using outer_prod_dim unfolding rank_1_proj_def + by (metis carrier_matD(1) carrier_matD(2) carrier_vec_dim_vec square_mat.simps) + +lemma rank_1_proj_dim[simp]: + shows "dim_row (rank_1_proj v) = dim_vec v" using outer_prod_dim unfolding rank_1_proj_def + using carrier_vecI by blast + +lemma rank_1_proj_carrier[simp]: + shows "rank_1_proj v \ carrier_mat (dim_vec v) (dim_vec v)" using outer_prod_dim + unfolding rank_1_proj_def using carrier_vecI by blast + +lemma rank_1_proj_coord: + assumes "i < dim_vec v" + and "j < dim_vec v" +shows "(rank_1_proj v) $$ (i, j) = Matrix.vec_index v i * (cnj (Matrix.vec_index v j))" using assms + unfolding rank_1_proj_def outer_prod_def by auto + +lemma rank_1_proj_adjoint: + shows "Complex_Matrix.adjoint (rank_1_proj (v::complex Matrix.vec)) = rank_1_proj v" +proof + show "dim_row (Complex_Matrix.adjoint (rank_1_proj v)) = dim_row (rank_1_proj v)" + using rank_1_proj_square_mat by auto + thus "dim_col (Complex_Matrix.adjoint (rank_1_proj v)) = dim_col (rank_1_proj v)" by auto + fix i j + assume "i < dim_row (rank_1_proj v)" and "j < dim_col (rank_1_proj v)" note ij = this + have "Complex_Matrix.adjoint (rank_1_proj v) $$ (i, j) = conjugate ((rank_1_proj v) $$ (j, i))" + using ij \dim_col (Complex_Matrix.adjoint (rank_1_proj v)) = dim_col (rank_1_proj v)\ + adjoint_eval by fastforce + also have "... = conjugate (Matrix.vec_index v j * (cnj (Matrix.vec_index v i)))" + using rank_1_proj_coord ij + by (metis \dim_col (Complex_Matrix.adjoint (rank_1_proj v)) = dim_col (rank_1_proj v)\ + adjoint_dim_col rank_1_proj_dim) + also have "... = Matrix.vec_index v i * (cnj (Matrix.vec_index v j))" by simp + also have "... = rank_1_proj v $$ (i, j)" using ij rank_1_proj_coord + by (metis \dim_col (Complex_Matrix.adjoint (rank_1_proj v)) = dim_col (rank_1_proj v)\ + adjoint_dim_col rank_1_proj_dim) + finally show "Complex_Matrix.adjoint (rank_1_proj v) $$ (i, j) = rank_1_proj v $$ (i, j)". +qed + +lemma rank_1_proj_hermitian: + shows "hermitian (rank_1_proj (v::complex Matrix.vec))" using rank_1_proj_adjoint + unfolding hermitian_def by simp + +lemma rank_1_proj_trace: + assumes "\v\ = 1" + shows "Complex_Matrix.trace (rank_1_proj v) = 1" +proof - + have "Complex_Matrix.trace (rank_1_proj v) = inner_prod v v" using trace_outer_prod + unfolding rank_1_proj_def using carrier_vecI by blast + also have "... = (vec_norm v)\<^sup>2" unfolding vec_norm_def using power2_csqrt by presburger + also have "... = \v\\<^sup>2" using vec_norm_sq_cpx_vec_length_sq by simp + also have "... = 1" using assms by simp + finally show ?thesis . +qed + +lemma rank_1_proj_mat_col: + assumes "A \ carrier_mat n n" + and "i < n" + and "j < n" + and "k < n" +shows "(rank_1_proj (Matrix.col A i)) $$ (j, k) = A $$ (j, i) * conjugate (A $$ (k,i))" +proof - + have "(rank_1_proj (Matrix.col A i)) $$ (j, k) = Matrix.vec_index (Matrix.col A i) j * + conjugate (Matrix.vec_index (Matrix.col A i) k)" using index_outer_prod[of "Matrix.col A i" n "Matrix.col A i" n] + assms unfolding rank_1_proj_def by simp + also have "... = A $$ (j, i) * conjugate (A $$ (k,i))" using assms by simp + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) weighted_sum_rank_1_proj_unitary_index: + assumes "A \ fc_mats" +and "B \ fc_mats" +and "diagonal_mat B" +and "Complex_Matrix.unitary A" +and "j < dimR" +and "k < dimR" +shows "(sum_mat (\i. (diag_mat B)!i \\<^sub>m rank_1_proj (Matrix.col A i)) {..< dimR}) $$ (j,k) = + (A * B * (Complex_Matrix.adjoint A)) $$ (j,k)" +proof - + have "(sum_mat (\i. (diag_mat B)!i \\<^sub>m rank_1_proj (Matrix.col A i)) {..< dimR}) $$ (j,k) = + (\ i\ {..< dimR}. ((diag_mat B)!i \\<^sub>m rank_1_proj (Matrix.col A i)) $$ (j,k))" + proof (rule sum_mat_index, (auto simp add: fc_mats_carrier assms)) + show "\i. i < dimR \ (diag_mat B)!i \\<^sub>m rank_1_proj (Matrix.col A i) \ carrier_mat dimR dimC" + using rank_1_proj_carrier assms fc_mats_carrier dim_eq + by (metis smult_carrier_mat zero_col_col zero_col_dim) + show "k < dimC" using assms dim_eq by simp + qed + also have "... = (\ i\ {..< dimR}. (diag_mat B)!i* A $$ (j, i) * conjugate (A $$ (k,i)))" + proof (rule sum.cong, simp) + have idx: "\x. x \ {.. (rank_1_proj (Matrix.col A x)) $$ (j, k) = + A $$ (j, x) * conjugate (A $$ (k, x))" using rank_1_proj_mat_col assms fc_mats_carrier dim_eq + by blast + show "\x. x \ {.. ((diag_mat B)!x \\<^sub>m rank_1_proj (Matrix.col A x)) $$ (j, k) = + (diag_mat B)!x * A $$ (j, x) * conjugate (A $$ (k, x))" + proof - + fix x + assume "x\ {..< dimR}" + have "((diag_mat B)!x \\<^sub>m rank_1_proj (Matrix.col A x)) $$ (j, k) = + (diag_mat B)!x * (rank_1_proj (Matrix.col A x)) $$ (j, k)" + proof (rule index_smult_mat) + show "j < dim_row (rank_1_proj (Matrix.col A x))" using \x\ {..< dimR}\ assms fc_mats_carrier by simp + show "k < dim_col (rank_1_proj (Matrix.col A x))" using \x\ {..< dimR}\ assms fc_mats_carrier + rank_1_proj_carrier[of "Matrix.col A x"] by simp + qed + thus "((diag_mat B)!x \\<^sub>m rank_1_proj (Matrix.col A x)) $$ (j, k) = + (diag_mat B)!x * A $$ (j, x) * conjugate (A $$ (k, x))" using idx \x\ {..< dimR}\ by simp + qed + qed + also have "... = Matrix.scalar_prod (Matrix.col (Complex_Matrix.adjoint A) k) (Matrix.row (A*B) j) " + unfolding Matrix.scalar_prod_def + proof (rule sum.cong) + show "{..x. x \ {0.. + diag_mat B ! x * A $$ (j, x) * conjugate (A $$ (k, x)) = + Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x * + Matrix.vec_index (Matrix.row (A*B) j) x" + proof - + fix x + assume "x\ {0.. {0.. carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp + show "B \ carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp + show "x < dimR" using \x\{0..< dimR}\ by simp + qed + moreover have "conjugate (A $$ (k, x)) = + Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x" using \x\ {0.. assms + fc_mats_carrier dim_eq by (simp add: adjoint_col) + ultimately show "diag_mat B ! x * A $$ (j, x) * conjugate (A $$ (k, x)) = + Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x * + Matrix.vec_index (Matrix.row (A*B) j) x" by simp + qed + qed + also have "... = (A*B * (Complex_Matrix.adjoint A)) $$ (j,k)" + proof - + have "Matrix.mat (dim_row (A*B)) (dim_col (Complex_Matrix.adjoint A)) + (\(i, j). Matrix.scalar_prod (Matrix.row (A*B) i) (Matrix.col (Complex_Matrix.adjoint A) j)) $$ + (j, k) = Matrix.scalar_prod (Matrix.row (A*B) j) (Matrix.col (Complex_Matrix.adjoint A) k)" + using assms fc_mats_carrier by simp + also have "... = Matrix.scalar_prod (Matrix.col (Complex_Matrix.adjoint A) k) (Matrix.row (A*B) j)" + using assms comm_scalar_prod[of "Matrix.row (A*B) j" dimR] fc_mats_carrier dim_eq + by (metis adjoint_dim Matrix.col_carrier_vec row_carrier_vec cpx_sq_mat_mult) + thus ?thesis using assms fc_mats_carrier unfolding times_mat_def by simp + qed + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) weighted_sum_rank_1_proj_unitary: + assumes "A \ fc_mats" +and "B \ fc_mats" +and "diagonal_mat B" +and "Complex_Matrix.unitary A" +shows "(sum_mat (\i. (diag_mat B)!i \\<^sub>m rank_1_proj (Matrix.col A i)) {..< dimR}) = + (A * B * (Complex_Matrix.adjoint A))" +proof + show "dim_row (sum_mat (\i. diag_mat B ! i \\<^sub>m rank_1_proj (Matrix.col A i)) {..i. diag_mat B ! i \\<^sub>m rank_1_proj (Matrix.col A i)) {..i j. i < dim_row (A * B * Complex_Matrix.adjoint A) \ + j < dim_col (A * B * Complex_Matrix.adjoint A) \ + local.sum_mat (\i. diag_mat B ! i \\<^sub>m rank_1_proj (Matrix.col A i)) {..v\ = 1" + shows "projector (rank_1_proj v)" +proof - + have "Complex_Matrix.adjoint (rank_1_proj v) = rank_1_proj v" using rank_1_proj_adjoint by simp + hence a: "hermitian (rank_1_proj v)" unfolding hermitian_def by simp + have "rank_1_proj v * rank_1_proj v = inner_prod v v \\<^sub>m outer_prod v v" unfolding rank_1_proj_def + using outer_prod_mult_outer_prod assms using carrier_vec_dim_vec by blast + also have "... = (vec_norm v)\<^sup>2 \\<^sub>m outer_prod v v" unfolding vec_norm_def using power2_csqrt + by presburger + also have "... = (cpx_vec_length v)\<^sup>2 \\<^sub>m outer_prod v v " using vec_norm_sq_cpx_vec_length_sq + by simp + also have "... = outer_prod v v" using assms state_qbit_norm_sq smult_one[of "outer_prod v v"] + by simp + also have "... = rank_1_proj v" unfolding rank_1_proj_def by simp + finally show ?thesis using a unfolding projector_def by simp +qed + +lemma rank_1_proj_positive: + assumes "\v\ = 1" + shows "Complex_Matrix.positive (rank_1_proj v)" +proof - + have "projector (rank_1_proj v)" using assms rank_1_proj_projector by simp + thus ?thesis using projector_positive by simp +qed + +lemma rank_1_proj_density: + assumes "\v\ = 1" + shows "density_operator (rank_1_proj v)" unfolding density_operator_def using assms + by (simp add: rank_1_proj_positive rank_1_proj_trace) + +lemma (in cpx_sq_mat) sum_rank_1_proj_unitary_index: + assumes "A \ fc_mats" +and "Complex_Matrix.unitary A" +and "j < dimR" +and "k < dimR" +shows "(sum_mat (\i. rank_1_proj (Matrix.col A i)) {..< dimR}) $$ (j,k) = (1\<^sub>m dimR) $$ (j,k)" +proof - + have "(sum_mat (\i. rank_1_proj (Matrix.col A i)) {..< dimR}) $$ (j,k) = + (\ i\ {..< dimR}. (rank_1_proj (Matrix.col A i)) $$ (j,k))" + proof (rule sum_mat_index, (auto simp add: fc_mats_carrier assms)) + show "\i. i < dimR \ rank_1_proj (Matrix.col A i) \ carrier_mat dimR dimC" + proof - + fix i + assume "i < dimR" + hence "dim_vec (Matrix.col A i) = dimR" using assms fc_mats_carrier by simp + thus "rank_1_proj (Matrix.col A i) \ carrier_mat dimR dimC" using rank_1_proj_carrier assms + fc_mats_carrier dim_eq fc_mats_carrier by (metis dim_col fc_mats_carrier) + qed + show "k < dimC" using assms dim_eq by simp + qed + also have "... = (\ i\ {..< dimR}. A $$ (j, i) * conjugate (A $$ (k,i)))" + proof (rule sum.cong, simp) + show "\x. x \ {.. rank_1_proj (Matrix.col A x) $$ (j, k) = + A $$ (j, x) * conjugate (A $$ (k, x))" + using rank_1_proj_mat_col assms using local.fc_mats_carrier dim_eq by blast + qed + also have "... = Matrix.scalar_prod (Matrix.col (Complex_Matrix.adjoint A) k) (Matrix.row A j) " + unfolding Matrix.scalar_prod_def + proof (rule sum.cong) + show "{..x. x \ {0.. + A $$ (j, x) * conjugate (A $$ (k, x)) = + Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x * Matrix.vec_index (Matrix.row A j) x" + proof - + fix x + assume "x\ {0.. {0..x\ {0.. + assms fc_mats_carrier dim_eq by simp + moreover have "conjugate (A $$ (k, x)) = + Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x" using \x\ {0.. + assms fc_mats_carrier dim_eq by (simp add: adjoint_col) + ultimately show "A $$ (j, x) * conjugate (A $$ (k, x)) = + Matrix.vec_index ((Matrix.col (Complex_Matrix.adjoint A) k)) x * + Matrix.vec_index (Matrix.row A j) x" by simp + qed + qed + also have "... = (A * (Complex_Matrix.adjoint A)) $$ (j,k)" + proof - + have "Matrix.mat (dim_row A) (dim_col (Complex_Matrix.adjoint A)) + (\(i, j). Matrix.scalar_prod (Matrix.row A i) (Matrix.col (Complex_Matrix.adjoint A) j)) $$ + (j, k) = Matrix.scalar_prod (Matrix.row A j) (Matrix.col (Complex_Matrix.adjoint A) k)" + using assms fc_mats_carrier by simp + also have "... = Matrix.scalar_prod (Matrix.col (Complex_Matrix.adjoint A) k) (Matrix.row A j)" + using assms comm_scalar_prod[of "Matrix.row A j" dimR] fc_mats_carrier + by (simp add: adjoint_dim dim_eq) + thus ?thesis using assms fc_mats_carrier unfolding times_mat_def by simp + qed + also have "... = (1\<^sub>m dimR) $$ (j,k)" using assms dim_eq by (simp add: fc_mats_carrier) + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) rank_1_proj_sum_density: + assumes "finite I" + and "\i\ I. \u i\ = 1" + and "\i\ I. dim_vec (u i) = dimR" + and "\i\ I. 0 \ p i" + and "(\i\ I. p i) = 1" +shows "density_operator (sum_mat (\i. p i \\<^sub>m (rank_1_proj (u i))) I)" unfolding density_operator_def +proof + have "Complex_Matrix.trace (sum_mat (\i. p i \\<^sub>m rank_1_proj (u i)) I) = + (\i\ I. Complex_Matrix.trace (p i \\<^sub>m rank_1_proj (u i)))" + proof (rule trace_sum_mat, (simp add: assms)) + show "\i. i \ I \ p i \\<^sub>m rank_1_proj (u i) \ fc_mats" using assms smult_mem fc_mats_carrier + dim_eq by auto + qed + also have "... = (\i\ I. p i * Complex_Matrix.trace (rank_1_proj (u i)))" + proof - + { + fix i + assume "i \ I" + hence "Complex_Matrix.trace (p i \\<^sub>m rank_1_proj (u i)) = + p i * Complex_Matrix.trace (rank_1_proj (u i))" + using trace_smult[of "rank_1_proj (u i)" dimR] assms fc_mats_carrier dim_eq by auto + } + thus ?thesis by simp + qed + also have "... = 1" using assms rank_1_proj_trace assms by auto + finally show "Complex_Matrix.trace (sum_mat (\i. p i \\<^sub>m rank_1_proj (u i)) I) = 1" . +next + show "Complex_Matrix.positive (sum_mat (\i. p i \\<^sub>m rank_1_proj (u i)) I)" + proof (rule sum_mat_positive, (simp add: assms)) + fix i + assume "i\ I" + thus "p i \\<^sub>m rank_1_proj (u i) \ fc_mats" using assms smult_mem fc_mats_carrier dim_eq by auto + show "Complex_Matrix.positive (p i \\<^sub>m rank_1_proj (u i))" using assms \i\ I\ + rank_1_proj_positive positive_smult[of "rank_1_proj (u i)" dimR] dim_eq by auto + qed +qed + + + +lemma (in cpx_sq_mat) sum_rank_1_proj_unitary: + assumes "A \ fc_mats" +and "Complex_Matrix.unitary A" +shows "(sum_mat (\i. rank_1_proj (Matrix.col A i)) {..< dimR})= (1\<^sub>m dimR)" +proof + show "dim_row (sum_mat (\i. rank_1_proj (Matrix.col A i)) {..m dimR)" + using assms fc_mats_carrier + by (metis carrier_matD(1) dim_col dim_eq index_one_mat(2) rank_1_proj_carrier sum_mat_carrier) + show "dim_col (sum_mat (\i. rank_1_proj (Matrix.col A i)) {..m dimR)" + using assms fc_mats_carrier rank_1_proj_carrier sum_mat_carrier + by (metis carrier_matD(2) dim_col dim_eq index_one_mat(3) square_mat.simps square_mats) + show "\i j. i < dim_row (1\<^sub>m dimR) \ + j < dim_col (1\<^sub>m dimR) \ sum_mat (\i. rank_1_proj (Matrix.col A i)) {..m dimR $$ (i, j)" + using assms sum_rank_1_proj_unitary_index by simp +qed + +lemma (in cpx_sq_mat) rank_1_proj_unitary: + assumes "A \ fc_mats" +and "Complex_Matrix.unitary A" +and "j < dimR" +and "k < dimR" +shows "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A k)) = + (1\<^sub>m dimR) $$ (j,k) \\<^sub>m (outer_prod (Matrix.col A j) (Matrix.col A k))" +proof - + have "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A k)) = + Complex_Matrix.inner_prod (Matrix.col A j) (Matrix.col A k) \\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)" + using outer_prod_mult_outer_prod assms Matrix.col_dim local.fc_mats_carrier unfolding rank_1_proj_def + by blast + also have "... = (Complex_Matrix.adjoint A * A) $$ (j, k)\\<^sub>m (outer_prod (Matrix.col A j) (Matrix.col A k))" + using inner_prod_adjoint_comp[of A dimR A] assms fc_mats_carrier dim_eq by simp + also have "... = (1\<^sub>m dimR) $$ (j,k) \\<^sub>m (outer_prod (Matrix.col A j) (Matrix.col A k))" using assms + unfolding Complex_Matrix.unitary_def + by (metis add_commute assms(2) index_add_mat(2) index_one_mat(2) one_mem unitary_simps(1)) + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) rank_1_proj_unitary_ne: + assumes "A \ fc_mats" +and "Complex_Matrix.unitary A" +and "j < dimR" +and "k < dimR" +and "j\ k" +shows "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A k)) = (0\<^sub>m dimR dimR)" +proof - + have "dim_row (0 \\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dim_row (outer_prod (Matrix.col A j) (Matrix.col A k))" + by simp + also have "... = dimR" using assms fc_mats_carrier dim_eq by auto + finally have rw: "dim_row (0 \\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dimR" . + have "dim_col (0 \\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dim_col (outer_prod (Matrix.col A j) (Matrix.col A k))" + by simp + also have "... = dimR" using assms fc_mats_carrier dim_eq by auto + finally have cl: "dim_col (0 \\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dimR" . + have "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A k)) = + (0::complex) \\<^sub>m (outer_prod (Matrix.col A j) (Matrix.col A k))" + using assms rank_1_proj_unitary by simp + also have "... = (0\<^sub>m dimR dimR)" + proof + show "dim_row (0 \\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dim_row (0\<^sub>m dimR dimR)" using rw by simp + next + show "dim_col (0 \\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) = dim_col (0\<^sub>m dimR dimR)" using cl by simp + next + show "\i p. i < dim_row (0\<^sub>m dimR dimR) \ p < dim_col (0\<^sub>m dimR dimR) \ + (0 \\<^sub>m outer_prod (Matrix.col A j) (Matrix.col A k)) $$ (i, p) = 0\<^sub>m dimR dimR $$ (i, p)" using rw cl by auto + qed + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) rank_1_proj_unitary_eq: + assumes "A \ fc_mats" +and "Complex_Matrix.unitary A" +and "j < dimR" +shows "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A j)) = rank_1_proj (Matrix.col A j)" +proof - + have "rank_1_proj (Matrix.col A j) * (rank_1_proj (Matrix.col A j)) = (1::complex) \\<^sub>m (rank_1_proj (Matrix.col A j))" + using assms rank_1_proj_unitary unfolding rank_1_proj_def by simp + also have "... = (rank_1_proj (Matrix.col A j))" by (simp add: smult_one) + finally show ?thesis . +qed + + +end \ No newline at end of file diff --git a/thys/Projective_Measurements/Projective_Measurements.thy b/thys/Projective_Measurements/Projective_Measurements.thy new file mode 100644 --- /dev/null +++ b/thys/Projective_Measurements/Projective_Measurements.thy @@ -0,0 +1,1670 @@ +(* +Author: + Mnacho Echenim, Université Grenoble Alpes +*) + +theory Projective_Measurements imports + Linear_Algebra_Complements + + +begin + + +section \Projective measurements\ + +text \In this part we define projective measurements, also refered to as von Neumann measurements. + The latter are characterized by a set of orthogonal projectors, which are used to compute the +probabilities of measure outcomes and to represent the state of the system after the measurement.\ + +text \The state of the system (a density operator in this case) after a measurement is represented by +the \verb+density_collapse+ function.\ + +subsection \First definitions\ + +text \We begin by defining a type synonym for couples of measurement values (reals) and the +associated projectors (complex matrices).\ + +type_synonym measure_outcome = "real \ complex Matrix.mat" + +text \The corresponding values and projectors are retrieved thanks to \verb+meas_outcome_val+ +and \verb+meas_outcome_prj+.\ + +definition meas_outcome_val::"measure_outcome \ real" where +"meas_outcome_val Mi = fst Mi" + +definition meas_outcome_prj::"measure_outcome \ complex Matrix.mat" where +"meas_outcome_prj Mi = snd Mi" + +text \We define a predicate for projective measurements. A projective measurement is characterized +by the number $p$ of possible measure outcomes, and a function $M$ mapping outcome $i$ to the +corresponding \verb+measure_outcome+.\ + +definition (in cpx_sq_mat) proj_measurement::"nat \ (nat \ measure_outcome) \ bool" where + "proj_measurement n M \ + (inj_on (\i. meas_outcome_val (M i)) {..< n}) \ + (\j < n. meas_outcome_prj (M j) \ fc_mats \ + projector (meas_outcome_prj (M j))) \ + (\ i < n. \ j < n. i \ j \ + meas_outcome_prj (M i) * meas_outcome_prj (M j) = 0\<^sub>m dimR dimR) \ + sum_mat (\j. meas_outcome_prj (M j)) {..< n} = 1\<^sub>m dimR" + +lemma (in cpx_sq_mat) proj_measurement_inj: + assumes "proj_measurement p M" + shows "inj_on (\i. meas_outcome_val (M i)) {..< p}" using assms + unfolding proj_measurement_def by simp + +lemma (in cpx_sq_mat) proj_measurement_carrier: + assumes "proj_measurement p M" + and "i < p" + shows "meas_outcome_prj (M i) \ fc_mats" using assms + unfolding proj_measurement_def by simp + +lemma (in cpx_sq_mat) proj_measurement_ortho: + assumes "proj_measurement p M" +and "i < p" +and "j < p" +and "i\ j" +shows "meas_outcome_prj (M i) * meas_outcome_prj (M j) = 0\<^sub>m dimR dimR" using assms + unfolding proj_measurement_def by simp + +lemma (in cpx_sq_mat) proj_measurement_id: + assumes "proj_measurement p M" + shows "sum_mat (\j. meas_outcome_prj (M j)) {..< p} = 1\<^sub>m dimR" using assms + unfolding proj_measurement_def by simp + +lemma (in cpx_sq_mat) proj_measurement_square: + assumes "proj_measurement p M" +and "i < p" +shows "meas_outcome_prj (M i) \ fc_mats" using assms unfolding proj_measurement_def by simp + +lemma (in cpx_sq_mat) proj_measurement_proj: + assumes "proj_measurement p M" +and "i < p" +shows "projector (meas_outcome_prj (M i))" using assms unfolding proj_measurement_def by simp + +text \We define the probability of obtaining a measurement outcome: this is a positive number and +the sum over all the measurement outcomes is 1.\ + +definition (in cpx_sq_mat) meas_outcome_prob :: "complex Matrix.mat \ + (nat \ real \ complex Matrix.mat) \ nat \ complex" where +"meas_outcome_prob R M i = Complex_Matrix.trace (R* (meas_outcome_prj (M i)))" + +lemma (in cpx_sq_mat) meas_outcome_prob_real: +assumes "R\ fc_mats" + and "density_operator R" + and "proj_measurement n M" + and "i < n" +shows "meas_outcome_prob R M i \ \" +proof - + have "complex_of_real (Re (Complex_Matrix.trace (R * meas_outcome_prj (M i)))) = + Complex_Matrix.trace (R * meas_outcome_prj (M i))" + proof (rule trace_proj_pos_real) + show "R \ carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp + show "Complex_Matrix.positive R" using assms unfolding density_operator_def by simp + show "projector (meas_outcome_prj (M i))" using assms proj_measurement_proj by simp + show "meas_outcome_prj (M i) \ carrier_mat dimR dimR" using assms proj_measurement_carrier + fc_mats_carrier dim_eq by simp + qed + thus ?thesis unfolding meas_outcome_prob_def by (metis Reals_of_real) +qed + +lemma (in cpx_sq_mat) meas_outcome_prob_pos: + assumes "R\ fc_mats" + and "density_operator R" + and "proj_measurement n M" + and "i < n" +shows "0 \ meas_outcome_prob R M i" unfolding meas_outcome_prob_def +proof (rule positive_proj_trace) + show "R \ carrier_mat dimR dimR" using assms fc_mats_carrier dim_eq by simp + show "Complex_Matrix.positive R" using assms unfolding density_operator_def by simp + show "projector (meas_outcome_prj (M i))" using assms proj_measurement_proj by simp + show "meas_outcome_prj (M i) \ carrier_mat dimR dimR" using assms proj_measurement_carrier + fc_mats_carrier dim_eq by simp +qed + +lemma (in cpx_sq_mat) meas_outcome_prob_sum: + assumes "density_operator R" + and "R\ fc_mats" + and" proj_measurement n M" +shows "(\ j \ {..< n}. meas_outcome_prob R M j) = 1" +proof - + have "(\ j \ {..< n}. Complex_Matrix.trace (R* (meas_outcome_prj (M j)))) = + Complex_Matrix.trace (sum_mat (\j. R* (meas_outcome_prj (M j))) {..< n})" + proof (rule trace_sum_mat[symmetric], auto) + fix j + assume "j < n" + thus "R * meas_outcome_prj (M j) \ fc_mats" using cpx_sq_mat_mult assms + unfolding proj_measurement_def by simp + qed + also have "... = Complex_Matrix.trace (R * (sum_mat (\j. (meas_outcome_prj (M j))) {..< n}))" + proof - + have "sum_mat (\j. R* (meas_outcome_prj (M j))) {..< n} = + R * (sum_mat (\j. (meas_outcome_prj (M j))) {..< n})" + proof (rule mult_sum_mat_distrib_left, (auto simp add: assms)) + fix j + assume "j < n" + thus "meas_outcome_prj (M j) \ fc_mats" using assms unfolding proj_measurement_def by simp + qed + thus ?thesis by simp + qed + also have "... = Complex_Matrix.trace (R * 1\<^sub>m dimR)" using assms unfolding proj_measurement_def + by simp + also have "... = Complex_Matrix.trace R" using assms by (simp add: fc_mats_carrier dim_eq) + also have "... = 1" using assms unfolding density_operator_def by simp + finally show ?thesis unfolding meas_outcome_prob_def . +qed + +text \We introduce the maximally mixed density operator. Intuitively, this density operator +corresponds to a uniform distribution of the states of an orthonormal basis. +This operator will be used to define the density operator after a measurement for the measure +outcome probabilities equal to zero.\ + +definition max_mix_density :: "nat \ complex Matrix.mat" where +"max_mix_density n = ((1::real)/ n) \\<^sub>m (1\<^sub>m n)" + +lemma max_mix_density_carrier: + shows "max_mix_density n \ carrier_mat n n" unfolding max_mix_density_def by simp + +lemma max_mix_is_density: + assumes "0 < n" + shows "density_operator (max_mix_density n)" unfolding density_operator_def max_mix_density_def +proof + have "Complex_Matrix.trace (complex_of_real ((1::real)/n) \\<^sub>m 1\<^sub>m n) = + (complex_of_real ((1::real)/n)) * (Complex_Matrix.trace ((1\<^sub>m n)::complex Matrix.mat))" + using one_carrier_mat trace_smult[of "(1\<^sub>m n)::complex Matrix.mat"] by blast + also have "... = (complex_of_real ((1::real)/n)) * (real n)" using trace_1[of n] by simp + also have "... = 1" using assms by simp + finally show "Complex_Matrix.trace (complex_of_real ((1::real)/n) \\<^sub>m 1\<^sub>m n) = 1" . +next + show "Complex_Matrix.positive (complex_of_real (1 / real n) \\<^sub>m 1\<^sub>m n)" + by (rule positive_smult, (auto simp add: positive_one)) +qed + +lemma (in cpx_sq_mat) max_mix_density_square: + shows "max_mix_density dimR \ fc_mats" unfolding max_mix_density_def + using fc_mats_carrier dim_eq by simp + +text \Given a measurement outcome, \verb+density_collapse+ represents the resulting density +operator. In practice only the measure outcomes with nonzero probabilities are of interest; we +(arbitrarily) collapse the density operator for zero-probability outcomes to the maximally mixed +density operator.\ + +definition density_collapse ::"complex Matrix.mat \ complex Matrix.mat \ complex Matrix.mat" where +"density_collapse R P = (if ((Complex_Matrix.trace (R * P)) = 0) then (max_mix_density (dim_row R)) + else ((1::real)/ ((Complex_Matrix.trace (R * P)))) \\<^sub>m (P * R * P))" + +lemma density_collapse_carrier: + assumes "0 < dim_row R" + and "P \ carrier_mat n n" + and "R \ carrier_mat n n" +shows "(density_collapse R P) \ carrier_mat n n" +proof (cases "(Complex_Matrix.trace (R * P)) = 0") + case True + hence "density_collapse R P = max_mix_density (dim_row R)" unfolding density_collapse_def by simp + then show ?thesis using max_mix_is_density assms max_mix_density_carrier by auto +next + case False + hence "density_collapse R P = complex_of_real 1 / Complex_Matrix.trace (R * P) \\<^sub>m (P * R * P)" + unfolding density_collapse_def by simp + thus ?thesis using assms by auto +qed + +lemma density_collapse_operator: + assumes "projector P" + and "density_operator R" + and "0 < dim_row R" + and "P \ carrier_mat n n" + and "R \ carrier_mat n n" +shows "density_operator (density_collapse R P)" +proof (cases "(Complex_Matrix.trace (R * P)) = 0") + case True + hence "density_collapse R P = max_mix_density (dim_row R)" unfolding density_collapse_def by simp + then show ?thesis using max_mix_is_density assms by simp +next + case False + show ?thesis unfolding density_operator_def + proof (intro conjI) + have "Complex_Matrix.positive ((1 / (Complex_Matrix.trace (R * P))) \\<^sub>m (P * R * P))" + proof (rule positive_smult) + show "P * R * P \ carrier_mat n n" using assms by simp + have "Complex_Matrix.positive R" using assms unfolding density_operator_def by simp + hence "0 \ (Complex_Matrix.trace (R * P))" using positive_proj_trace[of P R n] assms + False by auto + hence "0 \ Re (Complex_Matrix.trace (R * P))" by simp + hence "0 \ 1/(Re (Complex_Matrix.trace (R * P)))" by simp + have "Re (Complex_Matrix.trace (R * P)) = Complex_Matrix.trace (R * P)" + using assms \Complex_Matrix.positive R\ trace_proj_pos_real by simp + hence inv: "1/ (Complex_Matrix.trace (R * P)) = 1/(Re (Complex_Matrix.trace (R * P)))" by simp + thus "0 \ 1/ (Complex_Matrix.trace (R * P))" + using \0 \ 1/(Re (Complex_Matrix.trace (R * P)))\ by (simp add: inv) + show "Complex_Matrix.positive (P * R * P)" using assms + positive_close_under_left_right_mult_adjoint[of P n R] + by (simp add: \Complex_Matrix.positive R\ hermitian_def projector_def) + qed + thus "Complex_Matrix.positive (density_collapse R P)" using False + unfolding density_collapse_def by simp + next + have "Complex_Matrix.trace (density_collapse R P) = + Complex_Matrix.trace ((1/ (Complex_Matrix.trace (R * P))) \\<^sub>m (P * R * P))" + using False unfolding density_collapse_def by simp + also have "... = 1/ (Complex_Matrix.trace (R * P)) * Complex_Matrix.trace (P * R * P)" + using trace_smult[of "P * R * P" n] assms by simp + also have "... = 1/ (Complex_Matrix.trace (R * P)) * Complex_Matrix.trace (R * P)" + using projector_collapse_trace assms by simp + also have "... = 1" using False by simp + finally show "Complex_Matrix.trace (density_collapse R P) = 1" . + qed +qed + + +subsection \Measurements with observables\ + +text \It is standard in quantum mechanics to represent projective measurements with so-called +\emph{observables}. These are Hermitian matrices which encode projective measurements as follows: +the eigenvalues of an observable represent the possible projective measurement outcomes, and the +associated projectors are the projectors onto the corresponding eigenspaces. The results in this +part are based on the spectral theorem, which states that any Hermitian matrix admits an +orthonormal basis consisting of eigenvectors of the matrix.\ + + +subsubsection \On the diagonal elements of a matrix\ + +text \We begin by introducing definitions that will be used on the diagonalized version of a +Hermitian matrix.\ + +definition diag_elems where +"diag_elems B = {B$$(i,i) |i. i < dim_row B}" + +text \Relationship between \verb+diag_elems+ and the list \verb+diag_mat+\ + +lemma diag_elems_set_diag_mat: + shows "diag_elems B = set (diag_mat B)" unfolding diag_mat_def diag_elems_def +proof + show "{B $$ (i, i) |i. i < dim_row B} \ set (map (\i. B $$ (i, i)) [0.. {B $$ (i, i) |i. i < dim_row B}" + hence "\i < dim_row B. x = B $$(i,i)" by auto + from this obtain i where "i < dim_row B" and "x = B $$(i,i)" by auto + thus "x \ set (map (\i. B $$ (i, i)) [0..i. B $$ (i, i)) [0.. {B $$ (i, i) |i. i < dim_row B}" + proof + fix x + assume "x \ set (map (\i. B $$ (i, i)) [0.. {B $$ (i, i) |i. i < dim_row B}" by auto + qed +qed + +lemma diag_elems_finite[simp]: + shows "finite (diag_elems B)" unfolding diag_elems_def by simp + +lemma diag_elems_mem[simp]: + assumes "i < dim_row B" + shows "B $$(i,i) \ diag_elems B" using assms unfolding diag_elems_def by auto + +text \When $x$ is a diagonal element of $B$, \verb+diag_elem_indices+ returns the set of diagonal +indices of $B$ with value $x$.\ + +definition diag_elem_indices where +"diag_elem_indices x B = {i|i. i < dim_row B \ B $$ (i,i) = x}" + +lemma diag_elem_indices_elem: + assumes "a \ diag_elem_indices x B" + shows "a < dim_row B \ B$$(a,a) = x" using assms unfolding diag_elem_indices_def by simp + +lemma diag_elem_indices_itself: + assumes "i < dim_row B" + shows "i \ diag_elem_indices (B $$(i,i)) B" using assms unfolding diag_elem_indices_def by simp + +lemma diag_elem_indices_finite: + shows "finite (diag_elem_indices x B)" unfolding diag_elem_indices_def by simp + +text \We can therefore partition the diagonal indices of a matrix $B$ depending on the value +of the diagonal elements. If $B$ admits $p$ elements on its diagonal, then we define bijections +between its set of diagonal elements and the initial segment $[0..p-1]$.\ + +definition dist_el_card where +"dist_el_card B = card (diag_elems B)" + +definition diag_idx_to_el where +"diag_idx_to_el B = (SOME h. bij_betw h {..< dist_el_card B} (diag_elems B))" + +definition diag_el_to_idx where +"diag_el_to_idx B = inv_into {..< dist_el_card B} (diag_idx_to_el B)" + +lemma diag_idx_to_el_bij: + shows "bij_betw (diag_idx_to_el B) {..< dist_el_card B} (diag_elems B)" +proof - + let ?V = "SOME h. bij_betw h {..< dist_el_card B} (diag_elems B)" + have vprop: "bij_betw ?V {..< dist_el_card B} (diag_elems B)" using + someI_ex[of "\h. bij_betw h {..< dist_el_card B} (diag_elems B)"] + diag_elems_finite unfolding dist_el_card_def using bij_betw_from_nat_into_finite by blast + show ?thesis by (simp add:diag_idx_to_el_def vprop) +qed + +lemma diag_el_to_idx_bij: + shows "bij_betw (diag_el_to_idx B) (diag_elems B) {..< dist_el_card B}" + unfolding diag_el_to_idx_def +proof (rule bij_betw_inv_into_subset[of _ _ "diag_elems B"], (simp add: diag_idx_to_el_bij)+) + show "diag_idx_to_el B ` {.. {..< dist_el_card B}" using assms by simp + moreover have "j\ {..< dist_el_card B}" using assms by simp + moreover have "inj_on (diag_idx_to_el B) {.. diag_elems B" +shows "\k \ {..< dist_el_card B}. x = diag_idx_to_el B k" +proof - + have "diag_idx_to_el B ` {.. diag_elems B" +proof - + have "diag_idx_to_el B ` {..i < dim_row B. B$$(i,i) \ Reals" + shows "diag_elems B \ Reals" +proof + fix x + assume "x\ diag_elems B" + hence "\i < dim_row B. x = B $$(i,i)" using assms unfolding diag_elems_def by auto + from this obtain i where "i < dim_row B" "x = B $$ (i,i)" by auto + thus "x \ Reals" using assms by simp +qed + +lemma diag_elems_Re: + fixes B::"complex Matrix.mat" + assumes "\i < (dim_row B). B$$(i,i) \ Reals" + shows "{Re x|x. x\ diag_elems B} = diag_elems B" +proof + show "{complex_of_real (Re x) |x. x \ diag_elems B} \ diag_elems B" + proof + fix x + assume "x \ {complex_of_real (Re x) |x. x \ diag_elems B}" + hence "\y \ diag_elems B. x = Re y" by auto + from this obtain y where "y\ diag_elems B" and "x = Re y" by auto + hence "y = x" using assms diag_elems_real[of B] by auto + thus "x\ diag_elems B" using \y\ diag_elems B\ by simp + qed + show "diag_elems B \ {complex_of_real (Re x) |x. x \ diag_elems B}" + proof + fix x + assume "x \ diag_elems B" + hence "Re x = x" using assms diag_elems_real[of B] by auto + thus "x\ {complex_of_real (Re x) |x. x \ diag_elems B}" using \x\ diag_elems B\ by force + qed +qed + +lemma diag_idx_to_el_real: + fixes B::"complex Matrix.mat" + assumes "\i < dim_row B. B$$(i,i) \ Reals" +and "i < dist_el_card B" +shows "Re (diag_idx_to_el B i) = diag_idx_to_el B i" +proof - + have "diag_idx_to_el B i \ diag_elems B" using diag_idx_to_el_img[of i B] assms by simp + hence "diag_idx_to_el B i \ Reals" using diag_elems_real[of B] assms by auto + thus ?thesis by simp +qed + +lemma diag_elem_indices_empty: + assumes "B \ carrier_mat dimR dimC" + and "i < (dist_el_card B)" +and "j < (dist_el_card B)" +and "i\ j" +shows "diag_elem_indices (diag_idx_to_el B i) B \ + (diag_elem_indices (diag_idx_to_el B j) B) = {}" +proof (rule ccontr) + assume "diag_elem_indices (diag_idx_to_el B i) B \ + diag_elem_indices (diag_idx_to_el B j) B \ {}" + hence "\x. x\ diag_elem_indices (diag_idx_to_el B i) B \ + diag_elem_indices (diag_idx_to_el B j) B" by auto + from this obtain x where + xprop: "x\ diag_elem_indices (diag_idx_to_el B i) B \ + diag_elem_indices (diag_idx_to_el B j) B" by auto + hence "B $$ (x,x) = (diag_idx_to_el B i)" + using diag_elem_indices_elem[of x "diag_idx_to_el B i"] by simp + moreover have "B $$ (x,x) = (diag_idx_to_el B j)" + using diag_elem_indices_elem[of x "diag_idx_to_el B j"] xprop by simp + ultimately have "diag_idx_to_el B i = diag_idx_to_el B j" by simp + hence "i = j" using diag_idx_to_el_less_inj assms by auto + thus False using assms by simp +qed + +lemma (in cpx_sq_mat) diag_elem_indices_disjoint: + assumes "B\ carrier_mat dimR dimC" + shows "disjoint_family_on (\n. diag_elem_indices (diag_idx_to_el B n) B) + {.. {..< dist_el_card B}" and "p\ {..< dist_el_card B}" and "m\ p" + thus "diag_elem_indices (diag_idx_to_el B m) B \ + diag_elem_indices (diag_idx_to_el B p) B = {}" + using diag_elem_indices_empty assms fc_mats_carrier by simp +qed + +lemma diag_elem_indices_union: + assumes "B\ carrier_mat dimR dimC" + shows "(\ i \ {..< dist_el_card B}. diag_elem_indices (diag_idx_to_el B i) B) = + {..< dimR}" +proof + show "(\i {.. (\ii < dist_el_card B. x\ diag_elem_indices (diag_idx_to_el B i) B" by auto + from this obtain i where "i < dist_el_card B" + "x\ diag_elem_indices (diag_idx_to_el B i) B" by auto + hence "x < dimR" using diag_elem_indices_elem[of x _ B] assms by simp + thus "x \ {..< dimR}" by auto + qed +next + show "{.. (\i {..< dimR}" + hence "j < dim_row B" using assms by simp + hence "B$$(j,j) \ diag_elems B" by simp + hence "\k \ {..< dist_el_card B}. B$$(j,j) = diag_idx_to_el B k" + using diag_idx_to_el_less_surj[of "B $$(j,j)"] by simp + from this obtain k where kprop: "k \ {..< dist_el_card B}" + "B$$(j,j) = diag_idx_to_el B k" by auto + hence "j \ diag_elem_indices (diag_idx_to_el B k) B" using \j < dim_row B\ + diag_elem_indices_itself by fastforce + thus "j \ (\iConstruction of measurement outcomes\ + +text \The construction of a projective measurement for a hermitian matrix $A$ is based on the Schur +decomposition $A = U*B*U^\dagger$, where $B$ is diagonal and $U$ is unitary. The columns of $U$ are +normalized and pairwise orthogonal; they are used to construct the projectors associated with +a measurement value\ + +definition (in cpx_sq_mat) project_vecs where +"project_vecs (f::nat \ complex Matrix.vec) N = sum_mat (\i. rank_1_proj (f i)) N" + +lemma (in cpx_sq_mat) project_vecs_dim: + assumes "\i \ N. dim_vec (f i) = dimR" + shows "project_vecs f N \ fc_mats" +proof - + have "project_vecs f N \ carrier_mat dimR dimC" unfolding project_vecs_def + proof (rule sum_mat_carrier) + show "\i. i \ N \ rank_1_proj (f i) \ fc_mats" using assms fc_mats_carrier rank_1_proj_dim + dim_eq rank_1_proj_carrier by fastforce + qed + thus ?thesis using fc_mats_carrier by simp +qed + +definition (in cpx_sq_mat) mk_meas_outcome where +"mk_meas_outcome B U = (\i. (Re (diag_idx_to_el B i), + project_vecs (\i. zero_col U i) (diag_elem_indices (diag_idx_to_el B i) B)))" + +lemma (in cpx_sq_mat) mk_meas_outcome_carrier: + assumes "Complex_Matrix.unitary U" + and "U \ fc_mats" + and "B\ fc_mats" +shows "meas_outcome_prj ((mk_meas_outcome B U) j) \ fc_mats" +proof - + have "project_vecs (\i. zero_col U i) (diag_elem_indices (diag_idx_to_el B j) B) \ fc_mats" + using project_vecs_dim by (simp add: assms(2) zero_col_dim) + thus ?thesis unfolding mk_meas_outcome_def meas_outcome_prj_def by simp +qed + +lemma (in cpx_sq_mat) mk_meas_outcome_sum_id: + assumes "Complex_Matrix.unitary U" + and "U \ fc_mats" + and "B\ fc_mats" +shows "sum_mat (\j. meas_outcome_prj ((mk_meas_outcome B U) j)) + {..<(dist_el_card B)} = 1\<^sub>m dimR" +proof - + have "sum_mat (\j. meas_outcome_prj ((mk_meas_outcome B U) j)) {..<(dist_el_card B)} = + sum_mat (\j. project_vecs (\i. zero_col U i) (diag_elem_indices (diag_idx_to_el B j) B)) + {..<(dist_el_card B)}" + unfolding mk_meas_outcome_def meas_outcome_prj_def by simp + also have "... = sum_mat (\i. rank_1_proj (zero_col U i)) + (\jj. rank_1_proj (zero_col U j) \ fc_mats" using zero_col_dim fc_mats_carrier dim_eq + by (metis assms(2) rank_1_proj_carrier) + show "finite {..i. i \ {.. finite (diag_elem_indices (diag_idx_to_el B i) B)" + using diag_elem_indices_finite by simp + show "disjoint_family_on (\n. diag_elem_indices (diag_idx_to_el B n) B) + {.. {..< dist_el_card B}" and "p\ {..< dist_el_card B}" and "m\ p" + thus "diag_elem_indices (diag_idx_to_el B m) B \ + diag_elem_indices (diag_idx_to_el B p) B = {}" + using diag_elem_indices_empty assms fc_mats_carrier by simp + qed + qed + also have "... = sum_mat (\i. rank_1_proj (zero_col U i)) {..< dimR}" + using diag_elem_indices_union[of B] assms fc_mats_carrier by simp + also have "... = sum_mat (\i. rank_1_proj (Matrix.col U i)) {..< dimR}" + proof (rule sum_mat_cong, simp) + show "\i. i \ {.. rank_1_proj (zero_col U i) \ fc_mats" using dim_eq + by (metis assms(2) local.fc_mats_carrier rank_1_proj_carrier zero_col_dim) + thus "\i. i \ {.. rank_1_proj (Matrix.col U i) \ fc_mats" using dim_eq + by (metis lessThan_iff zero_col_col) + show "\i. i \ {.. rank_1_proj (zero_col U i) = rank_1_proj (Matrix.col U i)" + by (simp add: zero_col_col) + qed + also have "... = 1\<^sub>m dimR" using sum_rank_1_proj_unitary assms by simp + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) make_meas_outcome_prj_ortho: + assumes "Complex_Matrix.unitary U" + and "U \ fc_mats" + and "B\ fc_mats" + and "i < dist_el_card B" + and "j < dist_el_card B" + and "i \ j" +shows "meas_outcome_prj ((mk_meas_outcome B U) i) * + meas_outcome_prj ((mk_meas_outcome B U) j) = 0\<^sub>m dimR dimR" +proof - + define Pi where "Pi = sum_mat (\k. rank_1_proj (zero_col U k)) + (diag_elem_indices (diag_idx_to_el B i) B)" + have sneqi: "meas_outcome_prj (mk_meas_outcome B U i) = Pi" + unfolding mk_meas_outcome_def project_vecs_def Pi_def meas_outcome_prj_def by simp + define Pj where "Pj = sum_mat (\k. rank_1_proj (zero_col U k)) + (diag_elem_indices (diag_idx_to_el B j) B)" + have sneqj: "meas_outcome_prj (mk_meas_outcome B U j) = Pj" + unfolding mk_meas_outcome_def project_vecs_def Pj_def meas_outcome_prj_def by simp + have "Pi * Pj = 0\<^sub>m dimR dimR" unfolding Pi_def + proof (rule sum_mat_left_ortho_zero) + show "finite (diag_elem_indices (diag_idx_to_el B i) B)" + using diag_elem_indices_finite[of _ B] by simp + show km: "\k. k \ diag_elem_indices (diag_idx_to_el B i) B \ + rank_1_proj (zero_col U k) \ fc_mats" using zero_col_dim assms fc_mats_carrier dim_eq + by (metis rank_1_proj_carrier) + show "Pj \ fc_mats" using sneqj assms mk_meas_outcome_carrier by auto + show "\k. k \ diag_elem_indices (diag_idx_to_el B i) B \ + rank_1_proj (zero_col U k) * Pj = 0\<^sub>m dimR dimR" + proof - + fix k + assume "k \ diag_elem_indices (diag_idx_to_el B i) B" + show "rank_1_proj (zero_col U k) * Pj = 0\<^sub>m dimR dimR" unfolding Pj_def + proof (rule sum_mat_right_ortho_zero) + show "finite (diag_elem_indices (diag_idx_to_el B j) B)" + using diag_elem_indices_finite[of _ B] by simp + show "\i. i \ diag_elem_indices (diag_idx_to_el B j) B \ + rank_1_proj (zero_col U i) \ fc_mats" using zero_col_dim assms fc_mats_carrier dim_eq + by (metis rank_1_proj_carrier) + show "rank_1_proj (zero_col U k) \ fc_mats" + by (simp add: km \k \ diag_elem_indices (diag_idx_to_el B i) B\) + show "\i. i \ diag_elem_indices (diag_idx_to_el B j) B \ + rank_1_proj (zero_col U k) * rank_1_proj (zero_col U i) = 0\<^sub>m dimR dimR" + proof - + fix m + assume "m \ diag_elem_indices (diag_idx_to_el B j) B" + hence "m \ k" using \k \ diag_elem_indices (diag_idx_to_el B i) B\ + diag_elem_indices_disjoint[of B] fc_mats_carrier assms unfolding disjoint_family_on_def by auto + have "\i. i \ diag_elem_indices (diag_idx_to_el B j) B \ i < dimR" + using diag_elem_indices_elem fc_mats_carrier assms dim_eq by (metis carrier_matD(1)) + hence "m < dimR" using \m \ diag_elem_indices (diag_idx_to_el B j) B\ by simp + have "\k. k \ diag_elem_indices (diag_idx_to_el B i) B \ k < dimR" + using diag_elem_indices_elem fc_mats_carrier assms dim_eq by (metis carrier_matD(1)) + hence "k < dimR" using \k \ diag_elem_indices (diag_idx_to_el B i) B\ by simp + show "rank_1_proj (zero_col U k) * rank_1_proj (zero_col U m) = 0\<^sub>m dimR dimR" + using rank_1_proj_unitary_ne[of U k m] assms \m < dimR\ \k < dimR\ + by (metis \m \ k\ zero_col_col) + qed + qed + qed + qed + thus ?thesis using sneqi sneqj by simp +qed + +lemma (in cpx_sq_mat) make_meas_outcome_prjectors: + assumes "Complex_Matrix.unitary U" + and "U \ fc_mats" + and "B\ fc_mats" + and "j < dist_el_card B" +shows "projector (meas_outcome_prj ((mk_meas_outcome B U) j))" unfolding projector_def +proof + define Pj where "Pj = sum_mat (\i. rank_1_proj (zero_col U i)) + (diag_elem_indices (diag_idx_to_el B j) B)" + have sneq: "meas_outcome_prj (mk_meas_outcome B U j) = Pj" + unfolding mk_meas_outcome_def project_vecs_def Pj_def meas_outcome_prj_def by simp + moreover have "hermitian Pj" unfolding Pj_def + proof (rule sum_mat_hermitian) + show "finite (diag_elem_indices (diag_idx_to_el B j) B)" + using diag_elem_indices_finite[of _ B] by simp + show "\i\diag_elem_indices (diag_idx_to_el B j) B. hermitian (rank_1_proj (zero_col U i))" + using rank_1_proj_hermitian by simp + show "\i\diag_elem_indices (diag_idx_to_el B j) B. rank_1_proj (zero_col U i) \ fc_mats" + using zero_col_dim fc_mats_carrier dim_eq by (metis assms(2) rank_1_proj_carrier) + qed + ultimately show "hermitian (meas_outcome_prj (mk_meas_outcome B U j))" by simp + have "Pj * Pj = Pj" unfolding Pj_def + proof (rule sum_mat_ortho_square) + show "finite (diag_elem_indices (diag_idx_to_el B j) B)" + using diag_elem_indices_finite[of _ B] by simp + show "\i. i \ diag_elem_indices (diag_idx_to_el B j) B \ + rank_1_proj (zero_col U i) * rank_1_proj (zero_col U i) = rank_1_proj (zero_col U i)" + proof - + fix i + assume imem: "i\ diag_elem_indices (diag_idx_to_el B j) B" + hence "i < dimR" using diag_elem_indices_elem fc_mats_carrier assms dim_eq + by (metis carrier_matD(1)) + hence "zero_col U i = Matrix.col U i" using zero_col_col[of i] by simp + hence "rank_1_proj (zero_col U i) = rank_1_proj (Matrix.col U i)" by simp + moreover have "rank_1_proj (Matrix.col U i) * rank_1_proj (Matrix.col U i) = + rank_1_proj (Matrix.col U i)" by (rule rank_1_proj_unitary_eq, (auto simp add: assms \i < dimR\)) + ultimately show "rank_1_proj (zero_col U i) * rank_1_proj (zero_col U i) = + rank_1_proj (zero_col U i)" by simp + qed + show "\i. i \ diag_elem_indices (diag_idx_to_el B j) B \ + rank_1_proj (zero_col U i) \ fc_mats" + using zero_col_dim assms fc_mats_carrier dim_eq by (metis rank_1_proj_carrier) + have "\i. i \ diag_elem_indices (diag_idx_to_el B j) B \ i < dimR" + using diag_elem_indices_elem fc_mats_carrier assms dim_eq by (metis carrier_matD(1)) + thus "\i ja. + i \ diag_elem_indices (diag_idx_to_el B j) B \ + ja \ diag_elem_indices (diag_idx_to_el B j) B \ + i \ ja \ rank_1_proj (zero_col U i) * rank_1_proj (zero_col U ja) = 0\<^sub>m dimR dimR" + using rank_1_proj_unitary_ne by (simp add: assms(1) assms(2) zero_col_col) + qed + thus "meas_outcome_prj (mk_meas_outcome B U j) * + meas_outcome_prj (mk_meas_outcome B U j) = + meas_outcome_prj (mk_meas_outcome B U j)" + using sneq by simp +qed + +lemma (in cpx_sq_mat) mk_meas_outcome_fst_inj: + assumes "\i < (dim_row B). B$$(i,i) \ Reals" + shows "inj_on (\i. meas_outcome_val ((mk_meas_outcome B U) i)) {.. {.. {..i < (dim_row B). B$$(i,i) \ Reals" + shows "bij_betw (\i. meas_outcome_val ((mk_meas_outcome B U) i)) {..< dist_el_card B} + {Re x|x. x\ diag_elems B}" + unfolding bij_betw_def +proof + have "inj_on (\x. (meas_outcome_val (mk_meas_outcome B U x))) {.. diag_elems B} = diag_elems B" using diag_elems_Re[of B] assms by simp + ultimately show "inj_on (\x. meas_outcome_val (mk_meas_outcome B U x)) + {..i. meas_outcome_val (mk_meas_outcome B U i)) ` {.. diag_elems B}" unfolding meas_outcome_val_def mk_meas_outcome_def + proof + show "(\i. fst (Re (diag_idx_to_el B i), project_vecs (zero_col U) + (diag_elem_indices (diag_idx_to_el B i) B))) ` {.. + {Re x |x. x \ diag_elems B}" + using diag_idx_to_el_bij[of B] bij_betw_apply by fastforce + show "{Re x |x. x \ diag_elems B} + \ (\i. fst (Re (diag_idx_to_el B i), + project_vecs (zero_col U) (diag_elem_indices (diag_idx_to_el B i) B))) ` + {..Projective measurement associated with an observable\ + +definition eigvals where +"eigvals M = (SOME as. char_poly M = (\a\as. [:- a, 1:]) \ length as = dim_row M)" + +lemma eigvals_poly_length: + assumes "(M::complex Matrix.mat) \ carrier_mat n n" + shows "char_poly M = (\a\(eigvals M). [:- a, 1:]) \ length (eigvals M) = dim_row M" +proof - + let ?V = "SOME as. char_poly M = (\a\as. [:- a, 1:]) \ length as = dim_row M" + have vprop: "char_poly M = (\a\?V. [:- a, 1:]) \ length ?V = dim_row M" using + someI_ex[of "\as. char_poly M = (\a\as. [:- a, 1:]) \ length as = dim_row M"] + complex_mat_char_poly_factorizable assms by blast + show ?thesis by (metis (no_types) eigvals_def vprop) +qed + +text \We define the spectrum of a matrix $A$: this is its set of eigenvalues; its elements are +roots of the characteristic polynomial of $A$.\ + +definition spectrum where +"spectrum M = set (eigvals M)" + +lemma spectrum_finite: + shows "finite (spectrum M)" unfolding spectrum_def by simp + +lemma spectrum_char_poly_root: + fixes A::"complex Matrix.mat" + assumes "A\ carrier_mat n n" +and "k \ spectrum A" +shows "poly (char_poly A) k = 0" using eigvals_poly_length[of A n] assms + unfolding spectrum_def eigenvalue_root_char_poly + by (simp add: linear_poly_root) + +lemma spectrum_eigenvalues: + fixes A::"complex Matrix.mat" + assumes "A\ carrier_mat n n" +and "k\ spectrum A" +shows "eigenvalue A k" using eigenvalue_root_char_poly[of A n k] + spectrum_char_poly_root[of A n k] assms by simp + +text \The main result that is used to construct a projective measurement for a Hermitian matrix +is that it is always possible to decompose it as $A = U*B*U^\dagger$, where $B$ is diagonal and +only contains real elements, and $U$ is unitary.\ + +definition hermitian_decomp where +"hermitian_decomp A B U \ similar_mat_wit A B U (Complex_Matrix.adjoint U) \ diagonal_mat B \ + diag_mat B = (eigvals A) \ unitary U \ (\i < dim_row B. B$$(i, i) \ Reals)" + +lemma hermitian_decomp_sim: + assumes "hermitian_decomp A B U" + shows "similar_mat_wit A B U (Complex_Matrix.adjoint U)" using assms + unfolding hermitian_decomp_def by simp + +lemma hermitian_decomp_diag_mat: + assumes "hermitian_decomp A B U" + shows "diagonal_mat B" using assms + unfolding hermitian_decomp_def by simp + +lemma hermitian_decomp_eigenvalues: + assumes "hermitian_decomp A B U" + shows "diag_mat B = (eigvals A)" using assms + unfolding hermitian_decomp_def by simp + +lemma hermitian_decomp_unitary: + assumes "hermitian_decomp A B U" + shows "unitary U" using assms + unfolding hermitian_decomp_def by simp + +lemma hermitian_decomp_real_eigvals: + assumes "hermitian_decomp A B U" + shows "\i < dim_row B. B$$(i, i) \ Reals" using assms + unfolding hermitian_decomp_def by simp + +lemma hermitian_decomp_dim_carrier: + assumes "hermitian_decomp A B U" + shows "B \ carrier_mat (dim_row A) (dim_col A)" using assms + unfolding hermitian_decomp_def similar_mat_wit_def + by (metis (full_types) index_mult_mat(3) index_one_mat(3) insert_subset) + +lemma similar_mat_wit_dim_row: + assumes "similar_mat_wit A B Q R" + shows "dim_row B = dim_row A" using assms Let_def unfolding similar_mat_wit_def + by (meson carrier_matD(1) insert_subset) + +lemma (in cpx_sq_mat) hermitian_schur_decomp: + assumes "hermitian A" + and "A\ fc_mats" +obtains B U where "hermitian_decomp A B U" +proof - + { + have es: "char_poly A = (\ (e :: complex) \ (eigvals A). [:- e, 1:])" + using assms fc_mats_carrier eigvals_poly_length dim_eq by auto + obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" + by (cases "unitary_schur_decomposition A (eigvals A)") + hence pr: "similar_mat_wit A B U (Complex_Matrix.adjoint U) \ diagonal_mat B \ + diag_mat B = (eigvals A) \ unitary U \ (\i < dimR. B$$(i, i) \ Reals)" + using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto + moreover have "dim_row B = dimR" using assms fc_mats_carrier dim_eq similar_mat_wit_dim_row[of A] + pr by auto + ultimately have "hermitian_decomp A B U" unfolding hermitian_decomp_def by simp + hence "\ B U. hermitian_decomp A B U" by auto + } + thus ?thesis using that by auto +qed + +lemma (in cpx_sq_mat) hermitian_spectrum_real: + assumes "A \ fc_mats" + and "hermitian A" + and "a \ spectrum A" +shows "a \ Reals" +proof - + obtain B U where bu: "hermitian_decomp A B U" using assms hermitian_schur_decomp by auto + hence dimB: "B \ carrier_mat dimR dimR" using assms fc_mats_carrier + dim_eq hermitian_decomp_dim_carrier[of A] by simp + hence Bii: "\i. i < dimR \ B$$(i, i) \ Reals" using hermitian_decomp_real_eigvals[of A B U] + bu assms fc_mats_carrier by simp + have "diag_mat B = (eigvals A)" using bu hermitian_decomp_eigenvalues[of A B] by simp + hence "a \ set (diag_mat B)" using assms unfolding spectrum_def by simp + hence "\i < length (diag_mat B). a = diag_mat B ! i" by (metis in_set_conv_nth) + from this obtain i where "i < length (diag_mat B)" and "a = diag_mat B ! i" by auto + hence "a = B $$ (i,i)" unfolding diag_mat_def by simp + moreover have "i < dimR" using dimB \i < length (diag_mat B)\ unfolding diag_mat_def by simp + ultimately show ?thesis using Bii by simp +qed + +lemma (in cpx_sq_mat) spectrum_ne: + assumes "A\ fc_mats" +and "hermitian A" +shows "spectrum A \ {}" +proof - + obtain B U where bu: "hermitian_decomp A B U" using assms hermitian_schur_decomp by auto + hence dimB: "B \ carrier_mat dimR dimR" using assms fc_mats_carrier + dim_eq hermitian_decomp_dim_carrier[of A] by simp + have "diag_mat B = (eigvals A)" using bu hermitian_decomp_eigenvalues[of A B] by simp + have "B$$(0,0) \ set (diag_mat B)" using dimB npos unfolding diag_mat_def by simp + hence "set (diag_mat B) \ {}" by auto + thus ?thesis unfolding spectrum_def using \diag_mat B = eigvals A\ by auto +qed + +lemma unitary_hermitian_eigenvalues: + fixes U::"complex Matrix.mat" + assumes "unitary U" + and "hermitian U" + and "U \ carrier_mat n n" + and "0 < n" + and "k \ spectrum U" +shows "k \ {-1, 1}" +proof - + have "cpx_sq_mat n n (carrier_mat n n)" by (unfold_locales, (simp add: assms)+) + have "eigenvalue U k" using spectrum_eigenvalues assms by simp + have "k \ Reals" using assms \cpx_sq_mat n n (carrier_mat n n)\ + cpx_sq_mat.hermitian_spectrum_real by simp + hence "conjugate k = k" by (simp add: Reals_cnj_iff) + hence "k\<^sup>2 = 1" using unitary_eigenvalues_norm_square[of U n k] assms + by (simp add: \eigenvalue U k\ power2_eq_square) + thus ?thesis using power2_eq_1_iff by auto +qed + +lemma unitary_hermitian_Re_spectrum: + fixes U::"complex Matrix.mat" + assumes "unitary U" + and "hermitian U" + and "U \ carrier_mat n n" + and "0 < n" + shows "{Re x|x. x\ spectrum U} \ {-1,1}" +proof + fix y + assume "y\ {Re x|x. x\ spectrum U}" + hence "\x \ spectrum U. y = Re x" by auto + from this obtain x where "x\ spectrum U" and "y = Re x" by auto + hence "x\ {-1,1}" using unitary_hermitian_eigenvalues assms by simp + thus "y \ {-1, 1}" using \y = Re x\ by auto +qed + +text \The projective measurement associated with matrix $M$ is obtained from its Schur +decomposition, by considering the number of distinct elements on the resulting diagonal matrix +and constructing the projectors associated with each of them.\ + +type_synonym proj_meas_rep = "nat \ (nat \ measure_outcome)" + +definition proj_meas_size::"proj_meas_rep \ nat" where +"proj_meas_size P = fst P" + +definition proj_meas_outcomes::"proj_meas_rep \ (nat \ measure_outcome)" where +"proj_meas_outcomes P = snd P" + +definition (in cpx_sq_mat) make_pm::"complex Matrix.mat \ proj_meas_rep" where +"make_pm A = (let (B,U,_) = unitary_schur_decomposition A (eigvals A) in + (dist_el_card B, mk_meas_outcome B U))" + +lemma (in cpx_sq_mat) make_pm_decomp: + shows "make_pm A = (proj_meas_size (make_pm A), proj_meas_outcomes (make_pm A))" + unfolding proj_meas_size_def proj_meas_outcomes_def by simp + +lemma (in cpx_sq_mat) make_pm_proj_measurement: + assumes "A \ fc_mats" + and "hermitian A" + and "make_pm A = (n, M)" +shows "proj_measurement n M" +proof - + have es: "char_poly A = (\ (e :: complex) \ (eigvals A). [:- e, 1:])" + using assms fc_mats_carrier eigvals_poly_length dim_eq by auto + obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" + by (cases "unitary_schur_decomposition A (eigvals A)", auto) + then have "similar_mat_wit A B U (Complex_Matrix.adjoint U) \ diagonal_mat B \ + diag_mat B = (eigvals A) \ unitary U \ (\i < dimR. B$$(i, i) \ Reals)" + using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto + hence A: "A = U * B * (Complex_Matrix.adjoint U)" and dB: "diagonal_mat B" + and Bii: "\i. i < dimR \ B$$(i, i) \ Reals" + and dimB: "B \ carrier_mat dimR dimR" and dimP: "U \ carrier_mat dimR dimR" and + dimaP: "Complex_Matrix.adjoint U \ carrier_mat dimR dimR" and unit: "unitary U" + unfolding similar_mat_wit_def Let_def using assms fc_mats_carrier by auto + hence mpeq: "make_pm A = (dist_el_card B, mk_meas_outcome B U)" using us Let_def + unfolding make_pm_def by simp + hence "n = dist_el_card B" using assms by simp + have "M = mk_meas_outcome B U" using assms mpeq by simp + show ?thesis unfolding proj_measurement_def + proof (intro conjI) + show "inj_on (\i. meas_outcome_val (M i)) {..n = dist_el_card B\ \M = mk_meas_outcome B U\ Bii fc_mats_carrier dimB by auto + show "\j fc_mats \ projector (meas_outcome_prj (M j))" + proof (intro allI impI conjI) + fix j + assume "j < n" + show "meas_outcome_prj (M j) \ fc_mats" using \M = mk_meas_outcome B U\ assms + fc_mats_carrier \j < n\ \n = dist_el_card B\ dim_eq mk_meas_outcome_carrier + dimB dimP unit by blast + show "projector (meas_outcome_prj (M j))" using make_meas_outcome_prjectors + \M = mk_meas_outcome B U\ + fc_mats_carrier \n = dist_el_card B\ unit \j < n\ dimB dimP dim_eq by blast + qed + show "\ij j \ meas_outcome_prj (M i) * meas_outcome_prj (M j) = + 0\<^sub>m dimR dimR" + proof (intro allI impI) + fix i + fix j + assume "i < n" and "j < n" and "i\ j" + thus "meas_outcome_prj (M i) * meas_outcome_prj (M j) = 0\<^sub>m dimR dimR" + using make_meas_outcome_prj_ortho[of U B i j] assms dimB dimP fc_mats_carrier dim_eq + by (simp add: \M = mk_meas_outcome B U\ \n = dist_el_card B\ unit) + qed + show "sum_mat (\j. meas_outcome_prj (M j)) {..m dimR" using + mk_meas_outcome_sum_id + \M = mk_meas_outcome B U\ fc_mats_carrier dim_eq \n = dist_el_card B\ unit dimB dimP + by blast + qed +qed + +lemma (in cpx_sq_mat) make_pm_proj_measurement': + assumes "A\ fc_mats" + and "hermitian A" +shows "proj_measurement (proj_meas_size (make_pm A)) (proj_meas_outcomes (make_pm A))" + unfolding proj_meas_size_def proj_meas_outcomes_def + by (rule make_pm_proj_measurement[of A], (simp add: assms)+) + +lemma (in cpx_sq_mat) make_pm_projectors: + assumes "A\ fc_mats" + and "hermitian A" +and "i < proj_meas_size (make_pm A)" +shows "projector (meas_outcome_prj (proj_meas_outcomes (make_pm A) i))" +proof - + have "proj_measurement (proj_meas_size (make_pm A)) (proj_meas_outcomes (make_pm A))" + using assms make_pm_proj_measurement' by simp + thus ?thesis using proj_measurement_proj assms by simp +qed + +lemma (in cpx_sq_mat) make_pm_square: + assumes "A\ fc_mats" + and "hermitian A" +and "i < proj_meas_size (make_pm A)" +shows "meas_outcome_prj (proj_meas_outcomes (make_pm A) i) \ fc_mats" +proof - + have "proj_measurement (proj_meas_size (make_pm A)) (proj_meas_outcomes (make_pm A))" + using assms make_pm_proj_measurement' by simp + thus ?thesis using proj_measurement_square assms by simp +qed + + +subsubsection \Properties on the spectrum of a Hermitian matrix\ + +lemma (in cpx_sq_mat) hermitian_schur_decomp': + assumes "hermitian A" + and "A\ fc_mats" +obtains B U where "hermitian_decomp A B U \ + make_pm A = (dist_el_card B, mk_meas_outcome B U)" +proof - + { + have es: "char_poly A = (\ (e :: complex) \ (eigvals A). [:- e, 1:])" + using assms fc_mats_carrier eigvals_poly_length dim_eq by auto + obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" + by (cases "unitary_schur_decomposition A (eigvals A)") + hence pr: "similar_mat_wit A B U (Complex_Matrix.adjoint U) \ diagonal_mat B \ + diag_mat B = (eigvals A) \ unitary U \ (\i < dimR. B$$(i, i) \ Reals)" + using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto + moreover have "dim_row B = dimR" using assms fc_mats_carrier dim_eq similar_mat_wit_dim_row[of A] + pr by auto + ultimately have "hermitian_decomp A B U" unfolding hermitian_decomp_def by simp + moreover have "make_pm A = (dist_el_card B, mk_meas_outcome B U)" using us Let_def + unfolding make_pm_def hermitian_decomp_def by simp + ultimately have "\ B U. hermitian_decomp A B U \ + make_pm A = (dist_el_card B, mk_meas_outcome B U)" by auto + } + thus ?thesis using that by auto +qed + +lemma (in cpx_sq_mat) spectrum_meas_outcome_val_eq: + assumes "hermitian A" + and "A \ fc_mats" +and "make_pm A = (p, M)" +shows "spectrum A = (\i. meas_outcome_val (M i)) `{..< p}" +proof - + obtain B U where bu: "hermitian_decomp A B U \ + make_pm A = (dist_el_card B, mk_meas_outcome B U)" + using assms hermitian_schur_decomp'[OF assms(1)] by auto + hence "p = dist_el_card B" using assms by simp + have dimB: "B \ carrier_mat dimR dimR" using hermitian_decomp_dim_carrier[of A] dim_eq bu assms + fc_mats_carrier by auto + have Bvals: "diag_mat B = eigvals A" using bu hermitian_decomp_eigenvalues[of A B U] by simp + have Bii: "\i. i < dimR \ B$$(i, i) \ Reals" using bu hermitian_decomp_real_eigvals[of A B U] + dimB by simp + have "diag_elems B = set (eigvals A)" using dimB Bvals diag_elems_set_diag_mat[of B] by simp + have "M = mk_meas_outcome B U" using assms bu by simp + { + fix i + assume "i < p" + have "meas_outcome_val (M i) = Re (diag_idx_to_el B i)" + using \M = mk_meas_outcome B U\ + unfolding meas_outcome_val_def mk_meas_outcome_def by simp + also have "... = diag_idx_to_el B i" using diag_idx_to_el_real dimB \i < p\ + \p = dist_el_card B\ Bii by simp + finally have "meas_outcome_val (M i) = diag_idx_to_el B i" . + } note eq = this + have "bij_betw (diag_idx_to_el B) {..p = dist_el_card B\ + unfolding bij_betw_def by simp + thus ?thesis using eq \diag_elems B = set (eigvals A)\ unfolding spectrum_def by auto +qed + +lemma (in cpx_sq_mat) spectrum_meas_outcome_val_eq': + assumes "hermitian A" + and "A \ fc_mats" +and "make_pm A = (p, M)" +shows "{Re x|x. x\ spectrum A} = (\i. meas_outcome_val (M i)) `{..< p}" +proof + show "{Re x |x. x \ spectrum A} \ (\i. meas_outcome_val (M i)) ` {..i. meas_outcome_val (M i)) ` {.. {Re x |x. x \ spectrum A}" + using spectrum_meas_outcome_val_eq assms by force +qed + +lemma (in cpx_sq_mat) make_pm_eigenvalues: + assumes "A\ fc_mats" + and "hermitian A" +and "i < proj_meas_size (make_pm A)" +shows "meas_outcome_val (proj_meas_outcomes (make_pm A) i) \ spectrum A" + using spectrum_meas_outcome_val_eq[of A] assms make_pm_decomp by auto + +lemma (in cpx_sq_mat) make_pm_spectrum: + assumes "A\ fc_mats" + and "hermitian A" + and "make_pm A = (p,M)" +shows "(\i. meas_outcome_val (proj_meas_outcomes (make_pm A) i)) ` {..< p} = spectrum A" +proof + show "(\x. complex_of_real (meas_outcome_val (proj_meas_outcomes (make_pm A) x))) ` {.. + spectrum A" + using assms make_pm_eigenvalues make_pm_decomp + by (metis (mono_tags, lifting) Pair_inject image_subsetI lessThan_iff) + show "spectrum A \ + (\x. complex_of_real (meas_outcome_val (proj_meas_outcomes (make_pm A) x))) ` {.. fc_mats" +and "make_pm A = (p, M)" +shows "p = card (spectrum A)" +proof - + obtain B U where bu: "hermitian_decomp A B U \ + make_pm A = (dist_el_card B, mk_meas_outcome B U)" + using assms hermitian_schur_decomp'[OF assms(1)] by auto + hence "p = dist_el_card B" using assms by simp + have "spectrum A = set (diag_mat B)" using bu hermitian_decomp_eigenvalues[of A B U] + unfolding spectrum_def by simp + also have "... = diag_elems B" using diag_elems_set_diag_mat[of B] by simp + finally have "spectrum A = diag_elems B" . + thus ?thesis using \p = dist_el_card B\ unfolding dist_el_card_def by simp +qed + +lemma (in cpx_sq_mat) spectrum_size': + assumes "hermitian A" +and "A\ fc_mats" +shows "proj_meas_size (make_pm A) = card (spectrum A)" using spectrum_size + unfolding proj_meas_size_def + by (metis assms fst_conv surj_pair) + +lemma (in cpx_sq_mat) make_pm_projectors': + assumes "hermitian A" + and "A \ fc_mats" + and "a fc_mats" + and "a fc_mats" +proof (rule proj_measurement_square) + show "proj_measurement (proj_meas_size (make_pm A)) (proj_meas_outcomes (make_pm A))" + using make_pm_proj_measurement' assms by simp + show "a < proj_meas_size (make_pm A)" using assms + spectrum_size[of _ "proj_meas_size (make_pm A)"] make_pm_decomp[of A] by simp +qed + +lemma (in cpx_sq_mat) meas_outcome_prj_trace_real: + assumes "hermitian A" + and "density_operator R" + and "R \ fc_mats" + and "A\ fc_mats" + and "a carrier_mat dimR dimR" using fc_mats_carrier assms dim_eq by simp + show "Complex_Matrix.positive R" using assms unfolding density_operator_def by simp + show "projector (meas_outcome_prj (proj_meas_outcomes (make_pm A) a))" using assms + make_pm_projectors' by simp + show "meas_outcome_prj (proj_meas_outcomes (make_pm A) a) \ carrier_mat dimR dimR" + using meas_outcome_prj_carrier assms + dim_eq fc_mats_carrier by simp +qed + +lemma (in cpx_sq_mat) sum_over_spectrum: + assumes "A\ fc_mats" +and "hermitian A" +and "make_pm A = (p, M)" +shows "(\ y \ spectrum A. f y) = (\ i < p. f (meas_outcome_val (M i)))" +proof (rule sum.reindex_cong) +show "spectrum A =(\x. (meas_outcome_val (M x)))` {..< p}" + using spectrum_meas_outcome_val_eq assms by simp + show "inj_on (\x. complex_of_real (meas_outcome_val (M x))) {..x. (meas_outcome_val (M x))) {.. fc_mats" +and "hermitian A" +and "make_pm A = (p, M)" +shows "(\ y \ {Re x|x. x \ spectrum A}. f y) = (\ i < p. f (meas_outcome_val (M i)))" +proof (rule sum.reindex_cong) + show "{Re x|x. x \ spectrum A} =(\x. (meas_outcome_val (M x)))` {..< p}" + using spectrum_meas_outcome_val_eq' assms by simp + show "inj_on (\x. (meas_outcome_val (M x))) {..When a matrix $A$ is decomposed into a projective measurement $\{(\lambda_a, \pi_a)\}$, it +can be recovered by the formula $A = \sum \lambda_a \pi_a$.\ + +lemma (in cpx_sq_mat) make_pm_sum: + assumes "A \ fc_mats" + and "hermitian A" + and "make_pm A = (p, M)" +shows "sum_mat (\i. (meas_outcome_val (M i)) \\<^sub>m meas_outcome_prj (M i)) {..< p} = A" +proof - + have es: "char_poly A = (\ (e :: complex) \ (eigvals A). [:- e, 1:])" + using assms fc_mats_carrier eigvals_poly_length dim_eq by auto + obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" + by (cases "unitary_schur_decomposition A (eigvals A)", auto) + then have "similar_mat_wit A B U (Complex_Matrix.adjoint U) \ diagonal_mat B \ + diag_mat B = (eigvals A) + \ unitary U \ (\i < dimR. B$$(i, i) \ Reals)" + using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto + hence A: "A = U * B * (Complex_Matrix.adjoint U)" and dB: "diagonal_mat B" + and Bii: "\i. i < dimR \ B$$(i, i) \ Reals" + and dimB: "B \ carrier_mat dimR dimR" and dimP: "U \ carrier_mat dimR dimR" and + dimaP: "Complex_Matrix.adjoint U \ carrier_mat dimR dimR" and unit: "unitary U" + unfolding similar_mat_wit_def Let_def using assms fc_mats_carrier by auto + hence mpeq: "make_pm A = (dist_el_card B, mk_meas_outcome B U)" using us Let_def + unfolding make_pm_def by simp + hence "p = dist_el_card B" using assms by simp + have "M = mk_meas_outcome B U" using assms mpeq by simp + have "sum_mat (\i. meas_outcome_val (M i) \\<^sub>m meas_outcome_prj (M i)) {..< p} = + sum_mat (\j. Re (diag_idx_to_el B j)\\<^sub>m project_vecs (\i. zero_col U i) + (diag_elem_indices (diag_idx_to_el B j) B)) {..<(dist_el_card B)}" + using \p = dist_el_card B\ + \M = mk_meas_outcome B U\ unfolding meas_outcome_val_def meas_outcome_prj_def + mk_meas_outcome_def by simp + also have "... = sum_mat + (\j. sum_mat (\i. (Re (diag_idx_to_el B j)) \\<^sub>m rank_1_proj (zero_col U i)) + (diag_elem_indices (diag_idx_to_el B j) B)) {..i. i \ {.. + complex_of_real (Re (diag_idx_to_el B i)) \\<^sub>m + sum_mat (\i. rank_1_proj (zero_col U i)) (diag_elem_indices (diag_idx_to_el B i) B) + \ fc_mats" using assms fc_mats_carrier dimP project_vecs_def project_vecs_dim zero_col_dim + dim_eq by auto + show "\i. i \ {.. + sum_mat (\ia. complex_of_real (Re (diag_idx_to_el B i)) \\<^sub>m rank_1_proj (zero_col U ia)) + (diag_elem_indices (diag_idx_to_el B i) B) \ fc_mats" using assms fc_mats_carrier dimP + project_vecs_def project_vecs_dim zero_col_dim dim_eq + by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult sum_mat_carrier) + show "\j. j \ {.. + (Re (diag_idx_to_el B j)) \\<^sub>m sum_mat (\i. rank_1_proj (zero_col U i)) + (diag_elem_indices (diag_idx_to_el B j) B) = + sum_mat (\i. complex_of_real (Re (diag_idx_to_el B j)) \\<^sub>m rank_1_proj (zero_col U i)) + (diag_elem_indices (diag_idx_to_el B j) B)" + proof - + fix j + assume "j \ {..\<^sub>m sum_mat (\i. rank_1_proj (zero_col U i)) + (diag_elem_indices (diag_idx_to_el B j) B) = + sum_mat (\i. (Re (diag_idx_to_el B j)) \\<^sub>m rank_1_proj (zero_col U i)) + (diag_elem_indices (diag_idx_to_el B j) B)" + proof (rule smult_sum_mat) + show "finite (diag_elem_indices (diag_idx_to_el B j) B)" + using diag_elem_indices_finite[of _ B] by simp + show "\i. i \ diag_elem_indices (diag_idx_to_el B j) B \ + rank_1_proj (zero_col U i) \ fc_mats" + using dim_eq by (metis dimP local.fc_mats_carrier rank_1_proj_carrier zero_col_dim) + qed + qed + qed + also have "... = sum_mat + (\j. sum_mat (\ia. (diag_mat B ! ia) \\<^sub>m rank_1_proj (zero_col U ia)) + (diag_elem_indices (diag_idx_to_el B j) B)) {..i. i \ {.. + sum_mat (\ia. complex_of_real (Re (diag_idx_to_el B i)) \\<^sub>m rank_1_proj (zero_col U ia)) + (diag_elem_indices (diag_idx_to_el B i) B) \ fc_mats" using assms fc_mats_carrier dimP + project_vecs_def project_vecs_dim zero_col_dim dim_eq + by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult sum_mat_carrier) + show "\i. i \ {.. + local.sum_mat (\ia. (diag_mat B ! ia) \\<^sub>m rank_1_proj (zero_col U ia)) + (diag_elem_indices (diag_idx_to_el B i) B) \ fc_mats" using assms fc_mats_carrier dimP + project_vecs_def project_vecs_dim zero_col_dim dim_eq + by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult sum_mat_carrier) + show "\i. i \ {.. + sum_mat (\ia. (Re (diag_idx_to_el B i)) \\<^sub>m rank_1_proj (zero_col U ia)) + (diag_elem_indices (diag_idx_to_el B i) B) = + sum_mat (\ia. (diag_mat B ! ia) \\<^sub>m rank_1_proj (zero_col U ia)) + (diag_elem_indices (diag_idx_to_el B i) B)" + proof - + fix i + assume "i\ {..< dist_el_card B}" + show "sum_mat (\ia. (Re (diag_idx_to_el B i)) \\<^sub>m rank_1_proj (zero_col U ia)) + (diag_elem_indices (diag_idx_to_el B i) B) = + sum_mat (\ia. (diag_mat B ! ia) \\<^sub>m rank_1_proj (zero_col U ia)) + (diag_elem_indices (diag_idx_to_el B i) B)" + proof (rule sum_mat_cong) + show "finite (diag_elem_indices (diag_idx_to_el B i) B)" + using diag_elem_indices_finite[of _ B] by simp + show "\ia. ia \ diag_elem_indices (diag_idx_to_el B i) B \ + (Re (diag_idx_to_el B i)) \\<^sub>m rank_1_proj (zero_col U ia) \ fc_mats" + using assms fc_mats_carrier dimP project_vecs_def project_vecs_dim zero_col_dim dim_eq + by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult) + show "\ia. ia \ diag_elem_indices (diag_idx_to_el B i) B \ + (diag_mat B !ia) \\<^sub>m rank_1_proj (zero_col U ia) \ fc_mats" + using assms fc_mats_carrier dimP project_vecs_def project_vecs_dim zero_col_dim dim_eq + by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult) + show "\ia. ia \ diag_elem_indices (diag_idx_to_el B i) B \ + (Re (diag_idx_to_el B i)) \\<^sub>m rank_1_proj (zero_col U ia) = + (diag_mat B ! ia) \\<^sub>m rank_1_proj (zero_col U ia)" + proof - + fix ia + assume ia: "ia \ diag_elem_indices (diag_idx_to_el B i) B" + hence "ia < dim_row B" using diag_elem_indices_elem[of ia _ B] by simp + have "Re (diag_idx_to_el B i) = Re (B $$ (ia, ia))" + using diag_elem_indices_elem[of ia _ B] ia by simp + also have "... = B $$ (ia, ia)" using Bii using \ia < dim_row B\ dimB of_real_Re by blast + also have "... = diag_mat B ! ia" using \ia < dim_row B\ unfolding diag_mat_def by simp + finally have "Re (diag_idx_to_el B i) = diag_mat B ! ia" . + thus "(Re (diag_idx_to_el B i)) \\<^sub>m rank_1_proj (zero_col U ia) = + (diag_mat B ! ia) \\<^sub>m rank_1_proj (zero_col U ia)" by simp + qed + qed + qed + qed + also have "... = sum_mat + (\i. (diag_mat B ! i) \\<^sub>m rank_1_proj (zero_col U i)) + (\jj. (diag_mat B ! j) \\<^sub>m rank_1_proj (zero_col U j) \ fc_mats" using assms fc_mats_carrier dimP + project_vecs_def project_vecs_dim zero_col_dim dim_eq + by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult) + show "\i. i \ {.. finite (diag_elem_indices (diag_idx_to_el B i) B)" + by (simp add: diag_elem_indices_finite) + show "disjoint_family_on (\n. diag_elem_indices (diag_idx_to_el B n) B) + {..i. (diag_mat B ! i) \\<^sub>m rank_1_proj (zero_col U i)) {..< dimR}" + using diag_elem_indices_union[of B] dimB dim_eq by simp + also have "... = sum_mat (\i. (diag_mat B ! i) \\<^sub>mrank_1_proj (Matrix.col U i)) {..< dimR}" + proof (rule sum_mat_cong, simp) + show res: "\i. i \ {.. (diag_mat B ! i) \\<^sub>m rank_1_proj (zero_col U i) \ fc_mats" + using assms fc_mats_carrier dimP project_vecs_def project_vecs_dim zero_col_dim dim_eq + by (metis (no_types, lifting) rank_1_proj_carrier cpx_sq_mat_smult) + show "\i. i \ {.. (diag_mat B ! i) \\<^sub>m rank_1_proj (Matrix.col U i) \ fc_mats" + using assms fc_mats_carrier dimP project_vecs_def project_vecs_dim zero_col_dim + by (metis res lessThan_iff zero_col_col) + show "\i. i \ {.. (diag_mat B ! i) \\<^sub>m rank_1_proj (zero_col U i) = + (diag_mat B ! i) \\<^sub>m rank_1_proj (Matrix.col U i)" + by (simp add: zero_col_col) + qed + also have "... = U * B * Complex_Matrix.adjoint U" + proof (rule weighted_sum_rank_1_proj_unitary) + show "diagonal_mat B" using dB . + show "Complex_Matrix.unitary U" using unit . + show "U \ fc_mats" using fc_mats_carrier dim_eq dimP by simp + show "B\ fc_mats" using fc_mats_carrier dim_eq dimB by simp + qed + also have "... = A" using A by simp + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) trace_hermitian_pos_real: + fixes f::"'a \ real" + assumes "hermitian A" + and "Complex_Matrix.positive R" + and "A \ fc_mats" + and "R \ fc_mats" +shows "Complex_Matrix.trace (R * A) = + Re (Complex_Matrix.trace (R * A))" +proof - + define prj_mems where "prj_mems = make_pm A" + define p where "p = proj_meas_size prj_mems" + define meas where "meas = proj_meas_outcomes prj_mems" + have tre: "Complex_Matrix.trace (R * A) = + Complex_Matrix.trace (R * + sum_mat (\i. (meas_outcome_val (meas i)) \\<^sub>m meas_outcome_prj (meas i)) {..< p})" + using make_pm_sum assms meas_def p_def proj_meas_size_def proj_meas_outcomes_def prj_mems_def + meas_outcome_val_def meas_outcome_prj_def by auto + also have "... = Re (Complex_Matrix.trace (R * + sum_mat (\i. (meas_outcome_val (meas i)) \\<^sub>m meas_outcome_prj (meas i)) {..< p}))" + proof (rule trace_sum_mat_proj_pos_real, (auto simp add: assms)) + fix i + assume "i < p" + thus "projector (meas_outcome_prj (meas i))" using make_pm_projectors assms + unfolding p_def meas_def prj_mems_def by simp + show "meas_outcome_prj (meas i) \ fc_mats" using make_pm_square assms \i < p\ + unfolding p_def meas_def prj_mems_def by simp + qed + also have "... = Re (Complex_Matrix.trace (R * A))" using tre by simp + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) hermitian_Re_spectrum: + assumes "hermitian A" +and "A\ fc_mats" +and "{Re x |x. x \ spectrum A} = {a,b}" +shows "spectrum A = {complex_of_real a, complex_of_real b}" +proof + have ar: "\(a::complex). a \ spectrum A \ Re a = a" using hermitian_spectrum_real assms by simp + show "spectrum A \ {complex_of_real a, complex_of_real b}" + proof + fix x + assume "x\ spectrum A" + hence "Re x = x" using ar by simp + have "Re x \ {a,b}" using \x\ spectrum A\ assms by blast + thus "x \ {complex_of_real a, complex_of_real b}" using \Re x = x\ by auto + qed + show "{complex_of_real a, complex_of_real b} \ spectrum A" + proof + fix x + assume "x \ {complex_of_real a, complex_of_real b}" + hence "x \ {complex_of_real (Re x) |x. x \ spectrum A}" using assms + proof - + have "\r. r \ {a, b} \ (\c. r = Re c \ c \ spectrum A)" + using \{Re x |x. x \ spectrum A} = {a, b}\ by blast + then show ?thesis + using \x \ {complex_of_real a, complex_of_real b}\ by blast + qed + thus "x\ spectrum A" using ar by auto + qed +qed + + +subsubsection \Similar properties for eigenvalues rather than spectrum indices\ + +text \In this part we go the other way round: given an eigenvalue of $A$, \verb+spectrum_to_pm_idx+ +permits to retrieve its index in the associated projective measurement\ + +definition (in cpx_sq_mat) spectrum_to_pm_idx + where "spectrum_to_pm_idx A x = (let (B,U,_) = unitary_schur_decomposition A (eigvals A) in + diag_el_to_idx B x)" + +lemma (in cpx_sq_mat) spectrum_to_pm_idx_bij: +assumes "hermitian A" + and "A\ fc_mats" +shows "bij_betw (spectrum_to_pm_idx A) (spectrum A) {..< card (spectrum A)}" +proof - + define p where "p = proj_meas_size (make_pm A)" + define M where "M = proj_meas_outcomes (make_pm A)" + have es: "char_poly A = (\ (e :: complex) \ (eigvals A). [:- e, 1:])" + using assms fc_mats_carrier eigvals_poly_length dim_eq by auto + obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" + by (cases "unitary_schur_decomposition A (eigvals A)") + hence pr: "similar_mat_wit A B U (Complex_Matrix.adjoint U) \ + diag_mat B = (eigvals A)" + using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto + have "(p,M) = make_pm A" unfolding p_def M_def using make_pm_decomp by simp + hence "p = dist_el_card B" using assms us unfolding make_pm_def by simp + have dimB: "B \ carrier_mat dimR dimR" using dim_eq pr assms + fc_mats_carrier unfolding similar_mat_wit_def by auto + have Bvals: "diag_mat B = eigvals A" using pr hermitian_decomp_eigenvalues[of A B U] by simp + have "diag_elems B = spectrum A" unfolding spectrum_def using dimB Bvals + diag_elems_set_diag_mat[of B] by simp + moreover have "dist_el_card B = card (spectrum A)" using spectrum_size[of A p M] assms + \(p,M) = make_pm A\ \p = dist_el_card B\ by simp + ultimately show "bij_betw (spectrum_to_pm_idx A) (spectrum A) {..< card (spectrum A)}" + using diag_el_to_idx_bij us unfolding spectrum_to_pm_idx_def Let_def + by (metis (mono_tags, lifting) bij_betw_cong case_prod_conv) +qed + +lemma (in cpx_sq_mat) spectrum_to_pm_idx_lt_card: +assumes "A\ fc_mats" + and "hermitian A" +and "a\ spectrum A" +shows "spectrum_to_pm_idx A a < card (spectrum A)" using spectrum_to_pm_idx_bij[of A] assms + by (meson bij_betw_apply lessThan_iff) + +lemma (in cpx_sq_mat) spectrum_to_pm_idx_inj: +assumes "hermitian A" + and "A\ fc_mats" +shows "inj_on (spectrum_to_pm_idx A) (spectrum A)" using assms spectrum_to_pm_idx_bij + unfolding bij_betw_def by simp + +lemma (in cpx_sq_mat) spectrum_meas_outcome_val_inv: +assumes "A\ fc_mats" + and "hermitian A" +and "make_pm A = (p,M)" +and "i < p" +shows "spectrum_to_pm_idx A (meas_outcome_val (M i)) = i" +proof - + have es: "char_poly A = (\ (e :: complex) \ (eigvals A). [:- e, 1:])" + using assms fc_mats_carrier eigvals_poly_length dim_eq by auto + obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" + by (cases "unitary_schur_decomposition A (eigvals A)") + hence pr: "similar_mat_wit A B U (Complex_Matrix.adjoint U) \ + diag_mat B = (eigvals A) \ (\i < dimR. B$$(i, i) \ Reals)" + using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto + have "dim_row B = dimR" using assms fc_mats_carrier dim_eq similar_mat_wit_dim_row[of A] + pr by auto + hence "(p,M) = (dist_el_card B, mk_meas_outcome B U)" using assms us + unfolding make_pm_def by simp + hence "M = mk_meas_outcome B U" by simp + have "meas_outcome_val (M i) = Re (diag_idx_to_el B i)" + using \M = mk_meas_outcome B U\ unfolding mk_meas_outcome_def + meas_outcome_val_def by simp + also have "... = diag_idx_to_el B i" using pr + \(p, M) = (dist_el_card B, mk_meas_outcome B U)\ \dim_row B = dimR\ assms + diag_idx_to_el_real by auto + finally have "meas_outcome_val (M i) = diag_idx_to_el B i" . + hence "spectrum_to_pm_idx A (meas_outcome_val (M i)) = + spectrum_to_pm_idx A (diag_idx_to_el B i)" by simp + also have "... = diag_el_to_idx B (diag_idx_to_el B i)" unfolding spectrum_to_pm_idx_def + using us by simp + also have "... = i" using assms unfolding diag_el_to_idx_def + using \(p, M) = (dist_el_card B, mk_meas_outcome B U)\ bij_betw_inv_into_left + diag_idx_to_el_bij by fastforce + finally show ?thesis . +qed + +lemma (in cpx_sq_mat) meas_outcome_val_spectrum_inv: + assumes "A\ fc_mats" + and "hermitian A" +and "x\ spectrum A" +and "make_pm A = (p,M)" +shows "meas_outcome_val (M (spectrum_to_pm_idx A x)) = x" +proof - + have es: "char_poly A = (\ (e :: complex) \ (eigvals A). [:- e, 1:])" + using assms fc_mats_carrier eigvals_poly_length dim_eq by auto + obtain B U Q where us: "unitary_schur_decomposition A (eigvals A) = (B,U,Q)" + by (cases "unitary_schur_decomposition A (eigvals A)") + hence pr: "similar_mat_wit A B U (Complex_Matrix.adjoint U) \ diagonal_mat B \ + diag_mat B = (eigvals A) \ unitary U \ (\i < dimR. B$$(i, i) \ Reals)" + using hermitian_eigenvalue_real assms fc_mats_carrier es dim_eq by auto + have "dim_row B = dimR" using assms fc_mats_carrier dim_eq similar_mat_wit_dim_row[of A] + pr by auto + hence "(p,M) = (dist_el_card B, mk_meas_outcome B U)" using assms us + unfolding make_pm_def by simp + hence "M = mk_meas_outcome B U" by simp + have "diag_mat B = (eigvals A)" using pr by simp + hence "x \ set (diag_mat B)" using \diag_mat B = eigvals A\ assms unfolding spectrum_def by simp + hence "x \ diag_elems B" using diag_elems_set_diag_mat[of B] by simp + hence "diag_idx_to_el B (diag_el_to_idx B x) = x" unfolding diag_el_to_idx_def + by (meson bij_betw_inv_into_right diag_idx_to_el_bij) + moreover have "spectrum_to_pm_idx A x = diag_el_to_idx B x" unfolding spectrum_to_pm_idx_def + using us by simp + moreover have "meas_outcome_val (M (spectrum_to_pm_idx A x)) = + Re (diag_idx_to_el B (diag_el_to_idx B x))" using \M = mk_meas_outcome B U\ + unfolding mk_meas_outcome_def meas_outcome_val_def by (simp add: calculation(2)) + ultimately show ?thesis by simp +qed + +definition (in cpx_sq_mat) eigen_projector where +"eigen_projector A a = + meas_outcome_prj ((proj_meas_outcomes (make_pm A)) (spectrum_to_pm_idx A a))" + +lemma (in cpx_sq_mat) eigen_projector_carrier: + assumes "A\ fc_mats" + and "a\ spectrum A" + and "hermitian A" +shows "eigen_projector A a \ fc_mats" unfolding eigen_projector_def + using meas_outcome_prj_carrier[of A "spectrum_to_pm_idx A a"] + spectrum_to_pm_idx_lt_card[of A a] assms by simp + +text \We obtain the following result, which is similar to \verb+make_pm_sum+ but with a sum on +the elements of the spectrum of Hermitian matrix $A$, which is a more standard statement of the +spectral decomposition theorem.\ + +lemma (in cpx_sq_mat) make_pm_sum': + assumes "A \ fc_mats" + and "hermitian A" +shows "sum_mat (\a. a \\<^sub>m (eigen_projector A a)) (spectrum A) = A" +proof - + define p where "p = proj_meas_size (make_pm A)" + define M where "M = proj_meas_outcomes (make_pm A)" + have "(p,M) = make_pm A" unfolding p_def M_def using make_pm_decomp by simp + define g where + "g = (\i. (if i < p + then complex_of_real (meas_outcome_val (M i)) \\<^sub>m meas_outcome_prj (M i) + else (0\<^sub>m dimR dimC)))" + have g: "\x. g x \ fc_mats" + proof + fix x + show "g x \ fc_mats" + proof (cases "x < p") + case True + hence "(meas_outcome_val (M x)) \\<^sub>m meas_outcome_prj (M x) \ fc_mats" + using meas_outcome_prj_carrier + spectrum_size assms cpx_sq_mat_smult make_pm_proj_measurement proj_measurement_square + \(p,M) = make_pm A\ by metis + then show ?thesis unfolding g_def using True by simp + next + case False + then show ?thesis unfolding g_def using zero_mem by simp + qed + qed + define h where "h = (\a. (if a \ (spectrum A) then a \\<^sub>m eigen_projector A a else (0\<^sub>m dimR dimC)))" + have h: "\x. h x \ fc_mats" + proof + fix x + show "h x \ fc_mats" + proof (cases "x\ spectrum A") + case True + then show ?thesis unfolding h_def using eigen_projector_carrier[of A x] assms True + by (simp add: cpx_sq_mat_smult) + next + case False + then show ?thesis unfolding h_def using zero_mem by simp + qed + qed + have "inj_on (spectrum_to_pm_idx A) (spectrum A)" using assms spectrum_to_pm_idx_inj by simp + moreover have "{..(p,M) = make_pm A\ + spectrum_to_pm_idx_bij spectrum_size unfolding bij_betw_def + by (metis assms(1) assms(2)) + moreover have "\x. x \ spectrum A \ g (spectrum_to_pm_idx A x) = h x" + proof - + fix a + assume "a \ spectrum A" + hence "Re a = a" using hermitian_spectrum_real assms by simp + have "spectrum_to_pm_idx A a < p" using spectrum_to_pm_idx_lt_card[of A] spectrum_size assms + \a \ spectrum A\ \(p,M) = make_pm A\ by metis + have "g (spectrum_to_pm_idx A a) = + (meas_outcome_val (M (spectrum_to_pm_idx A a))) \\<^sub>m + meas_outcome_prj (M (spectrum_to_pm_idx A a))" + using \spectrum_to_pm_idx A a < p\ unfolding g_def by simp + also have "... = a \\<^sub>m meas_outcome_prj (M (spectrum_to_pm_idx A a))" + using meas_outcome_val_spectrum_inv[of A "Re a"] \Re a = a\ assms \a \ spectrum A\ + \(p,M) = make_pm A\ by metis + also have "... = h a" using \a \ spectrum A\ unfolding eigen_projector_def M_def h_def by simp + finally show "g (spectrum_to_pm_idx A a) = h a" . + qed + ultimately have "sum_mat h (spectrum A) = + sum_mat g (spectrum_to_pm_idx A ` spectrum A)" unfolding sum_mat_def + using sum_with_reindex_cong[symmetric, of g h "spectrum_to_pm_idx A" "spectrum A" "{..< p}"] + g h by simp + also have "... = sum_mat g {..< p}" using \{.. by simp + also have "... = sum_mat (\i. (meas_outcome_val (M i)) \\<^sub>m meas_outcome_prj (M i)) {.. {..< p}" + hence "i < p" by simp + show "g i \ fc_mats" using g by simp + show "g i = (meas_outcome_val (M i)) \\<^sub>m meas_outcome_prj (M i)" unfolding g_def + using \i < p\ by simp + show "(meas_outcome_val (M i)) \\<^sub>m meas_outcome_prj (M i) \ fc_mats" + using meas_outcome_prj_carrier spectrum_size assms cpx_sq_mat_smult + make_pm_proj_measurement proj_measurement_square \i < p\ \(p,M) = make_pm A\ by metis + qed + also have "... = A" using make_pm_sum assms \(p,M) = make_pm A\ unfolding g_def by simp + finally have "sum_mat h (spectrum A) = A" . + moreover have "sum_mat h (spectrum A) = sum_mat (\a. a \\<^sub>m (eigen_projector A a)) (spectrum A)" + proof (rule sum_mat_cong) + show "finite (spectrum A)" using spectrum_finite[of A] by simp + fix i + assume "i\ spectrum A" + thus "h i = i \\<^sub>m eigen_projector A i" unfolding h_def by simp + show "h i \ fc_mats" using h by simp + show "i \\<^sub>m eigen_projector A i \ fc_mats" using eigen_projector_carrier[of A i] assms + \i\ spectrum A\ by (metis \h i = i \\<^sub>m eigen_projector A i\ h) + qed + ultimately show ?thesis by simp +qed + + + +end \ No newline at end of file diff --git a/thys/Projective_Measurements/ROOT b/thys/Projective_Measurements/ROOT new file mode 100644 --- /dev/null +++ b/thys/Projective_Measurements/ROOT @@ -0,0 +1,14 @@ +chapter AFP + +session Projective_Measurements (AFP) = "HOL-Probability" + + options [timeout = 600] + sessions + Isabelle_Marries_Dirac + QHLProver + "HOL-Types_To_Sets" + theories + Linear_Algebra_Complements + Projective_Measurements + CHSH_Inequality + document_files + "root.tex" diff --git a/thys/Projective_Measurements/document/root.tex b/thys/Projective_Measurements/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Projective_Measurements/document/root.tex @@ -0,0 +1,59 @@ +\documentclass[11pt,a4paper]{article} +\usepackage{isabelle,isabellesym} + +% further packages required for unusual symbols (see also +% isabellesym.sty), use only when needed + +%\usepackage{amssymb} + %for \, \, \, \, \, \, + %\, \, \, \, \, + %\, \, \ + +%\usepackage{eurosym} + %for \ + +%\usepackage[only,bigsqcap]{stmaryrd} + %for \ + +%\usepackage{eufrak} + %for \ ... \, \ ... \ (also included in amssymb) + +%\usepackage{textcomp} + %for \, \, \, \, \, + %\ + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + +% for uniform font size +%\renewcommand{\isastyle}{\isastyleminor} + + +\begin{document} + +\title{Projective-Measurements} +\author{Mnacho} +\maketitle + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +% optional bibliography +%\bibliographystyle{abbrv} +%\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/ROOTS b/thys/ROOTS --- a/thys/ROOTS +++ b/thys/ROOTS @@ -1,586 +1,591 @@ ADS_Functor AI_Planning_Languages_Semantics AODV AVL-Trees AWN Abortable_Linearizable_Modules Abs_Int_ITP2012 Abstract-Hoare-Logics Abstract-Rewriting Abstract_Completeness Abstract_Soundness Adaptive_State_Counting Affine_Arithmetic Aggregation_Algebras Akra_Bazzi Algebraic_Numbers Algebraic_VCs Allen_Calculus Amicable_Numbers Amortized_Complexity AnselmGod Applicative_Lifting Approximation_Algorithms Architectural_Design_Patterns Aristotles_Assertoric_Syllogistic Arith_Prog_Rel_Primes ArrowImpossibilityGS Attack_Trees Auto2_HOL Auto2_Imperative_HOL AutoFocus-Stream Automated_Stateful_Protocol_Verification Automatic_Refinement AxiomaticCategoryTheory BDD BNF_CC BNF_Operations BTree Banach_Steinhaus Bell_Numbers_Spivey Berlekamp_Zassenhaus Bernoulli Bertrands_Postulate Bicategory BinarySearchTree Binding_Syntax_Theory Binomial-Heaps Binomial-Queues BirdKMP Blue_Eyes Bondy Boolean_Expression_Checkers Bounded_Deducibility_Security Buchi_Complementation Budan_Fourier Buffons_Needle Buildings BytecodeLogicJmlTypes C2KA_DistributedSystems CAVA_Automata CAVA_LTL_Modelchecker CCS CISC-Kernel CRDT CYK CakeML CakeML_Codegen Call_Arity Card_Equiv_Relations Card_Multisets Card_Number_Partitions Card_Partitions Cartan_FP Case_Labeling Catalan_Numbers Category Category2 Category3 Cauchy Cayley_Hamilton Certification_Monads Chandy_Lamport Chord_Segments Circus Clean ClockSynchInst Closest_Pair_Points CofGroups Coinductive Coinductive_Languages Collections Comparison_Sort_Lower_Bound Compiling-Exceptions-Correctly Complete_Non_Orders Completeness Complex_Geometry Complx ComponentDependencies ConcurrentGC ConcurrentIMP Concurrent_Ref_Alg Concurrent_Revisions Consensus_Refined Constructive_Cryptography Constructor_Funs Containers CoreC++ Core_DOM Core_SC_DOM Count_Complex_Roots CryptHOL CryptoBasedCompositionalProperties CSP_RefTK DFS_Framework DPT-SAT-Solver DataRefinementIBP Datatype_Order_Generator Decl_Sem_Fun_PL Decreasing-Diagrams Decreasing-Diagrams-II Deep_Learning Delta_System_Lemma Density_Compiler Dependent_SIFUM_Refinement Dependent_SIFUM_Type_Systems Depth-First-Search Derangements Deriving Descartes_Sign_Rule Dict_Construction Differential_Dynamic_Logic Differential_Game_Logic Dijkstra_Shortest_Path Diophantine_Eqns_Lin_Hom Dirichlet_L Dirichlet_Series DiscretePricing Discrete_Summation DiskPaxos DOM_Components DynamicArchitectures Dynamic_Tables E_Transcendental Echelon_Form EdmondsKarp_Maxflow Efficient-Mergesort Elliptic_Curves_Group_Law Encodability_Process_Calculi Epistemic_Logic Ergodic_Theory Error_Function Euler_MacLaurin Euler_Partition Example-Submission Extended_Finite_State_Machine_Inference Extended_Finite_State_Machines FFT FLP FOL-Fitting FOL_Harrison FOL_Seq_Calc1 Factored_Transition_System_Bounding Falling_Factorial_Sum Farkas FeatherweightJava Featherweight_OCL Fermat3_4 FileRefinement FinFun Finger-Trees Finite-Map-Extras Finite_Automata_HF First_Order_Terms First_Welfare_Theorem Fishburn_Impossibility Fisher_Yates Flow_Networks Floyd_Warshall Flyspeck-Tame FocusStreamsCaseStudies Forcing Formal_Puiseux_Series Formal_SSA Formula_Derivatives Fourier Free-Boolean-Algebra Free-Groups FunWithFunctions FunWithTilings Functional-Automata Functional_Ordered_Resolution_Prover Furstenberg_Topology GPU_Kernel_PL Gabow_SCC Game_Based_Crypto Gauss-Jordan-Elim-Fun Gauss_Jordan Gauss_Sums Gaussian_Integers GenClock General-Triangle Generalized_Counting_Sort Generic_Deriving Generic_Join GewirthPGCProof Girth_Chromatic GoedelGod Goedel_HFSet_Semantic Goedel_HFSet_Semanticless Goedel_Incompleteness Goodstein_Lambda GraphMarkingIBP Graph_Saturation Graph_Theory Green Groebner_Bases Groebner_Macaulay Gromov_Hyperbolicity Group-Ring-Module HOL-CSP HOLCF-Prelude HRB-Slicing Heard_Of Hello_World HereditarilyFinite Hermite +Hermite_Lindemann Hidden_Markov_Models Higher_Order_Terms Hoare_Time Hood_Melville_Queue HotelKeyCards Huffman Hybrid_Logic Hybrid_Multi_Lane_Spatial_Logic Hybrid_Systems_VCs HyperCTL IEEE_Floating_Point IMAP-CRDT IMO2019 IMP2 IMP2_Binary_Heap IP_Addresses Imperative_Insertion_Sort Impossible_Geometry Incompleteness Incredible_Proof_Machine Inductive_Confidentiality Inductive_Inference InfPathElimination InformationFlowSlicing InformationFlowSlicing_Inter Integration Interpreter_Optimizations Interval_Arithmetic_Word32 Iptables_Semantics Irrational_Series_Erdos_Straus Irrationality_J_Hancl Isabelle_C Isabelle_Marries_Dirac Isabelle_Meta_Model IsaGeoCoq Jacobson_Basic_Algebra Jinja JinjaDCI JinjaThreads JiveDataStoreModel Jordan_Hoelder Jordan_Normal_Form KAD KAT_and_DRA KBPs KD_Tree Key_Agreement_Strong_Adversaries Kleene_Algebra Knuth_Bendix_Order Knot_Theory Knuth_Bendix_Order Knuth_Morris_Pratt Koenigsberg_Friendship Kruskal Kuratowski_Closure_Complement LLL_Basis_Reduction LLL_Factorization LOFT LTL LTL_Master_Theorem LTL_Normal_Form LTL_to_DRA LTL_to_GBA Lam-ml-Normalization LambdaAuth LambdaMu Lambda_Free_EPO Lambda_Free_KBOs Lambda_Free_RPOs Lambert_W Landau_Symbols Laplace_Transform Latin_Square LatticeProperties Launchbury Laws_of_Large_Numbers Lazy-Lists-II Lazy_Case Lehmer Lifting_Definition_Option LightweightJava LinearQuantifierElim Linear_Inequalities Linear_Programming Linear_Recurrences Liouville_Numbers List-Index List-Infinite List_Interleaving List_Inversions List_Update LocalLexing Localization_Ring Locally-Nameless-Sigma Lowe_Ontological_Argument Lower_Semicontinuous Lp Lucas_Theorem MFMC_Countable MFODL_Monitor_Optimized MFOTL_Monitor MSO_Regex_Equivalence Markov_Models Marriage Mason_Stothers Matrices_for_ODEs Matrix Matrix_Tensor Matroids Max-Card-Matching Median_Of_Medians_Selection Menger +Mereology Mersenne_Primes MiniML Minimal_SSA Minkowskis_Theorem Minsky_Machines Modal_Logics_for_NTS +Modular_arithmetic_LLL_and_HNF_algorithms Modular_Assembly_Kit_Security Monad_Memo_DP Monad_Normalisation MonoBoolTranAlgebra MonoidalCategory Monomorphic_Monad MuchAdoAboutTwo Multi_Party_Computation Multirelations Myhill-Nerode Name_Carrying_Type_Inference Nash_Williams Nat-Interval-Logic Native_Word Nested_Multisets_Ordinals Network_Security_Policy_Verification Neumann_Morgenstern_Utility No_FTL_observers Nominal2 Noninterference_CSP Noninterference_Concurrent_Composition Noninterference_Generic_Unwinding Noninterference_Inductive_Unwinding Noninterference_Ipurge_Unwinding Noninterference_Sequential_Composition NormByEval Nullstellensatz Octonions OpSets Open_Induction Optics Optimal_BST Orbit_Stabiliser Order_Lattice_Props Ordered_Resolution_Prover Ordinal Ordinal_Partitions Ordinals_and_Cardinals Ordinary_Differential_Equations PAC_Checker PCF PLM POPLmark-deBruijn PSemigroupsConvolution Pairing_Heap Paraconsistency Parity_Game Partial_Function_MR Partial_Order_Reduction Password_Authentication_Protocol Pell Perfect-Number-Thm Perron_Frobenius Physical_Quantities Pi_Calculus Pi_Transcendental Planarity_Certificates Poincare_Bendixson Poincare_Disc Polynomial_Factorization Polynomial_Interpolation Polynomials Pop_Refinement Posix-Lexing Possibilistic_Noninterference Power_Sum_Polynomials Pratt_Certificate Presburger-Automata Prim_Dijkstra_Simple Prime_Distribution_Elementary Prime_Harmonic_Series Prime_Number_Theorem Priority_Queue_Braun Priority_Search_Trees Probabilistic_Noninterference Probabilistic_Prime_Tests Probabilistic_System_Zoo Probabilistic_Timed_Automata Probabilistic_While Program-Conflict-Analysis Projective_Geometry +Projective_Measurements Promela Proof_Strategy_Language PropResPI Propositional_Proof_Systems Prpu_Maxflow PseudoHoops Psi_Calculi Ptolemys_Theorem QHLProver QR_Decomposition Quantales Quaternions Quick_Sort_Cost RIPEMD-160-SPARK ROBDD RSAPSS Ramsey-Infinite Random_BSTs Random_Graph_Subgraph_Threshold Randomised_BSTs Randomised_Social_Choice Rank_Nullity_Theorem Real_Impl Recursion-Addition Recursion-Theory-I Refine_Imperative_HOL Refine_Monadic RefinementReactive Regex_Equivalence Regular-Sets Regular_Algebras Relation_Algebra Relational-Incorrectness-Logic Relational_Disjoint_Set_Forests Relational_Method Relational_Minimum_Spanning_Trees Relational_Paths Rep_Fin_Groups Residuated_Lattices Resolution_FOL Rewriting_Z Ribbon_Proofs Robbins-Conjecture Robinson_Arithmetic Root_Balanced_Tree Routing Roy_Floyd_Warshall SATSolverVerification SC_DOM_Components SDS_Impossibility SIFPL SIFUM_Type_Systems SPARCv8 Safe_Distance Safe_OCL Saturation_Framework Saturation_Framework_Extensions Shadow_DOM Secondary_Sylow Security_Protocol_Refinement Selection_Heap_Sort SenSocialChoice Separata Separation_Algebra Separation_Logic_Imperative_HOL SequentInvertibility Shadow_SC_DOM Shivers-CFA ShortestPath Show Sigma_Commit_Crypto Signature_Groebner Simpl Simple_Firewall Simplex Skew_Heap Skip_Lists Slicing Sliding_Window_Algorithm Smith_Normal_Form Smooth_Manifolds Sort_Encodings Source_Coding_Theorem Special_Function_Bounds Splay_Tree Sqrt_Babylonian Stable_Matching Statecharts Stateful_Protocol_Composition_and_Typing Stellar_Quorums Stern_Brocot Stewart_Apollonius Stirling_Formula Stochastic_Matrices Stone_Algebras Stone_Kleene_Relation_Algebras Stone_Relation_Algebras Store_Buffer_Reduction Stream-Fusion Stream_Fusion_Code Strong_Security Sturm_Sequences Sturm_Tarski Stuttering_Equivalence Subresultants Subset_Boolean_Algebras SumSquares +Sunflowers SuperCalc Surprise_Paradox Symmetric_Polynomials Syntax_Independent_Logic Szpilrajn TESL_Language TLA Tail_Recursive_Functions Tarskis_Geometry Taylor_Models Timed_Automata Topological_Semantics Topology TortoiseHare Transcendence_Series_Hancl_Rucki Transformer_Semantics Transition_Systems_and_Automata Transitive-Closure Transitive-Closure-II Treaps Tree-Automata Tree_Decomposition Triangle Trie Twelvefold_Way Tycon Types_Tableaus_and_Goedels_God UPF UPF_Firewall UTP Universal_Turing_Machine UpDown_Scheme Valuation VectorSpace VeriComp Verified-Prover Verified_SAT_Based_AI_Planning VerifyThis2018 VerifyThis2019 Vickrey_Clarke_Groves VolpanoSmith WHATandWHERE_Security WOOT_Strong_Eventual_Consistency WebAssembly Weight_Balanced_Trees Well_Quasi_Orders Winding_Number_Eval Word_Lib WorkerWrapper XML ZFC_in_HOL Zeta_3_Irrational Zeta_Function pGCL diff --git a/thys/Sunflowers/Erdos_Rado_Sunflower.thy b/thys/Sunflowers/Erdos_Rado_Sunflower.thy new file mode 100644 --- /dev/null +++ b/thys/Sunflowers/Erdos_Rado_Sunflower.thy @@ -0,0 +1,358 @@ +(* author: R. Thiemann *) + +section \The Sunflower Lemma\ + +text \We formalize the proof of the sunflower lemma of Erdős and Rado~\cite{erdos_rado}, +as it is presented in the textbook~\cite[Chapter~6]{book}. +We further integrate Exercise 6.2 from the textbook, +which provides a lower bound on the existence of sunflowers.\ + +theory Erdos_Rado_Sunflower + imports + Sunflower +begin + +text \When removing an element from all subsets, then one can afterwards + add these elements to a sunflower and get a new sunflower.\ + +lemma sunflower_remove_element_lift: + assumes S: "S \ { A - {a} | A . A \ F \ a \ A}" + and sf: "sunflower S" + shows "\ Sa. sunflower Sa \ Sa \ F \ card Sa = card S \ Sa = insert a ` S" +proof (intro exI[of _ "insert a ` S"] conjI refl) + let ?Sa = "insert a ` S" + { + fix B + assume "B \ ?Sa" + then obtain C where C: "C \ S" and B: "B = insert a C" + by auto + from C S obtain T where "T \ F" "a \ T" "C = T - {a}" + by auto + with B have "B = T" by auto + with \T \ F\ have "B \ F" by auto + } + thus SaF: "?Sa \ F" by auto + have inj: "inj_on (insert a) S" using S + by (intro inj_on_inverseI[of _ "\ B. B - {a}"], auto) + thus "card ?Sa = card S" by (rule card_image) + show "sunflower ?Sa" unfolding sunflower_def + proof (intro allI, intro impI) + fix x + assume "\C D. C \ ?Sa \ D \ ?Sa \ C \ D \ x \ C \ x \ D" + then obtain C D where *: "C \ ?Sa" "D \ ?Sa" "C \ D" "x \ C" "x \ D" + by auto + from *(1-2) obtain C' D' where + **: "C' \ S" "D' \ S" "C = insert a C'" "D = insert a D'" + by auto + with \C \ D\ inj have CD': "C' \ D'" by auto + show "\E. E \ ?Sa \ x \ E" + proof (cases "x = a") + case False + with * ** have "x \ C'" "x \ D'" by auto + with ** CD' have "\C D. C \ S \ D \ S \ C \ D \ x \ C \ x \ D" by auto + from sf[unfolded sunflower_def, rule_format, OF this] + show ?thesis by auto + qed auto + qed +qed + +text \The sunflower-lemma of Erdős and Rado: + if a set has a certain size and all elements + have the same cardinality, then a sunflower exists.\ + +lemma Erdos_Rado_sunflower_same_card: + assumes "\ A \ F. finite A \ card A = k" + and "card F > (r - 1)^k * fact k" + shows "\ S. S \ F \ sunflower S \ card S = r \ {} \ S" + using assms +proof (induct k arbitrary: F) + case 0 + hence "F = {{}} \ F = {}" "card F \ 2" by auto + hence False by auto + thus ?case by simp +next + case (Suc k F) + define pd_sub :: "'a set set \ nat \ bool" where + "pd_sub = (\ G t. G \ F \ card G = t \ pairwise disjnt G \ {} \ G)" + show ?case + proof (cases "\ t G. pd_sub G t \ t \ r") + case True + then obtain t G where pd_sub: "pd_sub G t" and t: "t \ r" by auto + from pd_sub[unfolded pd_sub_def] pairwise_disjnt_imp_sunflower + have *: "G \ F" "card G = t" "sunflower G" "{} \ G" by auto + from t \card G = t\ obtain H where "H \ G" "card H = r" + by (metis obtain_subset_with_card_n) + with sunflower_subset[OF \H \ G\] * show ?thesis by blast + next + case False + define P where "P = (\ t. \ G. pd_sub G t)" + have ex: "\ t. P t" unfolding P_def + by (intro exI[of _ 0] exI[of _ "{}"], auto simp: pd_sub_def) + have large': "\ t. P t \ t < r" using False unfolding P_def by auto + hence large: "\ t. P t \ t \ r" by fastforce + define t where "t = (GREATEST t. P t)" + from GreatestI_ex_nat[OF ex large, folded t_def] have Pt: "P t" . + from Greatest_le_nat[of P, OF _ large] + have greatest: "\ s. P s \ s \ t" unfolding t_def by auto + from large'[OF Pt] have tr: "t \ r - 1" by simp + from Pt[unfolded P_def pd_sub_def] obtain G where + cardG: "card G = t" and + disj: "pairwise disjnt G" and + GF: "G \ F" + by blast + define A where "A = (\ G)" + from Suc(3) have "card F > 0" by simp + hence "finite F" by (rule card_ge_0_finite) + from GF \finite F\ have finG: "finite G" by (rule finite_subset) + have "card (\ G) \ sum card G" + by (rule card_Union_le_sum_card, insert Suc(2) GF, auto) + also have "\ \ of_nat (card G) * Suc k" + by (rule sum_bounded_above, insert GF Suc(2), auto) + also have "\ \ (r - 1) * Suc k" + using tr[folded cardG] by (metis id_apply mult_le_mono1 of_nat_eq_id) + finally have cardA: "card A \ (r - 1) * Suc k" unfolding A_def . + { + fix B + assume *: "B \ F" + with Suc(2) have nE: "B \ {}" by auto + from Suc(2) have eF: "{} \ F" by auto + have "B \ A \ {}" + proof + assume dis: "B \ A = {}" + hence disj: "pairwise disjnt ({B} \ G)" using disj unfolding A_def + by (smt (verit, ccfv_SIG) Int_commute Un_iff + Union_disjoint disjnt_def pairwise_def singleton_iff) + from nE dis have "B \ G" unfolding A_def by auto + with finG have c: "card ({B} \ G) = Suc t" by (simp add: cardG) + have "P (Suc t)" unfolding P_def pd_sub_def + by (intro exI[of _ "{B} \ G"], insert eF disj c * GF, auto) + with greatest show False by force + qed + } note overlap = this + have "F \ {}" using Suc(2-) by auto + with overlap have Ane: "A \ {}" unfolding A_def by auto + have "finite A" unfolding A_def using finG Suc(2-) GF by auto + let ?g = "\ B x. x \ B \ A" + define f where "f = (\ B. SOME x. ?g B x)" + have "f \ F \ A" + proof + fix B + assume "B \ F" + from overlap[OF this] have "\ x. ?g B x" unfolding A_def by auto + from someI_ex[OF this] show "f B \ A" unfolding f_def by auto + qed + from pigeonhole_card[OF this \finite F\ \finite A\ Ane] + obtain a where a: "a \ A" + and le: "card F \ card (f -` {a} \ F) * card A" by auto + { + fix S + assume "S \ F" "f S \ {a}" + with someI_ex[of "?g S"] a overlap[OF this(1)] + have "a \ S" unfolding f_def by auto + } note FaS = this + let ?F = "{S - {a} | S . S \ F \ f S \ {a}}" + from cardA have "((r - 1) ^ k * fact k) * card A \ ((r - 1) ^ k * fact k) * ((r - 1) * Suc k)" + by simp + also have "\ = (r - 1) ^ (Suc k) * fact (Suc k)" + by (metis (no_types, lifting) fact_Suc mult.assoc mult.commute of_nat_id power_Suc2) + also have "\ < card (f -` {a} \ F) * card A" + using Suc(3) le by auto + also have "f -` {a} \ F = {S \ F. f S \ {a}}" by auto + also have "card \ = card ((\ S. S - {a}) ` {S \ F. f S \ {a}})" + by (subst card_image; intro inj_onI refl, insert FaS) auto + also have "(\ S. S - {a}) ` {S \ F. f S \ {a}} = ?F" by auto + finally have lt: "(r - 1) ^ k * fact k < card ?F" by simp + have "\ A \ ?F. finite A \ card A = k" using Suc(2) FaS by auto + from Suc(1)[OF this lt] obtain S + where "sunflower S" "card S = r" "S \ ?F" by auto + from \S \ ?F\ FaS have "S \ {A - {a} |A. A \ F \ a \ A}" by auto + from sunflower_remove_element_lift[OF this \sunflower S\] \card S = r\ + show ?thesis by auto + qed +qed + +text \Using @{thm [source] sunflower_card_subset_lift} we can easily + replace the condition that the cardinality is exactly @{term k} + by the requirement that the cardinality is at most @{term k}. + However, then @{term "{} \ S"} cannot be ensured. + Consider @{term "(r :: nat) = 1 \ (k :: nat) > 0 \ F = {{}}"}.\ + +lemma Erdos_Rado_sunflower: + assumes "\ A \ F. finite A \ card A \ k" + and "card F > (r - 1)^k * fact k" + shows "\ S. S \ F \ sunflower S \ card S = r" + by (rule sunflower_card_subset_lift[OF _ assms], + metis Erdos_Rado_sunflower_same_card) + +text \We further provide a lower bound on the existence of sunflowers, +i.e., Exercise 6.2 of the textbook~\cite{book}. +To be more precise, we prove that there is a set of sets of cardinality +@{term \(r - 1 :: nat)^k\}, where each element is a set of cardinality +@{term k}, such that there is no subset which is a sunflower with cardinality +of at least @{term r}.\ + +lemma sunflower_lower_bound: + assumes inf: "infinite (UNIV :: 'a set)" + and r: "r \ 0" + and rk: "r = 1 \ k \ 0" + shows "\ F. + card F = (r - 1)^k \ finite F \ + (\ A \ F. finite (A :: 'a set) \ card A = k) \ + (\ S. S \ F \ sunflower S \ card S \ r)" +proof (cases "r = 1") + case False + with r have r: "r > 1" by auto + show ?thesis + proof (induct k) + case 0 + have id: "S \ {{}} \ (S = {} \ S = {{}})" for S :: "'a set set" by auto + show ?case using r + by (intro exI[of _ "{{}}"], auto simp: id) + next + case (Suc k) + then obtain F where + cardF: "card F = (r - 1) ^ k" and + fin: "finite F" and + AF: "\ A. (A :: 'a set) \ F \ finite A \ card A = k" and + sf: "\ (\S\F. sunflower S \ r \ card S)" + by metis + text \main idea: get @{term "k-1 :: nat"} fresh elements + and add one of these to all elements of F\ + have "finite (\ F)" using fin AF by simp + hence "infinite (UNIV - \ F)" using inf by simp + from infinite_arbitrarily_large[OF this, of "r - 1"] + obtain New where New: "finite New" "card New = r - 1" + "New \ \ F = {}" by auto + define G where "G = (\ (A, a). insert a A) ` (F \ New)" + show ?case + proof (intro exI[of _ G] conjI) + show "finite G" using New fin unfolding G_def by simp + have "card G = card (F \ New)" unfolding G_def + proof ((subst card_image; (intro refl)?), intro inj_onI, clarsimp, goal_cases) + case (1 A a B b) + hence ab: "a = b" using New by auto + from 1(1) have "insert a A - {a} = insert b B - {a}" by simp + also have "insert a A - {a} = A" using New 1 by auto + also have "insert b B - {a} = B" using New 1 ab[symmetric] by auto + finally show ?case using ab by auto + qed + also have "\ = card F * card New" using New fin by auto + finally show "card G = (r - 1) ^ Suc k" + unfolding cardF New by simp + { + fix B + assume "B \ G" + then obtain a A where G: "a \ New" "A \ F" "B = insert a A" + unfolding G_def by auto + with AF[of A] New have "finite B" "card B = Suc k" + by (auto simp: card_insert_if) + } + thus "\A\G. finite A \ card A = Suc k" by auto + show "\ (\S\G. sunflower S \ r \ card S)" + proof (intro notI, elim exE conjE) + fix S + assume *: "S \ G" "sunflower S" "r \ card S" + define g where "g B = (SOME a. a \ New \ a \ B)" for B + { + fix B + assume "B \ S" + with \S \ G\ have "B \ G" by auto + hence "\ a. a \ New \ a \ B" unfolding G_def by auto + from someI_ex[OF this, folded g_def] + have "g B \ New" "g B \ B" by auto + } note gB = this + have "card (g ` S) \ card New" + by (rule card_mono, insert New gB, auto) + also have "\ < r" unfolding New using r by simp + also have "\ \ card S" by fact + finally have "card (g ` S) < card S" . + from pigeonhole[OF this] have "\ inj_on g S" . + then obtain B1 B2 where B12: "B1 \ S" "B2 \ S" "B1 \ B2" "g B1 = g B2" + unfolding inj_on_def by auto + define a where "a = g B2" + from B12 gB[of B1] gB[of B2] have a: "a \ New" "a \ B1" "a \ B2" + unfolding a_def by auto + with B12 have "\B1 B2. B1 \ S \ B2 \ S \ B1 \ B2 \ a \ B1 \ a \ B2" + unfolding a_def by blast + from \sunflower S\[unfolded sunflower_def, rule_format, OF this] + have aS: "B \ S \ a \ B" for B by auto + define h where "h B = B - {a}" for B + define T where "T = h ` S" + have "\S\F. sunflower S \ r \ card S" + proof (intro exI[of _ T] conjI) + { + fix B + assume "B \ S" + have hB: "h B = B - {a}" + unfolding h_def T_def by auto + from aS \B \ S\ have aB: "a \ B" by auto + from \B \ S\ \S \ G\ obtain a' A where AF: "A \ F" + and B: "B = insert a' A" + and a': "a' \ New" unfolding G_def by force + from aB B a' New AF a(1) hB AF have "insert a (h B) = B" "h B = A" by auto + hence "insert a (h B) = B" "h B \ F" "insert a (h B) \ S" using AF \B \ S\ by auto + } note main = this + have CTS: "C \ T \ insert a C \ S" for C using main unfolding T_def by force + show "T \ F" unfolding T_def using main by auto + have "r \ card S" by fact + also have "\ = card T" unfolding T_def + by (subst card_image, intro inj_on_inverseI[of _ "insert a"], insert main, auto) + finally show "r \ card T" . + show "sunflower T" unfolding sunflower_def + proof (intro allI impI, elim exE conjE, goal_cases) + case (1 x C C1 C2) + from CTS[OF \C1 \ T\] CTS[OF \C2 \ T\] CTS[OF \C \ T\] + have *: "insert a C1 \ S" "insert a C2 \ S" "insert a C \ S" by auto + from 1 have "insert a C1 \ insert a C2" using main + unfolding T_def by auto + hence "\A B. A \ S \ B \ S \ A \ B \ x \ A \ x \ B" + using * 1 by auto + from \sunflower S\[unfolded sunflower_def, rule_format, OF this *(3)] + have "x \ insert a C" . + with 1 show "x \ C" unfolding T_def h_def by auto + qed + qed + with sf + show False .. + qed + qed + qed +next + case r: True + with rk have "k \ 0" by auto + then obtain l where k: "k = Suc l" by (cases k, auto) + show ?thesis unfolding r k + by (intro exI[of _ "{}"], auto) +qed + +text \The difference between the lower and the +upper bound on the existence of sunflowers as they have been formalized +is @{term \fact k\}. There is more recent work with tighter bounds +\cite{sunflower_new}, but we only integrate the initial +result of Erdős and Rado in this theory.\ + +text \We further provide the Erdős Rado lemma + lifted to obtain non-empty cores or cores of arbitrary cardinality.\ + +lemma Erdos_Rado_sunflower_card_core: + assumes "finite E" + and "\ A \ F. A \ E \ s \ card A \ card A \ k" + and "card F > (card E choose s) * (r - 1)^k * fact k" + and "s \ 0" + and "r \ 0" + shows "\ S. S \ F \ sunflower S \ card S = r \ card (\ S) \ s" + by (rule sunflower_card_core_lift[OF assms(1) _ assms(2) _ assms(4-5), + of "(r - 1)^k * fact k"], + rule Erdos_Rado_sunflower, insert assms(3), auto simp: ac_simps) + +lemma Erdos_Rado_sunflower_nonempty_core: + assumes "finite E" + and "\ A \ F. A \ E \ card A \ k" + and "{} \ F" + and "card F > card E * (r - 1)^k * fact k" + shows "\ S. S \ F \ sunflower S \ card S = r \ \ S \ {}" + by (rule sunflower_nonempty_core_lift[OF assms(1) + _ assms(2-3), of "(r - 1)^k * fact k"], + rule Erdos_Rado_sunflower, insert assms(4), auto simp: ac_simps) + +end \ No newline at end of file diff --git a/thys/Sunflowers/ROOT b/thys/Sunflowers/ROOT new file mode 100644 --- /dev/null +++ b/thys/Sunflowers/ROOT @@ -0,0 +1,11 @@ +chapter AFP + +session Sunflowers (AFP) = HOL + + options [timeout = 600] + sessions + "HOL-Library" + theories + Erdos_Rado_Sunflower + document_files + "root.bib" + "root.tex" diff --git a/thys/Sunflowers/Sunflower.thy b/thys/Sunflowers/Sunflower.thy new file mode 100644 --- /dev/null +++ b/thys/Sunflowers/Sunflower.thy @@ -0,0 +1,295 @@ +(* author: R. Thiemann *) + +section \Sunflowers\ + +text \Sunflowers are sets of sets, such that whenever an element + is contained in at least two of the sets, + then it is contained in all of the sets.\ + +theory Sunflower + imports Main + "HOL-Library.FuncSet" +begin + +definition sunflower :: "'a set set \ bool" where + "sunflower S = (\ x. (\ A B. A \ S \ B \ S \ A \ B \ + x \ A \ x \ B) + \ (\ A. A \ S \ x \ A))" + +lemma sunflower_subset: "F \ G \ sunflower G \ sunflower F" + unfolding sunflower_def by blast + +lemma pairwise_disjnt_imp_sunflower: + "pairwise disjnt F \ sunflower F" + unfolding sunflower_def + by (metis disjnt_insert1 mk_disjoint_insert pairwiseD) + +lemma card2_sunflower: assumes "finite S" and "card S \ 2" + shows "sunflower S" +proof - + from assms have "card S = 0 \ card S = Suc 0 \ card S = 2" by linarith + with \finite S\ obtain A B where "S = {} \ S = {A} \ S = {A,B}" + using card_2_iff[of S] card_1_singleton_iff[of S] by auto + thus ?thesis unfolding sunflower_def by auto +qed + +lemma empty_sunflower: "sunflower {}" + by (rule card2_sunflower, auto) + +lemma singleton_sunflower: "sunflower {A}" + by (rule card2_sunflower, auto) + +lemma doubleton_sunflower: "sunflower {A,B}" + by (rule card2_sunflower, auto, cases "A = B", auto) + +lemma sunflower_imp_union_intersect_unique: + assumes "sunflower S" + and "x \ (\ S) - (\ S)" + shows "\! A. A \ S \ x \ A" +proof - + from assms obtain A where A: "A \ S" "x \ A" by auto + show ?thesis + proof + show "A \ S \ x \ A" using A by auto + fix B + assume B: "B \ S \ x \ B" + show "B = A" + proof (rule ccontr) + assume "B \ A" + with A B have "\A B. A \ S \ B \ S \ A \ B \ x \ A \ x \ B" by auto + from \sunflower S\[unfolded sunflower_def, rule_format, OF this] + have "x \ \ S" by auto + with assms show False by auto + qed + qed +qed + +lemma union_intersect_unique_imp_sunflower: + assumes "\ x. x \ (\ S) - (\ S) \ \\<^sub>\\<^sub>1 A. A \ S \ x \ A" + shows "sunflower S" + unfolding sunflower_def +proof (intro allI impI, elim exE conjE, goal_cases) + case (1 x C A B) + hence x: "x \ \ S" by auto + show ?case + proof (cases "x \ \ S") + case False + with assms[of x] x have "\\<^sub>\\<^sub>1 A. A \ S \ x \ A" by blast + with 1 have False unfolding Uniq_def by blast + thus ?thesis .. + next + case True + with 1 show ?thesis by blast + qed +qed + +lemma sunflower_iff_union_intersect_unique: + "sunflower S \ (\ x \ \ S - \ S. \! A. A \ S \ x \ A)" + (is "?l = ?r") +proof + assume ?l + from sunflower_imp_union_intersect_unique[OF this] + show ?r by auto +next + assume ?r + hence *: "\x\\ S - \ S. \\<^sub>\\<^sub>1 A. A \ S \ x \ A" + unfolding ex1_iff_ex_Uniq by auto + show ?l + by (rule union_intersect_unique_imp_sunflower, insert *, auto) +qed + +lemma sunflower_iff_intersect_Uniq: + "sunflower S \ (\ x. x \ \ S \ (\\<^sub>\\<^sub>1 A. A \ S \ x \ A))" + (is "?l = ?r") +proof + assume ?l + from sunflower_imp_union_intersect_unique[OF this] + show ?r unfolding ex1_iff_ex_Uniq + by (metis (no_types, lifting) DiffI UnionI Uniq_I) +next + assume ?r + show ?l + by (rule union_intersect_unique_imp_sunflower, insert \?r\, auto) +qed + +text \If there exists sunflowers whenever all elements are sets of + the same cardinality @{term r}, then there also exists sunflowers + whenever all elements are sets with cardinality at most @{term r}.\ + +lemma sunflower_card_subset_lift: fixes F :: "'a set set" + assumes sunflower: "\ G :: ('a + nat) set set. + (\ A \ G. finite A \ card A = k) \ card G > c + \ \ S. S \ G \ sunflower S \ card S = r" + and kF: "\ A \ F. finite A \ card A \ k" + and cardF: "card F > c" + shows "\ S. S \ F \ sunflower S \ card S = r" +proof - + let ?n = "Suc c" + from cardF have "card F \ ?n" by auto + then obtain FF where sub: "FF \ F" and cardF: "card FF = ?n" + by (rule obtain_subset_with_card_n) + let ?N = "{0 ..< ?n}" + from cardF have "finite FF" + by (simp add: card_ge_0_finite) + from ex_bij_betw_nat_finite[OF this, unfolded cardF] + obtain f where f: "bij_betw f ?N FF" by auto + hence injf: "inj_on f ?N" by (rule bij_betw_imp_inj_on) + have Ff: "FF = f ` ?N" + by (metis bij_betw_imp_surj_on f) + define g where "g = (\ i. (Inl ` f i) \ (Inr ` {0 ..< (k - card (f i))}))" + have injg: "inj_on g ?N" unfolding g_def using f + proof (intro inj_onI, goal_cases) + case (1 x y) + hence "f x = f y" by auto + with injf 1 show "x = y" + by (meson inj_onD) + qed + hence cardgN: "card (g ` ?N) > c" + by (simp add: card_image) + { + fix i + assume "i \ ?N" + hence "f i \ FF" unfolding Ff by auto + with sub have "f i \ F" by auto + hence "card (f i) \ k" "finite (f i)" using kF by auto + hence "card (g i) = k \ finite (g i)" unfolding g_def + by (subst card_Un_disjoint, auto, subst (1 2) card_image, auto intro: inj_onI) + } + hence "\ A \ g ` ?N. finite A \ card A = k" by auto + from sunflower[OF this cardgN] + obtain S where SgN: "S \ g ` ?N" and sf: "sunflower S" and card: "card S = r" by auto + from SgN obtain N where NN: "N \ ?N" and SgN: "S = g ` N" + by (meson subset_image_iff) + from injg NN have inj_g: "inj_on g N" + by (rule inj_on_subset) + from injf NN have inj_f: "inj_on f N" + by (rule inj_on_subset) + from card_image[OF inj_g] SgN card + have cardN: "card N = r" by auto + let ?S = "f ` N" + show ?thesis + proof (intro exI[of _ ?S] conjI) + from NN show "?S \ F" using Ff sub by auto + from card_image[OF inj_f] cardN show "card ?S = r" by auto + show "sunflower ?S" unfolding sunflower_def + proof (intro allI impI, elim exE conjE, goal_cases) + case (1 x C A B) + from \A \ f ` N\ obtain i where i: "i \ N" and A: "A = f i" by auto + from \B \ f ` N\ obtain j where j: "j \ N" and B: "B = f j" by auto + from \C \ f ` N\ obtain k where k: "k \ N" and C: "C = f k" by auto + hence gk: "g k \ g ` N" by auto + from \A \ B\ A B have ij: "i \ j" by auto + from inj_g ij i j have gij: "g i \ g j" by (metis inj_on_contraD) + from \x \ A\ have memi: "Inl x \ g i" unfolding A g_def by auto + from \x \ B\ have memj: "Inl x \ g j" unfolding B g_def by auto + have "\A B. A \ g ` N \ B \ g ` N \ A \ B \ Inl x \ A \ Inl x \ B" + using memi memj gij i j by auto + from sf[unfolded sunflower_def SgN, rule_format, OF this gk] have "Inl x \ g k" . + thus "x \ C" unfolding C g_def by auto + qed + qed +qed + +text \We provide another sunflower lifting lemma that ensures + non-empty cores. Here, all elements must be taken + from a finite set, and the bound is multiplied the cardinality.\ + +lemma sunflower_card_core_lift: + assumes finE: "finite (E :: 'a set)" + and sunflower: "\ G :: 'a set set. + (\ A \ G. finite A \ card A \ k) \ card G > c + \ \ S. S \ G \ sunflower S \ card S = r" + and F: "\ A \ F. A \ E \ s \ card A \ card A \ k" + and cardF: "card F > (card E choose s) * c" + and s: "s \ 0" + and r: "r \ 0" + shows "\ S. S \ F \ sunflower S \ card S = r \ card (\ S) \ s" +proof - + let ?g = "\ (A :: 'a set) x. card x = s \ x \ A" + let ?E = "{X. X \ E \ card X = s}" + from cardF have finF: "finite F" + by (metis card.infinite le_0_eq less_le) + from cardF have FnE: "F \ {}" by force + { + from FnE obtain B where B: "B \ F" by auto + with F[rule_format, OF B] obtain A where "A \ E" "card A = s" + by (meson obtain_subset_with_card_n order_trans) + hence "?E \ {}" using B by auto + } note EnE = this + define f where "f = (\ A. SOME x. ?g A x)" + from finE have finiteE: "finite ?E" by simp + + have "f \ F \ ?E" + proof + fix B + assume B: "B \ F" + with F[rule_format, OF B] have "\ x. ?g B x" by (meson obtain_subset_with_card_n) + from someI_ex[OF this] B F show "f B \ ?E" unfolding f_def by auto + qed + from pigeonhole_card[OF this finF finiteE EnE] + obtain a where a: "a \ ?E" + and le: "card F \ card (f -` {a} \ F) * card ?E" by auto + have precond: "\A\f -` {a} \ F. finite A \ card A \ k" + using F finite_subset[OF _ finE] by auto + have "c * (card E choose s) = (card E choose s) * c" by simp + also have "\ < card F" by fact + also have "\ \ (card (f -` {a} \ F)) * card ?E" by fact + also have "card ?E = card E choose s" by (rule n_subsets[OF finE]) + finally have "c < card (f -` {a} \ F)" by auto + from sunflower[OF precond this] + obtain S where *: "S \ f -` {a} \ F" "sunflower S" "card S = r" + by auto + from finite_subset[OF _ finF, of S] + have finS: "finite S" using * by auto + from * r have SnE: "S \ {}" by auto + have finIS: "finite (\ S)" + proof (rule finite_Inter) + from SnE obtain A where A: "A \ S" by auto + with F s have "finite A" + using * precond by blast + thus "\A\S. finite A" using A by auto + qed + show ?thesis + proof (intro exI[of _ S] conjI *) + show "S \ F" using * by auto + { + fix A + assume "A \ S" + with *(1) have "A \ f -` {a}" and A: "A \ F" using * by auto + from this have **: "f A = a" "A \ F" by auto + from F[rule_format, OF A] have "\x. card x = s \ x \ A" + by (meson obtain_subset_with_card_n order_trans) + from someI_ex[of "?g A", OF this] ** + have "a \ A" unfolding f_def by auto + } + hence "a \ \ S" by auto + from card_mono[OF finIS this] + have "card a \ card (\ S)" . + with a show "s \ card (\ S)" by auto + qed +qed + +lemma sunflower_nonempty_core_lift: + assumes finE: "finite (E :: 'a set)" + and sunflower: "\ G :: 'a set set. + (\ A \ G. finite A \ card A \ k) \ card G > c + \ \ S. S \ G \ sunflower S \ card S = r" + and F: "\ A \ F. A \ E \ card A \ k" + and empty: "{} \ F" + and cardF: "card F > card E * c" + shows "\ S. S \ F \ sunflower S \ card S = r \ (\ S) \ {}" +proof (cases "r = 0") + case False + from F empty have F': "\A\F. A \ E \ 1 \ card A \ card A \ k " using finE + by (metis One_nat_def Suc_leI card_gt_0_iff finite_subset) + from cardF have cardF': "(card E choose 1) * c < card F" by auto + from sunflower_card_core_lift[OF finE sunflower, of k c F 1, OF _ _ F' cardF' _ False] + obtain S where "S \ F" and main: "sunflower S" "card S = r" "1 \ card (\ S)" by auto + thus ?thesis by (intro exI[of _ S], auto) +next + case True + thus ?thesis by (intro exI[of _ "{}"], auto simp: empty_sunflower) +qed + + +end \ No newline at end of file diff --git a/thys/Sunflowers/document/root.bib b/thys/Sunflowers/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Sunflowers/document/root.bib @@ -0,0 +1,46 @@ +@preamble(" + \newcommand{\doi}[1]{%\newline + \href{http://dx.doi.org/#1}{\nolinkurl{doi:#1}}}") + +@book{book, + author={Stasys Jukna}, + title={Extremal Combinatorics}, + publisher={Springer}, + series = {Texts in Theoretical Computer Science. An {EATCS} Series}, + year=2011, + chapter=6, + doi={10.1007/978-3-642-17364-6_6}, + note = {\doi{10.1007/978-3-642-17364-6_6}}, +} + +@inproceedings{sunflower_new, + author = {Ryan Alweiss and + Shachar Lovett and + Kewen Wu and + Jiapeng Zhang}, + opteditor = {Konstantin Makarychev and + Yury Makarychev and + Madhur Tulsiani and + Gautam Kamath and + Julia Chuzhoy}, + title = {Improved bounds for the sunflower lemma}, + booktitle = {Proccedings of the 52nd Annual {ACM} {SIGACT} Symposium on Theory + of Computing, {STOC} 2020}, + pages = {624--630}, + publisher = {{ACM}}, + year = {2020}, + doi = {10.1145/3357713.3384234}, + note = {\doi{10.1145/3357713.3384234}}, +} + +@article{erdos_rado, + title = {Intersection theorems for systems of sets}, + author = {Paul Erdős and Richard Rado}, + year = 1960, + journal = {Journal of the London Mathematical Society}, + volume = 35, + issue = 1, + pages = {85--90}, + doi = {10.1112/jlms/s1-35.1.85}, + note = {\doi{10.1112/jlms/s1-35.1.85}}, +} \ No newline at end of file diff --git a/thys/Sunflowers/document/root.tex b/thys/Sunflowers/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Sunflowers/document/root.tex @@ -0,0 +1,36 @@ +\documentclass[11pt,a4paper]{article} +\usepackage{isabelle,isabellesym} + +\usepackage{amsmath} +\usepackage{amssymb} + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{it} + + +\begin{document} + +\title{The Sunflower Lemma of Erdős and Rado} +\author{René Thiemann} +\maketitle + +\begin{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 \cdot k!$, then it contains a sunflower of cardinality $r$. +\end{abstract} + +% include generated text of all theories +\input{session} + +% optional bibliography +%\addcontentsline{toc}{section}{Bibliography} +%\nocite{*} +\bibliographystyle{plain} +\bibliography{root} + +\end{document} diff --git a/web/about.html b/web/about.html --- a/web/about.html +++ b/web/about.html @@ -1,144 +1,146 @@ Archive of Formal Proofs

 

 

 

 

 

 

Archive of Formal Proofs

 

About

The Archive of Formal Proofs is a collection of proof libraries, examples, and larger scientific developments, mechanically checked in the theorem prover Isabelle. It is organized in the way of a scientific journal. Submissions are refereed.

The archive repository is hosted on Heptapod to provide easy free access to archive entries. The entries are tested and maintained continuously against the current stable release of Isabelle. Older versions of archive entries will remain available.

Editors

The editors of the archive are

Why

We aim to strengthen the community and to foster the development of formal proofs.

We hope that the archive will provide

  • a resource of knowledge, examples, and libraries for users,
  • a large and relevant test bed of theories for Isabelle developers, and
  • a central, citable place for authors to publish their theories

We encourage authors of publications that contain Isabelle developments to make their theories available in the Archive of Formal Proofs and to refer to the archive entry in their publication. It makes it easier for referees to check the validity of theorems (all entries in the archive are mechanically checked), it makes it easier for readers of the publication to understand details of your development, and it makes it easier to use and build on your work.

License

All entries in the Archive of Formal Proofs are licensed under a BSD-style License or the GNU LGPL. This means they are free to download, free to use, free to change, and free to redistribute with minimal restrictions.

The authors retain their full copyright on their original work, including their right to make the development available under another, additional license in the future.

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

 

 

 

 

 

 

Abstract Rewriting

 

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

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

 

 

 

 

 

 

Algebraic Numbers in Isabelle/HOL

 

- +
Title: Algebraic Numbers in Isabelle/HOL
Authors: - René Thiemann, + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at), Akihisa Yamada and Sebastiaan Joosten
Contributor: Manuel Eberl
Submission date: 2015-12-22
Abstract: Based on existing libraries for matrices, factorization of rational polynomials, and Sturm's theorem, we formalized algebraic numbers in Isabelle/HOL. Our development serves as an implementation for real and complex numbers, and it admits to compute roots and completely factorize real and complex polynomials, provided that all coefficients are rational numbers. Moreover, we provide two implementations to display algebraic numbers, an injective and expensive one, or a faster but approximative version.

To this end, we mechanized several results on resultants, which also required us to prove that polynomials over a unique factorization domain form again a unique factorization domain.

Change history: [2016-01-29]: Split off Polynomial Interpolation and Polynomial Factorization
[2017-04-16]: Use certified Berlekamp-Zassenhaus factorization, use subresultant algorithm for computing resultants, improved bisection algorithm
BibTeX:
@article{Algebraic_Numbers-AFP,
   author  = {René Thiemann and Akihisa Yamada and Sebastiaan Joosten},
   title   = {Algebraic Numbers in Isabelle/HOL},
   journal = {Archive of Formal Proofs},
   month   = dec,
   year    = 2015,
   note    = {\url{https://isa-afp.org/entries/Algebraic_Numbers.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Berlekamp_Zassenhaus, Sturm_Sequences
Used by:LLL_Basis_Reduction
Hermite_Lindemann, LLL_Basis_Reduction

\ No newline at end of file diff --git a/web/entries/AnselmGod.html b/web/entries/AnselmGod.html --- a/web/entries/AnselmGod.html +++ b/web/entries/AnselmGod.html @@ -1,223 +1,223 @@ Anselm's God in Isabelle/HOL - Archive of Formal Proofs

 

 

 

 

 

 

Anselm's God in Isabelle/HOL

 

Title: Anselm's God in Isabelle/HOL
Author: - Ben Blumson + Ben Blumson
Submission date: 2017-09-06
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.
BibTeX:
@article{AnselmGod-AFP,
   author  = {Ben Blumson},
   title   = {Anselm's God in Isabelle/HOL},
   journal = {Archive of Formal Proofs},
   month   = sep,
   year    = 2017,
   note    = {\url{https://isa-afp.org/entries/AnselmGod.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License

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

 

 

 

 

 

 

The Factorization Algorithm of Berlekamp and Zassenhaus

 

Title: The Factorization Algorithm of Berlekamp and Zassenhaus
Authors: Jose Divasón, Sebastiaan Joosten, - René Thiemann and + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and Akihisa Yamada
Submission date: 2016-10-14
Abstract:

We formalize the Berlekamp-Zassenhaus algorithm for factoring square-free integer polynomials in Isabelle/HOL. We further adapt an existing formalization of Yun’s square-free factorization algorithm to integer polynomials, and thus provide an efficient and certified factorization algorithm for arbitrary univariate polynomials.

The algorithm first performs a factorization in the prime field GF(p) and then performs computations in the integer ring modulo p^k, where both p and k are determined at runtime. Since a natural modeling of these structures via dependent types is not possible in Isabelle/HOL, we formalize the whole algorithm using Isabelle’s recent addition of local type definitions.

Through experiments we verify that our algorithm factors polynomials of degree 100 within seconds.

BibTeX:
@article{Berlekamp_Zassenhaus-AFP,
   author  = {Jose Divasón and Sebastiaan Joosten and René Thiemann and Akihisa Yamada},
   title   = {The Factorization Algorithm of Berlekamp and Zassenhaus},
   journal = {Archive of Formal Proofs},
   month   = oct,
   year    = 2016,
   note    = {\url{https://isa-afp.org/entries/Berlekamp_Zassenhaus.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Used by: Algebraic_Numbers, LLL_Basis_Reduction, Smith_Normal_Form

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

 

 

 

 

 

 

Certification Monads

 

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

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

 

 

 

 

 

 

Generating linear orders for datatypes

 

Title: Generating linear orders for datatypes
Author: - René Thiemann + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at)
Submission date: 2012-08-07
Abstract: We provide a framework for registering automatic methods to derive class instances of datatypes, as it is possible using Haskell's ``deriving Ord, Show, ...'' feature.

We further implemented such automatic methods to derive (linear) orders or hash-functions which are required in the Isabelle Collection Framework. Moreover, for the tactic of Huffman and Krauss to show that a datatype is countable, we implemented a wrapper so that this tactic becomes accessible in our framework.

Our formalization was performed as part of the IsaFoR/CeTA project. With our new tactic we could completely remove tedious proofs for linear orders of two datatypes.

This development is aimed at datatypes generated by the "old_datatype" command.

BibTeX:
@article{Datatype_Order_Generator-AFP,
   author  = {René Thiemann},
   title   = {Generating linear orders for datatypes},
   journal = {Archive of Formal Proofs},
   month   = aug,
   year    = 2012,
   note    = {\url{https://isa-afp.org/entries/Datatype_Order_Generator.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Deriving, Native_Word
Used by: Higher_Order_Terms, WOOT_Strong_Eventual_Consistency

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

 

 

 

 

 

 

Deriving class instances for datatypes

 

Title: Deriving class instances for datatypes
Authors: Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com) and - René Thiemann + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at)
Submission date: 2015-03-11
Abstract:

We provide a framework for registering automatic methods to derive class instances of datatypes, as it is possible using Haskell's ``deriving Ord, Show, ...'' feature.

We further implemented such automatic methods to derive comparators, linear orders, parametrizable equality functions, and hash-functions which are required in the Isabelle Collection Framework and the Container Framework. Moreover, for the tactic of Blanchette to show that a datatype is countable, we implemented a wrapper so that this tactic becomes accessible in our framework. All of the generators are based on the infrastructure that is provided by the BNF-based datatype package.

Our formalization was performed as part of the IsaFoR/CeTA project. With our new tactics we could remove several tedious proofs for (conditional) linear orders, and conditional equality operators within IsaFoR and the Container Framework.

BibTeX:
@article{Deriving-AFP,
   author  = {Christian Sternagel and René Thiemann},
   title   = {Deriving class instances for datatypes},
   journal = {Archive of Formal Proofs},
   month   = mar,
   year    = 2015,
   note    = {\url{https://isa-afp.org/entries/Deriving.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Collections
Used by: Affine_Arithmetic, Containers, Datatype_Order_Generator, Formula_Derivatives, Groebner_Bases, LTL_Master_Theorem, MSO_Regex_Equivalence, Real_Impl, Show

\ No newline at end of file diff --git a/web/entries/DiscretePricing.html b/web/entries/DiscretePricing.html --- a/web/entries/DiscretePricing.html +++ b/web/entries/DiscretePricing.html @@ -1,222 +1,222 @@ Pricing in discrete financial models - Archive of Formal Proofs

 

 

 

 

 

 

Pricing in discrete financial models

 

Title: Pricing in discrete financial models
Author: - Mnacho Echenim + Mnacho Echenim
Submission date: 2018-07-16
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.
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)
BibTeX:
@article{DiscretePricing-AFP,
   author  = {Mnacho Echenim},
   title   = {Pricing in discrete financial models},
   journal = {Archive of Formal Proofs},
   month   = jul,
   year    = 2018,
   note    = {\url{https://isa-afp.org/entries/DiscretePricing.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License

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

 

 

 

 

 

 

Farkas' Lemma and Motzkin's Transposition Theorem

 

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

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

 

 

 

 

 

 

First-Order Terms

 

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

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

 

 

 

 

 

 

Hermite Normal Form

 

- +
Title: Hermite Normal Form
Authors: Jose Divasón and Jesús Aransay
Submission 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.
BibTeX:
@article{Hermite-AFP,
   author  = {Jose Divasón and Jesús Aransay},
   title   = {Hermite Normal Form},
   journal = {Archive of Formal Proofs},
   month   = jul,
   year    = 2015,
   note    = {\url{https://isa-afp.org/entries/Hermite.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Echelon_Form
Used by:Smith_Normal_Form
Modular_arithmetic_LLL_and_HNF_algorithms, Smith_Normal_Form

\ No newline at end of file diff --git a/web/entries/Hermite_Lindemann.html b/web/entries/Hermite_Lindemann.html new file mode 100644 --- /dev/null +++ b/web/entries/Hermite_Lindemann.html @@ -0,0 +1,210 @@ + + + + +The Hermite–Lindemann–Weierstraß Transcendence Theorem - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +
+

 

+ + + +

 

+

 

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

 

+

 

+
+
+

 

+

The + + Hermite–Lindemann–Weierstraß + + Transcendence + + Theorem + +

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Title:The Hermite–Lindemann–Weierstraß Transcendence Theorem
+ Author: + + Manuel Eberl +
Submission date:2021-03-03
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\}$
BibTeX: +
@article{Hermite_Lindemann-AFP,
+  author  = {Manuel Eberl},
+  title   = {The Hermite–Lindemann–Weierstraß Transcendence Theorem},
+  journal = {Archive of Formal Proofs},
+  month   = mar,
+  year    = 2021,
+  note    = {\url{https://isa-afp.org/entries/Hermite_Lindemann.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
+
License:BSD License
Depends on:Algebraic_Numbers, Pi_Transcendental, Power_Sum_Polynomials
+ +

+ + + + + + + + + + + + + + + + + + +
+
+ + + + + + \ No newline at end of file diff --git a/web/entries/Isabelle_Marries_Dirac.html b/web/entries/Isabelle_Marries_Dirac.html --- a/web/entries/Isabelle_Marries_Dirac.html +++ b/web/entries/Isabelle_Marries_Dirac.html @@ -1,216 +1,218 @@ Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information - Archive of Formal Proofs

 

 

 

 

 

 

Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information

 

- + + +
Title: Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information
Authors: Anthony Bordg (apdb3 /at/ cam /dot/ ac /dot/ uk), Hanna Lachnitt (lachnitt /at/ stanford /dot/ edu) and Yijun He (yh403 /at/ cam /dot/ ac /dot/ uk)
Submission date: 2020-11-22
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.
BibTeX:
@article{Isabelle_Marries_Dirac-AFP,
   author  = {Anthony Bordg and Hanna Lachnitt and Yijun He},
   title   = {Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information},
   journal = {Archive of Formal Proofs},
   month   = nov,
   year    = 2020,
   note    = {\url{https://isa-afp.org/entries/Isabelle_Marries_Dirac.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Jordan_Normal_Form, Matrix_Tensor, VectorSpace
Used by:Projective_Measurements

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

 

 

 

 

 

 

Matrices, Jordan Normal Forms, and Spectral Radius Theory

 

- +
Title: Matrices, Jordan Normal Forms, and Spectral Radius Theory
Authors: - René Thiemann and + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and Akihisa Yamada
Contributor: Alexander Bentkamp (bentkamp /at/ gmail /dot/ com)
Submission date: 2015-08-21
Abstract:

Matrix interpretations are useful as measure functions in termination proving. In order to use these interpretations also for complexity analysis, the growth rate of matrix powers has to examined. Here, we formalized a central result of spectral radius theory, namely that the growth rate is polynomially bounded if and only if the spectral radius of a matrix is at most one.

To formally prove this result we first studied the growth rates of matrices in Jordan normal form, and prove the result that every complex matrix has a Jordan normal form using a constructive prove via Schur decomposition.

The whole development is based on a new abstract type for matrices, which is also executable by a suitable setup of the code generator. It completely subsumes our former AFP-entry on executable matrices, and its main advantage is its close connection to the HMA-representation which allowed us to easily adapt existing proofs on determinants.

All the results have been applied to improve CeTA, our certifier to validate termination and complexity proof certificates.

Change history: [2016-01-07]: Added Schur-decomposition, Gram-Schmidt orthogonalization, uniqueness of Jordan normal forms
[2018-04-17]: Integrated lemmas from deep-learning AFP-entry of Alexander Bentkamp
BibTeX:
@article{Jordan_Normal_Form-AFP,
   author  = {René Thiemann and Akihisa Yamada},
   title   = {Matrices, Jordan Normal Forms, and Spectral Radius Theory},
   journal = {Archive of Formal Proofs},
   month   = aug,
   year    = 2015,
   note    = {\url{https://isa-afp.org/entries/Jordan_Normal_Form.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Polynomial_Factorization
Used by:Deep_Learning, Farkas, Groebner_Bases, Isabelle_Marries_Dirac, Linear_Programming, Perron_Frobenius, QHLProver, Stochastic_Matrices, Subresultants
Deep_Learning, Farkas, Groebner_Bases, Isabelle_Marries_Dirac, Linear_Programming, Modular_arithmetic_LLL_and_HNF_algorithms, Perron_Frobenius, QHLProver, Stochastic_Matrices, Subresultants

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

 

 

 

 

 

 

A Formalization of Knuth–Bendix Orders

 

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

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

 

 

 

 

 

 

A verified LLL algorithm

 

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

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

 

 

 

 

 

 

A verified factorization algorithm for integer polynomials with polynomial complexity

 

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

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

 

 

 

 

 

 

Lifting Definition Option

 

Title: Lifting Definition Option
Author: - René Thiemann + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at)
Submission date: 2014-10-13
Abstract: We implemented a command that can be used to easily generate elements of a restricted type {x :: 'a. P x}, provided the definition is of the form f ys = (if check ys then Some(generate ys :: 'a) else None) where ys is a list of variables y1 ... yn and check ys ==> P(generate ys) can be proved.

In principle, such a definition is also directly possible using the lift_definition command. However, then this definition will not be suitable for code-generation. To this end, we automated a more complex construction of Joachim Breitner which is amenable for code-generation, and where the test check ys will only be performed once. In the automation, one auxiliary type is created, and Isabelle's lifting- and transfer-package is invoked several times.

BibTeX:
@article{Lifting_Definition_Option-AFP,
   author  = {René Thiemann},
   title   = {Lifting Definition Option},
   journal = {Archive of Formal Proofs},
   month   = oct,
   year    = 2014,
   note    = {\url{https://isa-afp.org/entries/Lifting_Definition_Option.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: GNU Lesser General Public License (LGPL)

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

 

 

 

 

 

 

Linear Inequalities

 

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

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

 

 

 

 

 

 

Executable Matrix Operations on Matrices of Arbitrary Dimensions

 

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

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

 

+ + + +

 

+

 

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

 

+

 

+
+
+

 

+

Mereology + +

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Title:Mereology
+ Author: + + Ben Blumson +
Submission date:2021-03-01
Abstract: +We use Isabelle/HOL to verify elementary theorems and alternative +axiomatizations of classical extensional mereology.
BibTeX: +
@article{Mereology-AFP,
+  author  = {Ben Blumson},
+  title   = {Mereology},
+  journal = {Archive of Formal Proofs},
+  month   = mar,
+  year    = 2021,
+  note    = {\url{https://isa-afp.org/entries/Mereology.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
+
License:BSD License
+ +

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

 

+ + + +

 

+

 

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

 

+

 

+
+
+

 

+

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

+

 

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

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

 

 

 

 

 

 

Mutually Recursive Partial Functions

 

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

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

 

 

 

 

 

 

Perron-Frobenius Theorem for Spectral Radius Analysis

 

Title: Perron-Frobenius Theorem for Spectral Radius Analysis
Authors: Jose Divasón, Ondřej Kunčar, - René Thiemann and + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and Akihisa Yamada
Submission date: 2016-05-20
Abstract:

The spectral radius of a matrix A is the maximum norm of all eigenvalues of A. In previous work we already formalized that for a complex matrix A, the values in 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.

Change history: [2017-10-18]: added Perron-Frobenius theorem for irreducible matrices with generalization (revision bda1f1ce8a1c)
[2018-05-17]: prove conjecture of CPP'18 paper: Jordan blocks of spectral radius have maximum size (revision ffdb3794e5d5)
BibTeX:
@article{Perron_Frobenius-AFP,
   author  = {Jose Divasón and Ondřej Kunčar and René Thiemann and Akihisa Yamada},
   title   = {Perron-Frobenius Theorem for Spectral Radius Analysis},
   journal = {Archive of Formal Proofs},
   month   = may,
   year    = 2016,
   note    = {\url{https://isa-afp.org/entries/Perron_Frobenius.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Jordan_Normal_Form, Polynomial_Factorization, Rank_Nullity_Theorem, Sturm_Sequences
Used by: LLL_Factorization, Smith_Normal_Form, Stochastic_Matrices

\ No newline at end of file diff --git a/web/entries/Pi_Transcendental.html b/web/entries/Pi_Transcendental.html --- a/web/entries/Pi_Transcendental.html +++ b/web/entries/Pi_Transcendental.html @@ -1,207 +1,209 @@ The Transcendence of π - Archive of Formal Proofs

 

 

 

 

 

 

The Transcendence of π

 

- + + +
Title: The Transcendence of π
Author: Manuel Eberl
Submission date: 2018-09-28
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.

BibTeX:
@article{Pi_Transcendental-AFP,
   author  = {Manuel Eberl},
   title   = {The Transcendence of π},
   journal = {Archive of Formal Proofs},
   month   = sep,
   year    = 2018,
   note    = {\url{https://isa-afp.org/entries/Pi_Transcendental.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: E_Transcendental, Symmetric_Polynomials
Used by:Hermite_Lindemann

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

 

 

 

 

 

 

Polynomial Factorization

 

Title: Polynomial Factorization
Authors: - René Thiemann and + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and Akihisa Yamada
Submission date: 2016-01-29
Abstract: Based on existing libraries for polynomial interpolation and matrices, we formalized several factorization algorithms for polynomials, including Kronecker's algorithm for integer polynomials, Yun's square-free factorization algorithm for field polynomials, and Berlekamp's algorithm for polynomials over finite fields. By combining the last one with Hensel's lifting, we derive an efficient factorization algorithm for the integer polynomials, which is then lifted for rational polynomials by mechanizing Gauss' lemma. Finally, we assembled a combined factorization algorithm for rational polynomials, which combines all the mentioned algorithms and additionally uses the explicit formula for roots of quadratic polynomials and a rational root test.

As side products, we developed division algorithms for polynomials over integral domains, as well as primality-testing and prime-factorization algorithms for integers.

BibTeX:
@article{Polynomial_Factorization-AFP,
   author  = {René Thiemann and Akihisa Yamada},
   title   = {Polynomial Factorization},
   journal = {Archive of Formal Proofs},
   month   = jan,
   year    = 2016,
   note    = {\url{https://isa-afp.org/entries/Polynomial_Factorization.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Partial_Function_MR, Polynomial_Interpolation, Show, Sqrt_Babylonian
Used by: Amicable_Numbers, Dirichlet_Series, Functional_Ordered_Resolution_Prover, Gaussian_Integers, Jordan_Normal_Form, Knuth_Bendix_Order, Linear_Recurrences, Perron_Frobenius, Power_Sum_Polynomials, Subresultants

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

 

 

 

 

 

 

Polynomial Interpolation

 

Title: Polynomial Interpolation
Authors: - René Thiemann and + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and Akihisa Yamada
Submission date: 2016-01-29
Abstract: We formalized three algorithms for polynomial interpolation over arbitrary fields: Lagrange's explicit expression, the recursive algorithm of Neville and Aitken, and the Newton interpolation in combination with an efficient implementation of divided differences. Variants of these algorithms for integer polynomials are also available, where sometimes the interpolation can fail; e.g., there is no linear integer polynomial p such that p(0) = 0 and p(2) = 1. Moreover, for the Newton interpolation for integer polynomials, we proved that all intermediate results that are computed during the algorithm must be integers. This admits an early failure detection in the implementation. Finally, we proved the uniqueness of polynomial interpolation.

The development also contains improved code equations to speed up the division of integers in target languages.

BibTeX:
@article{Polynomial_Interpolation-AFP,
   author  = {René Thiemann and Akihisa Yamada},
   title   = {Polynomial Interpolation},
   journal = {Archive of Formal Proofs},
   month   = jan,
   year    = 2016,
   note    = {\url{https://isa-afp.org/entries/Polynomial_Interpolation.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Sqrt_Babylonian
Used by: Deep_Learning, Formal_Puiseux_Series, Gauss_Sums, Polynomial_Factorization

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

 

 

 

 

 

 

Executable Multivariate Polynomials

 

Title: Executable Multivariate Polynomials
Authors: Christian Sternagel (c /dot/ sternagel /at/ gmail /dot/ com), - René Thiemann, + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at), Alexander Maletzky, Fabian Immler, Florian Haftmann, Andreas Lochbihler and Alexander Bentkamp (bentkamp /at/ gmail /dot/ com)
Submission date: 2010-08-10
Abstract: We define multivariate polynomials over arbitrary (ordered) semirings in combination with (executable) operations like addition, multiplication, and substitution. We also define (weak) monotonicity of polynomials and comparison of polynomials where we provide standard estimations like absolute positiveness or the more recent approach of Neurauter, Zankl, and Middeldorp. Moreover, it is proven that strongly normalizing (monotone) orders can be lifted to strongly normalizing (monotone) orders over polynomials. Our formalization was performed as part of the IsaFoR/CeTA-system which contains several termination techniques. The provided theories have been essential to formalize polynomial interpretations.

This formalization also contains an abstract representation as coefficient functions with finite support and a type of power-products. If this type is ordered by a linear (term) ordering, various additional notions, such as leading power-product, leading coefficient etc., are introduced as well. Furthermore, a lot of generic properties of, and functions on, multivariate polynomials are formalized, including the substitution and evaluation homomorphisms, embeddings of polynomial rings into larger rings (i.e. with one additional indeterminate), homogenization and dehomogenization of polynomials, and the canonical isomorphism between R[X,Y] and R[X][Y].

Change history: [2010-09-17]: Moved theories on arbitrary (ordered) semirings to Abstract Rewriting.
[2016-10-28]: Added abstract representation of polynomials and authors Maletzky/Immler.
[2018-01-23]: Added authors Haftmann, Lochbihler after incorporating their formalization of multivariate polynomials based on Polynomial mappings. Moved material from Bentkamp's entry "Deep Learning".
[2019-04-18]: Added material about polynomials whose power-products are represented themselves by polynomial mappings.
BibTeX:
@article{Polynomials-AFP,
   author  = {Christian Sternagel and René Thiemann and Alexander Maletzky and Fabian Immler and Florian Haftmann and Andreas Lochbihler and Alexander Bentkamp},
   title   = {Executable Multivariate Polynomials},
   journal = {Archive of Formal Proofs},
   month   = aug,
   year    = 2010,
   note    = {\url{https://isa-afp.org/entries/Polynomials.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: GNU Lesser General Public License (LGPL)
Depends on: Abstract-Rewriting, Matrix, Show, Well_Quasi_Orders
Used by: Deep_Learning, Groebner_Bases, Lambda_Free_KBOs, PAC_Checker, Symmetric_Polynomials

\ No newline at end of file diff --git a/web/entries/Power_Sum_Polynomials.html b/web/entries/Power_Sum_Polynomials.html --- a/web/entries/Power_Sum_Polynomials.html +++ b/web/entries/Power_Sum_Polynomials.html @@ -1,228 +1,230 @@ Power Sum Polynomials - Archive of Formal Proofs

 

 

 

 

 

 

Power Sum Polynomials

 

- + + +
Title: Power Sum Polynomials
Author: Manuel Eberl
Submission date: 2020-04-24
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.

BibTeX:
@article{Power_Sum_Polynomials-AFP,
   author  = {Manuel Eberl},
   title   = {Power Sum Polynomials},
   journal = {Archive of Formal Proofs},
   month   = apr,
   year    = 2020,
   note    = {\url{https://isa-afp.org/entries/Power_Sum_Polynomials.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Polynomial_Factorization, Symmetric_Polynomials
Used by:Hermite_Lindemann

\ No newline at end of file diff --git a/web/entries/Projective_Measurements.html b/web/entries/Projective_Measurements.html new file mode 100644 --- /dev/null +++ b/web/entries/Projective_Measurements.html @@ -0,0 +1,196 @@ + + + + +Quantum projective measurements and the CHSH inequality - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + + + + +
+

 

+ + + +

 

+

 

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

 

+

 

+
+
+

 

+

Quantum + + projective + + measurements + + and + + the + + CHSH + + inequality + +

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Title:Quantum projective measurements and the CHSH inequality
+ Author: + + Mnacho Echenim +
Submission date:2021-03-03
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.
BibTeX: +
@article{Projective_Measurements-AFP,
+  author  = {Mnacho Echenim},
+  title   = {Quantum projective measurements and the CHSH inequality},
+  journal = {Archive of Formal Proofs},
+  month   = mar,
+  year    = 2021,
+  note    = {\url{https://isa-afp.org/entries/Projective_Measurements.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
+
License:BSD License
Depends on:Isabelle_Marries_Dirac, QHLProver
+ +

+ + + + + + + + + + + + + + + + + + +
+
+ + + + + + \ No newline at end of file diff --git a/web/entries/QHLProver.html b/web/entries/QHLProver.html --- a/web/entries/QHLProver.html +++ b/web/entries/QHLProver.html @@ -1,212 +1,214 @@ Quantum Hoare Logic - Archive of Formal Proofs

 

 

 

 

 

 

Quantum Hoare Logic

 

- + + +
Title: Quantum Hoare Logic
Authors: Junyi Liu, Bohua Zhan, Shuling Wang, Shenggang Ying, Tao Liu, Yangjia Li, Mingsheng Ying and Naijun Zhan
Submission date: 2019-03-24
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.
BibTeX:
@article{QHLProver-AFP,
   author  = {Junyi Liu and Bohua Zhan and Shuling Wang and Shenggang Ying and Tao Liu and Yangjia Li and Mingsheng Ying and Naijun Zhan},
   title   = {Quantum Hoare Logic},
   journal = {Archive of Formal Proofs},
   month   = mar,
   year    = 2019,
   note    = {\url{https://isa-afp.org/entries/QHLProver.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Deep_Learning, Jordan_Normal_Form
Used by:Projective_Measurements

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

 

 

 

 

 

 

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

 

Title: Implementing field extensions of the form Q[sqrt(b)]
Author: - René Thiemann + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at)
Submission date: 2014-02-06
Abstract: We apply data refinement to implement the real numbers, where we support all numbers in the field extension Q[sqrt(b)], i.e., all numbers of the form p + q * sqrt(b) for rational numbers p and q and some fixed natural number b. To this end, we also developed algorithms to precisely compute roots of a rational number, and to perform a factorization of natural numbers which eliminates duplicate prime factors.

Our results have been used to certify termination proofs which involve polynomial interpretations over the reals.

Change history: [2014-07-11]: Moved NthRoot_Impl to Sqrt-Babylonian.
BibTeX:
@article{Real_Impl-AFP,
   author  = {René Thiemann},
   title   = {Implementing field extensions of the form Q[sqrt(b)]},
   journal = {Archive of Formal Proofs},
   month   = feb,
   year    = 2014,
   note    = {\url{https://isa-afp.org/entries/Real_Impl.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: GNU Lesser General Public License (LGPL)
Depends on: Deriving, Show, Sqrt_Babylonian
Used by: QR_Decomposition

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

 

 

 

 

 

 

Haskell's Show Class in Isabelle/HOL

 

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

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

 

 

 

 

 

 

An Incremental Simplex Algorithm with Unsatisfiable Core Generation

 

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

\ No newline at end of file diff --git a/web/entries/Smith_Normal_Form.html b/web/entries/Smith_Normal_Form.html --- a/web/entries/Smith_Normal_Form.html +++ b/web/entries/Smith_Normal_Form.html @@ -1,220 +1,222 @@ A verified algorithm for computing the Smith normal form of a matrix - Archive of Formal Proofs

 

 

 

 

 

 

A verified algorithm for computing the Smith normal form of a matrix

 

- + + +
Title: A verified algorithm for computing the Smith normal form of a matrix
Author: Jose Divasón
Submission date: 2020-05-23
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.
BibTeX:
@article{Smith_Normal_Form-AFP,
   author  = {Jose Divasón},
   title   = {A verified algorithm for computing the Smith normal form of a matrix},
   journal = {Archive of Formal Proofs},
   month   = may,
   year    = 2020,
   note    = {\url{https://isa-afp.org/entries/Smith_Normal_Form.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License
Depends on: Berlekamp_Zassenhaus, Hermite, List-Index, Perron_Frobenius
Used by:Modular_arithmetic_LLL_and_HNF_algorithms

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

 

 

 

 

 

 

Computing N-th Roots using the Babylonian Method

 

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

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

 

 

 

 

 

 

Stochastic Matrices and the Perron-Frobenius Theorem

 

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

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

 

 

 

 

 

 

Subresultants

 

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

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

 

+ + + +

 

+

 

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

 

+

 

+
+
+

 

+

The + + Sunflower + + Lemma + + of + + Erdős + + and + + Rado + +

+

 

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

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

 

 

 

 

 

 

Executable Transitive Closures

 

Title: Executable Transitive Closures
Author: - René Thiemann + René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at)
Submission date: 2012-02-29
Abstract:

We provide a generic work-list algorithm to compute the (reflexive-)transitive closure of relations where only successors of newly detected states are generated. In contrast to our previous work, the relations do not have to be finite, but each element must only have finitely many (indirect) successors. Moreover, a subsumption relation can be used instead of pure equality. An executable variant of the algorithm is available where the generic operations are instantiated with list operations.

This formalization was performed as part of the IsaFoR/CeTA project, and it has been used to certify size-change termination proofs where large transitive closures have to be computed.

BibTeX:
@article{Transitive-Closure-II-AFP,
   author  = {René Thiemann},
   title   = {Executable Transitive Closures},
   journal = {Archive of Formal Proofs},
   month   = feb,
   year    = 2012,
   note    = {\url{https://isa-afp.org/entries/Transitive-Closure-II.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: GNU Lesser General Public License (LGPL)
Depends on: Regular-Sets

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

 

 

 

 

 

 

Executable Transitive Closures of Finite Relations

 

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

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

 

 

 

 

 

 

XML

 

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

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

 

 

 

 

 

 

Archive of Formal Proofs

 

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

A development version of the archive is available as well.

 

 

+ + + + + + + + + + + + + + +
2021
+ 2021-03-12: Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation +
+ Authors: + Ralph Bottesch, + Jose Divasón + and René Thiemann +
+ 2021-03-03: Quantum projective measurements and the CHSH inequality +
+ Author: + Mnacho Echenim +
+ 2021-03-03: The Hermite–Lindemann–Weierstraß Transcendence Theorem +
+ Author: + Manuel Eberl +
+ 2021-03-01: Mereology +
+ Author: + Ben Blumson +
+ 2021-02-25: The Sunflower Lemma of Erdős and Rado +
+ Author: + René Thiemann +
2021-02-24: A Verified Imperative Implementation of B-Trees
Author: Niels Mündler
2021-02-17: Formal Puiseux Series
Author: Manuel Eberl
2021-02-10: The Laws of Large Numbers
Author: Manuel Eberl
2021-01-31: Tarski's Parallel Postulate implies the 5th Postulate of Euclid, the Postulate of Playfair and the original Parallel Postulate of Euclid
Author: Roland Coghetto
2021-01-30: Solution to the xkcd Blue Eyes puzzle
Author: Jakub Kądziołka
2021-01-18: Hood-Melville Queue
Author: Alejandro Gómez-Londoño
2021-01-11: JinjaDCI: a Java semantics with dynamic class initialization
Author: Susannah Mansky

 

2020
2020-12-27: Cofinality and the Delta System Lemma
Author: Pedro Sánchez Terraf
2020-12-17: Topological semantics for paraconsistent and paracomplete logics
Author: David Fuenmayor
2020-12-08: Relational Minimum Spanning Tree Algorithms
Authors: Walter Guttmann and Nicolas Robinson-O'Brien
2020-12-07: Inline Caching and Unboxing Optimization for Interpreters
Author: Martin Desharnais
2020-12-05: The Relational Method with Message Anonymity for the Verification of Cryptographic Protocols
Author: Pasquale Noce
2020-11-22: Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information
Authors: Anthony Bordg, Hanna Lachnitt and Yijun He
2020-11-19: The HOL-CSP Refinement Toolkit
Authors: Safouan Taha, Burkhart Wolff and Lina Ye
2020-10-29: Verified SAT-Based AI Planning
Authors: Mohammad Abdulaziz and Friedrich Kurz
2020-10-29: AI Planning Languages Semantics
Authors: Mohammad Abdulaziz and Peter Lammich
2020-10-20: A Sound Type System for Physical Quantities, Units, and Measurements
Authors: Simon Foster and Burkhart Wolff
2020-10-12: Finite Map Extras
Author: Javier Díaz
2020-09-28: A Formal Model of the Safely Composable Document Object Model with Shadow Roots
Authors: Achim D. Brucker and Michael Herzberg
2020-09-28: A Formal Model of the Document Object Model with Shadow Roots
Authors: Achim D. Brucker and Michael Herzberg
2020-09-28: A Formalization of Safely Composable Web Components
Authors: Achim D. Brucker and Michael Herzberg
2020-09-28: A Formalization of Web Components
Authors: Achim D. Brucker and Michael Herzberg
2020-09-28: The Safely Composable DOM
Authors: Achim D. Brucker and Michael Herzberg
2020-09-16: Syntax-Independent Logic Infrastructure
Authors: Andrei Popescu and Dmitriy Traytel
2020-09-16: Robinson Arithmetic
Authors: Andrei Popescu and Dmitriy Traytel
2020-09-16: An Abstract Formalization of Gödel's Incompleteness Theorems
Authors: Andrei Popescu and Dmitriy Traytel
2020-09-16: From Abstract to Concrete Gödel's Incompleteness Theorems—Part II
Authors: Andrei Popescu and Dmitriy Traytel
2020-09-16: From Abstract to Concrete Gödel's Incompleteness Theorems—Part I
Authors: Andrei Popescu and Dmitriy Traytel
2020-09-07: A Formal Model of Extended Finite State Machines
Authors: Michael Foster, Achim D. Brucker, Ramsay G. Taylor and John Derrick
2020-09-07: Inference of Extended Finite State Machines
Authors: Michael Foster, Achim D. Brucker, Ramsay G. Taylor and John Derrick
2020-08-31: Practical Algebraic Calculus Checker
Authors: Mathias Fleury and Daniela Kaufmann
2020-08-31: Some classical results in inductive inference of recursive functions
Author: Frank J. Balbach
2020-08-26: Relational Disjoint-Set Forests
Author: Walter Guttmann
2020-08-25: Extensions to the Comprehensive Framework for Saturation Theorem Proving
Authors: Jasmin Blanchette and Sophie Tourret
2020-08-25: Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching
Author: Peter Gammie
2020-08-04: Amicable Numbers
Author: Angeliki Koutsoukou-Argyraki
2020-08-03: Ordinal Partitions
Author: Lawrence C. Paulson
2020-07-21: A Formal Proof of The Chandy--Lamport Distributed Snapshot Algorithm
Authors: Ben Fiedler and Dmitriy Traytel
2020-07-13: Relational Characterisations of Paths
Authors: Walter Guttmann and Peter Höfner
2020-06-01: A Formally Verified Checker of the Safe Distance Traffic Rules for Autonomous Vehicles
Authors: Albert Rizaldi and Fabian Immler
2020-05-23: A verified algorithm for computing the Smith normal form of a matrix
Author: Jose Divasón
2020-05-16: The Nash-Williams Partition Theorem
Author: Lawrence C. Paulson
2020-05-13: A Formalization of Knuth–Bendix Orders
Authors: Christian Sternagel - and René Thiemann + and René Thiemann
2020-05-12: Irrationality Criteria for Series by Erdős and Straus
Authors: Angeliki Koutsoukou-Argyraki and Wenda Li
2020-05-11: Recursion Theorem in ZF
Author: Georgy Dunaev
2020-05-08: An Efficient Normalisation Procedure for Linear Temporal Logic: Isabelle/HOL Formalisation
Author: Salomon Sickert
2020-05-06: Formalization of Forcing in Isabelle/ZF
Authors: Emmanuel Gunther, Miguel Pagano and Pedro Sánchez Terraf
2020-05-02: Banach-Steinhaus Theorem
Authors: Dominique Unruh and Jose Manuel Rodriguez Caballero
2020-04-27: Attack Trees in Isabelle for GDPR compliance of IoT healthcare systems
Author: Florian Kammueller
2020-04-24: Power Sum Polynomials
Author: Manuel Eberl
2020-04-24: The Lambert W Function on the Reals
Author: Manuel Eberl
2020-04-24: Gaussian Integers
Author: Manuel Eberl
2020-04-19: Matrices for ODEs
Author: Jonathan Julian Huerta y Munive
2020-04-16: Authenticated Data Structures As Functors
Authors: Andreas Lochbihler and Ognjen Marić
2020-04-10: Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows
Authors: Lukas Heimes, Dmitriy Traytel and Joshua Schneider
2020-04-09: A Comprehensive Framework for Saturation Theorem Proving
Author: Sophie Tourret
2020-04-09: Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations
Authors: Thibault Dardinier, Lukas Heimes, Martin Raszyk, Joshua Schneider and Dmitriy Traytel
2020-04-08: Stateful Protocol Composition and Typing
Authors: Andreas V. Hess, Sebastian Mödersheim and Achim D. Brucker
2020-04-08: Automated Stateful Protocol Verification
Authors: Andreas V. Hess, Sebastian Mödersheim, Achim D. Brucker and Anders Schlichtkrull
2020-04-07: Lucas's Theorem
Author: Chelsea Edmonds
2020-03-25: Strong Eventual Consistency of the Collaborative Editing Framework WOOT
Authors: Emin Karayel and Edgar Gonzàlez
2020-03-22: Furstenberg's topology and his proof of the infinitude of primes
Author: Manuel Eberl
2020-03-12: An Under-Approximate Relational Logic
Author: Toby Murray
2020-03-07: Hello World
Authors: Cornelius Diekmann and Lars Hupel
2020-02-21: Implementing the Goodstein Function in λ-Calculus
Author: Bertram Felgenhauer
2020-02-10: A Generic Framework for Verified Compilers
Author: Martin Desharnais
2020-02-01: Arithmetic progressions and relative primes
Author: José Manuel Rodríguez Caballero
2020-01-31: A Hierarchy of Algebras for Boolean Subsets
Authors: Walter Guttmann and Bernhard Möller
2020-01-17: Mersenne primes and the Lucas–Lehmer test
Author: Manuel Eberl
2020-01-16: Verified Approximation Algorithms
Authors: Robin Eßmann, Tobias Nipkow and Simon Robillard
2020-01-13: Closest Pair of Points Algorithms
Authors: Martin Rau and Tobias Nipkow
2020-01-09: Skip Lists
Authors: Max W. Haslbeck and Manuel Eberl
2020-01-06: Bicategories
Author: Eugene W. Stark

 

2019
2019-12-27: The Irrationality of ζ(3)
Author: Manuel Eberl
2019-12-20: Formalizing a Seligman-Style Tableau System for Hybrid Logic
Author: Asta Halkjær From
2019-12-18: The Poincaré-Bendixson Theorem
Authors: Fabian Immler and Yong Kiam Tan
2019-12-16: Poincaré Disc Model
Authors: Danijela Simić, Filip Marić and Pierre Boutry
2019-12-16: Complex Geometry
Authors: Filip Marić and Danijela Simić
2019-12-10: Gauss Sums and the Pólya–Vinogradov Inequality
Authors: Rodrigo Raya and Manuel Eberl
2019-12-04: An Efficient Generalization of Counting Sort for Large, possibly Infinite Key Ranges
Author: Pasquale Noce
2019-11-27: Interval Arithmetic on 32-bit Words
Author: Brandon Bohrer
2019-10-24: Zermelo Fraenkel Set Theory in Higher-Order Logic
Author: Lawrence C. Paulson
2019-10-22: Isabelle/C
Authors: Frédéric Tuong and Burkhart Wolff
2019-10-16: VerifyThis 2019 -- Polished Isabelle Solutions
Authors: Peter Lammich and Simon Wimmer
2019-10-08: Aristotle's Assertoric Syllogistic
Author: Angeliki Koutsoukou-Argyraki
2019-10-07: Sigma Protocols and Commitment Schemes
Authors: David Butler and Andreas Lochbihler
2019-10-04: Clean - An Abstract Imperative Programming Language and its Theory
Authors: Frédéric Tuong and Burkhart Wolff
2019-09-16: Formalization of Multiway-Join Algorithms
Author: Thibault Dardinier
2019-09-10: Verification Components for Hybrid Systems
Author: Jonathan Julian Huerta y Munive
2019-09-06: Fourier Series
Author: Lawrence C Paulson
2019-08-30: A Case Study in Basic Algebra
Author: Clemens Ballarin
2019-08-16: Formalisation of an Adaptive State Counting Algorithm
Author: Robert Sachtleben
2019-08-14: Laplace Transform
Author: Fabian Immler
2019-08-06: Linear Programming
Authors: Julian Parsert and Cezary Kaliszyk
2019-08-06: Communicating Concurrent Kleene Algebra for Distributed Systems Specification
Authors: Maxime Buyse and Jason Jaskolka
2019-08-05: Selected Problems from the International Mathematical Olympiad 2019
Author: Manuel Eberl
2019-08-01: Stellar Quorum Systems
Author: Giuliano Losa
2019-07-30: A Formal Development of a Polychronous Polytimed Coordination Language
Authors: Hai Nguyen Van, Frédéric Boulanger and Burkhart Wolff
2019-07-27: Szpilrajn Extension Theorem
Author: Peter Zeller
2019-07-18: A Sequent Calculus for First-Order Logic
Author: Asta Halkjær From
2019-07-08: A Verified Code Generator from Isabelle/HOL to CakeML
Author: Lars Hupel
2019-07-04: Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic
Authors: Joshua Schneider and Dmitriy Traytel
2019-06-27: Complete Non-Orders and Fixed Points
Authors: Akihisa Yamada and Jérémy Dubut
2019-06-25: Priority Search Trees
Authors: Peter Lammich and Tobias Nipkow
2019-06-25: Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra
Authors: Peter Lammich and Tobias Nipkow
2019-06-21: Linear Inequalities
Authors: - Ralph Bottesch, + Ralph Bottesch, Alban Reynaud - and René Thiemann + and René Thiemann
2019-06-16: Hilbert's Nullstellensatz
Author: Alexander Maletzky
2019-06-15: Gröbner Bases, Macaulay Matrices and Dubé's Degree Bounds
Author: Alexander Maletzky
2019-06-13: Binary Heaps for IMP2
Author: Simon Griebel
2019-06-03: Differential Game Logic
Author: André Platzer
2019-05-30: Multidimensional Binary Search Trees
Author: Martin Rau
2019-05-14: Formalization of Generic Authenticated Data Structures
Authors: Matthias Brun and Dmitriy Traytel
2019-05-09: Multi-Party Computation
Authors: David Aspinall and David Butler
2019-04-26: HOL-CSP Version 2.0
Authors: Safouan Taha, Lina Ye and Burkhart Wolff
2019-04-16: A Compositional and Unified Translation of LTL into ω-Automata
Authors: Benedikt Seidl and Salomon Sickert
2019-04-06: A General Theory of Syntax with Bindings
Authors: Lorenzo Gheri and Andrei Popescu
2019-03-27: The Transcendence of Certain Infinite Series
Authors: Angeliki Koutsoukou-Argyraki and Wenda Li
2019-03-24: Quantum Hoare Logic
Authors: Junyi Liu, Bohua Zhan, Shuling Wang, Shenggang Ying, Tao Liu, Yangjia Li, Mingsheng Ying and Naijun Zhan
2019-03-09: Safe OCL
Author: Denis Nikiforov
2019-02-21: Elementary Facts About the Distribution of Primes
Author: Manuel Eberl
2019-02-14: Kruskal's Algorithm for Minimum Spanning Forest
Authors: Maximilian P.L. Haslbeck, Peter Lammich and Julian Biendarra
2019-02-11: Probabilistic Primality Testing
Authors: Daniel Stüwe and Manuel Eberl
2019-02-08: Universal Turing Machine
Authors: Jian Xu, Xingyuan Zhang, Christian Urban and Sebastiaan J. C. Joosten
2019-02-01: Isabelle/UTP: Mechanised Theory Engineering for Unifying Theories of Programming
Authors: Simon Foster, Frank Zeyda, Yakoub Nemouchi, Pedro Ribeiro and Burkhart Wolff
2019-02-01: The Inversions of a List
Author: Manuel Eberl
2019-01-17: Farkas' Lemma and Motzkin's Transposition Theorem
Authors: - Ralph Bottesch, + Ralph Bottesch, Max W. Haslbeck - and René Thiemann + and René Thiemann
2019-01-15: IMP2 – Simple Program Verification in Isabelle/HOL
Authors: Peter Lammich and Simon Wimmer
2019-01-15: An Algebra for Higher-Order Terms
Author: Lars Hupel
2019-01-07: A Reduction Theorem for Store Buffers
Authors: Ernie Cohen and Norbert Schirmer

 

2018
2018-12-26: A Formal Model of the Document Object Model
Authors: Achim D. Brucker and Michael Herzberg
2018-12-25: Formalization of Concurrent Revisions
Author: Roy Overbeek
2018-12-21: Verifying Imperative Programs using Auto2
Author: Bohua Zhan
2018-12-17: Constructive Cryptography in HOL
Authors: Andreas Lochbihler and S. Reza Sefidgar
2018-12-11: Transformer Semantics
Author: Georg Struth
2018-12-11: Quantales
Author: Georg Struth
2018-12-11: Properties of Orderings and Lattices
Author: Georg Struth
2018-11-23: Graph Saturation
Author: Sebastiaan J. C. Joosten
2018-11-23: A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover
Authors: Anders Schlichtkrull, Jasmin Christian Blanchette and Dmitriy Traytel
2018-11-20: Auto2 Prover
Author: Bohua Zhan
2018-11-16: Matroids
Author: Jonas Keinholz
2018-11-06: Deriving generic class instances for datatypes
Authors: Jonas Rädle and Lars Hupel
2018-10-30: Formalisation and Evaluation of Alan Gewirth's Proof for the Principle of Generic Consistency in Isabelle/HOL
Authors: David Fuenmayor and Christoph Benzmüller
2018-10-29: Epistemic Logic
Author: Asta Halkjær From
2018-10-22: Smooth Manifolds
Authors: Fabian Immler and Bohua Zhan
2018-10-19: Randomised Binary Search Trees
Author: Manuel Eberl
2018-10-19: Formalization of the Embedding Path Order for Lambda-Free Higher-Order Terms
Author: Alexander Bentkamp
2018-10-12: Upper Bounding Diameters of State Spaces of Factored Transition Systems
Authors: Friedrich Kurz and Mohammad Abdulaziz
2018-09-28: The Transcendence of π
Author: Manuel Eberl
2018-09-25: Symmetric Polynomials
Author: Manuel Eberl
2018-09-20: Signature-Based Gröbner Basis Algorithms
Author: Alexander Maletzky
2018-09-19: The Prime Number Theorem
Authors: Manuel Eberl and Lawrence C. Paulson
2018-09-15: Aggregation Algebras
Author: Walter Guttmann
2018-09-14: Octonions
Author: Angeliki Koutsoukou-Argyraki
2018-09-05: Quaternions
Author: Lawrence C. Paulson
2018-09-02: The Budan-Fourier Theorem and Counting Real Roots with Multiplicity
Author: Wenda Li
2018-08-24: An Incremental Simplex Algorithm with Unsatisfiable Core Generation
Authors: Filip Marić, Mirko Spasić - and René Thiemann + and René Thiemann
2018-08-14: Minsky Machines
Author: Bertram Felgenhauer
2018-07-16: Pricing in discrete financial models
Author: - Mnacho Echenim + Mnacho Echenim
2018-07-04: Von-Neumann-Morgenstern Utility Theorem
Authors: Julian Parsert and Cezary Kaliszyk
2018-06-23: Pell's Equation
Author: Manuel Eberl
2018-06-14: Projective Geometry
Author: Anthony Bordg
2018-06-14: The Localization of a Commutative Ring
Author: Anthony Bordg
2018-06-05: Partial Order Reduction
Author: Julian Brunner
2018-05-27: Optimal Binary Search Trees
Authors: Tobias Nipkow and Dániel Somogyi
2018-05-25: Hidden Markov Models
Author: Simon Wimmer
2018-05-24: Probabilistic Timed Automata
Authors: Simon Wimmer and Johannes Hölzl
2018-05-23: Irrational Rapidly Convergent Series
Authors: Angeliki Koutsoukou-Argyraki and Wenda Li
2018-05-23: Axiom Systems for Category Theory in Free Logic
Authors: Christoph Benzmüller and Dana Scott
2018-05-22: Monadification, Memoization and Dynamic Programming
Authors: Simon Wimmer, Shuwei Hu and Tobias Nipkow
2018-05-10: OpSets: Sequential Specifications for Replicated Datatypes
Authors: Martin Kleppmann, Victor B. F. Gomes, Dominic P. Mulligan and Alastair R. Beresford
2018-05-07: An Isabelle/HOL Formalization of the Modular Assembly Kit for Security Properties
Authors: Oliver Bračevac, Richard Gay, Sylvia Grewe, Heiko Mantel, Henning Sudbrock and Markus Tasch
2018-04-29: WebAssembly
Author: Conrad Watt
2018-04-27: VerifyThis 2018 - Polished Isabelle Solutions
Authors: Peter Lammich and Simon Wimmer
2018-04-24: Bounded Natural Functors with Covariance and Contravariance
Authors: Andreas Lochbihler and Joshua Schneider
2018-03-22: The Incompatibility of Fishburn-Strategyproofness and Pareto-Efficiency
Authors: Felix Brandt, Manuel Eberl, Christian Saile and Christian Stricker
2018-03-13: Weight-Balanced Trees
Authors: Tobias Nipkow and Stefan Dirix
2018-03-12: CakeML
Authors: Lars Hupel and Yu Zhang
2018-03-01: A Theory of Architectural Design Patterns
Author: Diego Marmsoler
2018-02-26: Hoare Logics for Time Bounds
Authors: Maximilian P. L. Haslbeck and Tobias Nipkow
2018-02-06: Treaps
Authors: Maximilian Haslbeck, Manuel Eberl and Tobias Nipkow
2018-02-06: A verified factorization algorithm for integer polynomials with polynomial complexity
Authors: Jose Divasón, Sebastiaan Joosten, - René Thiemann + René Thiemann and Akihisa Yamada
2018-02-06: First-Order Terms
Authors: Christian Sternagel - and René Thiemann + and René Thiemann
2018-02-06: The Error Function
Author: Manuel Eberl
2018-02-02: A verified LLL algorithm
Authors: - Ralph Bottesch, + Ralph Bottesch, Jose Divasón, Maximilian Haslbeck, Sebastiaan Joosten, - René Thiemann + René Thiemann and Akihisa Yamada
2018-01-18: Formalization of Bachmair and Ganzinger's Ordered Resolution Prover
Authors: Anders Schlichtkrull, Jasmin Christian Blanchette, Dmitriy Traytel and Uwe Waldmann
2018-01-16: Gromov Hyperbolicity
Author: Sebastien Gouezel
2018-01-11: An Isabelle/HOL formalisation of Green's Theorem
Authors: Mohammad Abdulaziz and Lawrence C. Paulson
2018-01-08: Taylor Models
Authors: Christoph Traut and Fabian Immler

 

2017
2017-12-22: The Falling Factorial of a Sum
Author: Lukas Bulwahn
2017-12-21: The Median-of-Medians Selection Algorithm
Author: Manuel Eberl
2017-12-21: The Mason–Stothers Theorem
Author: Manuel Eberl
2017-12-21: Dirichlet L-Functions and Dirichlet's Theorem
Author: Manuel Eberl
2017-12-19: Operations on Bounded Natural Functors
Authors: Jasmin Christian Blanchette, Andrei Popescu and Dmitriy Traytel
2017-12-18: The string search algorithm by Knuth, Morris and Pratt
Authors: Fabian Hellauer and Peter Lammich
2017-11-22: Stochastic Matrices and the Perron-Frobenius Theorem
Author: - René Thiemann + René Thiemann
2017-11-09: The IMAP CmRDT
Authors: Tim Jungnickel, Lennart Oldenburg and Matthias Loibl
2017-11-06: Hybrid Multi-Lane Spatial Logic
Author: Sven Linker
2017-10-26: The Kuratowski Closure-Complement Theorem
Authors: Peter Gammie and Gianpaolo Gioiosa
2017-10-19: Transition Systems and Automata
Author: Julian Brunner
2017-10-19: Büchi Complementation
Author: Julian Brunner
2017-10-17: Evaluate Winding Numbers through Cauchy Indices
Author: Wenda Li
2017-10-17: Count the Number of Complex Roots
Author: Wenda Li
2017-10-14: Homogeneous Linear Diophantine Equations
Authors: Florian Messner, Julian Parsert, Jonas Schöpf and Christian Sternagel
2017-10-12: The Hurwitz and Riemann ζ Functions
Author: Manuel Eberl
2017-10-12: Linear Recurrences
Author: Manuel Eberl
2017-10-12: Dirichlet Series
Author: Manuel Eberl
2017-09-21: Computer-assisted Reconstruction and Assessment of E. J. Lowe's Modal Ontological Argument
Authors: David Fuenmayor and Christoph Benzmüller
2017-09-17: Representation and Partial Automation of the Principia Logico-Metaphysica in Isabelle/HOL
Author: Daniel Kirchner
2017-09-06: Anselm's God in Isabelle/HOL
Author: - Ben Blumson + Ben Blumson
2017-09-01: Microeconomics and the First Welfare Theorem
Authors: Julian Parsert and Cezary Kaliszyk
2017-08-20: Root-Balanced Tree
Author: Tobias Nipkow
2017-08-20: Orbit-Stabiliser Theorem with Application to Rotational Symmetries
Author: Jonas Rädle
2017-08-16: The LambdaMu-calculus
Authors: Cristina Matache, Victor B. F. Gomes and Dominic P. Mulligan
2017-07-31: Stewart's Theorem and Apollonius' Theorem
Author: Lukas Bulwahn
2017-07-28: Dynamic Architectures
Author: Diego Marmsoler
2017-07-21: Declarative Semantics for Functional Languages
Author: Jeremy Siek
2017-07-15: HOLCF-Prelude
Authors: Joachim Breitner, Brian Huffman, Neil Mitchell and Christian Sternagel
2017-07-13: Minkowski's Theorem
Author: Manuel Eberl
2017-07-09: Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus
Author: Michael Rawson
2017-07-07: A framework for establishing Strong Eventual Consistency for Conflict-free Replicated Datatypes
Authors: Victor B. F. Gomes, Martin Kleppmann, Dominic P. Mulligan and Alastair R. Beresford
2017-07-06: Stone-Kleene Relation Algebras
Author: Walter Guttmann
2017-06-21: Propositional Proof Systems
Authors: Julius Michaelis and Tobias Nipkow
2017-06-13: Partial Semigroups and Convolution Algebras
Authors: Brijesh Dongol, Victor B. F. Gomes, Ian J. Hayes and Georg Struth
2017-06-06: Buffon's Needle Problem
Author: Manuel Eberl
2017-06-01: Formalizing Push-Relabel Algorithms
Authors: Peter Lammich and S. Reza Sefidgar
2017-06-01: Flow Networks and the Min-Cut-Max-Flow Theorem
Authors: Peter Lammich and S. Reza Sefidgar
2017-05-25: Optics
Authors: Simon Foster and Frank Zeyda
2017-05-24: Developing Security Protocols by Refinement
Authors: Christoph Sprenger and Ivano Somaini
2017-05-24: Dictionary Construction
Author: Lars Hupel
2017-05-08: The Floyd-Warshall Algorithm for Shortest Paths
Authors: Simon Wimmer and Peter Lammich
2017-05-05: Probabilistic while loop
Author: Andreas Lochbihler
2017-05-05: Effect polymorphism in higher-order logic
Author: Andreas Lochbihler
2017-05-05: Monad normalisation
Authors: Joshua Schneider, Manuel Eberl and Andreas Lochbihler
2017-05-05: Game-based cryptography in HOL
Authors: Andreas Lochbihler, S. Reza Sefidgar and Bhargav Bhatt
2017-05-05: CryptHOL
Author: Andreas Lochbihler
2017-05-04: Monoidal Categories
Author: Eugene W. Stark
2017-05-01: Types, Tableaus and Gödel’s God in Isabelle/HOL
Authors: David Fuenmayor and Christoph Benzmüller
2017-04-28: Local Lexing
Author: Steven Obua
2017-04-19: Constructor Functions
Author: Lars Hupel
2017-04-18: Lazifying case constants
Author: Lars Hupel
2017-04-06: Subresultants
Authors: Sebastiaan Joosten, - René Thiemann + René Thiemann and Akihisa Yamada
2017-04-04: Expected Shape of Random Binary Search Trees
Author: Manuel Eberl
2017-03-15: The number of comparisons in QuickSort
Author: Manuel Eberl
2017-03-15: Lower bound on comparison-based sorting algorithms
Author: Manuel Eberl
2017-03-10: The Euler–MacLaurin Formula
Author: Manuel Eberl
2017-02-28: The Group Law for Elliptic Curves
Author: Stefan Berghofer
2017-02-26: Menger's Theorem
Author: Christoph Dittmann
2017-02-13: Differential Dynamic Logic
Author: Brandon Bohrer
2017-02-10: Abstract Soundness
Authors: Jasmin Christian Blanchette, Andrei Popescu and Dmitriy Traytel
2017-02-07: Stone Relation Algebras
Author: Walter Guttmann
2017-01-31: Refining Authenticated Key Agreement with Strong Adversaries
Authors: Joseph Lallemand and Christoph Sprenger
2017-01-24: Bernoulli Numbers
Authors: Lukas Bulwahn and Manuel Eberl
2017-01-17: Minimal Static Single Assignment Form
Authors: Max Wagner and Denis Lohner
2017-01-17: Bertrand's postulate
Authors: Julian Biendarra and Manuel Eberl
2017-01-12: The Transcendence of e
Author: Manuel Eberl
2017-01-08: Formal Network Models and Their Application to Firewall Policies
Authors: Achim D. Brucker, Lukas Brügger and Burkhart Wolff
2017-01-03: Verification of a Diffie-Hellman Password-based Authentication Protocol by Extending the Inductive Method
Author: Pasquale Noce
2017-01-01: First-Order Logic According to Harrison
Authors: Alexander Birch Jensen, Anders Schlichtkrull and Jørgen Villadsen

 

2016
2016-12-30: Concurrent Refinement Algebra and Rely Quotients
Authors: Julian Fell, Ian J. Hayes and Andrius Velykis
2016-12-29: The Twelvefold Way
Author: Lukas Bulwahn
2016-12-20: Proof Strategy Language
Author: Yutaka Nagashima
2016-12-07: Paraconsistency
Authors: Anders Schlichtkrull and Jørgen Villadsen
2016-11-29: COMPLX: A Verification Framework for Concurrent Imperative Programs
Authors: Sidney Amani, June Andronick, Maksym Bortin, Corey Lewis, Christine Rizkallah and Joseph Tuong
2016-11-23: Abstract Interpretation of Annotated Commands
Author: Tobias Nipkow
2016-11-16: Separata: Isabelle tactics for Separation Algebra
Authors: Zhe Hou, David Sanan, Alwen Tiu, Rajeev Gore and Ranald Clouston
2016-11-12: Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals
Authors: Jasmin Christian Blanchette, Mathias Fleury and Dmitriy Traytel
2016-11-12: Formalization of Knuth–Bendix Orders for Lambda-Free Higher-Order Terms
Authors: Heiko Becker, Jasmin Christian Blanchette, Uwe Waldmann and Daniel Wand
2016-11-10: Expressiveness of Deep Learning
Author: Alexander Bentkamp
2016-10-25: Modal Logics for Nominal Transition Systems
Authors: Tjark Weber, Lars-Henrik Eriksson, Joachim Parrow, Johannes Borgström and Ramunas Gutkovas
2016-10-24: Stable Matching
Author: Peter Gammie
2016-10-21: LOFT — Verified Migration of Linux Firewalls to SDN
Authors: Julius Michaelis and Cornelius Diekmann
2016-10-19: Source Coding Theorem
Authors: Quentin Hibon and Lawrence C. Paulson
2016-10-19: A formal model for the SPARCv8 ISA and a proof of non-interference for the LEON3 processor
Authors: Zhe Hou, David Sanan, Alwen Tiu and Yang Liu
2016-10-14: The Factorization Algorithm of Berlekamp and Zassenhaus
Authors: Jose Divasón, Sebastiaan Joosten, - René Thiemann + René Thiemann and Akihisa Yamada
2016-10-11: Intersecting Chords Theorem
Author: Lukas Bulwahn
2016-10-05: Lp spaces
Author: Sebastien Gouezel
2016-09-30: Fisher–Yates shuffle
Author: Manuel Eberl
2016-09-29: Allen's Interval Calculus
Author: Fadoua Ghourabi
2016-09-23: Formalization of Recursive Path Orders for Lambda-Free Higher-Order Terms
Authors: Jasmin Christian Blanchette, Uwe Waldmann and Daniel Wand
2016-09-09: Iptables Semantics
Authors: Cornelius Diekmann and Lars Hupel
2016-09-06: A Variant of the Superposition Calculus
Author: Nicolas Peltier
2016-09-06: Stone Algebras
Author: Walter Guttmann
2016-09-01: Stirling's formula
Author: Manuel Eberl
2016-08-31: Routing
Authors: Julius Michaelis and Cornelius Diekmann
2016-08-24: Simple Firewall
Authors: Cornelius Diekmann, Julius Michaelis and Maximilian Haslbeck
2016-08-18: Infeasible Paths Elimination by Symbolic Execution Techniques: Proof of Correctness and Preservation of Paths
Authors: Romain Aissat, Frederic Voisin and Burkhart Wolff
2016-08-12: Formalizing the Edmonds-Karp Algorithm
Authors: Peter Lammich and S. Reza Sefidgar
2016-08-08: The Imperative Refinement Framework
Author: Peter Lammich
2016-08-07: Ptolemy's Theorem
Author: Lukas Bulwahn
2016-07-17: Surprise Paradox
Author: Joachim Breitner
2016-07-14: Pairing Heap
Authors: Hauke Brinkop and Tobias Nipkow
2016-07-05: A Framework for Verifying Depth-First Search Algorithms
Authors: Peter Lammich and René Neumann
2016-07-01: Chamber Complexes, Coxeter Systems, and Buildings
Author: Jeremy Sylvestre
2016-06-30: The Z Property
Authors: Bertram Felgenhauer, Julian Nagele, Vincent van Oostrom and Christian Sternagel
2016-06-30: The Resolution Calculus for First-Order Logic
Author: Anders Schlichtkrull
2016-06-28: IP Addresses
Authors: Cornelius Diekmann, Julius Michaelis and Lars Hupel
2016-06-28: Compositional Security-Preserving Refinement for Concurrent Imperative Programs
Authors: Toby Murray, Robert Sison, Edward Pierzchalski and Christine Rizkallah
2016-06-26: Category Theory with Adjunctions and Limits
Author: Eugene W. Stark
2016-06-26: Cardinality of Multisets
Author: Lukas Bulwahn
2016-06-25: A Dependent Security Type System for Concurrent Imperative Programs
Authors: Toby Murray, Robert Sison, Edward Pierzchalski and Christine Rizkallah
2016-06-21: Catalan Numbers
Author: Manuel Eberl
2016-06-18: Program Construction and Verification Components Based on Kleene Algebra
Authors: Victor B. F. Gomes and Georg Struth
2016-06-13: Conservation of CSP Noninterference Security under Concurrent Composition
Author: Pasquale Noce
2016-06-09: Finite Machine Word Library
Authors: Joel Beeren, Matthew Fernandez, Xin Gao, Gerwin Klein, Rafal Kolanski, Japheth Lim, Corey Lewis, Daniel Matichuk and Thomas Sewell
2016-05-31: Tree Decomposition
Author: Christoph Dittmann
2016-05-24: POSIX Lexing with Derivatives of Regular Expressions
Authors: Fahad Ausaf, Roy Dyckhoff and Christian Urban
2016-05-24: Cardinality of Equivalence Relations
Author: Lukas Bulwahn
2016-05-20: Perron-Frobenius Theorem for Spectral Radius Analysis
Authors: Jose Divasón, Ondřej Kunčar, - René Thiemann + René Thiemann and Akihisa Yamada
2016-05-20: The meta theory of the Incredible Proof Machine
Authors: Joachim Breitner and Denis Lohner
2016-05-18: A Constructive Proof for FLP
Authors: Benjamin Bisping, Paul-David Brodmann, Tim Jungnickel, Christina Rickmann, Henning Seidler, Anke Stüber, Arno Wilhelm-Weidner, Kirstin Peters and Uwe Nestmann
2016-05-09: A Formal Proof of the Max-Flow Min-Cut Theorem for Countable Networks
Author: Andreas Lochbihler
2016-05-05: Randomised Social Choice Theory
Author: Manuel Eberl
2016-05-04: The Incompatibility of SD-Efficiency and SD-Strategy-Proofness
Author: Manuel Eberl
2016-05-04: Spivey's Generalized Recurrence for Bell Numbers
Author: Lukas Bulwahn
2016-05-02: Gröbner Bases Theory
Authors: Fabian Immler and Alexander Maletzky
2016-04-28: No Faster-Than-Light Observers
Authors: Mike Stannett and István Németi
2016-04-27: Algorithms for Reduced Ordered Binary Decision Diagrams
Authors: Julius Michaelis, Maximilian Haslbeck, Peter Lammich and Lars Hupel
2016-04-27: A formalisation of the Cocke-Younger-Kasami algorithm
Author: Maksym Bortin
2016-04-26: Conservation of CSP Noninterference Security under Sequential Composition
Author: Pasquale Noce
2016-04-12: Kleene Algebras with Domain
Authors: Victor B. F. Gomes, Walter Guttmann, Peter Höfner, Georg Struth and Tjark Weber
2016-03-11: Propositional Resolution and Prime Implicates Generation
Author: Nicolas Peltier
2016-03-08: Timed Automata
Author: Simon Wimmer
2016-03-08: The Cartan Fixed Point Theorems
Author: Lawrence C. Paulson
2016-03-01: Linear Temporal Logic
Author: Salomon Sickert
2016-02-17: Analysis of List Update Algorithms
Authors: Maximilian P.L. Haslbeck and Tobias Nipkow
2016-02-05: Verified Construction of Static Single Assignment Form
Authors: Sebastian Ullrich and Denis Lohner
2016-01-29: Polynomial Interpolation
Authors: - René Thiemann + René Thiemann and Akihisa Yamada
2016-01-29: Polynomial Factorization
Authors: - René Thiemann + René Thiemann and Akihisa Yamada
2016-01-20: Knot Theory
Author: T.V.H. Prathamesh
2016-01-18: Tensor Product of Matrices
Author: T.V.H. Prathamesh
2016-01-14: Cardinality of Number Partitions
Author: Lukas Bulwahn

 

2015
2015-12-28: Basic Geometric Properties of Triangles
Author: Manuel Eberl
2015-12-28: The Divergence of the Prime Harmonic Series
Author: Manuel Eberl
2015-12-28: Liouville numbers
Author: Manuel Eberl
2015-12-28: Descartes' Rule of Signs
Author: Manuel Eberl
2015-12-22: The Stern-Brocot Tree
Authors: Peter Gammie and Andreas Lochbihler
2015-12-22: Applicative Lifting
Authors: Andreas Lochbihler and Joshua Schneider
2015-12-22: Algebraic Numbers in Isabelle/HOL
Authors: - René Thiemann, + René Thiemann, Akihisa Yamada and Sebastiaan Joosten
2015-12-12: Cardinality of Set Partitions
Author: Lukas Bulwahn
2015-12-02: Latin Square
Author: Alexander Bentkamp
2015-12-01: Ergodic Theory
Author: Sebastien Gouezel
2015-11-19: Euler's Partition Theorem
Author: Lukas Bulwahn
2015-11-18: The Tortoise and Hare Algorithm
Author: Peter Gammie
2015-11-11: Planarity Certificates
Author: Lars Noschinski
2015-11-02: Positional Determinacy of Parity Games
Author: Christoph Dittmann
2015-09-16: A Meta-Model for the Isabelle API
Authors: Frédéric Tuong and Burkhart Wolff
2015-09-04: Converting Linear Temporal Logic to Deterministic (Generalized) Rabin Automata
Author: Salomon Sickert
2015-08-21: Matrices, Jordan Normal Forms, and Spectral Radius Theory
Authors: - René Thiemann + René Thiemann and Akihisa Yamada
2015-08-20: Decreasing Diagrams II
Author: Bertram Felgenhauer
2015-08-18: The Inductive Unwinding Theorem for CSP Noninterference Security
Author: Pasquale Noce
2015-08-12: Representations of Finite Groups
Author: Jeremy Sylvestre
2015-08-10: Analysing and Comparing Encodability Criteria for Process Calculi
Authors: Kirstin Peters and Rob van Glabbeek
2015-07-21: Generating Cases from Labeled Subgoals
Author: Lars Noschinski
2015-07-14: Landau Symbols
Author: Manuel Eberl
2015-07-14: The Akra-Bazzi theorem and the Master theorem
Author: Manuel Eberl
2015-07-07: Hermite Normal Form
Authors: Jose Divasón and Jesús Aransay
2015-06-27: Derangements Formula
Author: Lukas Bulwahn
2015-06-11: The Ipurge Unwinding Theorem for CSP Noninterference Security
Author: Pasquale Noce
2015-06-11: The Generic Unwinding Theorem for CSP Noninterference Security
Author: Pasquale Noce
2015-06-11: Binary Multirelations
Authors: Hitoshi Furusawa and Georg Struth
2015-06-11: Reasoning about Lists via List Interleaving
Author: Pasquale Noce
2015-06-07: Parameterized Dynamic Tables
Author: Tobias Nipkow
2015-05-28: Derivatives of Logical Formulas
Author: Dmitriy Traytel
2015-05-27: A Zoo of Probabilistic Systems
Authors: Johannes Hölzl, Andreas Lochbihler and Dmitriy Traytel
2015-04-30: VCG - Combinatorial Vickrey-Clarke-Groves Auctions
Authors: Marco B. Caminati, Manfred Kerber, Christoph Lange and Colin Rowat
2015-04-15: Residuated Lattices
Authors: Victor B. F. Gomes and Georg Struth
2015-04-13: Concurrent IMP
Author: Peter Gammie
2015-04-13: Relaxing Safely: Verified On-the-Fly Garbage Collection for x86-TSO
Authors: Peter Gammie, Tony Hosking and Kai Engelhardt
2015-03-30: Trie
Authors: Andreas Lochbihler and Tobias Nipkow
2015-03-18: Consensus Refined
Authors: Ognjen Maric and Christoph Sprenger
2015-03-11: Deriving class instances for datatypes
Authors: Christian Sternagel - and René Thiemann + and René Thiemann
2015-02-20: The Safety of Call Arity
Author: Joachim Breitner
2015-02-12: QR Decomposition
Authors: Jose Divasón and Jesús Aransay
2015-02-12: Echelon Form
Authors: Jose Divasón and Jesús Aransay
2015-02-05: Finite Automata in Hereditarily Finite Set Theory
Author: Lawrence C. Paulson
2015-01-28: Verification of the UpDown Scheme
Author: Johannes Hölzl

 

2014
2014-11-28: The Unified Policy Framework (UPF)
Authors: Achim D. Brucker, Lukas Brügger and Burkhart Wolff
2014-10-23: Loop freedom of the (untimed) AODV routing protocol
Authors: Timothy Bourke and Peter Höfner
2014-10-13: Lifting Definition Option
Author: - René Thiemann + René Thiemann
2014-10-10: Stream Fusion in HOL with Code Generation
Authors: Andreas Lochbihler and Alexandra Maximova
2014-10-09: A Verified Compiler for Probability Density Functions
Authors: Manuel Eberl, Johannes Hölzl and Tobias Nipkow
2014-10-08: Formalization of Refinement Calculus for Reactive Systems
Author: Viorel Preoteasa
2014-10-03: XML
Authors: Christian Sternagel - and René Thiemann + and René Thiemann
2014-10-03: Certification Monads
Authors: Christian Sternagel - and René Thiemann + and René Thiemann
2014-09-25: Imperative Insertion Sort
Author: Christian Sternagel
2014-09-19: The Sturm-Tarski Theorem
Author: Wenda Li
2014-09-15: The Cayley-Hamilton Theorem
Authors: Stephan Adelsberger, Stefan Hetzl and Florian Pollak
2014-09-09: The Jordan-Hölder Theorem
Author: Jakob von Raumer
2014-09-04: Priority Queues Based on Braun Trees
Author: Tobias Nipkow
2014-09-03: Gauss-Jordan Algorithm and Its Applications
Authors: Jose Divasón and Jesús Aransay
2014-08-29: Vector Spaces
Author: Holden Lee
2014-08-29: Real-Valued Special Functions: Upper and Lower Bounds
Author: Lawrence C. Paulson
2014-08-13: Skew Heap
Author: Tobias Nipkow
2014-08-12: Splay Tree
Author: Tobias Nipkow
2014-07-29: Haskell's Show Class in Isabelle/HOL
Authors: Christian Sternagel - and René Thiemann + and René Thiemann
2014-07-18: Formal Specification of a Generic Separation Kernel
Authors: Freek Verbeek, Sergey Tverdyshev, Oto Havle, Holger Blasum, Bruno Langenstein, Werner Stephan, Yakoub Nemouchi, Abderrahmane Feliachi, Burkhart Wolff and Julien Schmaltz
2014-07-13: pGCL for Isabelle
Author: David Cock
2014-07-07: Amortized Complexity Verified
Author: Tobias Nipkow
2014-07-04: Network Security Policy Verification
Author: Cornelius Diekmann
2014-07-03: Pop-Refinement
Author: Alessandro Coglio
2014-06-12: Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions
Authors: Dmitriy Traytel and Tobias Nipkow
2014-06-08: Boolean Expression Checkers
Author: Tobias Nipkow
2014-05-28: Promela Formalization
Author: René Neumann
2014-05-28: Converting Linear-Time Temporal Logic to Generalized Büchi Automata
Authors: Alexander Schimpf and Peter Lammich
2014-05-28: Verified Efficient Implementation of Gabow's Strongly Connected Components Algorithm
Author: Peter Lammich
2014-05-28: A Fully Verified Executable LTL Model Checker
Authors: Javier Esparza, Peter Lammich, René Neumann, Tobias Nipkow, Alexander Schimpf and Jan-Georg Smaus
2014-05-28: The CAVA Automata Library
Author: Peter Lammich
2014-05-23: Transitive closure according to Roy-Floyd-Warshall
Author: Makarius Wenzel
2014-05-23: Noninterference Security in Communicating Sequential Processes
Author: Pasquale Noce
2014-05-21: Regular Algebras
Authors: Simon Foster and Georg Struth
2014-04-28: Formalisation and Analysis of Component Dependencies
Author: Maria Spichkova
2014-04-23: A Formalization of Declassification with WHAT-and-WHERE-Security
Authors: Sylvia Grewe, Alexander Lux, Heiko Mantel and Jens Sauer
2014-04-23: A Formalization of Strong Security
Authors: Sylvia Grewe, Alexander Lux, Heiko Mantel and Jens Sauer
2014-04-23: A Formalization of Assumptions and Guarantees for Compositional Noninterference
Authors: Sylvia Grewe, Heiko Mantel and Daniel Schoepe
2014-04-22: Bounded-Deducibility Security
Authors: Andrei Popescu and Peter Lammich
2014-04-16: A shallow embedding of HyperCTL*
Authors: Markus N. Rabe, Peter Lammich and Andrei Popescu
2014-04-16: Abstract Completeness
Authors: Jasmin Christian Blanchette, Andrei Popescu and Dmitriy Traytel
2014-04-13: Discrete Summation
Author: Florian Haftmann
2014-04-03: Syntax and semantics of a GPU kernel programming language
Author: John Wickerson
2014-03-11: Probabilistic Noninterference
Authors: Andrei Popescu and Johannes Hölzl
2014-03-08: Mechanization of the Algebra for Wireless Networks (AWN)
Author: Timothy Bourke
2014-02-18: Mutually Recursive Partial Functions
Author: - René Thiemann + René Thiemann
2014-02-13: Properties of Random Graphs -- Subgraph Containment
Author: Lars Hupel
2014-02-11: Verification of Selection and Heap Sort Using Locales
Author: Danijela Petrovic
2014-02-07: Affine Arithmetic
Author: Fabian Immler
2014-02-06: Implementing field extensions of the form Q[sqrt(b)]
Author: - René Thiemann + René Thiemann
2014-01-30: Unified Decision Procedures for Regular Expression Equivalence
Authors: Tobias Nipkow and Dmitriy Traytel
2014-01-28: Secondary Sylow Theorems
Author: Jakob von Raumer
2014-01-25: Relation Algebra
Authors: Alasdair Armstrong, Simon Foster, Georg Struth and Tjark Weber
2014-01-23: Kleene Algebra with Tests and Demonic Refinement Algebras
Authors: Alasdair Armstrong, Victor B. F. Gomes and Georg Struth
2014-01-16: Featherweight OCL: A Proposal for a Machine-Checked Formal Semantics for OCL 2.5
Authors: Achim D. Brucker, Frédéric Tuong and Burkhart Wolff
2014-01-11: Sturm's Theorem
Author: Manuel Eberl
2014-01-11: Compositional Properties of Crypto-Based Components
Author: Maria Spichkova

 

2013
2013-12-01: A General Method for the Proof of Theorems on Tail-recursive Functions
Author: Pasquale Noce
2013-11-17: Gödel's Incompleteness Theorems
Author: Lawrence C. Paulson
2013-11-17: The Hereditarily Finite Sets
Author: Lawrence C. Paulson
2013-11-15: A Codatatype of Formal Languages
Author: Dmitriy Traytel
2013-11-14: Stream Processing Components: Isabelle/HOL Formalisation and Case Studies
Author: Maria Spichkova
2013-11-12: Gödel's God in Isabelle/HOL
Authors: Christoph Benzmüller and Bruno Woltzenlogel Paleo
2013-11-01: Decreasing Diagrams
Author: Harald Zankl
2013-10-02: Automatic Data Refinement
Author: Peter Lammich
2013-09-17: Native Word
Author: Andreas Lochbihler
2013-07-27: A Formal Model of IEEE Floating Point Arithmetic
Author: Lei Yu
2013-07-22: Pratt's Primality Certificates
Authors: Simon Wimmer and Lars Noschinski
2013-07-22: Lehmer's Theorem
Authors: Simon Wimmer and Lars Noschinski
2013-07-19: The Königsberg Bridge Problem and the Friendship Theorem
Author: Wenda Li
2013-06-27: Sound and Complete Sort Encodings for First-Order Logic
Authors: Jasmin Christian Blanchette and Andrei Popescu
2013-05-22: An Axiomatic Characterization of the Single-Source Shortest Path Problem
Author: Christine Rizkallah
2013-04-28: Graph Theory
Author: Lars Noschinski
2013-04-15: Light-weight Containers
Author: Andreas Lochbihler
2013-02-21: Nominal 2
Authors: Christian Urban, Stefan Berghofer and Cezary Kaliszyk
2013-01-31: The Correctness of Launchbury's Natural Semantics for Lazy Evaluation
Author: Joachim Breitner
2013-01-19: Ribbon Proofs
Author: John Wickerson
2013-01-16: Rank-Nullity Theorem in Linear Algebra
Authors: Jose Divasón and Jesús Aransay
2013-01-15: Kleene Algebra
Authors: Alasdair Armstrong, Georg Struth and Tjark Weber
2013-01-03: Computing N-th Roots using the Babylonian Method
Author: - René Thiemann + René Thiemann

 

2012
2012-11-14: A Separation Logic Framework for Imperative HOL
Authors: Peter Lammich and Rene Meis
2012-11-02: Open Induction
Authors: Mizuhito Ogawa and Christian Sternagel
2012-10-30: The independence of Tarski's Euclidean axiom
Author: T. J. M. Makarios
2012-10-27: Bondy's Theorem
Authors: Jeremy Avigad and Stefan Hetzl
2012-09-10: Possibilistic Noninterference
Authors: Andrei Popescu and Johannes Hölzl
2012-08-07: Generating linear orders for datatypes
Author: - René Thiemann + René Thiemann
2012-08-05: Proving the Impossibility of Trisecting an Angle and Doubling the Cube
Authors: Ralph Romanos and Lawrence C. Paulson
2012-07-27: Verifying Fault-Tolerant Distributed Algorithms in the Heard-Of Model
Authors: Henri Debrat and Stephan Merz
2012-07-01: Logical Relations for PCF
Author: Peter Gammie
2012-06-26: Type Constructor Classes and Monad Transformers
Author: Brian Huffman
2012-05-29: Psi-calculi in Isabelle
Author: Jesper Bengtson
2012-05-29: The pi-calculus in nominal logic
Author: Jesper Bengtson
2012-05-29: CCS in nominal logic
Author: Jesper Bengtson
2012-05-27: Isabelle/Circus
Authors: Abderrahmane Feliachi, Burkhart Wolff and Marie-Claude Gaudel
2012-05-11: Separation Algebra
Authors: Gerwin Klein, Rafal Kolanski and Andrew Boyton
2012-05-07: Stuttering Equivalence
Author: Stephan Merz
2012-05-02: Inductive Study of Confidentiality
Author: Giampaolo Bella
2012-04-26: Ordinary Differential Equations
Authors: Fabian Immler and Johannes Hölzl
2012-04-13: Well-Quasi-Orders
Author: Christian Sternagel
2012-03-01: Abortable Linearizable Modules
Authors: Rachid Guerraoui, Viktor Kuncak and Giuliano Losa
2012-02-29: Executable Transitive Closures
Author: - René Thiemann + René Thiemann
2012-02-06: A Probabilistic Proof of the Girth-Chromatic Number Theorem
Author: Lars Noschinski
2012-01-30: Refinement for Monadic Programs
Author: Peter Lammich
2012-01-30: Dijkstra's Shortest Path Algorithm
Authors: Benedikt Nordhoff and Peter Lammich
2012-01-03: Markov Models
Authors: Johannes Hölzl and Tobias Nipkow

 

2011
2011-11-19: A Definitional Encoding of TLA* in Isabelle/HOL
Authors: Gudmund Grov and Stephan Merz
2011-11-09: Efficient Mergesort
Author: Christian Sternagel
2011-09-22: Pseudo Hoops
Authors: George Georgescu, Laurentiu Leustean and Viorel Preoteasa
2011-09-22: Algebra of Monotonic Boolean Transformers
Author: Viorel Preoteasa
2011-09-22: Lattice Properties
Author: Viorel Preoteasa
2011-08-26: The Myhill-Nerode Theorem Based on Regular Expressions
Authors: Chunhan Wu, Xingyuan Zhang and Christian Urban
2011-08-19: Gauss-Jordan Elimination for Matrices Represented as Functions
Author: Tobias Nipkow
2011-07-21: Maximum Cardinality Matching
Author: Christine Rizkallah
2011-05-17: Knowledge-based programs
Author: Peter Gammie
2011-04-01: The General Triangle Is Unique
Author: Joachim Breitner
2011-03-14: Executable Transitive Closures of Finite Relations
Authors: Christian Sternagel - and René Thiemann + and René Thiemann
2011-02-23: Interval Temporal Logic on Natural Numbers
Author: David Trachtenherz
2011-02-23: Infinite Lists
Author: David Trachtenherz
2011-02-23: AutoFocus Stream Processing for Single-Clocking and Multi-Clocking Semantics
Author: David Trachtenherz
2011-02-07: Lightweight Java
Authors: Rok Strniša and Matthew Parkinson
2011-01-10: RIPEMD-160
Author: Fabian Immler
2011-01-08: Lower Semicontinuous Functions
Author: Bogdan Grechuk

 

2010
2010-12-17: Hall's Marriage Theorem
Authors: Dongchen Jiang and Tobias Nipkow
2010-11-16: Shivers' Control Flow Analysis
Author: Joachim Breitner
2010-10-28: Finger Trees
Authors: Benedikt Nordhoff, Stefan Körner and Peter Lammich
2010-10-28: Functional Binomial Queues
Author: René Neumann
2010-10-28: Binomial Heaps and Skew Binomial Heaps
Authors: Rene Meis, Finn Nielsen and Peter Lammich
2010-08-29: Strong Normalization of Moggis's Computational Metalanguage
Author: Christian Doczkal
2010-08-10: Executable Multivariate Polynomials
Authors: Christian Sternagel, - René Thiemann, + René Thiemann, Alexander Maletzky, Fabian Immler, Florian Haftmann, Andreas Lochbihler and Alexander Bentkamp
2010-08-08: Formalizing Statecharts using Hierarchical Automata
Authors: Steffen Helke and Florian Kammüller
2010-06-24: Free Groups
Author: Joachim Breitner
2010-06-20: Category Theory
Author: Alexander Katovsky
2010-06-17: Executable Matrix Operations on Matrices of Arbitrary Dimensions
Authors: Christian Sternagel - and René Thiemann + and René Thiemann
2010-06-14: Abstract Rewriting
Authors: Christian Sternagel - and René Thiemann + and René Thiemann
2010-05-28: Verification of the Deutsch-Schorr-Waite Graph Marking Algorithm using Data Refinement
Authors: Viorel Preoteasa and Ralph-Johan Back
2010-05-28: Semantics and Data Refinement of Invariant Based Programs
Authors: Viorel Preoteasa and Ralph-Johan Back
2010-05-22: A Complete Proof of the Robbins Conjecture
Author: Matthew Wampler-Doty
2010-05-12: Regular Sets and Expressions
Authors: Alexander Krauss and Tobias Nipkow
2010-04-30: Locally Nameless Sigma Calculus
Authors: Ludovic Henrio, Florian Kammüller, Bianca Lutz and Henry Sudhof
2010-03-29: Free Boolean Algebra
Author: Brian Huffman
2010-03-23: Inter-Procedural Information Flow Noninterference via Slicing
Author: Daniel Wasserrab
2010-03-23: Information Flow Noninterference via Slicing
Author: Daniel Wasserrab
2010-02-20: List Index
Author: Tobias Nipkow
2010-02-12: Coinductive
Author: Andreas Lochbihler

 

2009
2009-12-09: A Fast SAT Solver for Isabelle in Standard ML
Author: Armin Heller
2009-12-03: Formalizing the Logic-Automaton Connection
Authors: Stefan Berghofer and Markus Reiter
2009-11-25: Tree Automata
Author: Peter Lammich
2009-11-25: Collections Framework
Author: Peter Lammich
2009-11-22: Perfect Number Theorem
Author: Mark Ijbema
2009-11-13: Backing up Slicing: Verifying the Interprocedural Two-Phase Horwitz-Reps-Binkley Slicer
Author: Daniel Wasserrab
2009-10-30: The Worker/Wrapper Transformation
Author: Peter Gammie
2009-09-01: Ordinals and Cardinals
Author: Andrei Popescu
2009-08-28: Invertibility in Sequent Calculi
Author: Peter Chapman
2009-08-04: An Example of a Cofinitary Group in Isabelle/HOL
Author: Bart Kastermans
2009-05-06: Code Generation for Functions as Data
Author: Andreas Lochbihler
2009-04-29: Stream Fusion
Author: Brian Huffman

 

2008
2008-12-12: A Bytecode Logic for JML and Types
Authors: Lennart Beringer and Martin Hofmann
2008-11-10: Secure information flow and program logics
Authors: Lennart Beringer and Martin Hofmann
2008-11-09: Some classical results in Social Choice Theory
Author: Peter Gammie
2008-11-07: Fun With Tilings
Authors: Tobias Nipkow and Lawrence C. Paulson
2008-10-15: The Textbook Proof of Huffman's Algorithm
Author: Jasmin Christian Blanchette
2008-09-16: Towards Certified Slicing
Author: Daniel Wasserrab
2008-09-02: A Correctness Proof for the Volpano/Smith Security Typing System
Authors: Gregor Snelting and Daniel Wasserrab
2008-09-01: Arrow and Gibbard-Satterthwaite
Author: Tobias Nipkow
2008-08-26: Fun With Functions
Author: Tobias Nipkow
2008-07-23: Formal Verification of Modern SAT Solvers
Author: Filip Marić
2008-04-05: Recursion Theory I
Author: Michael Nedzelsky
2008-02-29: A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment
Author: Norbert Schirmer
2008-02-29: BDD Normalisation
Authors: Veronika Ortner and Norbert Schirmer
2008-02-18: Normalization by Evaluation
Authors: Klaus Aehlig and Tobias Nipkow
2008-01-11: Quantifier Elimination for Linear Arithmetic
Author: Tobias Nipkow

 

2007
2007-12-14: Formalization of Conflict Analysis of Programs with Procedures, Thread Creation, and Monitors
Authors: Peter Lammich and Markus Müller-Olm
2007-12-03: Jinja with Threads
Author: Andreas Lochbihler
2007-11-06: Much Ado About Two
Author: Sascha Böhme
2007-08-12: Sums of Two and Four Squares
Author: Roelof Oosterhuis
2007-08-12: Fermat's Last Theorem for Exponents 3 and 4 and the Parametrisation of Pythagorean Triples
Author: Roelof Oosterhuis
2007-08-08: Fundamental Properties of Valuation Theory and Hensel's Lemma
Author: Hidetsune Kobayashi
2007-08-02: POPLmark Challenge Via de Bruijn Indices
Author: Stefan Berghofer
2007-08-02: First-Order Logic According to Fitting
Author: Stefan Berghofer

 

2006
2006-09-09: Hotel Key Card System
Author: Tobias Nipkow
2006-08-08: Abstract Hoare Logics
Author: Tobias Nipkow
2006-05-22: Flyspeck I: Tame Graphs
Authors: Gertrud Bauer and Tobias Nipkow
2006-05-15: CoreC++
Author: Daniel Wasserrab
2006-03-31: A Theory of Featherweight Java in Isabelle/HOL
Authors: J. Nathan Foster and Dimitrios Vytiniotis
2006-03-15: Instances of Schneider's generalized protocol of clock synchronization
Author: Damián Barsotti
2006-03-14: Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality
Author: Benjamin Porter

 

2005
2005-11-11: Countable Ordinals
Author: Brian Huffman
2005-10-12: Fast Fourier Transform
Author: Clemens Ballarin
2005-06-24: Formalization of a Generalized Protocol for Clock Synchronization
Author: Alwen Tiu
2005-06-22: Proving the Correctness of Disk Paxos
Authors: Mauro Jaskelioff and Stephan Merz
2005-06-20: Jive Data and Store Model
Authors: Nicole Rauch and Norbert Schirmer
2005-06-01: Jinja is not Java
Authors: Gerwin Klein and Tobias Nipkow
2005-05-02: SHA1, RSA, PSS and more
Authors: Christina Lindenberg and Kai Wirt
2005-04-21: Category Theory to Yoneda's Lemma
Author: Greg O'Keefe

 

2004
2004-12-09: File Refinement
Authors: Karen Zee and Viktor Kuncak
2004-11-19: Integration theory and random variables
Author: Stefan Richter
2004-09-28: A Mechanically Verified, Efficient, Sound and Complete Theorem Prover For First Order Logic
Author: Tom Ridge
2004-09-20: Ramsey's theorem, infinitary version
Author: Tom Ridge
2004-09-20: Completeness theorem
Authors: James Margetson and Tom Ridge
2004-07-09: Compiling Exceptions Correctly
Author: Tobias Nipkow
2004-06-24: Depth First Search
Authors: Toshiaki Nishihara and Yasuhiko Minamide
2004-05-18: Groups, Rings and Modules
Authors: Hidetsune Kobayashi, L. Chen and H. Murao
2004-04-26: Topology
Author: Stefan Friedrich
2004-04-26: Lazy Lists II
Author: Stefan Friedrich
2004-04-05: Binary Search Trees
Author: Viktor Kuncak
2004-03-30: Functional Automata
Author: Tobias Nipkow
2004-03-19: Mini ML
Authors: Wolfgang Naraschewski and Tobias Nipkow
2004-03-19: AVL Trees
Authors: Tobias Nipkow and Cornelia Pusch
\ No newline at end of file diff --git a/web/rss.xml b/web/rss.xml --- a/web/rss.xml +++ b/web/rss.xml @@ -1,614 +1,594 @@ Archive of Formal Proofs https://www.isa-afp.org The Archive of Formal Proofs is a collection of proof libraries, examples, and larger scientific developments, mechanically checked in the theorem prover Isabelle. - 24 Feb 2021 00:00:00 +0000 + 12 Mar 2021 00:00:00 +0000 + + Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation + https://www.isa-afp.org/entries/Modular_arithmetic_LLL_and_HNF_algorithms.html + https://www.isa-afp.org/entries/Modular_arithmetic_LLL_and_HNF_algorithms.html + Ralph Bottesch, Jose Divasón, René Thiemann + 12 Mar 2021 00:00:00 +0000 + +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. + + + Quantum projective measurements and the CHSH inequality + https://www.isa-afp.org/entries/Projective_Measurements.html + https://www.isa-afp.org/entries/Projective_Measurements.html + Mnacho Echenim + 03 Mar 2021 00:00:00 +0000 + +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. + + + The Hermite–Lindemann–Weierstraß Transcendence Theorem + https://www.isa-afp.org/entries/Hermite_Lindemann.html + https://www.isa-afp.org/entries/Hermite_Lindemann.html + Manuel Eberl + 03 Mar 2021 00:00:00 +0000 + +<p>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.</p> +<p>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}$.</p> +<p>Like the <a +href="https://doi.org/10.1007/978-3-319-66107-0_5">previous +formalisation in Coq by Bernard</a>, I proceeded by formalising +<a +href="https://doi.org/10.1017/CBO9780511565977">Baker's +version of the theorem and proof</a> and then deriving the +original one from that. Baker's version states that for any +algebraic numbers $\beta_1, \ldots, \beta_n\in\mathbb{C}$ and distinct +algebraic numbers $\alpha_i, \ldots, \alpha_n\in\mathbb{C}$, we have +$\beta_1 e^{\alpha_1} + \ldots + \beta_n e^{\alpha_n} = 0$ if and only +if all the $\beta_i$ are zero.</p> <p>This has a number of +direct corollaries, e.g.:</p> <ul> <li>$e$ and $\pi$ +are transcendental</li> <li>$e^z$, $\sin z$, $\tan z$, +etc. are transcendental for algebraic +$z\in\mathbb{C}\setminus\{0\}$</li> <li>$\ln z$ is +transcendental for algebraic $z\in\mathbb{C}\setminus\{0, +1\}$</li> </ul> + + + Mereology + https://www.isa-afp.org/entries/Mereology.html + https://www.isa-afp.org/entries/Mereology.html + Ben Blumson + 01 Mar 2021 00:00:00 +0000 + +We use Isabelle/HOL to verify elementary theorems and alternative +axiomatizations of classical extensional mereology. + + + The Sunflower Lemma of Erdős and Rado + https://www.isa-afp.org/entries/Sunflowers.html + https://www.isa-afp.org/entries/Sunflowers.html + René Thiemann + 25 Feb 2021 00:00:00 +0000 + +We formally define sunflowers and provide a formalization of the +sunflower lemma of Erd&odblac;s and Rado: whenever a set of +size-<i>k</i>-sets has a larger cardinality than +<i>(r - 1)<sup>k</sup> &middot; k!</i>, +then it contains a sunflower of cardinality <i>r</i>. + A Verified Imperative Implementation of B-Trees https://www.isa-afp.org/entries/BTree.html https://www.isa-afp.org/entries/BTree.html Niels Mündler 24 Feb 2021 00:00:00 +0000 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 and insertion queries with efficient binary search for intra-node navigation. This is accomplished by first specifying the structure abstractly in the functional modeling language HOL and proving functional correctness. Using manual refinement, we derive an imperative implementation in Imperative/HOL. We show the validity of this refinement using the separation logic utilities from the <a href="https://www.isa-afp.org/entries/Refine_Imperative_HOL.html"> Isabelle Refinement Framework </a> . The code can be exported to the programming languages SML and Scala. We examine the runtime of all operations indirectly by reproducing results of the logarithmic relationship between height and the number of nodes. The results are discussed in greater detail in the corresponding <a href="https://mediatum.ub.tum.de/1596550">Bachelor's Thesis</a>. Formal Puiseux Series https://www.isa-afp.org/entries/Formal_Puiseux_Series.html https://www.isa-afp.org/entries/Formal_Puiseux_Series.html Manuel Eberl 17 Feb 2021 00:00:00 +0000 <p>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 <em>N</em> is an integer and <em>d</em> is a positive integer.</p> <p>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.</p> The Laws of Large Numbers https://www.isa-afp.org/entries/Laws_of_Large_Numbers.html https://www.isa-afp.org/entries/Laws_of_Large_Numbers.html Manuel Eberl 10 Feb 2021 00:00:00 +0000 <p>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]$.</p> <p> 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:</p> <ul> <li>The Weak Law of Large Numbers states that $\overline{X}_{n} \longrightarrow E[X_1]$ in probability for $n\to\infty$, i.e. $\mathcal{P}(|\overline{X}_{n} - E[X_1]| > \varepsilon) \longrightarrow 0$ as $n\to\infty$ for any $\varepsilon > 0$.</li> <li>The Strong Law of Large Numbers states that $\overline{X}_{n} \longrightarrow E[X_1]$ almost surely for $n\to\infty$, i.e. $\mathcal{P}(\overline{X}_{n} \longrightarrow E[X_1]) = 1$.</li> </ul> <p>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.</p> Tarski's Parallel Postulate implies the 5th Postulate of Euclid, the Postulate of Playfair and the original Parallel Postulate of Euclid https://www.isa-afp.org/entries/IsaGeoCoq.html https://www.isa-afp.org/entries/IsaGeoCoq.html Roland Coghetto 31 Jan 2021 00:00:00 +0000 <p>The <a href="https://geocoq.github.io/GeoCoq/">GeoCoq library</a> contains a formalization of geometry using the Coq proof assistant. It contains both proofs about the foundations of geometry and high-level proofs in the same style as in high school. We port a part of the GeoCoq 2.4.0 library to Isabelle/HOL: more precisely, the files Chap02.v to Chap13_3.v, suma.v as well as the associated definitions and some useful files for the demonstration of certain parallel postulates. The synthetic approach of the demonstrations is directly inspired by those contained in GeoCoq. The names of the lemmas and theorems used are kept as far as possible as well as the definitions. </p> <p>It should be noted that T.J.M. Makarios has done <a href="https://www.isa-afp.org/entries/Tarskis_Geometry.html">some proofs in Tarski's Geometry</a>. It uses a definition that does not quite coincide with the definition used in Geocoq and here. Furthermore, corresponding definitions in the <a href="https://www.isa-afp.org/entries/Poincare_Disc.html">Poincaré Disc Model development</a> are not identical to those defined in GeoCoq. </p> <p>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. </p> Solution to the xkcd Blue Eyes puzzle https://www.isa-afp.org/entries/Blue_Eyes.html https://www.isa-afp.org/entries/Blue_Eyes.html Jakub Kądziołka 30 Jan 2021 00:00:00 +0000 In a <a href="https://xkcd.com/blue_eyes.html">puzzle published by Randall Munroe</a>, perfect logicians forbidden from communicating are stranded on an island, and may only leave once they have figured out their own eye color. We present a method of modeling the behavior of perfect logicians and formalize a solution of the puzzle. Hood-Melville Queue https://www.isa-afp.org/entries/Hood_Melville_Queue.html https://www.isa-afp.org/entries/Hood_Melville_Queue.html Alejandro Gómez-Londoño 18 Jan 2021 00:00:00 +0000 This is a verified implementation of a constant time queue. The original design is due to <a href="https://doi.org/10.1016/0020-0190(81)90030-2">Hood and Melville</a>. This formalization follows the presentation in <em>Purely Functional Data Structures</em>by Okasaki. JinjaDCI: a Java semantics with dynamic class initialization https://www.isa-afp.org/entries/JinjaDCI.html https://www.isa-afp.org/entries/JinjaDCI.html Susannah Mansky 11 Jan 2021 00:00:00 +0000 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). Cofinality and the Delta System Lemma https://www.isa-afp.org/entries/Delta_System_Lemma.html https://www.isa-afp.org/entries/Delta_System_Lemma.html Pedro Sánchez Terraf 27 Dec 2020 00:00:00 +0000 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. Topological semantics for paraconsistent and paracomplete logics https://www.isa-afp.org/entries/Topological_Semantics.html https://www.isa-afp.org/entries/Topological_Semantics.html David Fuenmayor 17 Dec 2020 00:00:00 +0000 We introduce a generalized topological semantics for paraconsistent and paracomplete logics by drawing upon early works on topological Boolean algebras (cf. works by Kuratowski, Zarycki, McKinsey & Tarski, etc.). In particular, this work exemplarily illustrates the shallow semantical embeddings approach (<a href="http://dx.doi.org/10.1007/s11787-012-0052-y">SSE</a>) employing the proof assistant Isabelle/HOL. By means of the SSE technique we can effectively harness theorem provers, model finders and 'hammers' for reasoning with quantified non-classical logics. Relational Minimum Spanning Tree Algorithms https://www.isa-afp.org/entries/Relational_Minimum_Spanning_Trees.html https://www.isa-afp.org/entries/Relational_Minimum_Spanning_Trees.html Walter Guttmann, Nicolas Robinson-O'Brien 08 Dec 2020 00:00:00 +0000 We verify the correctness of Prim's, Kruskal's and Borůvka's minimum spanning tree algorithms based on algebras for aggregation and minimisation. Inline Caching and Unboxing Optimization for Interpreters https://www.isa-afp.org/entries/Interpreter_Optimizations.html https://www.isa-afp.org/entries/Interpreter_Optimizations.html Martin Desharnais 07 Dec 2020 00:00:00 +0000 This Isabelle/HOL formalization builds on the <em>VeriComp</em> entry of the <em>Archive of Formal Proofs</em> to provide the following contributions: <ul> <li>an operational semantics for a realistic virtual machine (Std) for dynamically typed programming languages;</li> <li>the formalization of an inline caching optimization (Inca), a proof of bisimulation with (Std), and a compilation function;</li> <li>the formalization of an unboxing optimization (Ubx), a proof of bisimulation with (Inca), and a simple compilation function.</li> </ul> This formalization was described in the CPP 2021 paper <em>Towards Efficient and Verified Virtual Machines for Dynamic Languages</em> The Relational Method with Message Anonymity for the Verification of Cryptographic Protocols https://www.isa-afp.org/entries/Relational_Method.html https://www.isa-afp.org/entries/Relational_Method.html Pasquale Noce 05 Dec 2020 00:00:00 +0000 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. Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information https://www.isa-afp.org/entries/Isabelle_Marries_Dirac.html https://www.isa-afp.org/entries/Isabelle_Marries_Dirac.html Anthony Bordg, Hanna Lachnitt, Yijun He 22 Nov 2020 00:00:00 +0000 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. The HOL-CSP Refinement Toolkit https://www.isa-afp.org/entries/CSP_RefTK.html https://www.isa-afp.org/entries/CSP_RefTK.html Safouan Taha, Burkhart Wolff, Lina Ye 19 Nov 2020 00:00:00 +0000 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. Verified SAT-Based AI Planning https://www.isa-afp.org/entries/Verified_SAT_Based_AI_Planning.html https://www.isa-afp.org/entries/Verified_SAT_Based_AI_Planning.html Mohammad Abdulaziz, Friedrich Kurz 29 Oct 2020 00:00:00 +0000 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. AI Planning Languages Semantics https://www.isa-afp.org/entries/AI_Planning_Languages_Semantics.html https://www.isa-afp.org/entries/AI_Planning_Languages_Semantics.html Mohammad Abdulaziz, Peter Lammich 29 Oct 2020 00:00:00 +0000 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. A Sound Type System for Physical Quantities, Units, and Measurements https://www.isa-afp.org/entries/Physical_Quantities.html https://www.isa-afp.org/entries/Physical_Quantities.html Simon Foster, Burkhart Wolff 20 Oct 2020 00:00:00 +0000 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). Finite Map Extras https://www.isa-afp.org/entries/Finite-Map-Extras.html https://www.isa-afp.org/entries/Finite-Map-Extras.html Javier Díaz 12 Oct 2020 00:00:00 +0000 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. A Formal Model of the Safely Composable Document Object Model with Shadow Roots https://www.isa-afp.org/entries/Shadow_SC_DOM.html https://www.isa-afp.org/entries/Shadow_SC_DOM.html Achim D. Brucker, Michael Herzberg 28 Sep 2020 00:00:00 +0000 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. A Formal Model of the Document Object Model with Shadow Roots https://www.isa-afp.org/entries/Shadow_DOM.html https://www.isa-afp.org/entries/Shadow_DOM.html Achim D. Brucker, Michael Herzberg 28 Sep 2020 00:00:00 +0000 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. A Formalization of Safely Composable Web Components https://www.isa-afp.org/entries/SC_DOM_Components.html https://www.isa-afp.org/entries/SC_DOM_Components.html Achim D. Brucker, Michael Herzberg 28 Sep 2020 00:00:00 +0000 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. A Formalization of Web Components https://www.isa-afp.org/entries/DOM_Components.html https://www.isa-afp.org/entries/DOM_Components.html Achim D. Brucker, Michael Herzberg 28 Sep 2020 00:00:00 +0000 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. The Safely Composable DOM https://www.isa-afp.org/entries/Core_SC_DOM.html https://www.isa-afp.org/entries/Core_SC_DOM.html Achim D. Brucker, Michael Herzberg 28 Sep 2020 00:00:00 +0000 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. Syntax-Independent Logic Infrastructure https://www.isa-afp.org/entries/Syntax_Independent_Logic.html https://www.isa-afp.org/entries/Syntax_Independent_Logic.html Andrei Popescu, Dmitriy Traytel 16 Sep 2020 00:00:00 +0000 We formalize a notion of logic whose terms and formulas are kept abstract. In particular, logical connectives, substitution, free variables, and provability are not defined, but characterized by their general properties as locale assumptions. Based on this abstract characterization, we develop further reusable reasoning infrastructure. For example, we define parallel substitution (along with proving its characterizing theorems) from single-point substitution. Similarly, we develop a natural deduction style proof system starting from the abstract Hilbert-style one. These one-time efforts benefit different concrete logics satisfying our locales' assumptions. We instantiate the syntax-independent logic infrastructure to Robinson arithmetic (also known as Q) in the AFP entry <a href="https://www.isa-afp.org/entries/Robinson_Arithmetic.html">Robinson_Arithmetic</a> and to hereditarily finite set theory in the AFP entries <a href="https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a> and <a href="https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>, which are part of our formalization of G&ouml;del's Incompleteness Theorems described in our CADE-27 paper <a href="https://dx.doi.org/10.1007/978-3-030-29436-6_26">A Formally Verified Abstract Account of Gödel's Incompleteness Theorems</a>. Robinson Arithmetic https://www.isa-afp.org/entries/Robinson_Arithmetic.html https://www.isa-afp.org/entries/Robinson_Arithmetic.html Andrei Popescu, Dmitriy Traytel 16 Sep 2020 00:00:00 +0000 We instantiate our syntax-independent logic infrastructure developed in <a href="https://www.isa-afp.org/entries/Syntax_Independent_Logic.html">a separate AFP entry</a> to the FOL theory of Robinson arithmetic (also known as Q). The latter was formalised using Nominal Isabelle by adapting <a href="https://www.isa-afp.org/entries/Incompleteness.html">Larry Paulson’s formalization of the Hereditarily Finite Set theory</a>. - - An Abstract Formalization of Gödel's Incompleteness Theorems - https://www.isa-afp.org/entries/Goedel_Incompleteness.html - https://www.isa-afp.org/entries/Goedel_Incompleteness.html - Andrei Popescu, Dmitriy Traytel - 16 Sep 2020 00:00:00 +0000 - -We present an abstract formalization of G&ouml;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&ndash;Paulson semantics-based approach. This -AFP entry is the main entry point to the results described in our -CADE-27 paper <a -href="https://dx.doi.org/10.1007/978-3-030-29436-6_26">A -Formally Verified Abstract Account of Gödel's Incompleteness -Theorems</a>. As part of our abstract formalization's -validation, we instantiate our locales twice in the separate AFP -entries <a -href="https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a> -and <a -href="https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>. - - - From Abstract to Concrete Gödel's Incompleteness Theorems—Part II - https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html - https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html - Andrei Popescu, Dmitriy Traytel - 16 Sep 2020 00:00:00 +0000 - -We validate an abstract formulation of G&ouml;del's Second -Incompleteness Theorem from a <a -href="https://www.isa-afp.org/entries/Goedel_Incompleteness.html">separate -AFP entry</a> by instantiating it to the case of <i>finite -consistent extensions of the Hereditarily Finite (HF) Set -theory</i>, i.e., consistent FOL theories extending the HF Set -theory with a finite set of axioms. The instantiation draws heavily -on infrastructure previously developed by Larry Paulson in his <a -href="https://www.isa-afp.org/entries/Incompleteness.html">direct -formalisation of the concrete result</a>. It strengthens -Paulson's formalization of G&ouml;del's Second from that -entry by <i>not</i> 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&ouml;del's Second locale. - - - From Abstract to Concrete Gödel's Incompleteness Theorems—Part I - https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html - https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html - Andrei Popescu, Dmitriy Traytel - 16 Sep 2020 00:00:00 +0000 - -We validate an abstract formulation of G&ouml;del's First and -Second Incompleteness Theorems from a <a -href="https://www.isa-afp.org/entries/Goedel_Incompleteness.html">separate -AFP entry</a> by instantiating them to the case of -<i>finite sound extensions of the Hereditarily Finite (HF) Set -theory</i>, i.e., FOL theories extending the HF Set theory with -a finite set of axioms that are sound in the standard model. The -concrete results had been previously formalised in an <a -href="https://www.isa-afp.org/entries/Incompleteness.html">AFP -entry by Larry Paulson</a>; our instantiation reuses the -infrastructure developed in that entry. - - - A Formal Model of Extended Finite State Machines - https://www.isa-afp.org/entries/Extended_Finite_State_Machines.html - https://www.isa-afp.org/entries/Extended_Finite_State_Machines.html - Michael Foster, Achim D. Brucker, Ramsay G. Taylor, John Derrick - 07 Sep 2020 00:00:00 +0000 - -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. - - - Inference of Extended Finite State Machines - https://www.isa-afp.org/entries/Extended_Finite_State_Machine_Inference.html - https://www.isa-afp.org/entries/Extended_Finite_State_Machine_Inference.html - Michael Foster, Achim D. Brucker, Ramsay G. Taylor, John Derrick - 07 Sep 2020 00:00:00 +0000 - -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. - diff --git a/web/statistics.html b/web/statistics.html --- a/web/statistics.html +++ b/web/statistics.html @@ -1,302 +1,302 @@ Archive of Formal Proofs

 

 

 

 

 

 

Statistics

 

Statistics

- + - - + +
Number of Articles:584
Number of Articles:589
Number of Authors:375
Number of lemmas:~163,900
Lines of Code:~2,861,000
Number of lemmas:~165,000
Lines of Code:~2,891,500

Most used AFP articles:

+ + + + - - - - + + + + - - - -
NameUsed by ? articles
1. List-Index 17
2. Coinductive 12
Collections 12
Regular-Sets 12
Show12
3. Landau_Symbols 11
Show11
4.Jordan_Normal_Form10
Polynomial_Factorization 10
5. Abstract-Rewriting 9
Automatic_Refinement 9
Deriving 9
Jordan_Normal_Form9

Growth in number of articles:

Growth in lines of code:

Growth in number of authors:

Size of articles:

\ No newline at end of file diff --git a/web/topics.html b/web/topics.html --- a/web/topics.html +++ b/web/topics.html @@ -1,942 +1,948 @@ Archive of Formal Proofs

 

 

 

 

 

 

Index by Topic

 

Computer science

Artificial intelligence

Automata and formal languages

Algorithms

Knuth_Morris_Pratt   Probabilistic_While   Comparison_Sort_Lower_Bound   Quick_Sort_Cost   TortoiseHare   Selection_Heap_Sort   VerifyThis2018   CYK   Boolean_Expression_Checkers   Efficient-Mergesort   SATSolverVerification   MuchAdoAboutTwo   First_Order_Terms   Monad_Memo_DP   Hidden_Markov_Models   Imperative_Insertion_Sort   Formal_SSA   ROBDD   Median_Of_Medians_Selection   Fisher_Yates   Optimal_BST   IMP2   Auto2_Imperative_HOL   List_Inversions   IMP2_Binary_Heap   MFOTL_Monitor   Adaptive_State_Counting   Generic_Join   VerifyThis2019   Generalized_Counting_Sort   MFODL_Monitor_Optimized   Sliding_Window_Algorithm   PAC_Checker   Graph: DFS_Framework   Prpu_Maxflow   Floyd_Warshall   Roy_Floyd_Warshall   Dijkstra_Shortest_Path   EdmondsKarp_Maxflow   Depth-First-Search   GraphMarkingIBP   Transitive-Closure   Transitive-Closure-II   Gabow_SCC   Kruskal   Prim_Dijkstra_Simple   Relational_Minimum_Spanning_Trees   Distributed: DiskPaxos   GenClock   ClockSynchInst   Heard_Of   Consensus_Refined   Abortable_Linearizable_Modules   IMAP-CRDT   CRDT   Chandy_Lamport   OpSets   Stellar_Quorums   WOOT_Strong_Eventual_Consistency   Concurrent: ConcurrentGC   Online: List_Update   Geometry: Closest_Pair_Points   Approximation: Approximation_Algorithms   Mathematical: FFT   Gauss-Jordan-Elim-Fun   UpDown_Scheme   Polynomials   Gauss_Jordan   Echelon_Form   QR_Decomposition   Hermite   Groebner_Bases   Diophantine_Eqns_Lin_Hom   Taylor_Models   LLL_Basis_Reduction   Signature_Groebner   Smith_Normal_Form   Safe_Distance   + Modular_arithmetic_LLL_and_HNF_algorithms   Optimization: Simplex   Quantum computing: Isabelle_Marries_Dirac   + Projective_Measurements  

Concurrency

Data structures

Functional programming

Hardware

SPARCv8  

Machine learning

Networks

Programming languages

Clean   Decl_Sem_Fun_PL   Language definitions: CakeML   WebAssembly   pGCL   GPU_Kernel_PL   LightweightJava   CoreC++   FeatherweightJava   Jinja   JinjaThreads   Locally-Nameless-Sigma   AutoFocus-Stream   FocusStreamsCaseStudies   Isabelle_Meta_Model   Simpl   Complx   Safe_OCL   Isabelle_C   JinjaDCI   Lambda calculi: Higher_Order_Terms   Launchbury   PCF   POPLmark-deBruijn   Lam-ml-Normalization   LambdaMu   Binding_Syntax_Theory   LambdaAuth   Type systems: Name_Carrying_Type_Inference   MiniML   Possibilistic_Noninterference   SIFUM_Type_Systems   Dependent_SIFUM_Type_Systems   Strong_Security   WHATandWHERE_Security   VolpanoSmith   Physical_Quantities   Logics: ConcurrentIMP   Refine_Monadic   Automatic_Refinement   MonoBoolTranAlgebra   Simpl   Separation_Algebra   Separation_Logic_Imperative_HOL   Relational-Incorrectness-Logic   Abstract-Hoare-Logics   Kleene_Algebra   KAT_and_DRA   KAD   BytecodeLogicJmlTypes   DataRefinementIBP   RefinementReactive   SIFPL   TLA   Ribbon_Proofs   Separata   Complx   Differential_Dynamic_Logic   Hoare_Time   IMP2   UTP   QHLProver   Differential_Game_Logic   Compiling: CakeML_Codegen   Compiling-Exceptions-Correctly   NormByEval   Density_Compiler   VeriComp   Static analysis: RIPEMD-160-SPARK   Program-Conflict-Analysis   Shivers-CFA   Slicing   HRB-Slicing   InfPathElimination   Abs_Int_ITP2012   Transformations: Call_Arity   Refine_Imperative_HOL   WorkerWrapper   Monad_Memo_DP   Formal_SSA   Minimal_SSA   Misc: JiveDataStoreModel   Pop_Refinement   Case_Labeling   Interpreter_Optimizations  

Security

Semantics

System description languages

Logic

Philosophical aspects

General logic

Computability

Set theory

Proof theory

Rewriting

Mathematics

Order

Algebra

Analysis

Probability theory

Number theory

Games and economics

Geometry

Topology

Graph theory

Combinatorics

Category theory

Physics

Misc

Tools

\ No newline at end of file