diff --git a/metadata/metadata b/metadata/metadata --- a/metadata/metadata +++ b/metadata/metadata @@ -1,8812 +1,8845 @@ +[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 &‌#8450;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/Economics date = 2018-07-16 notify = mnacho.echenim@univ-grenoble-alpes.fr abstract = We have formalized the computation of fair prices for derivative products in discrete financial models. As an application, we derive a way to compute fair prices of derivative products in the Cox-Ross-Rubinstein model of a financial market, thus completing the work that was presented in this paper. extra-history = Change history: [2019-05-12]: Renamed discr_mkt predicate to stk_strict_subs and got rid of predicate A for a more natural definition of the type discrete_market; renamed basic quantity processes for coherent notation; renamed value_process into val_process and closing_value_process to cls_val_process; relaxed hypothesis of lemma CRR_market_fair_price. Added functions to price some basic options. (revision 0b813a1a833f)
[Pell] title = Pell's Equation author = Manuel Eberl topic = Mathematics/Number Theory date = 2018-06-23 notify = eberlm@in.tum.de abstract =

This article gives the basic theory of Pell's equation x2 = 1 + D y2, where D ∈ ℕ is a parameter and x, y are integer variables.

The main result that is proven is the following: If D is not a perfect square, then there exists a fundamental solution (x0, y0) that is not the trivial solution (1, 0) and which generates all other solutions (x, y) in the sense that there exists some n ∈ ℕ such that |x| + |y| √D = (x0 + y0 √D)n. This also implies that the set of solutions is infinite, and it gives us an explicit and executable characterisation of all the solutions.

Based on this, simple executable algorithms for computing the fundamental solution and the infinite sequence of all non-negative solutions are also provided.

[WebAssembly] title = WebAssembly author = Conrad Watt topic = Computer Science/Programming Languages/Language Definitions date = 2018-04-29 notify = caw77@cam.ac.uk abstract = This is a mechanised specification of the WebAssembly language, drawn mainly from the previously published paper formalisation of Haas et al. Also included is a full proof of soundness of the type system, together with a verified type checker and interpreter. We include only a partial procedure for the extraction of the type checker and interpreter here. For more details, please see our paper in CPP 2018. [Knuth_Morris_Pratt] title = The string search algorithm by Knuth, Morris and Pratt author = Fabian Hellauer , Peter Lammich topic = Computer Science/Algorithms date = 2017-12-18 notify = hellauer@in.tum.de, lammich@in.tum.de abstract = The Knuth-Morris-Pratt algorithm is often used to show that the problem of finding a string s in a text t can be solved deterministically in O(|s| + |t|) time. We use the Isabelle Refinement Framework to formulate and verify the algorithm. Via refinement, we apply some optimisations and finally use the Sepref tool to obtain executable code in Imperative/HOL. [Minkowskis_Theorem] title = Minkowski's Theorem author = Manuel Eberl topic = Mathematics/Geometry, Mathematics/Number Theory date = 2017-07-13 notify = eberlm@in.tum.de abstract =

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

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

The entry contains a proof of both theorems.

[Name_Carrying_Type_Inference] title = Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus author = Michael Rawson topic = Computer Science/Programming Languages/Type Systems date = 2017-07-09 notify = mr644@cam.ac.uk, michaelrawson76@gmail.com abstract = I formalise a Church-style simply-typed \(\lambda\)-calculus, extended with pairs, a unit value, and projection functions, and show some metatheory of the calculus, such as the subject reduction property. Particular attention is paid to the treatment of names in the calculus. A nominal style of binding is used, but I use a manual approach over Nominal Isabelle in order to extract an executable type inference algorithm. More information can be found in my undergraduate dissertation. [Propositional_Proof_Systems] title = Propositional Proof Systems author = Julius Michaelis , Tobias Nipkow topic = Logic 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. [Game_Based_Crypto] title = Game-based cryptography in HOL author = Andreas Lochbihler , S. Reza Sefidgar <>, Bhargav Bhatt topic = Computer Science/Security/Cryptography date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract =

In this AFP entry, we show how to specify game-based cryptographic security notions and formally prove secure several cryptographic constructions from the literature using the CryptHOL framework. Among others, we formalise the notions of a random oracle, a pseudo-random function, an unpredictable function, and of encryption schemes that are indistinguishable under chosen plaintext and/or ciphertext attacks. We prove the random-permutation/random-function switching lemma, security of the Elgamal and hashed Elgamal public-key encryption scheme and correctness and security of several constructions with pseudo-random functions.

Our proofs follow the game-hopping style advocated by Shoup and Bellare and Rogaway, from which most of the examples have been taken. We generalise some of their results such that they can be reused in other proofs. Thanks to CryptHOL's integration with Isabelle's parametricity infrastructure, many simple hops are easily justified using the theory of representation independence.

extra-history = Change history: [2018-09-28]: added the CryptHOL tutorial for game-based cryptography (revision 489a395764ae) [Multi_Party_Computation] title = Multi-Party Computation author = David Aspinall , David Butler topic = Computer Science/Security date = 2019-05-09 notify = dbutler@turing.ac.uk abstract = We use CryptHOL to consider Multi-Party Computation (MPC) protocols. MPC was first considered by Yao in 1983 and recent advances in efficiency and an increased demand mean it is now deployed in the real world. Security is considered using the real/ideal world paradigm. We first define security in the semi-honest security setting where parties are assumed not to deviate from the protocol transcript. In this setting we prove multiple Oblivious Transfer (OT) protocols secure and then show security for the gates of the GMW protocol. We then define malicious security, this is a stronger notion of security where parties are assumed to be fully corrupted by an adversary. In this setting we again consider OT, as it is a fundamental building block of almost all MPC protocols. [Sigma_Commit_Crypto] title = Sigma Protocols and Commitment Schemes author = David Butler , Andreas Lochbihler topic = Computer Science/Security/Cryptography date = 2019-10-07 notify = dbutler@turing.ac.uk abstract = We use CryptHOL to formalise commitment schemes and Sigma-protocols. Both are widely used fundamental two party cryptographic primitives. Security for commitment schemes is considered using game-based definitions whereas the security of Sigma-protocols is considered using both the game-based and simulation-based security paradigms. In this work, we first define security for both primitives and then prove secure multiple case studies: the Schnorr, Chaum-Pedersen and Okamoto Sigma-protocols as well as a construction that allows for compound (AND and OR statements) Sigma-protocols and the Pedersen and Rivest commitment schemes. We also prove that commitment schemes can be constructed from Sigma-protocols. We formalise this proof at an abstract level, only assuming the existence of a Sigma-protocol; consequently, the instantiations of this result for the concrete Sigma-protocols we consider come for free. [CryptHOL] title = CryptHOL author = Andreas Lochbihler topic = Computer Science/Security/Cryptography, Computer Science/Functional Programming, Mathematics/Probability Theory date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract =

CryptHOL provides a framework for formalising cryptographic arguments in Isabelle/HOL. It shallowly embeds a probabilistic functional programming language in higher order logic. The language features monadic sequencing, recursion, random sampling, failures and failure handling, and black-box access to oracles. Oracles are probabilistic functions which maintain hidden state between different invocations. All operators are defined in the new semantic domain of generative probabilistic values, a codatatype. We derive proof rules for the operators and establish a connection with the theory of relational parametricity. Thus, the resuting proofs are trustworthy and comprehensible, and the framework is extensible and widely applicable.

The framework is used in the accompanying AFP entry "Game-based Cryptography in HOL". There, we show-case our framework by formalizing different game-based proofs from the literature. This formalisation continues the work described in the author's ESOP 2016 paper.

[Constructive_Cryptography] title = Constructive Cryptography in HOL author = Andreas Lochbihler , S. Reza Sefidgar<> topic = Computer Science/Security/Cryptography, Mathematics/Probability Theory date = 2018-12-17 notify = mail@andreas-lochbihler.de, reza.sefidgar@inf.ethz.ch abstract = Inspired by Abstract Cryptography, we extend CryptHOL, a framework for formalizing game-based proofs, with an abstract model of Random Systems and provide proof rules about their composition and equality. This foundation facilitates the formalization of Constructive Cryptography proofs, where the security of a cryptographic scheme is realized as a special form of construction in which a complex random system is built from simpler ones. This is a first step towards a fully-featured compositional framework, similar to Universal Composability framework, that supports formalization of simulation-based proofs. [Probabilistic_While] title = Probabilistic while loop author = Andreas Lochbihler topic = Computer Science/Functional Programming, Mathematics/Probability Theory, Computer Science/Algorithms date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = This AFP entry defines a probabilistic while operator based on sub-probability mass functions and formalises zero-one laws and variant rules for probabilistic loop termination. As applications, we implement probabilistic algorithms for the Bernoulli, geometric and arbitrary uniform distributions that only use fair coin flips, and prove them correct and terminating with probability 1. extra-history = Change history: [2018-02-02]: Added a proof that probabilistic conditioning can be implemented by repeated sampling. (revision 305867c4e911)
[Monad_Normalisation] title = Monad normalisation author = Joshua Schneider <>, Manuel Eberl , Andreas Lochbihler topic = Tools, Computer Science/Functional Programming, Logic/Rewriting date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = The usual monad laws can directly be used as rewrite rules for Isabelle’s simplifier to normalise monadic HOL terms and decide equivalences. In a commutative monad, however, the commutativity law is a higher-order permutative rewrite rule that makes the simplifier loop. This AFP entry implements a simproc that normalises monadic expressions in commutative monads using ordered rewriting. The simproc can also permute computations across control operators like if and case. [Monomorphic_Monad] title = Effect polymorphism in higher-order logic author = Andreas Lochbihler topic = Computer Science/Functional Programming date = 2017-05-05 notify = mail@andreas-lochbihler.de abstract = The notion of a monad cannot be expressed within higher-order logic (HOL) due to type system restrictions. We show that if a monad is used with values of only one type, this notion can be formalised in HOL. Based on this idea, we develop a library of effect specifications and implementations of monads and monad transformers. Hence, we can abstract over the concrete monad in HOL definitions and thus use the same definition for different (combinations of) effects. We illustrate the usefulness of effect polymorphism with a monadic interpreter for a simple language. extra-history = Change history: [2018-02-15]: added further specifications and implementations of non-determinism; more examples (revision bc5399eea78e)
[Constructor_Funs] title = Constructor Functions author = Lars Hupel topic = Tools date = 2017-04-19 notify = hupel@in.tum.de abstract = Isabelle's code generator performs various adaptations for target languages. Among others, constructor applications have to be fully saturated. That means that for constructor calls occuring as arguments to higher-order functions, synthetic lambdas have to be inserted. This entry provides tooling to avoid this construction altogether by introducing constructor functions. [Lazy_Case] title = Lazifying case constants author = Lars Hupel topic = Tools date = 2017-04-18 notify = hupel@in.tum.de abstract = Isabelle's code generator performs various adaptations for target languages. Among others, case statements are printed as match expressions. Internally, this is a sophisticated procedure, because in HOL, case statements are represented as nested calls to the case combinators as generated by the datatype package. Furthermore, the procedure relies on laziness of match expressions in the target language, i.e., that branches guarded by patterns that fail to match are not evaluated. Similarly, if-then-else is printed to the corresponding construct in the target language. This entry provides tooling to replace these special cases in the code generator by ignoring these target language features, instead printing case expressions and if-then-else as functions. [Dict_Construction] title = Dictionary Construction author = Lars Hupel topic = Tools date = 2017-05-24 notify = hupel@in.tum.de abstract = Isabelle's code generator natively supports type classes. For targets that do not have language support for classes and instances, it performs the well-known dictionary translation, as described by Haftmann and Nipkow. This translation happens outside the logic, i.e., there is no guarantee that it is correct, besides the pen-and-paper proof. This work implements a certified dictionary translation that produces new class-free constants and derives equality theorems. [Higher_Order_Terms] title = An Algebra for Higher-Order Terms author = Lars Hupel contributors = Yu Zhang <> topic = Computer Science/Programming Languages/Lambda Calculi date = 2019-01-15 notify = lars@hupel.info abstract = In this formalization, I introduce a higher-order term algebra, generalizing the notions of free variables, matching, and substitution. The need arose from the work on a verified compiler from Isabelle to CakeML. Terms can be thought of as consisting of a generic (free variables, constants, application) and a specific part. As example applications, this entry provides instantiations for de-Bruijn terms, terms with named variables, and Blanchette’s λ-free higher-order terms. Furthermore, I implement translation functions between de-Bruijn terms and named terms and prove their correctness. [Subresultants] title = Subresultants author = Sebastiaan Joosten , René Thiemann , Akihisa Yamada topic = Mathematics/Algebra date = 2017-04-06 notify = rene.thiemann@uibk.ac.at abstract = We formalize the theory of subresultants and the subresultant polynomial remainder sequence as described by Brown and Traub. As a result, we obtain efficient certified algorithms for computing the resultant and the greatest common divisor of polynomials. [Comparison_Sort_Lower_Bound] title = Lower bound on comparison-based sorting algorithms author = Manuel Eberl topic = Computer Science/Algorithms date = 2017-03-15 notify = eberlm@in.tum.de abstract =

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

[DFS_Framework] title = A Framework for Verifying Depth-First Search Algorithms author = Peter Lammich , René Neumann notify = lammich@in.tum.de date = 2016-07-05 topic = Computer Science/Algorithms/Graph abstract =

This entry presents a framework for the modular verification of DFS-based algorithms, which is described in our [CPP-2015] paper. It provides a generic DFS algorithm framework, that can be parameterized with user-defined actions on certain events (e.g. discovery of new node). It comes with an extensible library of invariants, which can be used to derive invariants of a specific parameterization. Using refinement techniques, efficient implementations of the algorithms can easily be derived. Here, the framework comes with templates for a recursive and a tail-recursive implementation, and also with several templates for implementing the data structures required by the DFS algorithm. Finally, this entry contains a set of re-usable DFS-based algorithms, which illustrate the application of the framework.

[CPP-2015] Peter Lammich, René Neumann: A Framework for Verifying Depth-First Search Algorithms. CPP 2015: 137-146

[Flow_Networks] title = Flow Networks and the Min-Cut-Max-Flow Theorem author = Peter Lammich , S. Reza Sefidgar <> topic = Mathematics/Graph Theory date = 2017-06-01 notify = lammich@in.tum.de abstract = We present a formalization of flow networks and the Min-Cut-Max-Flow theorem. Our formal proof closely follows a standard textbook proof, and is accessible even without being an expert in Isabelle/HOL, the interactive theorem prover used for the formalization. [Prpu_Maxflow] title = Formalizing Push-Relabel Algorithms author = Peter Lammich , S. Reza Sefidgar <> topic = Computer Science/Algorithms/Graph, Mathematics/Graph Theory date = 2017-06-01 notify = lammich@in.tum.de abstract = We present a formalization of push-relabel algorithms for computing the maximum flow in a network. We start with Goldberg's et al.~generic push-relabel algorithm, for which we show correctness and the time complexity bound of O(V^2E). We then derive the relabel-to-front and FIFO implementation. Using stepwise refinement techniques, we derive an efficient verified implementation. Our formal proof of the abstract algorithms closely follows a standard textbook proof. It is accessible even without being an expert in Isabelle/HOL, the interactive theorem prover used for the formalization. [Buildings] title = Chamber Complexes, Coxeter Systems, and Buildings author = Jeremy Sylvestre notify = jeremy.sylvestre@ualberta.ca date = 2016-07-01 topic = Mathematics/Algebra, Mathematics/Geometry abstract = We provide a basic formal framework for the theory of chamber complexes and Coxeter systems, and for buildings as thick chamber complexes endowed with a system of apartments. Along the way, we develop some of the general theory of abstract simplicial complexes and of groups (relying on the group_add class for the basics), including free groups and group presentations, and their universal properties. The main results verified are that the deletion condition is both necessary and sufficient for a group with a set of generators of order two to be a Coxeter system, and that the apartments in a (thick) building are all uniformly Coxeter. [Algebraic_VCs] title = Program Construction and Verification Components Based on Kleene Algebra author = Victor B. F. Gomes , Georg Struth notify = victor.gomes@cl.cam.ac.uk, g.struth@sheffield.ac.uk date = 2016-06-18 topic = Mathematics/Algebra abstract = Variants of Kleene algebra support program construction and verification by algebraic reasoning. This entry provides a verification component for Hoare logic based on Kleene algebra with tests, verification components for weakest preconditions and strongest postconditions based on Kleene algebra with domain and a component for step-wise refinement based on refinement Kleene algebra with tests. In addition to these components for the partial correctness of while programs, a verification component for total correctness based on divergence Kleene algebras and one for (partial correctness) of recursive programs based on domain quantales are provided. Finally we have integrated memory models for programs with pointers and a program trace semantics into the weakest precondition component. [C2KA_DistributedSystems] title = Communicating Concurrent Kleene Algebra for Distributed Systems Specification author = Maxime Buyse , Jason Jaskolka topic = Computer Science/Automata and Formal Languages, Mathematics/Algebra date = 2019-08-06 notify = maxime.buyse@polytechnique.edu, jason.jaskolka@carleton.ca abstract = Communicating Concurrent Kleene Algebra (C²KA) is a mathematical framework for capturing the communicating and concurrent behaviour of agents in distributed systems. It extends Hoare et al.'s Concurrent Kleene Algebra (CKA) with communication actions through the notions of stimuli and shared environments. C²KA has applications in studying system-level properties of distributed systems such as safety, security, and reliability. In this work, we formalize results about C²KA and its application for distributed systems specification. We first formalize the stimulus structure and behaviour structure (CKA). Next, we combine them to formalize C²KA and its properties. Then, we formalize notions and properties related to the topology of distributed systems and the potential for communication via stimuli and via shared environments of agents, all within the algebraic setting of C²KA. [Card_Equiv_Relations] title = Cardinality of Equivalence Relations author = Lukas Bulwahn notify = lukas.bulwahn@gmail.com date = 2016-05-24 topic = Mathematics/Combinatorics abstract = This entry provides formulae for counting the number of equivalence relations and partial equivalence relations over a finite carrier set with given cardinality. To count the number of equivalence relations, we provide bijections between equivalence relations and set partitions, and then transfer the main results of the two AFP entries, Cardinality of Set Partitions and Spivey's Generalized Recurrence for Bell Numbers, to theorems on equivalence relations. To count the number of partial equivalence relations, we observe that counting partial equivalence relations over a set A is equivalent to counting all equivalence relations over all subsets of the set A. From this observation and the results on equivalence relations, we show that the cardinality of partial equivalence relations over a finite set of cardinality n is equal to the n+1-th Bell number. [Twelvefold_Way] title = The Twelvefold Way author = Lukas Bulwahn topic = Mathematics/Combinatorics date = 2016-12-29 notify = lukas.bulwahn@gmail.com abstract = This entry provides all cardinality theorems of the Twelvefold Way. The Twelvefold Way systematically classifies twelve related combinatorial problems concerning two finite sets, which include counting permutations, combinations, multisets, set partitions and number partitions. This development builds upon the existing formal developments with cardinality theorems for those structures. It provides twelve bijections from the various structures to different equivalence classes on finite functions, and hence, proves cardinality formulae for these equivalence classes on finite functions. [Chord_Segments] title = Intersecting Chords Theorem author = Lukas Bulwahn notify = lukas.bulwahn@gmail.com date = 2016-10-11 topic = Mathematics/Geometry abstract = This entry provides a geometric proof of the intersecting chords theorem. The theorem states that when two chords intersect each other inside a circle, the products of their segments are equal. After a short review of existing proofs in the literature, I decided to use a proof approach that employs reasoning about lengths of line segments, the orthogonality of two lines and the Pythagoras Law. Hence, one can understand the formalized proof easily with the knowledge of a few general geometric facts that are commonly taught in high-school. This theorem is the 55th theorem of the Top 100 Theorems list. [Category3] title = Category Theory with Adjunctions and Limits author = Eugene W. Stark notify = stark@cs.stonybrook.edu date = 2016-06-26 topic = Mathematics/Category Theory abstract = This article attempts to develop a usable framework for doing category theory in Isabelle/HOL. Our point of view, which to some extent differs from that of the previous AFP articles on the subject, is to try to explore how category theory can be done efficaciously within HOL, rather than trying to match exactly the way things are done using a traditional approach. To this end, we define the notion of category in an "object-free" style, in which a category is represented by a single partial composition operation on arrows. This way of defining categories provides some advantages in the context of HOL, including the ability to avoid the use of records and the possibility of defining functors and natural transformations simply as certain functions on arrows, rather than as composite objects. We define various constructions associated with the basic notions, including: dual category, product category, functor category, discrete category, free category, functor composition, and horizontal and vertical composite of natural transformations. A "set category" locale is defined that axiomatizes the notion "category of all sets at a type and all functions between them," and a fairly extensive set of properties of set categories is derived from the locale assumptions. The notion of a set category is used to prove the Yoneda Lemma in a general setting of a category equipped with a "hom embedding," which maps arrows of the category to the "universe" of the set category. We also give a treatment of adjunctions, defining adjunctions via left and right adjoint functors, natural bijections between hom-sets, and unit and counit natural transformations, and showing the equivalence of these definitions. We also develop the theory of limits, including representations of functors, diagrams and cones, and diagonal functors. We show that right adjoint functors preserve limits, and that limits can be constructed via products and equalizers. We characterize the conditions under which limits exist in a set category. We also examine the case of limits in a functor category, ultimately culminating in a proof that the Yoneda embedding preserves limits. extra-history = Change history: [2018-05-29]: Revised axioms for the category locale. Introduced notation for composition and "in hom". (revision 8318366d4575)
[MonoidalCategory] title = Monoidal Categories author = Eugene W. Stark topic = Mathematics/Category Theory date = 2017-05-04 notify = stark@cs.stonybrook.edu abstract = Building on the formalization of basic category theory set out in the author's previous AFP article, the present article formalizes some basic aspects of the theory of monoidal categories. Among the notions defined here are monoidal category, monoidal functor, and equivalence of monoidal categories. The main theorems formalized are MacLane's coherence theorem and the constructions of the free monoidal category and free strict monoidal category generated by a given category. The coherence theorem is proved syntactically, using a structurally recursive approach to reduction of terms that might have some novel aspects. We also give proofs of some results given by Etingof et al, which may prove useful in a formal setting. In particular, we show that the left and right unitors need not be taken as given data in the definition of monoidal category, nor does the definition of monoidal functor need to take as given a specific isomorphism expressing the preservation of the unit object. Our definitions of monoidal category and monoidal functor are stated so as to take advantage of the economy afforded by these facts. extra-history = Change history: [2017-05-18]: Integrated material from MonoidalCategory/Category3Adapter into Category3/ and deleted adapter. (revision 015543cdd069)
[2018-05-29]: Modifications required due to 'Category3' changes. Introduced notation for "in hom". (revision 8318366d4575)
[Card_Multisets] title = Cardinality of Multisets author = Lukas Bulwahn notify = lukas.bulwahn@gmail.com date = 2016-06-26 topic = Mathematics/Combinatorics abstract =

This entry provides three lemmas to count the number of multisets of a given size and finite carrier set. The first lemma provides a cardinality formula assuming that the multiset's elements are chosen from the given carrier set. The latter two lemmas provide formulas assuming that the multiset's elements also cover the given carrier set, i.e., each element of the carrier set occurs in the multiset at least once.

The proof of the first lemma uses the argument of the recurrence relation for counting multisets. The proof of the second lemma is straightforward, and the proof of the third lemma is easily obtained using the first cardinality lemma. A challenge for the formalization is the derivation of the required induction rule, which is a special combination of the induction rules for finite sets and natural numbers. The induction rule is derived by defining a suitable inductive predicate and transforming the predicate's induction rule.

[Posix-Lexing] title = POSIX Lexing with Derivatives of Regular Expressions author = Fahad Ausaf , Roy Dyckhoff , Christian Urban notify = christian.urban@kcl.ac.uk date = 2016-05-24 topic = Computer Science/Automata and Formal Languages abstract = Brzozowski introduced the notion of derivatives for regular expressions. They can be used for a very simple regular expression matching algorithm. Sulzmann and Lu cleverly extended this algorithm in order to deal with POSIX matching, which is the underlying disambiguation strategy for regular expressions needed in lexers. In this entry we give our inductive definition of what a POSIX value is and show (i) that such a value is unique (for given regular expression and string being matched) and (ii) that Sulzmann and Lu's algorithm always generates such a value (provided that the regular expression matches the string). We also prove the correctness of an optimised version of the POSIX matching algorithm. [LocalLexing] title = Local Lexing author = Steven Obua topic = Computer Science/Automata and Formal Languages date = 2017-04-28 notify = steven@recursivemind.com abstract = This formalisation accompanies the paper Local Lexing which introduces a novel parsing concept of the same name. The paper also gives a high-level algorithm for local lexing as an extension of Earley's algorithm. This formalisation proves the algorithm to be correct with respect to its local lexing semantics. As a special case, this formalisation thus also contains a proof of the correctness of Earley's algorithm. The paper contains a short outline of how this formalisation is organised. [MFMC_Countable] title = A Formal Proof of the Max-Flow Min-Cut Theorem for Countable Networks author = Andreas Lochbihler date = 2016-05-09 topic = Mathematics/Graph Theory abstract = This article formalises a proof of the maximum-flow minimal-cut theorem for networks with countably many edges. A network is a directed graph with non-negative real-valued edge labels and two dedicated vertices, the source and the sink. A flow in a network assigns non-negative real numbers to the edges such that for all vertices except for the source and the sink, the sum of values on incoming edges equals the sum of values on outgoing edges. A cut is a subset of the vertices which contains the source, but not the sink. Our theorem states that in every network, there is a flow and a cut such that the flow saturates all the edges going out of the cut and is zero on all the incoming edges. The proof is based on the paper The Max-Flow Min-Cut theorem for countable networks by Aharoni et al. Additionally, we prove a characterisation of the lifting operation for relations on discrete probability distributions, which leads to a concise proof of its distributivity over relation composition. notify = mail@andreas-lochbihler.de extra-history = Change history: [2017-09-06]: derive characterisation for the lifting operations on discrete distributions from finite version of the max-flow min-cut theorem (revision a7a198f5bab0)
[Liouville_Numbers] title = Liouville numbers author = Manuel Eberl date = 2015-12-28 topic = Mathematics/Analysis, Mathematics/Number Theory abstract =

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

notify = [List_Interleaving] title = Reasoning about Lists via List Interleaving author = Pasquale Noce date = 2015-06-11 topic = Computer Science/Data Structures abstract =

Among the various mathematical tools introduced in his outstanding work on Communicating Sequential Processes, Hoare has defined "interleaves" as the predicate satisfied by any three lists such that the first list may be split into sublists alternately extracted from the other two ones, whatever is the criterion for extracting an item from either one list or the other in each step.

This paper enriches Hoare's definition by identifying such criterion with the truth value of a predicate taking as inputs the head and the tail of the first list. This enhanced "interleaves" predicate turns out to permit the proof of equalities between lists without the need of an induction. Some rules that allow to infer "interleaves" statements without induction, particularly applying to the addition or removal of a prefix to the input lists, are also proven. Finally, a stronger version of the predicate, named "Interleaves", is shown to fulfil further rules applying to the addition or removal of a suffix to the input lists.

notify = [Residuated_Lattices] title = Residuated Lattices author = Victor B. F. Gomes , Georg Struth date = 2015-04-15 topic = Mathematics/Algebra abstract = The theory of residuated lattices, first proposed by Ward and Dilworth, is formalised in Isabelle/HOL. This includes concepts of residuated functions; their adjoints and conjugates. It also contains necessary and sufficient conditions for the existence of these operations in an arbitrary lattice. The mathematical components for residuated lattices are linked to the AFP entry for relation algebra. In particular, we prove Jonsson and Tsinakis conditions for a residuated boolean algebra to form a relation algebra. notify = g.struth@sheffield.ac.uk [ConcurrentGC] title = Relaxing Safely: Verified On-the-Fly Garbage Collection for x86-TSO author = Peter Gammie , Tony Hosking , Kai Engelhardt <> date = 2015-04-13 topic = Computer Science/Algorithms/Concurrent abstract =

We use ConcurrentIMP to model Schism, a state-of-the-art real-time garbage collection scheme for weak memory, and show that it is safe on x86-TSO.

This development accompanies the PLDI 2015 paper of the same name.

notify = peteg42@gmail.com [List_Update] title = Analysis of List Update Algorithms author = Maximilian P.L. Haslbeck , Tobias Nipkow date = 2016-02-17 topic = Computer Science/Algorithms/Online abstract =

These theories formalize the quantitative analysis of a number of classical algorithms for the list update problem: 2-competitiveness of move-to-front, the lower bound of 2 for the competitiveness of deterministic list update algorithms and 1.6-competitiveness of the randomized COMB algorithm, the best randomized list update algorithm known to date. The material is based on the first two chapters of Online Computation and Competitive Analysis by Borodin and El-Yaniv.

For an informal description see the FSTTCS 2016 publication Verified Analysis of List Update Algorithms by Haslbeck and Nipkow.

notify = nipkow@in.tum.de [ConcurrentIMP] title = Concurrent IMP author = Peter Gammie date = 2015-04-13 topic = Computer Science/Programming Languages/Logics abstract = ConcurrentIMP extends the small imperative language IMP with control non-determinism and constructs for synchronous message passing. notify = peteg42@gmail.com [TortoiseHare] title = The Tortoise and Hare Algorithm author = Peter Gammie date = 2015-11-18 topic = Computer Science/Algorithms abstract = We formalize the Tortoise and Hare cycle-finding algorithm ascribed to Floyd by Knuth, and an improved version due to Brent. notify = peteg42@gmail.com [UPF] title = The Unified Policy Framework (UPF) author = Achim D. Brucker , Lukas Brügger , Burkhart Wolff date = 2014-11-28 topic = Computer Science/Security abstract = We present the Unified Policy Framework (UPF), a generic framework for modelling security (access-control) policies. UPF emphasizes the view that a policy is a policy decision function that grants or denies access to resources, permissions, etc. In other words, instead of modelling the relations of permitted or prohibited requests directly, we model the concrete function that implements the policy decision point in a system. In more detail, UPF is based on the following four principles: 1) Functional representation of policies, 2) No conflicts are possible, 3) Three-valued decision type (allow, deny, undefined), 4) Output type not containing the decision only. notify = adbrucker@0x5f.org, wolff@lri.fr, lukas.a.bruegger@gmail.com [UPF_Firewall] title = Formal Network Models and Their Application to Firewall Policies author = Achim D. Brucker , Lukas Brügger<>, Burkhart Wolff topic = Computer Science/Security, Computer Science/Networks date = 2017-01-08 notify = adbrucker@0x5f.org abstract = We present a formal model of network protocols and their application to modeling firewall policies. The formalization is based on the Unified Policy Framework (UPF). The formalization was originally developed with for generating test cases for testing the security configuration actual firewall and router (middle-boxes) using HOL-TestGen. Our work focuses on modeling application level protocols on top of tcp/ip. [AODV] title = Loop freedom of the (untimed) AODV routing protocol author = Timothy Bourke , Peter Höfner date = 2014-10-23 topic = Computer Science/Concurrency/Process Calculi abstract =

The Ad hoc On-demand Distance Vector (AODV) routing protocol allows the nodes in a Mobile Ad hoc Network (MANET) or a Wireless Mesh Network (WMN) to know where to forward data packets. Such a protocol is ‘loop free’ if it never leads to routing decisions that forward packets in circles.

This development mechanises an existing pen-and-paper proof of loop freedom of AODV. The protocol is modelled in the Algebra of Wireless Networks (AWN), which is the subject of an earlier paper and AFP mechanization. The proof relies on a novel compositional approach for lifting invariants to networks of nodes.

We exploit the mechanization to analyse several variants of AODV and show that Isabelle/HOL can re-establish most proof obligations automatically and identify exactly the steps that are no longer valid.

notify = tim@tbrk.org [Show] title = Haskell's Show Class in Isabelle/HOL author = Christian Sternagel , René Thiemann date = 2014-07-29 topic = Computer Science/Functional Programming license = LGPL abstract = We implemented a type class for "to-string" functions, similar to Haskell's Show class. Moreover, we provide instantiations for Isabelle/HOL's standard types like bool, prod, sum, nats, ints, and rats. It is further possible, to automatically derive show functions for arbitrary user defined datatypes similar to Haskell's "deriving Show". extra-history = Change history: [2015-03-11]: Adapted development to new-style (BNF-based) datatypes.
[2015-04-10]: Moved development for old-style datatypes into subdirectory "Old_Datatype".
notify = christian.sternagel@uibk.ac.at, rene.thiemann@uibk.ac.at [Certification_Monads] title = Certification Monads author = Christian Sternagel , René Thiemann date = 2014-10-03 topic = Computer Science/Functional Programming abstract = This entry provides several monads intended for the development of stand-alone certifiers via code generation from Isabelle/HOL. More specifically, there are three flavors of error monads (the sum type, for the case where all monadic functions are total; an instance of the former, the so called check monad, yielding either success without any further information or an error message; as well as a variant of the sum type that accommodates partial functions by providing an explicit bottom element) and a parser monad built on top. All of this monads are heavily used in the IsaFoR/CeTA project which thus provides many examples of their usage. notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at [CISC-Kernel] title = Formal Specification of a Generic Separation Kernel author = Freek Verbeek , Sergey Tverdyshev , Oto Havle , Holger Blasum , Bruno Langenstein , Werner Stephan , Yakoub Nemouchi , Abderrahmane Feliachi , Burkhart Wolff , Julien Schmaltz date = 2014-07-18 topic = Computer Science/Security abstract =

Intransitive noninterference has been a widely studied topic in the last few decades. Several well-established methodologies apply interactive theorem proving to formulate a noninterference theorem over abstract academic models. In joint work with several industrial and academic partners throughout Europe, we are helping in the certification process of PikeOS, an industrial separation kernel developed at SYSGO. In this process, established theories could not be applied. We present a new generic model of separation kernels and a new theory of intransitive noninterference. The model is rich in detail, making it suitable for formal verification of realistic and industrial systems such as PikeOS. Using a refinement-based theorem proving approach, we ensure that proofs remain manageable.

This document corresponds to the deliverable D31.1 of the EURO-MILS Project http://www.euromils.eu.

notify = [pGCL] title = pGCL for Isabelle author = David Cock date = 2014-07-13 topic = Computer Science/Programming Languages/Language Definitions abstract =

pGCL is both a programming language and a specification language that incorporates both probabilistic and nondeterministic choice, in a unified manner. Program verification is by refinement or annotation (or both), using either Hoare triples, or weakest-precondition entailment, in the style of GCL.

This package provides both a shallow embedding of the language primitives, and an annotation and refinement framework. The generated document includes a brief tutorial.

notify = [Noninterference_CSP] title = Noninterference Security in Communicating Sequential Processes author = Pasquale Noce date = 2014-05-23 topic = Computer Science/Security abstract =

An extension of classical noninterference security for deterministic state machines, as introduced by Goguen and Meseguer and elegantly formalized by Rushby, to nondeterministic systems should satisfy two fundamental requirements: it should be based on a mathematically precise theory of nondeterminism, and should be equivalent to (or at least not weaker than) the classical notion in the degenerate deterministic case.

This paper proposes a definition of noninterference security applying to Hoare's Communicating Sequential Processes (CSP) in the general case of a possibly intransitive noninterference policy, and proves the equivalence of this security property to classical noninterference security for processes representing deterministic state machines.

Furthermore, McCullough's generalized noninterference security is shown to be weaker than both the proposed notion of CSP noninterference security for a generic process, and classical noninterference security for processes representing deterministic state machines. This renders CSP noninterference security preferable as an extension of classical noninterference security to nondeterministic systems.

notify = pasquale.noce.lavoro@gmail.com [Floyd_Warshall] title = The Floyd-Warshall Algorithm for Shortest Paths author = Simon Wimmer , Peter Lammich topic = Computer Science/Algorithms/Graph date = 2017-05-08 notify = wimmers@in.tum.de abstract = The Floyd-Warshall algorithm [Flo62, Roy59, War62] is a classic dynamic programming algorithm to compute the length of all shortest paths between any two vertices in a graph (i.e. to solve the all-pairs shortest path problem, or APSP for short). Given a representation of the graph as a matrix of weights M, it computes another matrix M' which represents a graph with the same path lengths and contains the length of the shortest path between any two vertices i and j. This is only possible if the graph does not contain any negative cycles. However, in this case the Floyd-Warshall algorithm will detect the situation by calculating a negative diagonal entry. This entry includes a formalization of the algorithm and of these key properties. The algorithm is refined to an efficient imperative version using the Imperative Refinement Framework. [Roy_Floyd_Warshall] title = Transitive closure according to Roy-Floyd-Warshall author = Makarius Wenzel <> date = 2014-05-23 topic = Computer Science/Algorithms/Graph abstract = This formulation of the Roy-Floyd-Warshall algorithm for the transitive closure bypasses matrices and arrays, but uses a more direct mathematical model with adjacency functions for immediate predecessors and successors. This can be implemented efficiently in functional programming languages and is particularly adequate for sparse relations. notify = [GPU_Kernel_PL] title = Syntax and semantics of a GPU kernel programming language author = John Wickerson date = 2014-04-03 topic = Computer Science/Programming Languages/Language Definitions abstract = This document accompanies the article "The Design and Implementation of a Verification Technique for GPU Kernels" by Adam Betts, Nathan Chong, Alastair F. Donaldson, Jeroen Ketema, Shaz Qadeer, Paul Thomson and John Wickerson. It formalises all of the definitions provided in Sections 3 and 4 of the article. notify = [AWN] title = Mechanization of the Algebra for Wireless Networks (AWN) author = Timothy Bourke date = 2014-03-08 topic = Computer Science/Concurrency/Process Calculi abstract =

AWN is a process algebra developed for modelling and analysing protocols for Mobile Ad hoc Networks (MANETs) and Wireless Mesh Networks (WMNs). AWN models comprise five distinct layers: sequential processes, local parallel compositions, nodes, partial networks, and complete networks.

This development mechanises the original operational semantics of AWN and introduces a variant 'open' operational semantics that enables the compositional statement and proof of invariants across distinct network nodes. It supports labels (for weakening invariants) and (abstract) data state manipulations. A framework for compositional invariant proofs is developed, including a tactic (inv_cterms) for inductive invariant proofs of sequential processes, lifting rules for the open versions of the higher layers, and a rule for transferring lifted properties back to the standard semantics. A notion of 'control terms' reduces proof obligations to the subset of subterms that act directly (in contrast to operators for combining terms and joining processes).

notify = tim@tbrk.org [Selection_Heap_Sort] title = Verification of Selection and Heap Sort Using Locales author = Danijela Petrovic date = 2014-02-11 topic = Computer Science/Algorithms abstract = Stepwise program refinement techniques can be used to simplify program verification. Programs are better understood since their main properties are clearly stated, and verification of rather complex algorithms is reduced to proving simple statements connecting successive program specifications. Additionally, it is easy to analyze similar algorithms and to compare their properties within a single formalization. Usually, formal analysis is not done in educational setting due to complexity of verification and a lack of tools and procedures to make comparison easy. Verification of an algorithm should not only give correctness proof, but also better understanding of an algorithm. If the verification is based on small step program refinement, it can become simple enough to be demonstrated within the university-level computer science curriculum. In this paper we demonstrate this and give a formal analysis of two well known algorithms (Selection Sort and Heap Sort) using proof assistant Isabelle/HOL and program refinement techniques. notify = [Real_Impl] title = Implementing field extensions of the form Q[sqrt(b)] author = René Thiemann date = 2014-02-06 license = LGPL topic = Mathematics/Analysis abstract = We apply data refinement to implement the real numbers, where we support all numbers in the field extension Q[sqrt(b)], i.e., all numbers of the form p + q * sqrt(b) for rational numbers p and q and some fixed natural number b. To this end, we also developed algorithms to precisely compute roots of a rational number, and to perform a factorization of natural numbers which eliminates duplicate prime factors.

Our results have been used to certify termination proofs which involve polynomial interpretations over the reals. extra-history = Change history: [2014-07-11]: Moved NthRoot_Impl to Sqrt-Babylonian. notify = rene.thiemann@uibk.ac.at [ShortestPath] title = An Axiomatic Characterization of the Single-Source Shortest Path Problem author = Christine Rizkallah date = 2013-05-22 topic = Mathematics/Graph Theory abstract = This theory is split into two sections. In the first section, we give a formal proof that a well-known axiomatic characterization of the single-source shortest path problem is correct. Namely, we prove that in a directed graph with a non-negative cost function on the edges the single-source shortest path function is the only function that satisfies a set of four axioms. In the second section, we give a formal proof of the correctness of an axiomatic characterization of the single-source shortest path problem for directed graphs with general cost functions. The axioms here are more involved because we have to account for potential negative cycles in the graph. The axioms are summarized in three Isabelle locales. notify = [Launchbury] title = The Correctness of Launchbury's Natural Semantics for Lazy Evaluation author = Joachim Breitner date = 2013-01-31 topic = Computer Science/Programming Languages/Lambda Calculi, Computer Science/Semantics abstract = In his seminal paper "Natural Semantics for Lazy Evaluation", John Launchbury proves his semantics correct with respect to a denotational semantics, and outlines an adequacy proof. We have formalized both semantics and machine-checked the correctness proof, clarifying some details. Furthermore, we provide a new and more direct adequacy proof that does not require intermediate operational semantics. extra-history = Change history: [2014-05-24]: Added the proof of adequacy, as well as simplified and improved the existing proofs. Adjusted abstract accordingly. [2015-03-16]: Booleans and if-then-else added to syntax and semantics, making this entry suitable to be used by the entry "Call_Arity". notify = [Call_Arity] title = The Safety of Call Arity author = Joachim Breitner date = 2015-02-20 topic = Computer Science/Programming Languages/Transformations abstract = We formalize the Call Arity analysis, as implemented in GHC, and prove both functional correctness and, more interestingly, safety (i.e. the transformation does not increase allocation).

We use syntax and the denotational semantics from the entry "Launchbury", where we formalized Launchbury's natural semantics for lazy evaluation.

The functional correctness of Call Arity is proved with regard to that denotational semantics. The operational properties are shown with regard to a small-step semantics akin to Sestoft's mark 1 machine, which we prove to be equivalent to Launchbury's semantics.

We use Christian Urban's Nominal2 package to define our terms and make use of Brian Huffman's HOLCF package for the domain-theoretical aspects of the development. extra-history = Change history: [2015-03-16]: This entry now builds on top of the Launchbury entry, and the equivalency proof of the natural and the small-step semantics was added. notify = [CCS] title = CCS in nominal logic author = Jesper Bengtson date = 2012-05-29 topic = Computer Science/Concurrency/Process Calculi abstract = We formalise a large portion of CCS as described in Milner's book 'Communication and Concurrency' using the nominal datatype package in Isabelle. Our results include many of the standard theorems of bisimulation equivalence and congruence, for both weak and strong versions. One main goal of this formalisation is to keep the machine-checked proofs as close to their pen-and-paper counterpart as possible.

This entry is described in detail in Bengtson's thesis. notify = [Pi_Calculus] title = The pi-calculus in nominal logic author = Jesper Bengtson date = 2012-05-29 topic = Computer Science/Concurrency/Process Calculi abstract = We formalise the pi-calculus using the nominal datatype package, based on ideas from the nominal logic by Pitts et al., and demonstrate an implementation in Isabelle/HOL. The purpose is to derive powerful induction rules for the semantics in order to conduct machine checkable proofs, closely following the intuitive arguments found in manual proofs. In this way we have covered many of the standard theorems of bisimulation equivalence and congruence, both late and early, and both strong and weak in a uniform manner. We thus provide one of the most extensive formalisations of a the pi-calculus ever done inside a theorem prover.

A significant gain in our formulation is that agents are identified up to alpha-equivalence, thereby greatly reducing the arguments about bound names. This is a normal strategy for manual proofs about the pi-calculus, but that kind of hand waving has previously been difficult to incorporate smoothly in an interactive theorem prover. We show how the nominal logic formalism and its support in Isabelle accomplishes this and thus significantly reduces the tedium of conducting completely formal proofs. This improves on previous work using weak higher order abstract syntax since we do not need extra assumptions to filter out exotic terms and can keep all arguments within a familiar first-order logic.

This entry is described in detail in Bengtson's thesis. notify = [Psi_Calculi] title = Psi-calculi in Isabelle author = Jesper Bengtson date = 2012-05-29 topic = Computer Science/Concurrency/Process Calculi abstract = Psi-calculi are extensions of the pi-calculus, accommodating arbitrary nominal datatypes to represent not only data but also communication channels, assertions and conditions, giving it an expressive power beyond the applied pi-calculus and the concurrent constraint pi-calculus.

We have formalised psi-calculi in the interactive theorem prover Isabelle using its nominal datatype package. One distinctive feature is that the framework needs to treat binding sequences, as opposed to single binders, in an efficient way. While different methods for formalising single binder calculi have been proposed over the last decades, representations for such binding sequences are not very well explored.

The main effort in the formalisation is to keep the machine checked proofs as close to their pen-and-paper counterparts as possible. This includes treating all binding sequences as atomic elements, and creating custom induction and inversion rules that to remove the bulk of manual alpha-conversions.

This entry is described in detail in Bengtson's thesis. notify = [Encodability_Process_Calculi] title = Analysing and Comparing Encodability Criteria for Process Calculi author = Kirstin Peters , Rob van Glabbeek date = 2015-08-10 topic = Computer Science/Concurrency/Process Calculi abstract = Encodings or the proof of their absence are the main way to compare process calculi. To analyse the quality of encodings and to rule out trivial or meaningless encodings, they are augmented with quality criteria. There exists a bunch of different criteria and different variants of criteria in order to reason in different settings. This leads to incomparable results. Moreover it is not always clear whether the criteria used to obtain a result in a particular setting do indeed fit to this setting. We show how to formally reason about and compare encodability criteria by mapping them on requirements on a relation between source and target terms that is induced by the encoding function. In particular we analyse the common criteria full abstraction, operational correspondence, divergence reflection, success sensitiveness, and respect of barbs; e.g. we analyse the exact nature of the simulation relation (coupled simulation versus bisimulation) that is induced by different variants of operational correspondence. This way we reduce the problem of analysing or comparing encodability criteria to the better understood problem of comparing relations on processes. notify = kirstin.peters@tu-berlin.de [Circus] title = Isabelle/Circus author = Abderrahmane Feliachi , Burkhart Wolff , Marie-Claude Gaudel contributors = Makarius Wenzel date = 2012-05-27 topic = Computer Science/Concurrency/Process Calculi, Computer Science/System Description Languages abstract = The Circus specification language combines elements for complex data and behavior specifications, using an integration of Z and CSP with a refinement calculus. Its semantics is based on Hoare and He's Unifying Theories of Programming (UTP). Isabelle/Circus is a formalization of the UTP and the Circus language in Isabelle/HOL. It contains proof rules and tactic support that allows for proofs of refinement for Circus processes (involving both data and behavioral aspects).

The Isabelle/Circus environment supports a syntax for the semantic definitions which is close to textbook presentations of Circus. This article contains an extended version of corresponding VSTTE Paper together with the complete formal development of its underlying commented theories. extra-history = Change history: [2014-06-05]: More polishing, shorter proofs, added Circus syntax, added Makarius Wenzel as contributor. notify = [Dijkstra_Shortest_Path] title = Dijkstra's Shortest Path Algorithm author = Benedikt Nordhoff , Peter Lammich topic = Computer Science/Algorithms/Graph date = 2012-01-30 abstract = We implement and prove correct Dijkstra's algorithm for the single source shortest path problem, conceived in 1956 by E. Dijkstra. The algorithm is implemented using the data refinement framework for monadic, nondeterministic programs. An efficient implementation is derived using data structures from the Isabelle Collection Framework. notify = lammich@in.tum.de [Refine_Monadic] title = Refinement for Monadic Programs author = Peter Lammich topic = Computer Science/Programming Languages/Logics date = 2012-01-30 abstract = We provide a framework for program and data refinement in Isabelle/HOL. The framework is based on a nondeterminism-monad with assertions, i.e., the monad carries a set of results or an assertion failure. Recursion is expressed by fixed points. For convenience, we also provide while and foreach combinators.

The framework provides tools to automatize canonical tasks, such as verification condition generation, finding appropriate data refinement relations, and refine an executable program to a form that is accepted by the Isabelle/HOL code generator.

This submission comes with a collection of examples and a user-guide, illustrating the usage of the framework. extra-history = Change history: [2012-04-23] Introduced ordered FOREACH loops
[2012-06] New features: REC_rule_arb and RECT_rule_arb allow for generalizing over variables. prepare_code_thms - command extracts code equations for recursion combinators.
[2012-07] New example: Nested DFS for emptiness check of Buchi-automata with witness.
New feature: fo_rule method to apply resolution using first-order matching. Useful for arg_conf, fun_cong.
[2012-08] Adaptation to ICF v2.
[2012-10-05] Adaptations to include support for Automatic Refinement Framework.
[2013-09] This entry now depends on Automatic Refinement
[2014-06] New feature: vc_solve method to solve verification conditions. Maintenace changes: VCG-rules for nfoldli, improved setup for FOREACH-loops.
[2014-07] Now defining recursion via flat domain. Dropped many single-valued prerequisites. Changed notion of data refinement. In single-valued case, this matches the old notion. In non-single valued case, the new notion allows for more convenient rules. In particular, the new definitions allow for projecting away ghost variables as a refinement step.
[2014-11] New features: le-or-fail relation (leof), modular reasoning about loop invariants. notify = lammich@in.tum.de [Refine_Imperative_HOL] title = The Imperative Refinement Framework author = Peter Lammich notify = lammich@in.tum.de date = 2016-08-08 topic = Computer Science/Programming Languages/Transformations,Computer Science/Data Structures abstract = We present the Imperative Refinement Framework (IRF), a tool that supports a stepwise refinement based approach to imperative programs. This entry is based on the material we presented in [ITP-2015, CPP-2016]. It uses the Monadic Refinement Framework as a frontend for the specification of the abstract programs, and Imperative/HOL as a backend to generate executable imperative programs. The IRF comes with tool support to synthesize imperative programs from more abstract, functional ones, using efficient imperative implementations for the abstract data structures. This entry also includes the Imperative Isabelle Collection Framework (IICF), which provides a library of re-usable imperative collection data structures. Moreover, this entry contains a quickstart guide and a reference manual, which provide an introduction to using the IRF for Isabelle/HOL experts. It also provids a collection of (partly commented) practical examples, some highlights being Dijkstra's Algorithm, Nested-DFS, and a generic worklist algorithm with subsumption. Finally, this entry contains benchmark scripts that compare the runtime of some examples against reference implementations of the algorithms in Java and C++. [ITP-2015] Peter Lammich: Refinement to Imperative/HOL. ITP 2015: 253--269 [CPP-2016] Peter Lammich: Refinement based verification of imperative data structures. CPP 2016: 27--36 [Automatic_Refinement] title = Automatic Data Refinement author = Peter Lammich topic = Computer Science/Programming Languages/Logics date = 2013-10-02 abstract = We present the Autoref tool for Isabelle/HOL, which automatically refines algorithms specified over abstract concepts like maps and sets to algorithms over concrete implementations like red-black-trees, and produces a refinement theorem. It is based on ideas borrowed from relational parametricity due to Reynolds and Wadler. The tool allows for rapid prototyping of verified, executable algorithms. Moreover, it can be configured to fine-tune the result to the user~s needs. Our tool is able to automatically instantiate generic algorithms, which greatly simplifies the implementation of executable data structures.

This AFP-entry provides the basic tool, which is then used by the Refinement and Collection Framework to provide automatic data refinement for the nondeterminism monad and various collection datastructures. notify = lammich@in.tum.de [EdmondsKarp_Maxflow] title = Formalizing the Edmonds-Karp Algorithm author = Peter Lammich , S. Reza Sefidgar<> notify = lammich@in.tum.de date = 2016-08-12 topic = Computer Science/Algorithms/Graph abstract = We present a formalization of the Ford-Fulkerson method for computing the maximum flow in a network. Our formal proof closely follows a standard textbook proof, and is accessible even without being an expert in Isabelle/HOL--- the interactive theorem prover used for the formalization. We then use stepwise refinement to obtain the Edmonds-Karp algorithm, and formally prove a bound on its complexity. Further refinement yields a verified implementation, whose execution time compares well to an unverified reference implementation in Java. This entry is based on our ITP-2016 paper with the same title. [VerifyThis2018] title = VerifyThis 2018 - Polished Isabelle Solutions author = Peter Lammich , Simon Wimmer topic = Computer Science/Algorithms date = 2018-04-27 notify = lammich@in.tum.de abstract = VerifyThis 2018 was a program verification competition associated with ETAPS 2018. It was the 7th event in the VerifyThis competition series. In this entry, we present polished and completed versions of our solutions that we created during the competition. [PseudoHoops] title = Pseudo Hoops author = George Georgescu <>, Laurentiu Leustean <>, Viorel Preoteasa topic = Mathematics/Algebra date = 2011-09-22 abstract = Pseudo-hoops are algebraic structures introduced by B. Bosbach under the name of complementary semigroups. In this formalization we prove some properties of pseudo-hoops and we define the basic concepts of filter and normal filter. The lattice of normal filters is isomorphic with the lattice of congruences of a pseudo-hoop. We also study some important classes of pseudo-hoops. Bounded Wajsberg pseudo-hoops are equivalent to pseudo-Wajsberg algebras and bounded basic pseudo-hoops are equivalent to pseudo-BL algebras. Some examples of pseudo-hoops are given in the last section of the formalization. notify = viorel.preoteasa@aalto.fi [MonoBoolTranAlgebra] title = Algebra of Monotonic Boolean Transformers author = Viorel Preoteasa topic = Computer Science/Programming Languages/Logics date = 2011-09-22 abstract = Algebras of imperative programming languages have been successful in reasoning about programs. In general an algebra of programs is an algebraic structure with programs as elements and with program compositions (sequential composition, choice, skip) as algebra operations. Various versions of these algebras were introduced to model partial correctness, total correctness, refinement, demonic choice, and other aspects. We formalize here an algebra which can be used to model total correctness, refinement, demonic and angelic choice. The basic model of this algebra are monotonic Boolean transformers (monotonic functions from a Boolean algebra to itself). notify = viorel.preoteasa@aalto.fi [LatticeProperties] title = Lattice Properties author = Viorel Preoteasa topic = Mathematics/Order date = 2011-09-22 abstract = This formalization introduces and collects some algebraic structures based on lattices and complete lattices for use in other developments. The structures introduced are modular, and lattice ordered groups. In addition to the results proved for the new lattices, this formalization also introduces theorems about latices and complete lattices in general. extra-history = Change history: [2012-01-05]: Removed the theory about distributive complete lattices which is in the standard library now. Added a theory about well founded and transitive relations and a result about fixpoints in complete lattices and well founded relations. Moved the results about conjunctive and disjunctive functions to a new theory. Removed the syntactic classes for inf and sup which are in the standard library now. notify = viorel.preoteasa@aalto.fi [Impossible_Geometry] title = Proving the Impossibility of Trisecting an Angle and Doubling the Cube author = Ralph Romanos , Lawrence C. Paulson topic = Mathematics/Algebra, Mathematics/Geometry date = 2012-08-05 abstract = Squaring the circle, doubling the cube and trisecting an angle, using a compass and straightedge alone, are classic unsolved problems first posed by the ancient Greeks. All three problems were proved to be impossible in the 19th century. The following document presents the proof of the impossibility of solving the latter two problems using Isabelle/HOL, following a proof by Carrega. The proof uses elementary methods: no Galois theory or field extensions. The set of points constructible using a compass and straightedge is defined inductively. Radical expressions, which involve only square roots and arithmetic of rational numbers, are defined, and we find that all constructive points have radical coordinates. Finally, doubling the cube and trisecting certain angles requires solving certain cubic equations that can be proved to have no rational roots. The Isabelle proofs require a great many detailed calculations. notify = ralph.romanos@student.ecp.fr, lp15@cam.ac.uk [IP_Addresses] title = IP Addresses author = Cornelius Diekmann , Julius Michaelis , Lars Hupel notify = diekmann@net.in.tum.de date = 2016-06-28 topic = Computer Science/Networks abstract = This entry contains a definition of IP addresses and a library to work with them. Generic IP addresses are modeled as machine words of arbitrary length. Derived from this generic definition, IPv4 addresses are 32bit machine words, IPv6 addresses are 128bit words. Additionally, IPv4 addresses can be represented in dot-decimal notation and IPv6 addresses in (compressed) colon-separated notation. We support toString functions and parsers for both notations. Sets of IP addresses can be represented with a netmask (e.g. 192.168.0.0/255.255.0.0) or in CIDR notation (e.g. 192.168.0.0/16). To provide executable code for set operations on IP address ranges, the library includes a datatype to work on arbitrary intervals of machine words. [Simple_Firewall] title = Simple Firewall author = Cornelius Diekmann , Julius Michaelis , Maximilian Haslbeck notify = diekmann@net.in.tum.de, max.haslbeck@gmx.de date = 2016-08-24 topic = Computer Science/Networks abstract = We present a simple model of a firewall. The firewall can accept or drop a packet and can match on interfaces, IP addresses, protocol, and ports. It was designed to feature nice mathematical properties: The type of match expressions was carefully crafted such that the conjunction of two match expressions is only one match expression. This model is too simplistic to mirror all aspects of the real world. In the upcoming entry "Iptables Semantics", we will translate the Linux firewall iptables to this model. For a fixed service (e.g. ssh, http), we provide an algorithm to compute an overview of the firewall's filtering behavior. The algorithm computes minimal service matrices, i.e. graphs which partition the complete IPv4 and IPv6 address space and visualize the allowed accesses between partitions. For a detailed description, see Verified iptables Firewall Analysis, IFIP Networking 2016. [Iptables_Semantics] title = Iptables Semantics author = Cornelius Diekmann , Lars Hupel notify = diekmann@net.in.tum.de, hupel@in.tum.de date = 2016-09-09 topic = Computer Science/Networks abstract = We present a big step semantics of the filtering behavior of the Linux/netfilter iptables firewall. We provide algorithms to simplify complex iptables rulests to a simple firewall model (c.f. AFP entry Simple_Firewall) and to verify spoofing protection of a ruleset. Internally, we embed our semantics into ternary logic, ultimately supporting every iptables match condition by abstracting over unknowns. Using this AFP entry and all entries it depends on, we created an easy-to-use, stand-alone haskell tool called fffuu. The tool does not require any input —except for the iptables-save dump of the analyzed firewall— and presents interesting results about the user's ruleset. Real-Word firewall errors have been uncovered, and the correctness of rulesets has been proved, with the help of our tool. [Routing] title = Routing author = Julius Michaelis , Cornelius Diekmann notify = afp@liftm.de date = 2016-08-31 topic = Computer Science/Networks abstract = This entry contains definitions for routing with routing tables/longest prefix matching. A routing table entry is modelled as a record of a prefix match, a metric, an output port, and an optional next hop. A routing table is a list of entries, sorted by prefix length and metric. Additionally, a parser and serializer for the output of the ip-route command, a function to create a relation from output port to corresponding destination IP space, and a model of a Linux-style router are included. [KBPs] title = Knowledge-based programs author = Peter Gammie topic = Computer Science/Automata and Formal Languages date = 2011-05-17 abstract = Knowledge-based programs (KBPs) are a formalism for directly relating agents' knowledge and behaviour. Here we present a general scheme for compiling KBPs to executable automata with a proof of correctness in Isabelle/HOL. We develop the algorithm top-down, using Isabelle's locale mechanism to structure these proofs, and show that two classic examples can be synthesised using Isabelle's code generator. extra-history = Change history: [2012-03-06]: Add some more views and revive the code generation. notify = kleing@cse.unsw.edu.au [Tarskis_Geometry] title = The independence of Tarski's Euclidean axiom author = T. J. M. Makarios topic = Mathematics/Geometry date = 2012-10-30 abstract = Tarski's axioms of plane geometry are formalized and, using the standard real Cartesian model, shown to be consistent. A substantial theory of the projective plane is developed. Building on this theory, the Klein-Beltrami model of the hyperbolic plane is defined and shown to satisfy all of Tarski's axioms except his Euclidean axiom; thus Tarski's Euclidean axiom is shown to be independent of his other axioms of plane geometry.

An earlier version of this work was the subject of the author's MSc thesis, which contains natural-language explanations of some of the more interesting proofs. notify = tjm1983@gmail.com [General-Triangle] title = The General Triangle Is Unique author = Joachim Breitner topic = Mathematics/Geometry date = 2011-04-01 abstract = Some acute-angled triangles are special, e.g. right-angled or isoscele triangles. Some are not of this kind, but, without measuring angles, look as if they were. In that sense, there is exactly one general triangle. This well-known fact is proven here formally. notify = mail@joachim-breitner.de [LightweightJava] title = Lightweight Java author = Rok Strniša , Matthew Parkinson topic = Computer Science/Programming Languages/Language Definitions date = 2011-02-07 abstract = A fully-formalized and extensible minimal imperative fragment of Java. notify = rok@strnisa.com [Lower_Semicontinuous] title = Lower Semicontinuous Functions author = Bogdan Grechuk topic = Mathematics/Analysis date = 2011-01-08 abstract = We define the notions of lower and upper semicontinuity for functions from a metric space to the extended real line. We prove that a function is both lower and upper semicontinuous if and only if it is continuous. We also give several equivalent characterizations of lower semicontinuity. In particular, we prove that a function is lower semicontinuous if and only if its epigraph is a closed set. Also, we introduce the notion of the lower semicontinuous hull of an arbitrary function and prove its basic properties. notify = hoelzl@in.tum.de [RIPEMD-160-SPARK] title = RIPEMD-160 author = Fabian Immler topic = Computer Science/Programming Languages/Static Analysis date = 2011-01-10 abstract = This work presents a verification of an implementation in SPARK/ADA of the cryptographic hash-function RIPEMD-160. A functional specification of RIPEMD-160 is given in Isabelle/HOL. Proofs for the verification conditions generated by the static-analysis toolset of SPARK certify the functional correctness of the implementation. extra-history = Change history: [2015-11-09]: Entry is now obsolete, moved to Isabelle distribution. notify = immler@in.tum.de [Regular-Sets] title = Regular Sets and Expressions author = Alexander Krauss , Tobias Nipkow contributors = Manuel Eberl topic = Computer Science/Automata and Formal Languages date = 2010-05-12 abstract = This is a library of constructions on regular expressions and languages. It provides the operations of concatenation, Kleene star and derivative on languages. Regular expressions and their meaning are defined. An executable equivalence checker for regular expressions is verified; it does not need automata but works directly on regular expressions. By mapping regular expressions to binary relations, an automatic and complete proof method for (in)equalities of binary relations over union, concatenation and (reflexive) transitive closure is obtained.

Extended regular expressions with complement and intersection are also defined and an equivalence checker is provided. extra-history = Change history: [2011-08-26]: Christian Urban added a theory about derivatives and partial derivatives of regular expressions
[2012-05-10]: Tobias Nipkow added extended regular expressions
[2012-05-10]: Tobias Nipkow added equivalence checking with partial derivatives notify = nipkow@in.tum.de, krauss@in.tum.de, christian.urban@kcl.ac.uk [Regex_Equivalence] title = Unified Decision Procedures for Regular Expression Equivalence author = Tobias Nipkow , Dmitriy Traytel topic = Computer Science/Automata and Formal Languages date = 2014-01-30 abstract = We formalize a unified framework for verified decision procedures for regular expression equivalence. Five recently published formalizations of such decision procedures (three based on derivatives, two on marked regular expressions) can be obtained as instances of the framework. We discover that the two approaches based on marked regular expressions, which were previously thought to be the same, are different, and one seems to produce uniformly smaller automata. The common framework makes it possible to compare the performance of the different decision procedures in a meaningful way. The formalization is described in a paper of the same name presented at Interactive Theorem Proving 2014. notify = nipkow@in.tum.de, traytel@in.tum.de [MSO_Regex_Equivalence] title = Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions author = Dmitriy Traytel , Tobias Nipkow topic = Computer Science/Automata and Formal Languages, Logic 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 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, 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 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 abstract = This work presents a formalization of a library for automata on bit strings. It forms the basis of a reflection-based decision procedure for Presburger arithmetic, which is efficiently executable thanks to Isabelle's code generator. With this work, we therefore provide a mechanized proof of a well-known connection between logic and automata theory. The formalization is also described in a publication [TPHOLs 2009]. notify = berghofe@in.tum.de [Functional-Automata] title = Functional Automata author = Tobias Nipkow date = 2004-03-30 topic = Computer Science/Automata and Formal Languages abstract = This theory defines deterministic and nondeterministic automata in a functional representation: the transition function/relation and the finality predicate are just functions. Hence the state space may be infinite. It is shown how to convert regular expressions into such automata. A scanner (generator) is implemented with the help of functional automata: the scanner chops the input up into longest recognized substrings. Finally we also show how to convert a certain subclass of functional automata (essentially the finite deterministic ones) into regular sets. notify = nipkow@in.tum.de [Statecharts] title = Formalizing Statecharts using Hierarchical Automata author = Steffen Helke , Florian Kammüller topic = Computer Science/Automata and Formal Languages date = 2010-08-08 abstract = We formalize in Isabelle/HOL the abtract syntax and a synchronous step semantics for the specification language Statecharts. The formalization is based on Hierarchical Automata which allow a structural decomposition of Statecharts into Sequential Automata. To support the composition of Statecharts, we introduce calculating operators to construct a Hierarchical Automaton in a stepwise manner. Furthermore, we present a complete semantics of Statecharts including a theory of data spaces, which enables the modelling of racing effects. We also adapt CTL for Statecharts to build a bridge for future combinations with model checking. However the main motivation of this work is to provide a sound and complete basis for reasoning on Statecharts. As a central meta theorem we prove that the well-formedness of a Statechart is preserved by the semantics. notify = nipkow@in.tum.de [Stuttering_Equivalence] title = Stuttering Equivalence author = Stephan Merz topic = Computer Science/Automata and Formal Languages date = 2012-05-07 abstract =

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

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

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

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

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

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

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

The UpDown scheme allows us to compute the stiffness matrix on such a sparse grid. The stiffness matrix represents the influence of each representation function on the L^2 scalar product. For a detailed description see Dirk Pflüger's PhD thesis. This formalization was developed as an interdisciplinary project (IDP) at the Technische Universität München. notify = hoelzl@in.tum.de [GraphMarkingIBP] title = Verification of the Deutsch-Schorr-Waite Graph Marking Algorithm using Data Refinement author = Viorel Preoteasa , Ralph-Johan Back date = 2010-05-28 topic = Computer Science/Algorithms/Graph abstract = The verification of the Deutsch-Schorr-Waite graph marking algorithm is used as a benchmark in many formalizations of pointer programs. The main purpose of this mechanization is to show how data refinement of invariant based programs can be used in verifying practical algorithms. The verification starts with an abstract algorithm working on a graph given by a relation next on nodes. Gradually the abstract program is refined into Deutsch-Schorr-Waite graph marking algorithm where only one bit per graph node of additional memory is used for marking. extra-history = Change history: [2012-01-05]: Updated for the new definition of data refinement and the new syntax for demonic and angelic update statements notify = viorel.preoteasa@aalto.fi [Efficient-Mergesort] title = Efficient Mergesort topic = Computer Science/Algorithms date = 2011-11-09 author = Christian Sternagel abstract = We provide a formalization of the mergesort algorithm as used in GHC's Data.List module, proving correctness and stability. Furthermore, experimental data suggests that generated (Haskell-)code for this algorithm is much faster than for previous algorithms available in the Isabelle distribution. extra-history = Change history: [2012-10-24]: Added reference to journal article.
[2018-09-17]: Added theory Efficient_Mergesort that works exclusively with the mutual induction schemas generated by the function package.
[2018-09-19]: Added theory Mergesort_Complexity that proves an upper bound on the number of comparisons that are required by mergesort.
[2018-09-19]: Theory Efficient_Mergesort replaces theory Efficient_Sort but keeping the old name Efficient_Sort. notify = c.sternagel@gmail.com [SATSolverVerification] title = Formal Verification of Modern SAT Solvers -author = Filip Maric +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 theory implements priority queues via Braun trees. Insertion and deletion take logarithmic time and preserve the balanced nature of Braun trees. notify = nipkow@in.tum.de [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, rene.neumann@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 [AutoFocus-Stream] title = AutoFocus Stream Processing for Single-Clocking and Multi-Clocking Semantics author = David Trachtenherz <> date = 2011-02-23 topic = Computer Science/Programming Languages/Language Definitions abstract = We formalize the AutoFocus Semantics (a time-synchronous subset of the Focus formalism) as stream processing functions on finite and infinite message streams represented as finite/infinite lists. The formalization comprises both the conventional single-clocking semantics (uniform global clock for all components and communications channels) and its extension to multi-clocking semantics (internal execution clocking of a component may be a multiple of the external communication clocking). The semantics is defined by generic stream processing functions making it suitable for simulation/code generation in Isabelle/HOL. Furthermore, a number of AutoFocus semantics properties are formalized using definitions from the IntervalLogic theories. notify = nipkow@in.tum.de [FocusStreamsCaseStudies] title = Stream Processing Components: Isabelle/HOL Formalisation and Case Studies author = Maria Spichkova date = 2013-11-14 topic = Computer Science/Programming Languages/Language Definitions abstract = This set of theories presents an Isabelle/HOL formalisation of stream processing components introduced in Focus, a framework for formal specification and development of interactive systems. This is an extended and updated version of the formalisation, which was elaborated within the methodology "Focus on Isabelle". In addition, we also applied the formalisation on three case studies that cover different application areas: process control (Steam Boiler System), data transmission (FlexRay communication protocol), memory and processing components (Automotive-Gateway System). notify = lp15@cam.ac.uk, maria.spichkova@rmit.edu.au [Isabelle_Meta_Model] title = A Meta-Model for the Isabelle API author = Frédéric Tuong , Burkhart Wolff date = 2015-09-16 topic = Computer Science/Programming Languages/Language Definitions abstract = We represent a theory of (a fragment of) Isabelle/HOL in Isabelle/HOL. The purpose of this exercise is to write packages for domain-specific specifications such as class models, B-machines, ..., and generally speaking, any domain-specific languages whose abstract syntax can be defined by a HOL "datatype". On this basis, the Isabelle code-generator can then be used to generate code for global context transformations as well as tactic code.

Consequently the package is geared towards parsing, printing and code-generation to the Isabelle API. It is at the moment not sufficiently rich for doing meta theory on Isabelle itself. Extensions in this direction are possible though.

Moreover, the chosen fragment is fairly rudimentary. However it should be easily adapted to one's needs if a package is written on top of it. The supported API contains types, terms, transformation of global context like definitions and data-type declarations as well as infrastructure for Isar-setups.

This theory is drawn from the Featherweight OCL project where it is used to construct a package for object-oriented data-type theories generated from UML class diagrams. The Featherweight OCL, for example, allows for both the direct execution of compiled tactic code by the Isabelle API as well as the generation of ".thy"-files for debugging purposes.

Gained experience from this project shows that the compiled code is sufficiently efficient for practical purposes while being based on a formal model on which properties of the package can be proven such as termination of certain transformations, correctness, etc. notify = tuong@users.gforge.inria.fr, wolff@lri.fr [Clean] title = Clean - An Abstract Imperative Programming Language and its Theory author = Frédéric Tuong , Burkhart Wolff topic = Computer Science/Programming Languages, Computer Science/Semantics date = 2019-10-04 notify = wolff@lri.fr, ftuong@lri.fr abstract = Clean is based on a simple, abstract execution model for an imperative target language. “Abstract” is understood in contrast to “Concrete Semantics”; alternatively, the term “shallow-style embedding” could be used. It strives for a type-safe notion of program-variables, an incremental construction of the typed state-space, support of incremental verification, and open-world extensibility of new type definitions being intertwined with the program definitions. Clean is based on a “no-frills” state-exception monad with the usual definitions of bind and unit for the compositional glue of state-based computations. Clean offers conditionals and loops supporting C-like control-flow operators such as break and return. The state-space construction is based on the extensible record package. Direct recursion of procedures is supported. Clean’s design strives for extreme simplicity. It is geared towards symbolic execution and proven correct verification tools. The underlying libraries of this package, however, deliberately restrict themselves to the most elementary infrastructure for these tasks. The package is intended to serve as demonstrator semantic backend for Isabelle/C, or for the test-generation techniques. [PCF] title = Logical Relations for PCF author = Peter Gammie date = 2012-07-01 topic = Computer Science/Programming Languages/Lambda Calculi abstract = We apply Andy Pitts's methods of defining relations over domains to several classical results in the literature. We show that the Y combinator coincides with the domain-theoretic fixpoint operator, that parallel-or and the Plotkin existential are not definable in PCF, that the continuation semantics for PCF coincides with the direct semantics, and that our domain-theoretic semantics for PCF is adequate for reasoning about contextual equivalence in an operational semantics. Our version of PCF is untyped and has both strict and non-strict function abstractions. The development is carried out in HOLCF. notify = peteg42@gmail.com [POPLmark-deBruijn] title = POPLmark Challenge Via de Bruijn Indices author = Stefan Berghofer date = 2007-08-02 topic = Computer Science/Programming Languages/Lambda Calculi abstract = We present a solution to the POPLmark challenge designed by Aydemir et al., which has as a goal the formalization of the meta-theory of System F<:. The formalization is carried out in the theorem prover Isabelle/HOL using an encoding based on de Bruijn indices. We start with a relatively simple formalization covering only the basic features of System F<:, and explain how it can be extended to also cover records and more advanced binding constructs. notify = berghofe@in.tum.de [Lam-ml-Normalization] title = Strong Normalization of Moggis's Computational Metalanguage author = Christian Doczkal date = 2010-08-29 topic = Computer Science/Programming Languages/Lambda Calculi abstract = Handling variable binding is one of the main difficulties in formal proofs. In this context, Moggi's computational metalanguage serves as an interesting case study. It features monadic types and a commuting conversion rule that rearranges the binding structure. Lindley and Stark have given an elegant proof of strong normalization for this calculus. The key construction in their proof is a notion of relational TT-lifting, using stacks of elimination contexts to obtain a Girard-Tait style logical relation. I give a formalization of their proof in Isabelle/HOL-Nominal with a particular emphasis on the treatment of bound variables. notify = doczkal@ps.uni-saarland.de, nipkow@in.tum.de [MiniML] title = Mini ML author = Wolfgang Naraschewski <>, Tobias Nipkow date = 2004-03-19 topic = Computer Science/Programming Languages/Type Systems abstract = This theory defines the type inference rules and the type inference algorithm W for MiniML (simply-typed lambda terms with let) due to Milner. It proves the soundness and completeness of W w.r.t. the rules. notify = kleing@cse.unsw.edu.au [Simpl] title = A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment author = Norbert Schirmer <> date = 2008-02-29 topic = Computer Science/Programming Languages/Language Definitions, Computer Science/Programming Languages/Logics license = LGPL abstract = We present the theory of Simpl, a sequential imperative programming language. We introduce its syntax, its semantics (big and small-step operational semantics) and Hoare logics for both partial as well as total correctness. We prove soundness and completeness of the Hoare logic. We integrate and automate the Hoare logic in Isabelle/HOL to obtain a practically usable verification environment for imperative programs. Simpl is independent of a concrete programming language but expressive enough to cover all common language features: mutually recursive procedures, abrupt termination and exceptions, runtime faults, local and global variables, pointers and heap, expressions with side effects, pointers to procedures, partial application and closures, dynamic method invocation and also unbounded nondeterminism. notify = kleing@cse.unsw.edu.au, norbert.schirmer@web.de [Separation_Algebra] title = Separation Algebra author = Gerwin Klein , Rafal Kolanski , Andrew Boyton date = 2012-05-11 topic = Computer Science/Programming Languages/Logics license = BSD abstract = We present a generic type class implementation of separation algebra for Isabelle/HOL as well as lemmas and generic tactics which can be used directly for any instantiation of the type class.

The ex directory contains example instantiations that include structures such as a heap or virtual memory.

The abstract separation algebra is based upon "Abstract Separation Logic" by Calcagno et al. These theories are also the basis of the ITP 2012 rough diamond "Mechanised Separation Algebra" by the authors.

The aim of this work is to support and significantly reduce the effort for future separation logic developments in Isabelle/HOL by factoring out the part of separation logic that can be treated abstractly once and for all. This includes developing typical default rule sets for reasoning as well as automated tactic support for separation logic. notify = kleing@cse.unsw.edu.au, rafal.kolanski@nicta.com.au [Separation_Logic_Imperative_HOL] title = A Separation Logic Framework for Imperative HOL author = Peter Lammich , Rene Meis date = 2012-11-14 topic = Computer Science/Programming Languages/Logics license = BSD abstract = We provide a framework for separation-logic based correctness proofs of Imperative HOL programs. Our framework comes with a set of proof methods to automate canonical tasks such as verification condition generation and frame inference. Moreover, we provide a set of examples that show the applicability of our framework. The examples include algorithms on lists, hash-tables, and union-find trees. We also provide abstract interfaces for lists, maps, and sets, that allow to develop generic imperative algorithms and use data-refinement techniques.
As we target Imperative HOL, our programs can be translated to efficiently executable code in various target languages, including ML, OCaml, Haskell, and Scala. notify = lammich@in.tum.de [Inductive_Confidentiality] title = Inductive Study of Confidentiality author = Giampaolo Bella date = 2012-05-02 topic = Computer Science/Security abstract = This document contains the full theory files accompanying article Inductive Study of Confidentiality --- for Everyone in Formal Aspects of Computing. They aim at an illustrative and didactic presentation of the Inductive Method of protocol analysis, focusing on the treatment of one of the main goals of security protocols: confidentiality against a threat model. The treatment of confidentiality, which in fact forms a key aspect of all protocol analysis tools, has been found cryptic by many learners of the Inductive Method, hence the motivation for this work. The theory files in this document guide the reader step by step towards design and proof of significant confidentiality theorems. These are developed against two threat models, the standard Dolev-Yao and a more audacious one, the General Attacker, which turns out to be particularly useful also for teaching purposes. notify = giamp@dmi.unict.it [Possibilistic_Noninterference] title = Possibilistic Noninterference author = Andrei Popescu , Johannes Hölzl date = 2012-09-10 topic = Computer Science/Security, Computer Science/Programming Languages/Type Systems abstract = We formalize a wide variety of Volpano/Smith-style noninterference notions for a while language with parallel composition. We systematize and classify these notions according to compositionality w.r.t. the language constructs. Compositionality yields sound syntactic criteria (a.k.a. type systems) in a uniform way.

An article about these proofs is published in the proceedings of the conference Certified Programs and Proofs 2012. notify = hoelzl@in.tum.de [SIFUM_Type_Systems] title = A Formalization of Assumptions and Guarantees for Compositional Noninterference author = Sylvia Grewe , Heiko Mantel , Daniel Schoepe date = 2014-04-23 topic = Computer Science/Security, Computer Science/Programming Languages/Type Systems abstract = Research in information-flow security aims at developing methods to identify undesired information leaks within programs from private (high) sources to public (low) sinks. For a concurrent system, it is desirable to have compositional analysis methods that allow for analyzing each thread independently and that nevertheless guarantee that the parallel composition of successfully analyzed threads satisfies a global security guarantee. However, such a compositional analysis should not be overly pessimistic about what an environment might do with shared resources. Otherwise, the analysis will reject many intuitively secure programs.

The paper "Assumptions and Guarantees for Compositional Noninterference" by Mantel et. al. presents one solution for this problem: an approach for compositionally reasoning about non-interference in concurrent programs via rely-guarantee-style reasoning. We present an Isabelle/HOL formalization of the concepts and proofs of this approach. notify = grewe@cs.tu-darmstadt.de [Dependent_SIFUM_Type_Systems] title = A Dependent Security Type System for Concurrent Imperative Programs author = Toby Murray , Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah notify = toby.murray@unimelb.edu.au date = 2016-06-25 topic = Computer Science/Security, Computer Science/Programming Languages/Type Systems abstract = The paper "Compositional Verification and Refinement of Concurrent Value-Dependent Noninterference" by Murray et. al. (CSF 2016) presents a dependent security type system for compositionally verifying a value-dependent noninterference property, defined in (Murray, PLAS 2015), for concurrent programs. This development formalises that security definition, the type system and its soundness proof, and demonstrates its application on some small examples. It was derived from the SIFUM_Type_Systems AFP entry, by Sylvia Grewe, Heiko Mantel and Daniel Schoepe, and whose structure it inherits. extra-history = Change history: [2016-08-19]: Removed unused "stop" parameter and "stop_no_eval" assumption from the sifum_security locale. (revision dbc482d36372) [2016-09-27]: Added security locale support for the imposition of requirements on the initial memory. (revision cce4ceb74ddb) [Dependent_SIFUM_Refinement] title = Compositional Security-Preserving Refinement for Concurrent Imperative Programs author = Toby Murray , Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah notify = toby.murray@unimelb.edu.au date = 2016-06-28 topic = Computer Science/Security abstract = The paper "Compositional Verification and Refinement of Concurrent Value-Dependent Noninterference" by Murray et. al. (CSF 2016) presents a compositional theory of refinement for a value-dependent noninterference property, defined in (Murray, PLAS 2015), for concurrent programs. This development formalises that refinement theory, and demonstrates its application on some small examples. extra-history = Change history: [2016-08-19]: Removed unused "stop" parameters from the sifum_refinement locale. (revision dbc482d36372) [2016-09-02]: TobyM extended "simple" refinement theory to be usable for all bisimulations. (revision 547f31c25f60) [Strong_Security] title = A Formalization of Strong Security author = Sylvia Grewe , Alexander Lux , Heiko Mantel , Jens Sauer date = 2014-04-23 topic = Computer Science/Security, Computer Science/Programming Languages/Type Systems abstract = Research in information-flow security aims at developing methods to identify undesired information leaks within programs from private sources to public sinks. Noninterference captures this intuition. Strong security from Sabelfeld and Sands formalizes noninterference for concurrent systems.

We present an Isabelle/HOL formalization of strong security for arbitrary security lattices (Sabelfeld and Sands use a two-element security lattice in the original publication). The formalization includes compositionality proofs for strong security and a soundness proof for a security type system that checks strong security for programs in a simple while language with dynamic thread creation.

Our formalization of the security type system is abstract in the language for expressions and in the semantic side conditions for expressions. It can easily be instantiated with different syntactic approximations for these side conditions. The soundness proof of such an instantiation boils down to showing that these syntactic approximations imply the semantic side conditions. notify = grewe@cs.tu-darmstadt.de [WHATandWHERE_Security] title = A Formalization of Declassification with WHAT-and-WHERE-Security author = Sylvia Grewe , Alexander Lux , Heiko Mantel , Jens Sauer date = 2014-04-23 topic = Computer Science/Security, Computer Science/Programming Languages/Type Systems abstract = Research in information-flow security aims at developing methods to identify undesired information leaks within programs from private sources to public sinks. Noninterference captures this intuition by requiring that no information whatsoever flows from private sources to public sinks. However, in practice this definition is often too strict: Depending on the intuitive desired security policy, the controlled declassification of certain private information (WHAT) at certain points in the program (WHERE) might not result in an undesired information leak.

We present an Isabelle/HOL formalization of such a security property for controlled declassification, namely WHAT&WHERE-security from "Scheduler-Independent Declassification" by Lux, Mantel, and Perner. The formalization includes compositionality proofs for and a soundness proof for a security type system that checks for programs in a simple while language with dynamic thread creation.

Our formalization of the security type system is abstract in the language for expressions and in the semantic side conditions for expressions. It can easily be instantiated with different syntactic approximations for these side conditions. The soundness proof of such an instantiation boils down to showing that these syntactic approximations imply the semantic side conditions.

This Isabelle/HOL formalization uses theories from the entry Strong Security. notify = grewe@cs.tu-darmstadt.de [VolpanoSmith] title = A Correctness Proof for the Volpano/Smith Security Typing System author = Gregor Snelting , Daniel Wasserrab date = 2008-09-02 topic = Computer Science/Programming Languages/Type Systems, Computer Science/Security abstract = The Volpano/Smith/Irvine security type systems requires that variables are annotated as high (secret) or low (public), and provides typing rules which guarantee that secret values cannot leak to public output ports. This property of a program is called confidentiality. For a simple while-language without threads, our proof shows that typeability in the Volpano/Smith system guarantees noninterference. Noninterference means that if two initial states for program execution are low-equivalent, then the final states are low-equivalent as well. This indeed implies that secret values cannot leak to public ports. The proof defines an abstract syntax and operational semantics for programs, formalizes noninterference, and then proceeds by rule induction on the operational semantics. The mathematically most intricate part is the treatment of implicit flows. Note that the Volpano/Smith system is not flow-sensitive and thus quite unprecise, resulting in false alarms. However, due to the correctness property, all potential breaks of confidentiality are discovered. notify = [Abstract-Hoare-Logics] title = Abstract Hoare Logics author = Tobias Nipkow date = 2006-08-08 topic = Computer Science/Programming Languages/Logics abstract = These therories describe Hoare logics for a number of imperative language constructs, from while-loops to mutually recursive procedures. Both partial and total correctness are treated. In particular a proof system for total correctness of recursive procedures in the presence of unbounded nondeterminism is presented. notify = nipkow@in.tum.de [Stone_Algebras] title = Stone Algebras author = Walter Guttmann notify = walter.guttmann@canterbury.ac.nz date = 2016-09-06 topic = Mathematics/Order abstract = A range of algebras between lattices and Boolean algebras generalise the notion of a complement. We develop a hierarchy of these pseudo-complemented algebras that includes Stone algebras. Independently of this theory we study filters based on partial orders. Both theories are combined to prove Chen and Grätzer's construction theorem for Stone algebras. The latter involves extensive reasoning about algebraic structures in addition to reasoning in algebraic structures. [Kleene_Algebra] title = Kleene Algebra author = Alasdair Armstrong <>, Georg Struth , Tjark Weber date = 2013-01-15 topic = Computer Science/Programming Languages/Logics, Computer Science/Automata and Formal Languages, Mathematics/Algebra abstract = These files contain a formalisation of variants of Kleene algebras and their most important models as axiomatic type classes in Isabelle/HOL. Kleene algebras are foundational structures in computing with applications ranging from automata and language theory to computational modeling, program construction and verification.

We start with formalising dioids, which are additively idempotent semirings, and expand them by axiomatisations of the Kleene star for finite iteration and an omega operation for infinite iteration. We show that powersets over a given monoid, (regular) languages, sets of paths in a graph, sets of computation traces, binary relations and formal power series form Kleene algebras, and consider further models based on lattices, max-plus semirings and min-plus semirings. We also demonstrate that dioids are closed under the formation of matrices (proofs for Kleene algebras remain to be completed).

On the one hand we have aimed at a reference formalisation of variants of Kleene algebras that covers a wide range of variants and the core theorems in a structured and modular way and provides readable proofs at text book level. On the other hand, we intend to use this algebraic hierarchy and its models as a generic algebraic middle-layer from which programming applications can quickly be explored, implemented and verified. notify = g.struth@sheffield.ac.uk, tjark.weber@it.uu.se [KAT_and_DRA] title = Kleene Algebra with Tests and Demonic Refinement Algebras author = Alasdair Armstrong <>, Victor B. F. Gomes , Georg Struth date = 2014-01-23 topic = Computer Science/Programming Languages/Logics, Computer Science/Automata and Formal Languages, Mathematics/Algebra abstract = We formalise Kleene algebra with tests (KAT) and demonic refinement algebra (DRA) in Isabelle/HOL. KAT is relevant for program verification and correctness proofs in the partial correctness setting. While DRA targets similar applications in the context of total correctness. Our formalisation contains the two most important models of these algebras: binary relations in the case of KAT and predicate transformers in the case of DRA. In addition, we derive the inference rules for Hoare logic in KAT and its relational model and present a simple formally verified program verification tool prototype based on the algebraic approach. notify = g.struth@dcs.shef.ac.uk [KAD] title = Kleene Algebras with Domain author = Victor B. F. Gomes , Walter Guttmann , Peter Höfner , Georg Struth , Tjark Weber date = 2016-04-12 topic = Computer Science/Programming Languages/Logics, Computer Science/Automata and Formal Languages, Mathematics/Algebra abstract = Kleene algebras with domain are Kleene algebras endowed with an operation that maps each element of the algebra to its domain of definition (or its complement) in abstract fashion. They form a simple algebraic basis for Hoare logics, dynamic logics or predicate transformer semantics. We formalise a modular hierarchy of algebras with domain and antidomain (domain complement) operations in Isabelle/HOL that ranges from domain and antidomain semigroups to modal Kleene algebras and divergence Kleene algebras. We link these algebras with models of binary relations and program traces. We include some examples from modal logics, termination and program analysis. notify = walter.guttman@canterbury.ac.nz, g.struth@sheffield.ac.uk, tjark.weber@it.uu.se [Regular_Algebras] title = Regular Algebras author = Simon Foster , Georg Struth date = 2014-05-21 topic = Computer Science/Automata and Formal Languages, Mathematics/Algebra abstract = Regular algebras axiomatise the equational theory of regular expressions as induced by regular language identity. We use Isabelle/HOL for a detailed systematic study of regular algebras given by Boffa, Conway, Kozen and Salomaa. We investigate the relationships between these classes, formalise a soundness proof for the smallest class (Salomaa's) and obtain completeness of the largest one (Boffa's) relative to a deep result by Krob. In addition we provide a large collection of regular identities in the general setting of Boffa's axiom. Our regular algebra hierarchy is orthogonal to the Kleene algebra hierarchy in the Archive of Formal Proofs; we have not aimed at an integration for pragmatic reasons. notify = simon.foster@york.ac.uk, g.struth@sheffield.ac.uk [BytecodeLogicJmlTypes] title = A Bytecode Logic for JML and Types author = Lennart Beringer <>, Martin Hofmann date = 2008-12-12 topic = Computer Science/Programming Languages/Logics abstract = This document contains the Isabelle/HOL sources underlying the paper A bytecode logic for JML and types by Beringer and Hofmann, updated to Isabelle 2008. We present a program logic for a subset of sequential Java bytecode that is suitable for representing both, features found in high-level specification language JML as well as interpretations of high-level type systems. To this end, we introduce a fine-grained collection of assertions, including strong invariants, local annotations and VDM-reminiscent partial-correctness specifications. Thanks to a goal-oriented structure and interpretation of judgements, verification may proceed without recourse to an additional control flow analysis. The suitability for interpreting intensional type systems is illustrated by the proof-carrying-code style encoding of a type system for a first-order functional language which guarantees a constant upper bound on the number of objects allocated throughout an execution, be the execution terminating or non-terminating. Like the published paper, the formal development is restricted to a comparatively small subset of the JVML, lacking (among other features) exceptions, arrays, virtual methods, and static fields. This shortcoming has been overcome meanwhile, as our paper has formed the basis of the Mobius base logic, a program logic for the full sequential fragment of the JVML. Indeed, the present formalisation formed the basis of a subsequent formalisation of the Mobius base logic in the proof assistant Coq, which includes a proof of soundness with respect to the Bicolano operational semantics by Pichardie. notify = [DataRefinementIBP] title = Semantics and Data Refinement of Invariant Based Programs author = Viorel Preoteasa , Ralph-Johan Back date = 2010-05-28 topic = Computer Science/Programming Languages/Logics abstract = The invariant based programming is a technique of constructing correct programs by first identifying the basic situations (pre- and post-conditions and invariants) that can occur during the execution of the program, and then defining the transitions and proving that they preserve the invariants. Data refinement is a technique of building correct programs working on concrete datatypes as refinements of more abstract programs. In the theories presented here we formalize the predicate transformer semantics for invariant based programs and their data refinement. extra-history = Change history: [2012-01-05]: Moved some general complete lattice properties to the AFP entry Lattice Properties. Changed the definition of the data refinement relation to be more general and updated all corresponding theorems. Added new syntax for demonic and angelic update statements. notify = viorel.preoteasa@aalto.fi [RefinementReactive] title = Formalization of Refinement Calculus for Reactive Systems author = Viorel Preoteasa date = 2014-10-08 topic = Computer Science/Programming Languages/Logics abstract = We present a formalization of refinement calculus for reactive systems. Refinement calculus is based on monotonic predicate transformers (monotonic functions from sets of post-states to sets of pre-states), and it is a powerful formalism for reasoning about imperative programs. We model reactive systems as monotonic property transformers that transform sets of output infinite sequences into sets of input infinite sequences. Within this semantics we can model refinement of reactive systems, (unbounded) angelic and demonic nondeterminism, sequential composition, and other semantic properties. We can model systems that may fail for some inputs, and we can model compatibility of systems. We can specify systems that have liveness properties using linear temporal logic, and we can refine system specifications into systems based on symbolic transitions systems, suitable for implementations. notify = viorel.preoteasa@aalto.fi [SIFPL] title = Secure information flow and program logics author = Lennart Beringer <>, Martin Hofmann date = 2008-11-10 topic = Computer Science/Programming Languages/Logics, Computer Science/Security abstract = We present interpretations of type systems for secure information flow in Hoare logic, complementing previous encodings in relational program logics. We first treat the imperative language IMP, extended by a simple procedure call mechanism. For this language we consider base-line non-interference in the style of Volpano et al. and the flow-sensitive type system by Hunt and Sands. In both cases, we show how typing derivations may be used to automatically generate proofs in the program logic that certify the absence of illicit flows. We then add instructions for object creation and manipulation, and derive appropriate proof rules for base-line non-interference. As a consequence of our work, standard verification technology may be used for verifying that a concrete program satisfies the non-interference property.

The present proof development represents an update of the formalisation underlying our paper [CSF 2007] and is intended to resolve any ambiguities that may be present in the paper. notify = lennart.beringer@ifi.lmu.de [TLA] title = A Definitional Encoding of TLA* in Isabelle/HOL author = Gudmund Grov , Stephan Merz date = 2011-11-19 topic = Computer Science/Programming Languages/Logics abstract = We mechanise the logic TLA* [Merz 1999], an extension of Lamport's Temporal Logic of Actions (TLA) [Lamport 1994] for specifying and reasoning about concurrent and reactive systems. Aiming at a framework for mechanising] the verification of TLA (or TLA*) specifications, this contribution reuses some elements from a previous axiomatic encoding of TLA in Isabelle/HOL by the second author [Merz 1998], which has been part of the Isabelle distribution. In contrast to that previous work, we give here a shallow, definitional embedding, with the following highlights:

  • a theory of infinite sequences, including a formalisation of the concepts of stuttering invariance central to TLA and TLA*;
  • a definition of the semantics of TLA*, which extends TLA by a mutually-recursive definition of formulas and pre-formulas, generalising TLA action formulas;
  • a substantial set of derived proof rules, including the TLA* axioms and Lamport's proof rules for system verification;
  • a set of examples illustrating the usage of Isabelle/TLA* for reasoning about systems.
Note that this work is unrelated to the ongoing development of a proof system for the specification language TLA+, which includes an encoding of TLA+ as a new Isabelle object logic [Chaudhuri et al 2010]. notify = ggrov@inf.ed.ac.uk [Compiling-Exceptions-Correctly] title = Compiling Exceptions Correctly author = Tobias Nipkow date = 2004-07-09 topic = Computer Science/Programming Languages/Compiling abstract = An exception compilation scheme that dynamically creates and removes exception handler entries on the stack. A formalization of an article of the same name by Hutton and Wright. notify = nipkow@in.tum.de [NormByEval] title = Normalization by Evaluation author = Klaus Aehlig , Tobias Nipkow date = 2008-02-18 topic = Computer Science/Programming Languages/Compiling abstract = This article formalizes normalization by evaluation as implemented in Isabelle. Lambda calculus plus term rewriting is compiled into a functional program with pattern matching. It is proved that the result of a successful evaluation is a) correct, i.e. equivalent to the input, and b) in normal form. notify = nipkow@in.tum.de [Program-Conflict-Analysis] title = Formalization of Conflict Analysis of Programs with Procedures, Thread Creation, and Monitors topic = Computer Science/Programming Languages/Static Analysis author = Peter Lammich , Markus Müller-Olm date = 2007-12-14 abstract = In this work we formally verify the soundness and precision of a static program analysis that detects conflicts (e. g. data races) in programs with procedures, thread creation and monitors with the Isabelle theorem prover. As common in static program analysis, our program model abstracts guarded branching by nondeterministic branching, but completely interprets the call-/return behavior of procedures, synchronization by monitors, and thread creation. The analysis is based on the observation that all conflicts already occur in a class of particularly restricted schedules. These restricted schedules are suited to constraint-system-based program analysis. The formalization is based upon a flowgraph-based program model with an operational semantics as reference point. notify = peter.lammich@uni-muenster.de [Shivers-CFA] title = Shivers' Control Flow Analysis topic = Computer Science/Programming Languages/Static Analysis author = Joachim Breitner date = 2010-11-16 abstract = In his dissertation, Olin Shivers introduces a concept of control flow graphs for functional languages, provides an algorithm to statically derive a safe approximation of the control flow graph and proves this algorithm correct. In this research project, Shivers' algorithms and proofs are formalized in the HOLCF extension of HOL. notify = mail@joachim-breitner.de, nipkow@in.tum.de [Slicing] title = Towards Certified Slicing author = Daniel Wasserrab date = 2008-09-16 topic = Computer Science/Programming Languages/Static Analysis abstract = Slicing is a widely-used technique with applications in e.g. compiler technology and software security. Thus verification of algorithms in these areas is often based on the correctness of slicing, which should ideally be proven independent of concrete programming languages and with the help of well-known verifying techniques such as proof assistants. As a first step in this direction, this contribution presents a framework for dynamic and static intraprocedural slicing based on control flow and program dependence graphs. Abstracting from concrete syntax we base the framework on a graph representation of the program fulfilling certain structural and well-formedness properties.

The formalization consists of the basic framework (in subdirectory Basic/), the correctness proof for dynamic slicing (in subdirectory Dynamic/), the correctness proof for static intraprocedural slicing (in subdirectory StaticIntra/) and instantiations of the framework with a simple While language (in subdirectory While/) and the sophisticated object-oriented bytecode language of Jinja (in subdirectory JinjaVM/). For more information on the framework, see the TPHOLS 2008 paper by Wasserrab and Lochbihler and the PLAS 2009 paper by Wasserrab et al. notify = [HRB-Slicing] title = Backing up Slicing: Verifying the Interprocedural Two-Phase Horwitz-Reps-Binkley Slicer author = Daniel Wasserrab date = 2009-11-13 topic = Computer Science/Programming Languages/Static Analysis abstract = After verifying dynamic and static interprocedural slicing, we present a modular framework for static interprocedural slicing. To this end, we formalized the standard two-phase slicer from Horwitz, Reps and Binkley (see their TOPLAS 12(1) 1990 paper) together with summary edges as presented by Reps et al. (see FSE 1994). The framework is again modular in the programming language by using an abstract CFG, defined via structural and well-formedness properties. Using a weak simulation between the original and sliced graph, we were able to prove the correctness of static interprocedural slicing. We also instantiate our framework with a simple While language with procedures. This shows that the chosen abstractions are indeed valid. notify = nipkow@in.tum.de [WorkerWrapper] title = The Worker/Wrapper Transformation author = Peter Gammie date = 2009-10-30 topic = Computer Science/Programming Languages/Transformations abstract = Gill and Hutton formalise the worker/wrapper transformation, building on the work of Launchbury and Peyton-Jones who developed it as a way of changing the type at which a recursive function operates. This development establishes the soundness of the technique and several examples of its use. notify = peteg42@gmail.com, nipkow@in.tum.de [JiveDataStoreModel] title = Jive Data and Store Model author = Nicole Rauch , Norbert Schirmer <> date = 2005-06-20 license = LGPL topic = Computer Science/Programming Languages/Misc abstract = This document presents the formalization of an object-oriented data and store model in Isabelle/HOL. This model is being used in the Java Interactive Verification Environment, Jive. notify = kleing@cse.unsw.edu.au, schirmer@in.tum.de [HotelKeyCards] title = Hotel Key Card System author = Tobias Nipkow date = 2006-09-09 topic = Computer Science/Security abstract = Two models of an electronic hotel key card system are contrasted: a state based and a trace based one. Both are defined, verified, and proved equivalent in the theorem prover Isabelle/HOL. It is shown that if a guest follows a certain safety policy regarding her key cards, she can be sure that nobody but her can enter her room. notify = nipkow@in.tum.de [RSAPSS] title = SHA1, RSA, PSS and more author = Christina Lindenberg <>, Kai Wirt <> date = 2005-05-02 topic = Computer Science/Security/Cryptography abstract = Formal verification is getting more and more important in computer science. However the state of the art formal verification methods in cryptography are very rudimentary. These theories are one step to provide a tool box allowing the use of formal methods in every aspect of cryptography. Moreover we present a proof of concept for the feasibility of verification techniques to a standard signature algorithm. notify = nipkow@in.tum.de [InformationFlowSlicing] title = Information Flow Noninterference via Slicing author = Daniel Wasserrab date = 2010-03-23 topic = Computer Science/Security abstract =

In this contribution, we show how correctness proofs for intra- and interprocedural slicing can be used to prove that slicing is able to guarantee information flow noninterference. Moreover, we also illustrate how to lift the control flow graphs of the respective frameworks such that they fulfil the additional assumptions needed in the noninterference proofs. A detailed description of the intraprocedural proof and its interplay with the slicing framework can be found in the PLAS'09 paper by Wasserrab et al.

This entry contains the part for intra-procedural slicing. See entry InformationFlowSlicing_Inter for the inter-procedural part.

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

In this contribution, we show how correctness proofs for intra- and interprocedural slicing can be used to prove that slicing is able to guarantee information flow noninterference. Moreover, we also illustrate how to lift the control flow graphs of the respective frameworks such that they fulfil the additional assumptions needed in the noninterference proofs. A detailed description of the intraprocedural proof and its interplay with the slicing framework can be found in the PLAS'09 paper by Wasserrab et al.

This entry contains the part for inter-procedural slicing. See entry InformationFlowSlicing for the intra-procedural part.

extra-history = Change history: [2016-06-10]: The original entry InformationFlowSlicing contained both the inter- and intra-procedural case was split into two for easier maintenance. notify = [ComponentDependencies] title = Formalisation and Analysis of Component Dependencies author = Maria Spichkova date = 2014-04-28 topic = Computer Science/System Description Languages abstract = This set of theories presents a formalisation in Isabelle/HOL of data dependencies between components. The approach allows to analyse system structure oriented towards efficient checking of system: it aims at elaborating for a concrete system, which parts of the system are necessary to check a given property. notify = maria.spichkova@rmit.edu.au [Verified-Prover] title = A Mechanically Verified, Efficient, Sound and Complete Theorem Prover For First Order Logic author = Tom Ridge <> date = 2004-09-28 topic = Logic 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 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 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 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 = Andreas Halkjær From date = 2007-08-02 topic = 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 = Andreas Halkjær From topic = Logic date = 2018-10-29 notify = s144442@student.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 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 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 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 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 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 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, 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 = rene.neumann@in.tum.de [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 = rene.neumann@in.tum.de, 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@in.tum.de, 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@in.tum.de, 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/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/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/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@in.tum.de [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@in.tum.de [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@in.tum.de [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 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 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/Philosophy 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/Philosophy 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/Philosophy 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/Philosophy 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/Philosophy 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 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 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 and, based on that, the Riemann ζ function. This is done by first defining them for ℜ(z) > 1 and then successively extending the domain to the left using the Euler–MacLaurin formula.

Some basic results about these functions are also shown, such as their analyticity on ℂ∖{1}, that they have a simple pole with residue 1 at 1, their relation to the Γ function, and the special values at negative integers and positive even integers – including the famous ζ(-1) = -1/12 and ζ(2) = π²/6.

Lastly, 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.

[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@in.tum.de [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 = Computer Science/Games abstract = We present a formalization of parity games (a two-player game on directed graphs) and a proof of their positional determinacy in Isabelle/HOL. This proof works for both finite and infinite games. notify = [Ergodic_Theory] title = Ergodic Theory author = Sebastien Gouezel date = 2015-12-01 topic = Mathematics/Probability Theory abstract = Ergodic theory is the branch of mathematics that studies the behaviour of measure preserving transformations, in finite or infinite measure. It interacts both with probability theory (mainly through measure theory) and with geometry as a lot of interesting examples are from geometric origin. We implement the first definitions and theorems of ergodic theory, including notably Poicaré recurrence theorem for finite measure preserving systems (together with the notion of conservativity in general), induced maps, Kac's theorem, Birkhoff theorem (arguably the most important theorem in ergodic theory), and variations around it such as conservativity of the corresponding skew product, or Atkinson lemma. notify = sebastien.gouezel@univ-rennes1.fr, hoelzl@in.tum.de [Latin_Square] title = Latin Square author = Alexander Bentkamp date = 2015-12-02 topic = Mathematics/Combinatorics abstract = A Latin Square is a n x n table filled with integers from 1 to n where each number appears exactly once in each row and each column. A Latin Rectangle is a partially filled n x n table with r filled rows and n-r empty rows, such that each number appears at most once in each row and each column. The main result of this theory is that any Latin Rectangle can be completed to a Latin Square. notify = bentkamp@gmail.com [Deep_Learning] title = Expressiveness of Deep Learning author = Alexander Bentkamp date = 2016-11-10 topic = Computer Science/Algorithms 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 [Applicative_Lifting] title = Applicative Lifting author = Andreas Lochbihler , Joshua Schneider <> date = 2015-12-22 topic = Computer Science/Functional Programming abstract = Applicative functors augment computations with effects by lifting function application to types which model the effects. As the structure of the computation cannot depend on the effects, applicative expressions can be analysed statically. This allows us to lift universally quantified equations to the effectful types, as observed by Hinze. Thus, equational reasoning over effectful computations can be reduced to pure types.

This entry provides a package for registering applicative functors and two proof methods for lifting of equations over applicative functors. The first method normalises applicative expressions according to the laws of applicative functors. This way, equations whose two sides contain the same list of variables can be lifted to every applicative functor.

To lift larger classes of equations, the second method exploits a number of additional properties (e.g., commutativity of effects) provided the properties have been declared for the concrete applicative functor at hand upon registration.

We declare several types from the Isabelle library as applicative functors and illustrate the use of the methods with two examples: the lifting of the arithmetic type class hierarchy to streams and the verification of a relabelling function on binary trees. We also formalise and verify the normalisation algorithm used by the first proof method.

extra-history = Change history: [2016-03-03]: added formalisation of lifting with combinators
[2016-06-10]: implemented automatic derivation of lifted combinator reductions; support arbitrary lifted relations using relators; improved compatibility with locale interpretation (revision ec336f354f37)
notify = mail@andreas-lochbihler.de [Stern_Brocot] title = The Stern-Brocot Tree author = Peter Gammie , Andreas Lochbihler date = 2015-12-22 topic = Mathematics/Number Theory abstract = The Stern-Brocot tree contains all rational numbers exactly once and in their lowest terms. We formalise the Stern-Brocot tree as a coinductive tree using recursive and iterative specifications, which we have proven equivalent, and show that it indeed contains all the numbers as stated. Following Hinze, we prove that the Stern-Brocot tree can be linearised looplessly into Stern's diatonic sequence (also known as Dijkstra's fusc function) and that it is a permutation of the Bird tree.

The reasoning stays at an abstract level by appealing to the uniqueness of solutions of guarded recursive equations and lifting algebraic laws point-wise to trees and streams using applicative functors.

notify = mail@andreas-lochbihler.de [Algebraic_Numbers] title = Algebraic Numbers in Isabelle/HOL topic = Mathematics/Algebra author = René Thiemann , Akihisa Yamada , Sebastiaan Joosten date = 2015-12-22 abstract = Based on existing libraries for matrices, factorization of rational polynomials, and Sturm's theorem, we formalized algebraic numbers in Isabelle/HOL. Our development serves as an implementation for real and complex numbers, and it admits to compute roots and completely factorize real and complex polynomials, provided that all coefficients are rational numbers. Moreover, we provide two implementations to display algebraic numbers, an injective and expensive one, or a faster but approximative version.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

[PropResPI] title = Propositional Resolution and Prime Implicates Generation author = Nicolas Peltier notify = Nicolas.Peltier@imag.fr date = 2016-03-11 topic = Logic 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 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/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/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/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 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 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 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! ∼ √2πn (n/e)n on natural numbers and the real Gamma function Γ(x) ∼ √2π/x (x/e)x. The proof is based on work by Graham Jameson. [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, 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/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 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 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 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 Andreas 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 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, Computer Science/Programming Languages/Logics date = 2017-02-13 notify = bbohrer@cs.cmu.edu abstract = We formalize differential dynamic logic, a logic for proving properties of hybrid systems. The proof calculus in this formalization is based on the uniform substitution principle. We show it is sound with respect to our denotational semantics, which provides increased confidence in the correctness of the KeYmaera X theorem prover based on this calculus. As an application, we include a proof term checker embedded in Isabelle/HOL with several example proofs. Published in: Brandon Bohrer, Vincent Rahli, Ivana Vukotic, Marcus Völp, André Platzer: Formally verified differential dynamic logic. CPP 2017. [Elliptic_Curves_Group_Law] title = The Group Law for Elliptic Curves author = Stefan Berghofer topic = Computer Science/Security/Cryptography date = 2017-02-28 notify = berghofe@in.tum.de abstract = We prove the group law for elliptic curves in Weierstrass form over fields of characteristic greater than 2. In addition to affine coordinates, we also formalize projective coordinates, which allow for more efficient computations. By specializing the abstract formalization to prime fields, we can apply the curve operations to parameters used in standard security protocols. [Example-Submission] title = Example Submission author = Gerwin Klein topic = Mathematics/Analysis, Mathematics/Number Theory date = 2004-02-25 notify = kleing@cse.unsw.edu.au abstract = This is an example submission to the Archive of Formal Proofs. It shows submission requirements and explains the structure of a simple typical submission. 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 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/Philosophy 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. [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. [Approximation_Algorithms] title = Verified Approximation Algorithms author = Robin Eßmann , Tobias Nipkow , Simon Robillard topic = Computer Science/Algorithms/Approximation date = 2020-01-16 notify = nipkow@in.tum.de abstract = We present the first formal verification of approximation algorithms for NP-complete optimization problems: vertex cover, independent set, load balancing, and bin packing. The proofs correct incompletenesses in existing proofs and improve the approximation ratio in one case. [Diophantine_Eqns_Lin_Hom] title = Homogeneous Linear Diophantine Equations author = Florian Messner , Julian Parsert , Jonas Schöpf , Christian Sternagel topic = Computer Science/Algorithms/Mathematical, Mathematics/Number Theory, Tools license = LGPL date = 2017-10-14 notify = c.sternagel@gmail.com, julian.parsert@gmail.com abstract = We formalize the theory of homogeneous linear diophantine equations, focusing on two main results: (1) an abstract characterization of minimal complete sets of solutions, and (2) an algorithm computing them. Both, the characterization and the algorithm are based on previous work by Huet. Our starting point is a simple but inefficient variant of Huet's lexicographic algorithm incorporating improved bounds due to Clausen and Fortenbacher. We proceed by proving its soundness and completeness. Finally, we employ code equations to obtain a reasonably efficient implementation. Thus, we provide a formally verified solver for homogeneous linear diophantine equations. [Winding_Number_Eval] title = Evaluate Winding Numbers through Cauchy Indices author = Wenda Li topic = Mathematics/Analysis date = 2017-10-17 notify = wl302@cam.ac.uk, liwenda1990@hotmail.com abstract = In complex analysis, the winding number measures the number of times a path (counterclockwise) winds around a point, while the Cauchy index can approximate how the path winds. This entry provides a formalisation of the Cauchy index, which is then shown to be related to the winding number. In addition, this entry also offers a tactic that enables users to evaluate the winding number by calculating Cauchy indices. [Count_Complex_Roots] title = Count the Number of Complex Roots author = Wenda Li topic = Mathematics/Analysis date = 2017-10-17 notify = wl302@cam.ac.uk, liwenda1990@hotmail.com abstract = Based on evaluating Cauchy indices through remainder sequences, this entry provides an effective procedure to count the number of complex roots (with multiplicity) of a polynomial within a rectangle box or a half-plane. Potential applications of this entry include certified complex root isolation (of a polynomial) and testing the Routh-Hurwitz stability criterion (i.e., to check whether all the roots of some characteristic polynomial have negative real parts). [Buchi_Complementation] title = Büchi Complementation author = Julian Brunner topic = Computer Science/Automata and Formal Languages date = 2017-10-19 notify = brunnerj@in.tum.de abstract = This entry provides a verified implementation of rank-based Büchi Complementation. The verification is done in three steps:
  1. Definition of odd rankings and proof that an automaton rejects a word iff there exists an odd ranking for it.
  2. Definition of the complement automaton and proof that it accepts exactly those words for which there is an odd ranking.
  3. Verified implementation of the complement automaton using the Isabelle Collections Framework.
[Transition_Systems_and_Automata] title = Transition Systems and Automata author = Julian Brunner topic = Computer Science/Automata and Formal Languages date = 2017-10-19 notify = brunnerj@in.tum.de abstract = This entry provides a very abstract theory of transition systems that can be instantiated to express various types of automata. A transition system is typically instantiated by providing a set of initial states, a predicate for enabled transitions, and a transition execution function. From this, it defines the concepts of finite and infinite paths as well as the set of reachable states, among other things. Many useful theorems, from basic path manipulation rules to coinduction and run construction rules, are proven in this abstract transition system context. The library comes with instantiations for DFAs, NFAs, and Büchi automata. [Kuratowski_Closure_Complement] title = The Kuratowski Closure-Complement Theorem author = Peter Gammie , Gianpaolo Gioiosa<> topic = Mathematics/Topology date = 2017-10-26 notify = peteg42@gmail.com abstract = We discuss a topological curiosity discovered by Kuratowski (1922): the fact that the number of distinct operators on a topological space generated by compositions of closure and complement never exceeds 14, and is exactly 14 in the case of R. In addition, we prove a theorem due to Chagrov (1982) that classifies topological spaces according to the number of such operators they support. [Hybrid_Multi_Lane_Spatial_Logic] title = Hybrid Multi-Lane Spatial Logic author = Sven Linker topic = Logic date = 2017-11-06 notify = s.linker@liverpool.ac.uk abstract = We present a semantic embedding of a spatio-temporal multi-modal logic, specifically defined to reason about motorway traffic, into Isabelle/HOL. The semantic model is an abstraction of a motorway, emphasising local spatial properties, and parameterised by the types of sensors deployed in the vehicles. We use the logic to define controller constraints to ensure safety, i.e., the absence of collisions on the motorway. After proving safety with a restrictive definition of sensors, we relax these assumptions and show how to amend the controller constraints to still guarantee safety. [Dirichlet_L] title = Dirichlet L-Functions and Dirichlet's Theorem author = Manuel Eberl topic = Mathematics/Number Theory, Mathematics/Algebra date = 2017-12-21 notify = eberlm@in.tum.de abstract =

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

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

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

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

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

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

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

[Taylor_Models] title = Taylor Models author = Christoph Traut<>, Fabian Immler topic = Computer Science/Algorithms/Mathematical, Computer Science/Data Structures, Mathematics/Analysis, Mathematics/Algebra date = 2018-01-08 notify = immler@in.tum.de abstract = We present a formally verified implementation of multivariate Taylor models. Taylor models are a form of rigorous polynomial approximation, consisting of an approximation polynomial based on Taylor expansions, combined with a rigorous bound on the approximation error. Taylor models were introduced as a tool to mitigate the dependency problem of interval arithmetic. Our implementation automatically computes Taylor models for the class of elementary functions, expressed by composition of arithmetic operations and basic functions like exp, sin, or square root. [Green] title = An Isabelle/HOL formalisation of Green's Theorem author = Mohammad Abdulaziz , Lawrence C. Paulson topic = Mathematics/Analysis date = 2018-01-11 notify = mohammad.abdulaziz8@gmail.com, lp15@cam.ac.uk abstract = We formalise a statement of Green’s theorem—the first formalisation to our knowledge—in Isabelle/HOL. The theorem statement that we formalise is enough for most applications, especially in physics and engineering. Our formalisation is made possible by a novel proof that avoids the ubiquitous line integral cancellation argument. This eliminates the need to formalise orientations and region boundaries explicitly with respect to the outwards-pointing normal vector. Instead we appeal to a homological argument about equivalences between paths. [Gromov_Hyperbolicity] title = Gromov Hyperbolicity author = Sebastien Gouezel<> topic = Mathematics/Geometry date = 2018-01-16 notify = sebastien.gouezel@univ-rennes1.fr abstract = A geodesic metric space is Gromov hyperbolic if all its geodesic triangles are thin, i.e., every side is contained in a fixed thickening of the two other sides. While this definition looks innocuous, it has proved extremely important and versatile in modern geometry since its introduction by Gromov. We formalize the basic classical properties of Gromov hyperbolic spaces, notably the Morse lemma asserting that quasigeodesics are close to geodesics, the invariance of hyperbolicity under quasi-isometries, we define and study the Gromov boundary and its associated distance, and prove that a quasi-isometry between Gromov hyperbolic spaces extends to a homeomorphism of the boundaries. We also prove a less classical theorem, by Bonk and Schramm, asserting that a Gromov hyperbolic space embeds isometrically in a geodesic Gromov-hyperbolic space. As the original proof uses a transfinite sequence of Cauchy completions, this is an interesting formalization exercise. Along the way, we introduce basic material on isometries, quasi-isometries, Lipschitz maps, geodesic spaces, the Hausdorff distance, the Cauchy completion of a metric space, and the exponential on extended real numbers. [Ordered_Resolution_Prover] title = Formalization of Bachmair and Ganzinger's Ordered Resolution Prover author = Anders Schlichtkrull , Jasmin Christian Blanchette , Dmitriy Traytel , Uwe Waldmann topic = Logic 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. [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.

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

This article provides a short proof of the Prime Number Theorem in several equivalent forms, most notably π(x) ~ x/ln x where π(x) is the number of primes no larger than x. It also defines other basic number-theoretic functions related to primes like Chebyshev's functions ϑ and ψ and the “n-th prime number” function pn. We also show various bounds and relationship between these functions are shown. Lastly, we derive Mertens' First and Second Theorem, i. e. ∑p≤x ln p/p = ln x + O(1) and ∑p≤x 1/p = ln ln x + M + O(1/ln x). We also give explicit bounds for the remainder terms.

The proof of the Prime Number Theorem builds on a library of Dirichlet series and analytic combinatorics. We essentially follow the presentation by Newman. The core part of the proof is a Tauberian theorem for Dirichlet series, which is proven using complex analysis and then used to strengthen Mertens' First Theorem to ∑p≤x ln p/p = ln x + c + o(1).

A variant of this proof has been formalised before by Harrison in HOL Light, and formalisations of Selberg's elementary proof exist both by Avigad et al. in Isabelle and by Carneiro in Metamath. The advantage of the analytic proof is that, while it requires more powerful mathematical tools, it is considerably shorter and clearer. This article attempts to provide a short and clear formalisation of all components of that proof using the full range of mathematical machinery available in Isabelle, staying as close as possible to Newman's simple paper proof.

[Signature_Groebner] title = Signature-Based Gröbner Basis Algorithms author = Alexander Maletzky topic = Mathematics/Algebra, Computer Science/Algorithms/Mathematical date = 2018-09-20 notify = alexander.maletzky@risc.jku.at abstract =

This article formalizes signature-based algorithms for computing Gröbner bases. Such algorithms are, in general, superior to other algorithms in terms of efficiency, and have not been formalized in any proof assistant so far. The present development is both generic, in the sense that most known variants of signature-based algorithms are covered by it, and effectively executable on concrete input thanks to Isabelle's code generator. Sample computations of benchmark problems show that the verified implementation of signature-based algorithms indeed outperforms the existing implementation of Buchberger's algorithm in Isabelle/HOL.

Besides total correctness of the algorithms, the article also proves that under certain conditions they a-priori detect and avoid all useless zero-reductions, and always return 'minimal' (in some sense) Gröbner bases if an input parameter is chosen in the right way.

The formalization follows the recent survey article by Eder and Faugère.

[Factored_Transition_System_Bounding] title = Upper Bounding Diameters of State Spaces of Factored Transition Systems author = Friedrich Kurz <>, Mohammad Abdulaziz topic = Computer Science/Automata and Formal Languages, Mathematics/Graph Theory date = 2018-10-12 notify = friedrich.kurz@tum.de, mohammad.abdulaziz@in.tum.de abstract = A completeness threshold is required to guarantee the completeness of planning as satisfiability, and bounded model checking of safety properties. One valid completeness threshold is the diameter of the underlying transition system. The diameter is the maximum element in the set of lengths of all shortest paths between pairs of states. The diameter is not calculated exactly in our setting, where the transition system is succinctly described using a (propositionally) factored representation. Rather, an upper bound on the diameter is calculated compositionally, by bounding the diameters of small abstract subsystems, and then composing those. We port a HOL4 formalisation of a compositional algorithm for computing a relatively tight upper bound on the system diameter. This compositional algorithm exploits acyclicity in the state space to achieve compositionality, and it was introduced by Abdulaziz et. al. The formalisation that we port is described as a part of another paper by Abdulaziz et. al. As a part of this porting we developed a libray about transition systems, which shall be of use in future related mechanisation efforts. [Smooth_Manifolds] title = Smooth Manifolds author = Fabian Immler , Bohua Zhan topic = Mathematics/Analysis, Mathematics/Topology date = 2018-10-22 notify = immler@in.tum.de, bzhan@ios.ac.cn abstract = We formalize the definition and basic properties of smooth manifolds in Isabelle/HOL. Concepts covered include partition of unity, tangent and cotangent spaces, and the fundamental theorem of path integrals. We also examine some concrete manifolds such as spheres and projective spaces. The formalization makes extensive use of the analysis and linear algebra libraries in Isabelle/HOL, in particular its “types-to-sets” mechanism. [Matroids] title = Matroids author = Jonas Keinholz<> topic = Mathematics/Combinatorics date = 2018-11-16 notify = eberlm@in.tum.de abstract =

This article defines the combinatorial structures known as Independence Systems and Matroids and provides basic concepts and theorems related to them. These structures play an important role in combinatorial optimisation, e. g. greedy algorithms such as Kruskal's algorithm. The development is based on Oxley's `What is a Matroid?'.

[Graph_Saturation] title = Graph Saturation author = Sebastiaan J. C. Joosten<> topic = Logic/Rewriting, Mathematics/Graph Theory date = 2018-11-23 notify = sjcjoosten@gmail.com abstract = This is an Isabelle/HOL formalisation of graph saturation, closely following a paper by the author on graph saturation. Nine out of ten lemmas of the original paper are proven in this formalisation. The formalisation additionally includes two theorems that show the main premise of the paper: that consistency and entailment are decided through graph saturation. This formalisation does not give executable code, and it did not implement any of the optimisations suggested in the paper. [Functional_Ordered_Resolution_Prover] title = A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover author = Anders Schlichtkrull , Jasmin Christian Blanchette , Dmitriy Traytel topic = Logic date = 2018-11-23 notify = andschl@dtu.dk,j.c.blanchette@vu.nl,traytel@inf.ethz.ch abstract = This Isabelle/HOL formalization refines the abstract ordered resolution prover presented in Section 4.3 of Bachmair and Ganzinger's "Resolution Theorem Proving" chapter in the Handbook of Automated Reasoning. The result is a functional implementation of a first-order prover. [Auto2_HOL] title = Auto2 Prover author = Bohua Zhan topic = Tools date = 2018-11-20 notify = bzhan@ios.ac.cn abstract = Auto2 is a saturation-based heuristic prover for higher-order logic, implemented as a tactic in Isabelle. This entry contains the instantiation of auto2 for Isabelle/HOL, along with two basic examples: solutions to some of the Pelletier’s problems, and elementary number theory of primes. [Order_Lattice_Props] title = Properties of Orderings and Lattices author = Georg Struth topic = Mathematics/Order date = 2018-12-11 notify = g.struth@sheffield.ac.uk abstract = These components add further fundamental order and lattice-theoretic concepts and properties to Isabelle's libraries. They follow by and large the introductory sections of the Compendium of Continuous Lattices, covering directed and filtered sets, down-closed and up-closed sets, ideals and filters, Galois connections, closure and co-closure operators. Some emphasis is on duality and morphisms between structures, as in the Compendium. To this end, three ad-hoc approaches to duality are compared. [Quantales] title = Quantales author = Georg Struth topic = Mathematics/Algebra date = 2018-12-11 notify = g.struth@sheffield.ac.uk abstract = These mathematical components formalise basic properties of quantales, together with some important models, constructions, and concepts, including quantic nuclei and conuclei. [Transformer_Semantics] title = Transformer Semantics author = Georg Struth topic = Mathematics/Algebra, Computer Science/Semantics date = 2018-12-11 notify = g.struth@sheffield.ac.uk abstract = These mathematical components formalise predicate transformer semantics for programs, yet currently only for partial correctness and in the absence of faults. A first part for isotone (or monotone), Sup-preserving and Inf-preserving transformers follows Back and von Wright's approach, with additional emphasis on the quantalic structure of algebras of transformers. The second part develops Sup-preserving and Inf-preserving predicate transformers from the powerset monad, via its Kleisli category and Eilenberg-Moore algebras, with emphasis on adjunctions and dualities, as well as isomorphisms between relations, state transformers and predicate transformers. [Concurrent_Revisions] title = Formalization of Concurrent Revisions author = Roy Overbeek topic = Computer Science/Concurrency date = 2018-12-25 notify = Roy.Overbeek@cwi.nl abstract = Concurrent revisions is a concurrency control model developed by Microsoft Research. It has many interesting properties that distinguish it from other well-known models such as transactional memory. One of these properties is determinacy: programs written within the model always produce the same outcome, independent of scheduling activity. The concurrent revisions model has an operational semantics, with an informal proof of determinacy. This document contains an Isabelle/HOL formalization of this semantics and the proof of determinacy. [Core_DOM] title = A Formal Model of the Document Object Model author = Achim D. Brucker , Michael Herzberg topic = Computer Science/Data Structures date = 2018-12-26 notify = adbrucker@0x5f.org abstract = In this AFP entry, we formalize the core of the Document Object Model (DOM). At its core, the DOM defines a tree-like data structure for representing documents in general and HTML documents in particular. It is the heart of any modern web browser. Formalizing the key concepts of the DOM is a prerequisite for the formal reasoning over client-side JavaScript programs and for the analysis of security concepts in modern web browsers. We present a formalization of the core DOM, with focus on the node-tree and the operations defined on node-trees, in Isabelle/HOL. We use the formalization to verify the functional correctness of the most important functions defined in the DOM standard. Moreover, our formalization is 1) extensible, i.e., can be extended without the need of re-proving already proven properties and 2) executable, i.e., we can generate executable code from our specification. [Store_Buffer_Reduction] title = A Reduction Theorem for Store Buffers author = Ernie Cohen , Norbert Schirmer topic = Computer Science/Concurrency date = 2019-01-07 notify = norbert.schirmer@web.de abstract = When verifying a concurrent program, it is usual to assume that memory is sequentially consistent. However, most modern multiprocessors depend on store buffering for efficiency, and provide native sequential consistency only at a substantial performance penalty. To regain sequential consistency, a programmer has to follow an appropriate programming discipline. However, naïve disciplines, such as protecting all shared accesses with locks, are not flexible enough for building high-performance multiprocessor software. We present a new discipline for concurrent programming under TSO (total store order, with store buffer forwarding). It does not depend on concurrency primitives, such as locks. Instead, threads use ghost operations to acquire and release ownership of memory addresses. A thread can write to an address only if no other thread owns it, and can read from an address only if it owns it or it is shared and the thread has flushed its store buffer since it last wrote to an address it did not own. This discipline covers both coarse-grained concurrency (where data is protected by locks) as well as fine-grained concurrency (where atomic operations race to memory). We formalize this discipline in Isabelle/HOL, and prove that if every execution of a program in a system without store buffers follows the discipline, then every execution of the program with store buffers is sequentially consistent. Thus, we can show sequential consistency under TSO by ordinary assertional reasoning about the program, without having to consider store buffers at all. [IMP2] title = IMP2 – Simple Program Verification in Isabelle/HOL author = Peter Lammich , Simon Wimmer topic = Computer Science/Programming Languages/Logics, Computer Science/Algorithms date = 2019-01-15 notify = lammich@in.tum.de abstract = IMP2 is a simple imperative language together with Isabelle tooling to create a program verification environment in Isabelle/HOL. The tools include a C-like syntax, a verification condition generator, and Isabelle commands for the specification of programs. The framework is modular, i.e., it allows easy reuse of already proved programs within larger programs. This entry comes with a quickstart guide and a large collection of examples, spanning basic algorithms with simple proofs to more advanced algorithms and proof techniques like data refinement. Some highlights from the examples are:
  • Bisection Square Root,
  • Extended Euclid,
  • Exponentiation by Squaring,
  • Binary Search,
  • Insertion Sort,
  • Quicksort,
  • Depth First Search.
The abstract syntax and semantics are very simple and well-documented. They are suitable to be used in a course, as extension to the IMP language which comes with the Isabelle distribution. While this entry is limited to a simple imperative language, the ideas could be extended to more sophisticated languages. [Farkas] title = Farkas' Lemma and Motzkin's Transposition Theorem author = Ralph Bottesch , Max W. Haslbeck , René Thiemann topic = Mathematics/Algebra date = 2019-01-17 notify = rene.thiemann@uibk.ac.at abstract = We formalize a proof of Motzkin's transposition theorem and Farkas' lemma in Isabelle/HOL. Our proof is based on the formalization of the simplex algorithm which, given a set of linear constraints, either returns a satisfying assignment to the problem or detects unsatisfiability. By reusing facts about the simplex algorithm we show that a set of linear constraints is unsatisfiable if and only if there is a linear combination of the constraints which evaluates to a trivially unsatisfiable inequality. [Auto2_Imperative_HOL] title = Verifying Imperative Programs using Auto2 author = Bohua Zhan topic = Computer Science/Algorithms, Computer Science/Data Structures date = 2018-12-21 notify = bzhan@ios.ac.cn abstract = This entry contains the application of auto2 to verifying functional and imperative programs. Algorithms and data structures that are verified include linked lists, binary search trees, red-black trees, interval trees, priority queue, quicksort, union-find, Dijkstra's algorithm, and a sweep-line algorithm for detecting rectangle intersection. The imperative verification is based on Imperative HOL and its separation logic framework. A major goal of this work is to set up automation in order to reduce the length of proof that the user needs to provide, both for verifying functional programs and for working with separation logic. [UTP] title = Isabelle/UTP: Mechanised Theory Engineering for Unifying Theories of Programming author = Simon Foster , Frank Zeyda<>, Yakoub Nemouchi , Pedro Ribeiro<>, Burkhart Wolff topic = Computer Science/Programming Languages/Logics date = 2019-02-01 notify = simon.foster@york.ac.uk abstract = Isabelle/UTP is a mechanised theory engineering toolkit based on Hoare and He’s Unifying Theories of Programming (UTP). UTP enables the creation of denotational, algebraic, and operational semantics for different programming languages using an alphabetised relational calculus. We provide a semantic embedding of the alphabetised relational calculus in Isabelle/HOL, including new type definitions, relational constructors, automated proof tactics, and accompanying algebraic laws. Isabelle/UTP can be used to both capture laws of programming for different languages, and put these fundamental theorems to work in the creation of associated verification tools, using calculi like Hoare logics. This document describes the relational core of the UTP in Isabelle/HOL. [HOL-CSP] title = HOL-CSP Version 2.0 author = Safouan Taha , Lina Ye , Burkhart Wolff topic = Computer Science/Concurrency/Process Calculi, Computer Science/Semantics date = 2019-04-26 notify = wolff@lri.fr abstract = This is a complete formalization of the work of Hoare and Roscoe on the denotational semantics of the Failure/Divergence Model of CSP. It follows essentially the presentation of CSP in Roscoe’s Book ”Theory and Practice of Concurrency” [8] and the semantic details in a joint Paper of Roscoe and Brooks ”An improved failures model for communicating processes". The present work is based on a prior formalization attempt, called HOL-CSP 1.0, done in 1997 by H. Tej and B. Wolff with the Isabelle proof technology available at that time. This work revealed minor, but omnipresent foundational errors in key concepts like the process invariant. The present version HOL-CSP profits from substantially improved libraries (notably HOLCF), improved automated proof techniques, and structured proof techniques in Isar and is substantially shorter but more complete. [Probabilistic_Prime_Tests] title = Probabilistic Primality Testing author = Daniel Stüwe<>, Manuel Eberl topic = Mathematics/Number Theory date = 2019-02-11 notify = eberlm@in.tum.de abstract =

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

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

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

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

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

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

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

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

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

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

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

[QHLProver] title = Quantum Hoare Logic author = Junyi Liu<>, Bohua Zhan , Shuling Wang<>, Shenggang Ying<>, Tao Liu<>, Yangjia Li<>, Mingsheng Ying<>, Naijun Zhan<> topic = Computer Science/Programming Languages/Logics, Computer Science/Semantics date = 2019-03-24 notify = bzhan@ios.ac.cn abstract = We formalize quantum Hoare logic as given in [1]. In particular, we specify the syntax and denotational semantics of a simple model of quantum programs. Then, we write down the rules of quantum Hoare logic for partial correctness, and show the soundness and completeness of the resulting proof system. As an application, we verify the correctness of Grover’s algorithm. [Transcendence_Series_Hancl_Rucki] title = The Transcendence of Certain Infinite Series author = Angeliki Koutsoukou-Argyraki , Wenda Li topic = Mathematics/Analysis, Mathematics/Number Theory date = 2019-03-27 notify = wl302@cam.ac.uk, ak2110@cam.ac.uk abstract = We formalize the proofs of two transcendence criteria by J. Hančl and P. Rucki that assert the transcendence of the sums of certain infinite series built up by sequences that fulfil certain properties. Both proofs make use of Roth's celebrated theorem on diophantine approximations to algebraic numbers from 1955 which we implement as an assumption without having formalised its proof. [Binding_Syntax_Theory] title = A General Theory of Syntax with Bindings author = Lorenzo Gheri , Andrei Popescu topic = Computer Science/Programming Languages/Lambda Calculi, Computer Science/Functional Programming, Logic 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, 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 forthcoming 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. [FOL_Seq_Calc1] title = A Sequent Calculus for First-Order Logic author = Andreas Halkjær From contributors = Alexander Birch Jensen , Anders Schlichtkrull , Jørgen Villadsen topic = Logic date = 2019-07-18 notify = s144442@student.dtu.dk abstract = This work formalizes soundness and completeness of a one-sided sequent calculus for first-order logic. The completeness is shown via a translation from a complete semantic tableau calculus, the proof of which is based on the First-Order Logic According to Fitting theory. The calculi and proof techniques are taken from Ben-Ari's Mathematical Logic for Computer Science. [Szpilrajn] title = Szpilrajn Extension Theorem author = Peter Zeller topic = Mathematics/Order date = 2019-07-27 notify = p_zeller@cs.uni-kl.de abstract = We formalize the Szpilrajn extension theorem, also known as order-extension principal: Every strict partial order can be extended to a strict linear order. [TESL_Language] title = A Formal Development of a Polychronous Polytimed Coordination Language author = Hai Nguyen Van , Frédéric Boulanger , Burkhart Wolff topic = Computer Science/System Description Languages, Computer Science/Semantics, Computer Science/Concurrency date = 2019-07-30 notify = frederic.boulanger@centralesupelec.fr, burkhart.wolff@lri.fr abstract = The design of complex systems involves different formalisms for modeling their different parts or aspects. The global model of a system may therefore consist of a coordination of concurrent sub-models that use different paradigms. We develop here a theory for a language used to specify the timed coordination of such heterogeneous subsystems by addressing the following issues:

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

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

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

[Adaptive_State_Counting] title = Formalisation of an Adaptive State Counting Algorithm author = Robert Sachtleben topic = Computer Science/Automata and Formal Languages, Computer Science/Algorithms date = 2019-08-16 notify = rob_sac@uni-bremen.de abstract = This entry provides a formalisation of a refinement of an adaptive state counting algorithm, used to test for reduction between finite state machines. The algorithm has been originally presented by Hierons in the paper Testing from a Non-Deterministic Finite State Machine Using Adaptive State Counting. Definitions for finite state machines and adaptive test cases are given and many useful theorems are derived from these. The algorithm is formalised using mutually recursive functions, for which it is proven that the generated test suite is sufficient to test for reduction against finite state machines of a certain fault domain. Additionally, the algorithm is specified in a simple WHILE-language and its correctness is shown using Hoare-logic. [Jacobson_Basic_Algebra] title = A Case Study in Basic Algebra author = Clemens Ballarin topic = Mathematics/Algebra date = 2019-08-30 notify = ballarin@in.tum.de abstract = The focus of this case study is re-use in abstract algebra. It contains locale-based formalisations of selected parts of set, group and ring theory from Jacobson's Basic Algebra leading to the respective fundamental homomorphism theorems. The study is not intended as a library base for abstract algebra. It rather explores an approach towards abstract algebra in Isabelle. [Hybrid_Systems_VCs] title = Verification Components for Hybrid Systems author = Jonathan Julian Huerta y Munive <> topic = Mathematics/Algebra, Mathematics/Analysis date = 2019-09-10 notify = jjhuertaymunive1@sheffield.ac.uk, jonjulian23@gmail.com abstract = These components formalise a semantic framework for the deductive verification of hybrid systems. They support reasoning about continuous evolutions of hybrid programs in the style of differential dynamics logic. Vector fields or flows model these evolutions, and their verification is done with invariants for the former or orbits for the latter. Laws of modal Kleene algebra or categorical predicate transformers implement the verification condition generation. Examples show the approach at work. [Generic_Join] title = Formalization of Multiway-Join Algorithms author = Thibault Dardinier<> topic = Computer Science/Algorithms date = 2019-09-16 notify = tdardini@student.ethz.ch, traytel@inf.ethz.ch abstract = Worst-case optimal multiway-join algorithms are recent seminal achievement of the database community. These algorithms compute the natural join of multiple relational databases and improve in the worst case over traditional query plan optimizations of nested binary joins. In 2014, Ngo, Ré, and Rudra gave a unified presentation of different multi-way join algorithms. We formalized and proved correct their "Generic Join" algorithm and extended it to support negative joins. [Aristotles_Assertoric_Syllogistic] title = Aristotle's Assertoric Syllogistic author = Angeliki Koutsoukou-Argyraki topic = Logic/Philosophy 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 = Mathematics/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.

[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 date = 2019-12-20 notify = andro.from@gmail.com 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 the cited 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 derivable 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 derivable. Similarly, I start from simpler versions of the @-rules and derive the general ones. These restrictions are imposed to rule out some means of nontermination. [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. diff --git a/thys/Complex_Geometry/Angles.thy b/thys/Complex_Geometry/Angles.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Angles.thy @@ -0,0 +1,510 @@ +(* ---------------------------------------------------------------------------- *) +subsection \Angle between two vectors\ +(* ---------------------------------------------------------------------------- *) + +text \In this section we introduce different measures of angle between two vectors (represented by complex numbers).\ + +theory Angles +imports More_Transcendental Canonical_Angle More_Complex +begin + +(* ---------------------------------------------------------------------------- *) +subsubsection \Oriented angle\ +(* ---------------------------------------------------------------------------- *) + +text \Oriented angle between two vectors (it is always in the interval $(-\pi, \pi]$).\ +definition ang_vec ("\") where + [simp]: "\ z1 z2 \ \arg z2 - arg z1\" + +lemma ang_vec_bounded: + shows "-pi < \ z1 z2 \ \ z1 z2 \ pi" + by (simp add: canon_ang(1) canon_ang(2)) + +lemma ang_vec_sym: + assumes "\ z1 z2 \ pi" + shows "\ z1 z2 = - \ z2 z1" + using assms + unfolding ang_vec_def + using canon_ang_uminus[of "arg z2 - arg z1"] + by simp + +lemma ang_vec_sym_pi: + assumes "\ z1 z2 = pi" + shows "\ z1 z2 = \ z2 z1" + using assms + unfolding ang_vec_def + using canon_ang_uminus_pi[of "arg z2 - arg z1"] + by simp + +lemma ang_vec_plus_pi1: + assumes "\ z1 z2 > 0" + shows "\\ z1 z2 + pi\ = \ z1 z2 - pi" +proof (rule canon_ang_eqI) + show "\ x::int. \ z1 z2 - pi - (\ z1 z2 + pi) = 2 * real_of_int x * pi" + by (rule_tac x="-1" in exI) auto +next + show "- pi < \ z1 z2 - pi \ \ z1 z2 - pi \ pi" + using assms + unfolding ang_vec_def + using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"] + by auto +qed + +lemma ang_vec_plus_pi2: + assumes "\ z1 z2 \ 0" + shows "\\ z1 z2 + pi\ = \ z1 z2 + pi" +proof (rule canon_ang_id) + show "- pi < \ z1 z2 + pi \ \ z1 z2 + pi \ pi" + using assms + unfolding ang_vec_def + using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"] + by auto +qed + +lemma ang_vec_opposite1: + assumes "z1 \ 0" + shows "\ (-z1) z2 = \\ z1 z2 - pi\" +proof- + have "\ (-z1) z2 = \arg z2 - (arg z1 + pi)\" + unfolding ang_vec_def + using arg_uminus[OF assms] + using canon_ang_arg[of z2, symmetric] + using canon_ang_diff[of "arg z2" "arg z1 + pi", symmetric] + by simp + moreover + have "\\ z1 z2 - pi\ = \arg z2 - arg z1 - pi\" + using canon_ang_id[of pi, symmetric] + using canon_ang_diff[of "arg z2 - arg z1" "pi", symmetric] + by simp_all + ultimately + show ?thesis + by (simp add: field_simps) +qed + +lemma ang_vec_opposite2: + assumes "z2 \ 0" + shows "\ z1 (-z2) = \\ z1 z2 + pi\" + unfolding ang_vec_def + using arg_mult[of "-1" "z2"] assms + using arg_complex_of_real_negative[of "-1"] + using canon_ang_diff[of "arg (-1) + arg z2" "arg z1", symmetric] + using canon_ang_sum[of "arg z2 - arg z1" "pi", symmetric] + using canon_ang_id[of pi] canon_ang_arg[of z1] + by (auto simp: algebra_simps) + + +lemma ang_vec_opposite_opposite: + assumes "z1 \ 0" and "z2 \ 0" + shows "\ (-z1) (-z2) = \ z1 z2" +proof- + have "\ (-z1) (-z2) = \\\ z1 z2 + pi\ - \pi\\" + using ang_vec_opposite1[OF assms(1)] + using ang_vec_opposite2[OF assms(2)] + using canon_ang_id[of pi, symmetric] + by simp_all + also have "... = \\ z1 z2\" + by (subst canon_ang_diff[symmetric], simp) + finally + show ?thesis + by (metis ang_vec_def canon_ang(1) canon_ang(2) canon_ang_id) +qed + +lemma ang_vec_opposite_opposite': + assumes "z1 \ z" and "z2 \ z" + shows "\ (z - z1) (z - z2) = \ (z1 - z) (z2 - z)" +using ang_vec_opposite_opposite[of "z - z1" "z - z2"] assms +by (simp add: field_simps del: ang_vec_def) + +text \Cosine, scalar product and the law of cosines\ + +lemma cos_cmod_scalprod: + shows "cmod z1 * cmod z2 * (cos (\ z1 z2)) = Re (scalprod z1 z2)" +proof (cases "z1 = 0 \ z2 = 0") + case True + thus ?thesis + by auto +next + case False + thus ?thesis + by (simp add: cos_diff cos_arg sin_arg field_simps) +qed + +lemma cos0_scalprod0: + assumes "z1 \ 0" and "z2 \ 0" + shows "cos (\ z1 z2) = 0 \ scalprod z1 z2 = 0" + using assms + using cnj_mix_real[of z1 z2] + using cos_cmod_scalprod[of z1 z2] + by (auto simp add: complex_eq_if_Re_eq) + +lemma ortho_scalprod0: + assumes "z1 \ 0" and "z2 \ 0" + shows "\ z1 z2 = pi/2 \ \ z1 z2 = -pi/2 \ scalprod z1 z2 = 0" + using cos0_scalprod0[OF assms] + using ang_vec_bounded[of z1 z2] + using cos_0_iff_canon[of "\ z1 z2"] + by (metis cos_minus cos_pi_half divide_minus_left) + +lemma law_of_cosines: + shows "(cdist B C)\<^sup>2 = (cdist A C)\<^sup>2 + (cdist A B)\<^sup>2 - 2*(cdist A C)*(cdist A B)*(cos (\ (C-A) (B-A)))" +proof- + let ?a = "C-B" and ?b = "C-A" and ?c = "B-A" + have "?a = ?b - ?c" + by simp + hence "(cmod ?a)\<^sup>2 = (cmod (?b - ?c))\<^sup>2" + by metis + also have "... = Re (scalprod (?b-?c) (?b-?c))" + by (simp add: cmod_square) + also have "... = (cmod ?b)\<^sup>2 + (cmod ?c)\<^sup>2 - 2*Re (scalprod ?b ?c)" + by (simp add: cmod_square field_simps) + finally + show ?thesis + using cos_cmod_scalprod[of ?b ?c] + by simp +qed + +(* ---------------------------------------------------------------------------- *) +subsubsection \Unoriented angle\ +(* ---------------------------------------------------------------------------- *) + +text \Convex unoriented angle between two vectors (it is always in the interval $[0, pi]$).\ +definition ang_vec_c ("\c") where + [simp]:"\c z1 z2 \ abs (\ z1 z2)" + +lemma ang_vec_c_sym: + shows "\c z1 z2 = \c z2 z1" + unfolding ang_vec_c_def + using ang_vec_sym_pi[of z1 z2] ang_vec_sym[of z1 z2] + by (cases "\ z1 z2 = pi") auto + +lemma ang_vec_c_bounded: "0 \ \c z1 z2 \ \c z1 z2 \ pi" + using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"] + by auto + +text \Cosine and scalar product\ + +lemma cos_c_: "cos (\c z1 z2) = cos (\ z1 z2)" + unfolding ang_vec_c_def + by (smt cos_minus) + +lemma ortho_c_scalprod0: + assumes "z1 \ 0" and "z2 \ 0" + shows "\c z1 z2 = pi/2 \ scalprod z1 z2 = 0" +proof- + have "\ z1 z2 = pi / 2 \ \ z1 z2 = - pi / 2 \ \c z1 z2 = pi/2" + unfolding ang_vec_c_def + using arctan + by force + thus ?thesis + using ortho_scalprod0[OF assms] + by simp +qed + +(* ---------------------------------------------------------------------------- *) +subsubsection \Acute angle\ +(* ---------------------------------------------------------------------------- *) + +text \Acute or right angle (non-obtuse) between two vectors (it is always in the interval $[0, \frac{\pi}{2}$]). +We will use this to measure angle between two circles, since it can always be acute (or right).\ + +definition acute_ang where + [simp]: "acute_ang \ = (if \ > pi / 2 then pi - \ else \)" + +definition ang_vec_a ("\a") where + [simp]: "\a z1 z2 \ acute_ang (\c z1 z2)" + +lemma ang_vec_a_sym: + "\a z1 z2 = \a z2 z1" + unfolding ang_vec_a_def + using ang_vec_c_sym + by auto + +lemma ang_vec_a_opposite2: + "\a z1 z2 = \a z1 (-z2)" +proof(cases "z2 = 0") + case True + thus ?thesis + by (metis minus_zero) +next + case False + thus ?thesis + proof(cases "\ z1 z2 < -pi / 2") + case True + hence "\ z1 z2 < 0" + using pi_not_less_zero + by linarith + have "\a z1 z2 = pi + \ z1 z2" + using True \\ z1 z2 < 0\ + unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def + by auto + moreover + have "\a z1 (-z2) = pi + \ z1 z2" + unfolding ang_vec_a_def ang_vec_c_def abs_real_def + using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"] + using ang_vec_plus_pi2[of z1 z2] True \\ z1 z2 < 0\ \z2 \ 0\ + using ang_vec_opposite2[of z2 z1] + by auto + ultimately + show ?thesis + by auto + next + case False + show ?thesis + proof (cases "\ z1 z2 \ 0") + case True + have "\a z1 z2 = - \ z1 z2" + using \\ \ z1 z2 < - pi / 2\ True + unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def + by auto + moreover + have "\a z1 (-z2) = - \ z1 z2" + using \\ \ z1 z2 < - pi / 2\ True + unfolding ang_vec_a_def ang_vec_c_def abs_real_def + using ang_vec_plus_pi2[of z1 z2] + using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"] + using \z2 \ 0\ ang_vec_opposite2[of z2 z1] + by auto + ultimately + show ?thesis + by simp + next + case False + show ?thesis + proof (cases "\ z1 z2 < pi / 2") + case True + have "\a z1 z2 = \ z1 z2" + using \\ \ z1 z2 \ 0\ True + unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def + by auto + moreover + have "\a z1 (-z2) = \ z1 z2" + using \\ \ z1 z2 \ 0\ True + unfolding ang_vec_a_def ang_vec_c_def abs_real_def + using ang_vec_plus_pi1[of z1 z2] + using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"] + using \z2 \ 0\ ang_vec_opposite2[of z2 z1] + by auto + ultimately + show ?thesis + by simp + next + case False + have "\ z1 z2 > 0" + using False + by (metis less_linear less_trans pi_half_gt_zero) + have "\a z1 z2 = pi - \ z1 z2" + using False \\ z1 z2 > 0\ + unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def + by auto + moreover + have "\a z1 (-z2) = pi - \ z1 z2" + unfolding ang_vec_a_def ang_vec_c_def abs_real_def + using False \\ z1 z2 > 0\ + using ang_vec_plus_pi1[of z1 z2] + using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"] + using \z2 \ 0\ ang_vec_opposite2[of z2 z1] + by auto + ultimately + show ?thesis + by auto + qed + qed + qed +qed + +lemma ang_vec_a_opposite1: + shows "\a z1 z2 = \a (-z1) z2" + using ang_vec_a_sym[of "-z1" z2] ang_vec_a_opposite2[of z2 z1] ang_vec_a_sym[of z2 z1] + by auto + +lemma ang_vec_a_scale1: + assumes "k \ 0" + shows "\a (cor k * z1) z2 = \a z1 z2" +proof (cases "k > 0") + case True + thus ?thesis + unfolding ang_vec_a_def ang_vec_c_def ang_vec_def + using arg_mult_real_positive[of k z1] + by auto +next + case False + hence "k < 0" + using assms + by auto + thus ?thesis + using arg_mult_real_negative[of k z1] + using ang_vec_a_opposite1[of z1 z2] + unfolding ang_vec_a_def ang_vec_c_def ang_vec_def + by simp +qed + +lemma ang_vec_a_scale2: + assumes "k \ 0" + shows "\a z1 (cor k * z2) = \a z1 z2" + using ang_vec_a_sym[of z1 "complex_of_real k * z2"] + using ang_vec_a_scale1[OF assms, of z2 z1] + using ang_vec_a_sym[of z1 z2] + by auto + +lemma ang_vec_a_scale: + assumes "k1 \ 0" and "k2 \ 0" + shows "\a (cor k1 * z1) (cor k2 * z2) = \a z1 z2" + using ang_vec_a_scale1[OF assms(1)] ang_vec_a_scale2[OF assms(2)] + by auto + +lemma ang_a_cnj_cnj: + shows "\a z1 z2 = \a (cnj z1) (cnj z2)" +unfolding ang_vec_a_def ang_vec_c_def ang_vec_def +proof(cases "arg z1 \ pi \ arg z2 \ pi") + case True + thus "acute_ang \\arg z2 - arg z1\\ = acute_ang \\arg (cnj z2) - arg (cnj z1)\\" + using arg_cnj_not_pi[of z1] arg_cnj_not_pi[of z2] + apply (auto simp del:acute_ang_def) + proof(cases "\arg z2 - arg z1\ = pi") + case True + thus "acute_ang \\arg z2 - arg z1\\ = acute_ang \\arg z1 - arg z2\\" + using canon_ang_uminus_pi[of "arg z2 - arg z1"] + by (auto simp add:field_simps) + next + case False + thus "acute_ang \\arg z2 - arg z1\\ = acute_ang \\arg z1 - arg z2\\" + using canon_ang_uminus[of "arg z2 - arg z1"] + by (auto simp add:field_simps) + qed + next + case False + thus "acute_ang \\arg z2 - arg z1\\ = acute_ang \\arg (cnj z2) - arg (cnj z1)\\" + proof(cases "arg z1 = pi") + case False + hence "arg z2 = pi" + using \ \ (arg z1 \ pi \ arg z2 \ pi)\ + by auto + thus ?thesis + using False + using arg_cnj_not_pi[of z1] arg_cnj_pi[of z2] + apply (auto simp del:acute_ang_def) + proof(cases "arg z1 > 0") + case True + hence "-arg z1 \ 0" + by auto + thus "acute_ang \\pi - arg z1\\ = acute_ang \\pi + arg z1\\" + using True canon_ang_plus_pi1[of "arg z1"] + using arg_bounded[of z1] canon_ang_plus_pi2[of "-arg z1"] + by (auto simp add:field_simps) + next + case False + hence "-arg z1 \ 0" + by simp + thus "acute_ang \\pi - arg z1\\ = acute_ang \\pi + arg z1\\" + proof(cases "arg z1 = 0") + case True + thus ?thesis + by (auto simp del:acute_ang_def) + next + case False + hence "-arg z1 > 0" + using \-arg z1 \ 0\ + by auto + thus ?thesis + using False canon_ang_plus_pi1[of "-arg z1"] + using arg_bounded[of z1] canon_ang_plus_pi2[of "arg z1"] + by (auto simp add:field_simps) + qed + qed + next + case True + thus ?thesis + using arg_cnj_pi[of z1] + apply (auto simp del:acute_ang_def) + proof(cases "arg z2 = pi") + case True + thus "acute_ang \\arg z2 - pi\\ = acute_ang \\arg (cnj z2) - pi\\" + using arg_cnj_pi[of z2] + by auto + next + case False + thus "acute_ang \\arg z2 - pi\\ = acute_ang \\arg (cnj z2) - pi\\" + using arg_cnj_not_pi[of z2] + apply (auto simp del:acute_ang_def) + proof(cases "arg z2 > 0") + case True + hence "-arg z2 \ 0" + by auto + thus "acute_ang \\arg z2 - pi\\ = acute_ang \\- arg z2 - pi\\" + using True canon_ang_minus_pi1[of "arg z2"] + using arg_bounded[of z2] canon_ang_minus_pi2[of "-arg z2"] + by (auto simp add: field_simps) + next + case False + hence "-arg z2 \ 0" + by simp + thus "acute_ang \\arg z2 - pi\\ = acute_ang \\- arg z2 - pi\\" + proof(cases "arg z2 = 0") + case True + thus ?thesis + by (auto simp del:acute_ang_def) + next + case False + hence "-arg z2 > 0" + using \-arg z2 \ 0\ + by auto + thus ?thesis + using False canon_ang_minus_pi1[of "-arg z2"] + using arg_bounded[of z2] canon_ang_minus_pi2[of "arg z2"] + by (auto simp add:field_simps) + qed + qed + qed + qed +qed + +text \Cosine and scalar product\ + +lemma ortho_a_scalprod0: + assumes "z1 \ 0" and "z2 \ 0" + shows "\a z1 z2 = pi/2 \ scalprod z1 z2 = 0" + unfolding ang_vec_a_def + using assms ortho_c_scalprod0[of z1 z2] + by auto + +declare ang_vec_c_def[simp del] + +lemma cos_a_c: "cos (\a z1 z2) = abs (cos (\c z1 z2))" +proof- + have "0 \ \c z1 z2" "\c z1 z2 \ pi" + using ang_vec_c_bounded[of z1 z2] + by auto + show ?thesis + proof (cases "\c z1 z2 = pi/2") + case True + thus ?thesis + unfolding ang_vec_a_def acute_ang_def + by (smt cos_pi_half pi_def pi_half) + next + case False + show ?thesis + proof (cases "\c z1 z2 < pi / 2") + case True + thus ?thesis + using `0 \ \c z1 z2` + using cos_gt_zero_pi[of "\c z1 z2"] + unfolding ang_vec_a_def + by simp + next + case False + hence "\c z1 z2 > pi/2" + using `\c z1 z2 \ pi/2` + by simp + hence "cos (\c z1 z2) < 0" + using `\c z1 z2 \ pi` + using cos_lt_zero_on_pi2_pi[of "\c z1 z2"] + by simp + thus ?thesis + using `\c z1 z2 > pi/2` + unfolding ang_vec_a_def + by simp + qed + qed +qed + +end diff --git a/thys/Complex_Geometry/Canonical_Angle.thy b/thys/Complex_Geometry/Canonical_Angle.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Canonical_Angle.thy @@ -0,0 +1,361 @@ +(* -------------------------------------------------------------------------- *) +subsection \Canonical angle\ +(* -------------------------------------------------------------------------- *) + +text \Canonize any angle to $(-\pi, \pi]$ (taking account of $2\pi$ periodicity of @{term sin} and +@{term cos}). With this function, for example, multiplicative properties of @{term arg} for complex +numbers can easily be expressed and proved.\ + +theory Canonical_Angle +imports More_Transcendental +begin + + +abbreviation canon_ang_P where + "canon_ang_P \ \' \ (-pi < \' \ \' \ pi) \ (\ k::int. \ - \' = 2*k*pi)" + +definition canon_ang :: "real \ real" ("\_\") where + "\\\ = (THE \'. canon_ang_P \ \')" + +text \There is a canonical angle for every angle.\ +lemma canon_ang_ex: + shows "\ \'. canon_ang_P \ \'" +proof- + have ***: "\ \::real. \ \'. 0 < \' \ \' \ 1 \ (\ k::int. \' = \ - k)" + proof + fix \::real + show "\\'>0. \' \ 1 \ (\k::int. \' = \ - k)" + proof (cases "\ = floor \") + case True + thus ?thesis + by (rule_tac x="\ - floor \ + 1" in exI, auto) (rule_tac x="floor \ - 1" in exI, auto) + next + case False + thus ?thesis + using real_of_int_floor_ge_diff_one[of "\"] + using of_int_floor_le[of "\"] + by (rule_tac x="\ - floor \" in exI) smt + qed + qed + + have **: "\ \::real. \ \'. 0 < \' \ \' \ 2 \ (\ k::int. \ - \' = 2*k - 1)" + proof + fix \::real + from ***[rule_format, of "(\ + 1) /2"] + obtain \' and k::int where "0 < \'" "\' \ 1" "\' = (\ + 1)/2 - k" + by force + hence "0 < \'" "\' \ 1" "\' = \/2 - k + 1/2" + by auto + thus "\\'>0. \' \ 2 \ (\k::int. \ - \' = real_of_int (2 * k - 1))" + by (rule_tac x="2*\'" in exI) auto + qed + have *: "\ \::real. \ \'. -1 < \' \ \' \ 1 \ (\ k::int. \ - \' = 2*k)" + proof + fix \::real + from ** obtain \' and k :: int where + "0 < \' \ \' \ 2 \ \ - \' = 2*k - 1" + by force + thus "\\'>-1. \' \ 1 \ (\k. \ - \' = real_of_int (2 * (k::int)))" + by (rule_tac x="\' - 1" in exI) (auto simp add: field_simps) + qed + obtain \' k where 1: "\' >- 1 \ \' \ 1" and 2: "\ / pi - \' = real_of_int (2 * k)" + using *[rule_format, of "\ / pi"] + by auto + have "\'*pi > -pi \ \'*pi \ pi" + using 1 + by (smt mult.commute mult_le_cancel_left1 mult_minus_right pi_gt_zero) + moreover + have "\ - \'*pi = 2 * real_of_int k * pi" + using 2 + by (auto simp add: field_simps) + ultimately + show ?thesis + by auto +qed + +text \Canonical angle of any angle is unique.\ +lemma canon_ang_unique: + assumes "canon_ang_P \ \\<^sub>1" and "canon_ang_P \ \\<^sub>2" + shows "\\<^sub>1 = \\<^sub>2" +proof- + obtain k1::int where "\ - \\<^sub>1 = 2*k1*pi" + using assms(1) + by auto + obtain k2::int where "\ - \\<^sub>2 = 2*k2*pi" + using assms(2) + by auto + hence *: "-\\<^sub>1 + \\<^sub>2 = 2*(k1 - k2)*pi" + using \\ - \\<^sub>1 = 2*k1*pi\ + by (simp add:field_simps) + moreover + have "-\\<^sub>1 + \\<^sub>2 < 2 * pi" "-\\<^sub>1 + \\<^sub>2 > -2*pi" + using assms + by auto + ultimately + have "-\\<^sub>1 + \\<^sub>2 = 0" + using mult_less_cancel_right[of "-2" pi "real_of_int(2 * (k1 - k2))"] + by auto + thus ?thesis + by auto +qed + +text \Canonical angle is always in $(-\pi, \pi]$ and differs from the starting angle by $2k\pi$.\ +lemma canon_ang: + shows "-pi < \\\" and "\\\ \ pi" and "\ k::int. \ - \\\ = 2*k*pi" +proof- + obtain \' where "canon_ang_P \ \'" + using canon_ang_ex[of \] + by auto + have "canon_ang_P \ \\\" + unfolding canon_ang_def + proof (rule theI[where a="\'"]) + show "canon_ang_P \ \'" + by fact + next + fix \'' + assume "canon_ang_P \ \''" + thus "\'' = \'" + using \canon_ang_P \ \'\ + using canon_ang_unique[of \' \ \''] + by simp + qed + thus "-pi < \\\" "\\\ \ pi" "\ k::int. \ - \\\ = 2*k*pi" + by auto +qed + +text \Angles in $(-\pi, \pi]$ are already canonical.\ +lemma canon_ang_id: + assumes "-pi < \ \ \ \ pi" + shows "\\\ = \" + using assms + using canon_ang_unique[of "canon_ang \" \ \] canon_ang[of \] + by auto + +text \Angles that differ by $2k\pi$ have equal canonical angles.\ +lemma canon_ang_eq: + assumes "\ k::int. \\<^sub>1 - \\<^sub>2 = 2*k*pi" + shows "\\\<^sub>1\ = \\\<^sub>2\" +proof- + obtain k'::int where *: "- pi < \\\<^sub>1\" "\\\<^sub>1\ \ pi" "\\<^sub>1 - \\\<^sub>1\ = 2 * k' * pi" + using canon_ang[of \\<^sub>1] + by auto + + obtain k''::int where **: "- pi < \\\<^sub>2\" "\\\<^sub>2\ \ pi" "\\<^sub>2 - \\\<^sub>2\ = 2 * k'' * pi" + using canon_ang[of \\<^sub>2] + by auto + + obtain k::int where ***: "\\<^sub>1 - \\<^sub>2 = 2*k*pi" + using assms + by auto + + have "\m::int. \\<^sub>1 - \\\<^sub>2\ = 2 * m * pi" + using **(3) *** + by (rule_tac x="k+k''" in exI) (auto simp add: field_simps) + + thus ?thesis + using canon_ang_unique[of "\\\<^sub>1\" \\<^sub>1 "\\\<^sub>2\"] * ** + by auto +qed + +text \Introduction and elimination rules\ +lemma canon_ang_eqI: + assumes "\k::int. \' - \ = 2 * k * pi" and "- pi < \' \ \' \ pi" + shows "\\\ = \'" + using assms + using canon_ang_eq[of \' \] + using canon_ang_id[of \'] + by auto + +lemma canon_ang_eqE: + assumes "\\\<^sub>1\ = \\\<^sub>2\" + shows "\ (k::int). \\<^sub>1 - \\<^sub>2 = 2 *k * pi" +proof- + obtain k1 k2 :: int where + "\\<^sub>1 - \\\<^sub>1\ = 2 * k1 * pi" + "\\<^sub>2 - \\\<^sub>2\ = 2 * k2 * pi" + using canon_ang[of \\<^sub>1] canon_ang[of \\<^sub>2] + by auto + thus ?thesis + using assms + by (rule_tac x="k1 - k2" in exI) (auto simp add: field_simps) +qed + +text \Canonical angle of opposite angle\ + +lemma canon_ang_uminus: + assumes "\\\ \ pi" + shows "\-\\ = -\\\" +proof (rule canon_ang_eqI) + show "\x::int. - \\\ - - \ = 2 * x * pi" + using canon_ang(3)[of \] + by (metis minus_diff_eq minus_diff_minus) +next + show "- pi < - \\\ \ - \\\ \ pi" + using canon_ang(1)[of \] canon_ang(2)[of \] assms + by auto +qed + +lemma canon_ang_uminus_pi: + assumes "\\\ = pi" + shows "\-\\ = \\\" +proof (rule canon_ang_eqI) + obtain k::int where "\ - \\\ = 2 * k * pi" + using canon_ang(3)[of \] + by auto + thus "\x::int. \\\ - - \ = 2 * x * pi" + using assms + by (rule_tac x="k+(1::int)" in exI) (auto simp add: field_simps) +next + show "- pi < \\\ \ \\\ \ pi" + using assms + by auto +qed + +text \Canonical angle of difference of two angles\ +lemma canon_ang_diff: + shows "\\ - \\ = \\\\ - \\\\" +proof (rule canon_ang_eq) + show "\x::int. \ - \ - (\\\ - \\\) = 2 * x * pi" + proof- + obtain k1::int where "\ - \\\ = 2*k1*pi" + using canon_ang(3) + by auto + moreover + obtain k2::int where "\ - \\\ = 2*k2*pi" + using canon_ang(3) + by auto + ultimately + show ?thesis + by (rule_tac x="k1 - k2" in exI) (auto simp add: field_simps) + qed +qed + +text \Canonical angle of sum of two angles\ +lemma canon_ang_sum: + shows "\\ + \\ = \\\\ + \\\\" +proof (rule canon_ang_eq) + show "\x::int. \ + \ - (\\\ + \\\) = 2 * x * pi" + proof- + obtain k1::int where "\ - \\\ = 2*k1*pi" + using canon_ang(3) + by auto + moreover + obtain k2::int where "\ - \\\ = 2*k2*pi" + using canon_ang(3) + by auto + ultimately + show ?thesis + by (rule_tac x="k1 + k2" in exI) (auto simp add: field_simps) + qed +qed + +text \Canonical angle of angle from $(0, 2\pi]$ shifted by $\pi$\ + +lemma canon_ang_plus_pi1: + assumes "0 < \" and "\ \ 2*pi" + shows "\\ + pi\ = \ - pi" +proof (rule canon_ang_eqI) + show "\ x::int. \ - pi - (\ + pi) = 2 * x * pi" + by (rule_tac x="-1" in exI) auto +next + show "- pi < \ - pi \ \ - pi \ pi" + using assms + by auto +qed + +lemma canon_ang_minus_pi1: + assumes "0 < \" and "\ \ 2*pi" + shows "\\ - pi\ = \ - pi" +proof (rule canon_ang_id) + show "- pi < \ - pi \ \ - pi \ pi" + using assms + by auto +qed + +text \Canonical angle of angles from $(-2\pi, 0]$ shifted by $\pi$\ + +lemma canon_ang_plus_pi2: + assumes "-2*pi < \" and "\ \ 0" + shows "\\ + pi\ = \ + pi" +proof (rule canon_ang_id) + show "- pi < \ + pi \ \ + pi \ pi" + using assms + by auto +qed + +lemma canon_ang_minus_pi2: + assumes "-2*pi < \" and "\ \ 0" + shows "\\ - pi\ = \ + pi" +proof (rule canon_ang_eqI) + show "\ x::int. \ + pi - (\ - pi) = 2 * x * pi" + by (rule_tac x="1" in exI) auto +next + show "- pi < \ + pi \ \ + pi \ pi" + using assms + by auto +qed + +text \Canonical angle of angle in $(\pi, 3\pi]$.\ +lemma canon_ang_pi_3pi: + assumes "pi < \" and "\ \ 3 * pi" + shows "\\\ = \ - 2*pi" +proof- + have "\x. - pi = pi * real_of_int x" + by (rule_tac x="-1" in exI, simp) + thus ?thesis + using assms canon_ang_eqI[of "\ - 2*pi" "\"] + by auto +qed + +text \Canonical angle of angle in $(-3\pi, -\pi]$.\ +lemma canon_ang_minus_3pi_minus_pi: + assumes "-3*pi < \" and "\ \ -pi" + shows "\\\ = \ + 2*pi" +proof- + have "\x. pi = pi * real_of_int x" + by (rule_tac x="1" in exI, simp) + thus ?thesis + using assms canon_ang_eqI[of "\ + 2*pi" "\"] + by auto +qed + +text \Canonical angles for some special angles\ + +lemma zero_canonical [simp]: + shows "\0\ = 0" + using canon_ang_eqI[of 0 0] + by simp + +lemma pi_canonical [simp]: + shows "\pi\ = pi" + by (simp add: canon_ang_id) + +lemma two_pi_canonical [simp]: + shows "\2 * pi\ = 0" + using canon_ang_plus_pi1[of "pi"] + by simp + +text \Canonization preserves sine and cosine\ +lemma canon_ang_sin [simp]: + shows "sin \\\ = sin \" +proof- + obtain x::int where "\ = \\\ + pi * (x * 2)" + using canon_ang(3)[of \] + by (auto simp add: field_simps) + thus ?thesis + using sin_periodic_int[of "\\\" x] + by (simp add: field_simps) +qed + +lemma canon_ang_cos [simp]: + shows "cos \\\ = cos \" +proof- + obtain x::int where "\ = \\\ + pi * (x * 2)" + using canon_ang(3)[of \] + by (auto simp add: field_simps) + thus ?thesis + using cos_periodic_int[of "\\\" x] + by (simp add: field_simps) +qed + +end diff --git a/thys/Complex_Geometry/Chordal_Metric.thy b/thys/Complex_Geometry/Chordal_Metric.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Chordal_Metric.thy @@ -0,0 +1,1725 @@ +(* -------------------------------------------------------------------------- *) +subsection \Chordal Metric\ +(* -------------------------------------------------------------------------- *) + +text \Riemann sphere can be made a metric space. We are going to introduce distance on Riemann sphere +and to prove that it is a metric space. The distance between two points on the sphere is defined as +the length of the chord that connects them. This metric can be used in formalization of elliptic +geometry.\ + +theory Chordal_Metric + imports Homogeneous_Coordinates Riemann_Sphere Oriented_Circlines "HOL-Analysis.Inner_Product" "HOL-Analysis.Euclidean_Space" +begin + +(* -------------------------------------------------------------------------- *) +subsubsection \Inner product and norm\ +(* -------------------------------------------------------------------------- *) + +definition inprod_cvec :: "complex_vec \ complex_vec \ complex" where + [simp]: "inprod_cvec z w = + (let (z1, z2) = z; + (w1, w2) = w + in vec_cnj (z1, z2) *\<^sub>v\<^sub>v (w1, w2))" +syntax + "_inprod_cvec" :: "complex_vec \ complex_vec \ complex" ("\_,_\") +translations + "\z,w\" == "CONST inprod_cvec z w" + +lemma real_inprod_cvec [simp]: + shows "is_real \z,z\" + by (cases z, simp add: vec_cnj_def) + +lemma inprod_cvec_ge_zero [simp]: + shows "Re \z,z\ \ 0" + by (cases z, simp add: vec_cnj_def) + +lemma inprod_cvec_bilinear1 [simp]: + assumes "z' = k *\<^sub>s\<^sub>v z" + shows "\z',w\ = cnj k * \z,w\" + using assms + by (cases z, cases z', cases w) (simp add: vec_cnj_def field_simps) + +lemma inprod_cvec_bilinear2 [simp]: + assumes "z' = k *\<^sub>s\<^sub>v z" + shows "\w, z'\ = k * \w, z\" + using assms + by (cases z, cases z', cases w) (simp add: vec_cnj_def field_simps) + +lemma inprod_cvec_g_zero [simp]: + assumes "z \ vec_zero" + shows "Re \z, z\ > 0" +proof- + have "\ a b. a \ 0 \ b \ 0 \ 0 < (Re a * Re a + Im a * Im a) + (Re b * Re b + Im b * Im b)" + by (smt complex_eq_0 not_sum_squares_lt_zero power2_eq_square) + thus ?thesis + using assms + by (cases z, simp add: vec_cnj_def) +qed + +definition norm_cvec :: "complex_vec \ real" where + [simp]: "norm_cvec z = sqrt (Re \z,z\)" +syntax + "_norm_cvec" :: "complex_vec \ complex" ("\_\") +translations + "\z\" == "CONST norm_cvec z" + +lemma norm_cvec_square: + shows "\z\\<^sup>2 = Re (\z,z\)" + by (simp del: inprod_cvec_def) + +lemma norm_cvec_gt_0: + assumes "z \ vec_zero" + shows "\z\ > 0" + using assms + by (simp del: inprod_cvec_def) + +lemma norm_cvec_scale: + assumes "z' = k *\<^sub>s\<^sub>v z" + shows "\z'\\<^sup>2 = Re (cnj k * k) * \z\\<^sup>2" + unfolding norm_cvec_square + using inprod_cvec_bilinear1[OF assms, of z'] + using inprod_cvec_bilinear2[OF assms, of z] + by (simp del: inprod_cvec_def add: field_simps) + +lift_definition inprod_hcoords :: "complex_homo_coords \ complex_homo_coords \ complex" is inprod_cvec + done + +lift_definition norm_hcoords :: "complex_homo_coords \ real" is norm_cvec + done + +(* -------------------------------------------------------------------------- *) +subsubsection \Distance in $\mathbb{C}P^1$ - defined by Fubini-Study metric.\ +(* -------------------------------------------------------------------------- *) + +text \Formula for the chordal distance between the two points can be given directly based +on the homogenous coordinates of their stereographic projections in the plane. This is +called the Fubini-Study metric.\ + +definition dist_fs_cvec :: "complex_vec \ complex_vec \ real" where [simp]: + "dist_fs_cvec z1 z2 = + (let (z1x, z1y) = z1; + (z2x, z2y) = z2; + num = (z1x*z2y - z2x*z1y) * (cnj z1x*cnj z2y - cnj z2x*cnj z1y); + den = (z1x*cnj z1x + z1y*cnj z1y) * (z2x*cnj z2x + z2y*cnj z2y) + in 2*sqrt(Re num / Re den))" + +lemma dist_fs_cvec_iff: + assumes "z \ vec_zero" and "w \ vec_zero" + shows "dist_fs_cvec z w = 2*sqrt(1 - (cmod \z,w\)\<^sup>2 / (\z\\<^sup>2 * \w\\<^sup>2))" +proof- + obtain z1 z2 w1 w2 where *: "z = (z1, z2)" "w = (w1, w2)" + by (cases "z", cases "w") auto + have 1: "2*sqrt(1 - (cmod \z,w\)\<^sup>2 / (\z\\<^sup>2 * \w\\<^sup>2)) = 2*sqrt((\z\\<^sup>2 * \w\\<^sup>2 - (cmod \z,w\)\<^sup>2) / (\z\\<^sup>2 * \w\\<^sup>2))" + using norm_cvec_gt_0[of z] norm_cvec_gt_0[of w] assms + by (simp add: field_simps) + + have 2: "\z\\<^sup>2 * \w\\<^sup>2 = Re ((z1*cnj z1 + z2*cnj z2) * (w1*cnj w1 + w2*cnj w2))" + using assms * + by (simp add: vec_cnj_def) + + have 3: "\z\\<^sup>2 * \w\\<^sup>2 - (cmod \z,w\)\<^sup>2 = Re ((z1*w2 - w1*z2) * (cnj z1*cnj w2 - cnj w1*cnj z2))" + apply (subst cmod_square, (subst norm_cvec_square)+) + using * + by (simp add: vec_cnj_def field_simps) + + thus ?thesis + using 1 2 3 + using * + unfolding dist_fs_cvec_def Let_def + by simp +qed + +lift_definition dist_fs_hcoords :: "complex_homo_coords \ complex_homo_coords \ real" is dist_fs_cvec + done + +lift_definition dist_fs :: "complex_homo \ complex_homo \ real" is dist_fs_hcoords +proof transfer + fix z1 z2 z1' z2' :: complex_vec + obtain z1x z1y z2x z2y z1'x z1'y z2'x z2'y where + zz: "z1 = (z1x, z1y)" "z2 = (z2x, z2y)" "z1' = (z1'x, z1'y)" "z2' = (z2'x, z2'y)" + by (cases "z1", cases "z2", cases "z1'", cases "z2'") blast + + assume 1: "z1 \ vec_zero" "z2 \ vec_zero" "z1' \ vec_zero" "z2' \ vec_zero" "z1 \\<^sub>v z1'" "z2 \\<^sub>v z2'" + then obtain k1 k2 where + *: "k1 \ 0" "z1' = k1 *\<^sub>s\<^sub>v z1" and + **: "k2 \ 0" "z2' = k2 *\<^sub>s\<^sub>v z2" + by auto + have "(cmod \z1,z2\)\<^sup>2 / (\z1\\<^sup>2 * \z2\\<^sup>2) = (cmod \z1',z2'\)\<^sup>2 / (\z1'\\<^sup>2 * \z2'\\<^sup>2)" + using \k1 \ 0\ \k2 \ 0\ + using cmod_square[symmetric, of k1] cmod_square[symmetric, of k2] + apply (subst norm_cvec_scale[OF *(2)]) + apply (subst norm_cvec_scale[OF **(2)]) + apply (subst inprod_cvec_bilinear1[OF *(2)]) + apply (subst inprod_cvec_bilinear2[OF **(2)]) + by (simp add: power2_eq_square) + thus "dist_fs_cvec z1 z2 = dist_fs_cvec z1' z2'" + using 1 dist_fs_cvec_iff + by simp +qed + +lemma dist_fs_finite: + shows "dist_fs (of_complex z1) (of_complex z2) = 2 * cmod(z1 - z2) / (sqrt (1+(cmod z1)\<^sup>2) * sqrt (1+(cmod z2)\<^sup>2))" + apply transfer + apply transfer + apply (subst cmod_square)+ + apply (simp add: real_sqrt_divide cmod_def power2_eq_square) + apply (subst real_sqrt_mult[symmetric]) + apply (simp add: field_simps) + done + +lemma dist_fs_infinite1: + shows "dist_fs (of_complex z1) \\<^sub>h = 2 / sqrt (1+(cmod z1)\<^sup>2)" + by (transfer, transfer) (subst cmod_square, simp add: real_sqrt_divide) + +lemma dist_fs_infinite2: + shows "dist_fs \\<^sub>h (of_complex z1) = 2 / sqrt (1+(cmod z1)\<^sup>2)" + by (transfer, transfer) (subst cmod_square, simp add: real_sqrt_divide) + +lemma dist_fs_cvec_zero: + assumes "z \ vec_zero" and "w \ vec_zero" + shows "dist_fs_cvec z w = 0 \ (cmod \z,w\)\<^sup>2 = (\z\\<^sup>2 * \w\\<^sup>2)" + using assms norm_cvec_gt_0[of z] norm_cvec_gt_0[of w] + by (subst dist_fs_cvec_iff) auto + +lemma dist_fs_zero1 [simp]: + shows "dist_fs z z = 0" + by (transfer, transfer) + (subst dist_fs_cvec_zero, simp, (subst norm_cvec_square)+, subst cmod_square, simp del: inprod_cvec_def) + +lemma dist_fs_zero2 [simp]: + assumes "dist_fs z1 z2 = 0" + shows "z1 = z2" + using assms +proof (transfer, transfer) + fix z w :: complex_vec + obtain z1 z2 w1 w2 where *: "z = (z1, z2)" "w = (w1, w2)" + by (cases "z", cases "w", auto) + let ?x = "(z1*w2 - w1*z2) * (cnj z1*cnj w2 - cnj w1*cnj z2)" + assume "z \ vec_zero" "w \ vec_zero" "dist_fs_cvec z w = 0" + hence "(cmod \z,w\)\<^sup>2 = \z\\<^sup>2 * \w\\<^sup>2" + by (subst (asm) dist_fs_cvec_zero, simp_all) + hence "Re ?x = 0" + using * + by (subst (asm) cmod_square) ((subst (asm) norm_cvec_square)+, simp add: vec_cnj_def field_simps) + hence "?x = 0" + using complex_mult_cnj_cmod[of "z1*w2 - w1*z2"] zero_complex.simps + by (subst complex_eq_if_Re_eq[of ?x 0]) (simp add: power2_eq_square, simp, linarith) + moreover + have "z1 * w2 - w1 * z2 = 0 \ cnj z1 * cnj w2 - cnj w1 * cnj z2 = 0" + by (metis complex_cnj_diff complex_cnj_mult complex_cnj_zero_iff) + ultimately + show "z \\<^sub>v w" + using * \z \ vec_zero\ \w \ vec_zero\ + using complex_cvec_eq_mix[of z1 z2 w1 w2] + by auto +qed + +lemma dist_fs_sym: + shows "dist_fs z1 z2 = dist_fs z2 z1" + by (transfer, transfer) (simp add: split_def field_simps) + +(* -------------------------------------------------------------------------- *) +subsubsection \Triangle inequality for Fubini-Study metric\ +(* -------------------------------------------------------------------------- *) + +lemma dist_fs_triangle_finite: + shows "cmod(a - b) / (sqrt (1+(cmod a)\<^sup>2) * sqrt (1+(cmod b)\<^sup>2)) \ cmod (a - c) / (sqrt (1+(cmod a)\<^sup>2) * sqrt (1+(cmod c)\<^sup>2)) + cmod (c - b) / (sqrt (1+(cmod b)\<^sup>2) * sqrt (1+(cmod c)\<^sup>2))" +proof- + let ?cc = "1+(cmod c)\<^sup>2" and ?bb = "1+(cmod b)\<^sup>2" and ?aa = "1+(cmod a)\<^sup>2" + have "sqrt ?cc > 0" "sqrt ?aa > 0" "sqrt ?bb > 0" + by (smt real_sqrt_gt_zero zero_compare_simps(12))+ + have "(a - b)*(1+cnj c*c) = (a-c)*(1+cnj c*b) + (c-b)*(1 + cnj c*a)" + by (simp add: field_simps) + moreover + have "1 + cnj c * c = 1 + (cmod c)\<^sup>2" + using complex_norm_square + by auto + hence "cmod ((a - b)*(1+cnj c*c)) = cmod(a - b) * (1+(cmod c)\<^sup>2)" + by (smt norm_mult norm_of_real zero_compare_simps(12)) + ultimately + have "cmod(a - b) * (1+(cmod c)\<^sup>2) \ cmod (a-c) * cmod (1+cnj c*b) + cmod (c-b) * cmod(1 + cnj c*a)" + using complex_mod_triangle_ineq2[of "(a-c)*(1+cnj c*b)" "(c-b)*(1 + cnj c*a)"] + by simp + moreover + have *: "\ a b c d b' d'. \b \ b'; d \ d'; a \ (0::real); c \ 0\ \ a*b + c*d \ a*b' + c*d'" + by (smt mult_left_mono) + have "cmod (a-c) * cmod (1+cnj c*b) + cmod (c-b) * cmod(1 + cnj c*a) \ cmod (a - c) * (sqrt (1+(cmod c)\<^sup>2) * sqrt (1+(cmod b)\<^sup>2)) + cmod (c - b) * (sqrt (1+(cmod c)\<^sup>2) * sqrt (1+(cmod a)\<^sup>2))" + using *[OF cmod_1_plus_mult_le[of "cnj c" b] cmod_1_plus_mult_le[of "cnj c" a], of "cmod (a-c)" "cmod (c-b)"] + by (simp add: field_simps real_sqrt_mult[symmetric]) + ultimately + have "cmod(a - b) * ?cc \ cmod (a - c) * sqrt ?cc * sqrt ?bb + cmod (c - b) * sqrt ?cc * sqrt ?aa" + by simp + moreover + hence "0 \ ?cc * sqrt ?aa * sqrt ?bb" + using mult_right_mono[of 0 "sqrt ?aa" "sqrt ?bb"] + using mult_right_mono[of 0 "?cc" "sqrt ?aa * sqrt ?bb"] + by simp + moreover + have "sqrt ?cc / ?cc = 1 / sqrt ?cc" + using \sqrt ?cc > 0\ + by (simp add: field_simps) + hence "sqrt ?cc / (?cc * sqrt ?aa) = 1 / (sqrt ?aa * sqrt ?cc)" + using times_divide_eq_right[of "1/sqrt ?aa" "sqrt ?cc" "?cc"] + using \sqrt ?aa > 0\ + by simp + hence "cmod (a - c) * sqrt ?cc / (?cc * sqrt ?aa) = cmod (a - c) / (sqrt ?aa * sqrt ?cc)" + using times_divide_eq_right[of "cmod (a - c)" "sqrt ?cc" "(?cc * sqrt ?aa)"] + by simp + moreover + have "sqrt ?cc / ?cc = 1 / sqrt ?cc" + using \sqrt ?cc > 0\ + by (simp add: field_simps) + hence "sqrt ?cc / (?cc * sqrt ?bb) = 1 / (sqrt ?bb * sqrt ?cc)" + using times_divide_eq_right[of "1/sqrt ?bb" "sqrt ?cc" "?cc"] + using \sqrt ?bb > 0\ + by simp + hence "cmod (c - b) * sqrt ?cc / (?cc * sqrt ?bb) = cmod (c - b) / (sqrt ?bb * sqrt ?cc)" + using times_divide_eq_right[of "cmod (c - b)" "sqrt ?cc" "?cc * sqrt ?bb"] + by simp + ultimately + show ?thesis + using divide_right_mono[of "cmod (a - b) * ?cc" "cmod (a - c) * sqrt ?cc * sqrt ?bb + cmod (c - b) * sqrt ?cc * sqrt ?aa" "?cc * sqrt ?aa * sqrt ?bb"] \sqrt ?aa > 0\ \sqrt ?bb > 0\ \sqrt ?cc > 0\ + by (simp add: add_divide_distrib) +qed + +lemma dist_fs_triangle_infinite1: + shows "1 / sqrt(1 + (cmod b)\<^sup>2) \ 1 / sqrt(1 + (cmod c)\<^sup>2) + cmod (b - c) / (sqrt(1 + (cmod b)\<^sup>2) * sqrt(1 + (cmod c)\<^sup>2))" +proof- + let ?bb = "sqrt (1 + (cmod b)\<^sup>2)" and ?cc = "sqrt (1 + (cmod c)\<^sup>2)" + have "?bb > 0" "?cc > 0" + by (metis add_strict_increasing real_sqrt_gt_0_iff zero_le_power2 zero_less_one)+ + hence *: "?bb * ?cc \ 0" + by simp + have **: "(?cc - ?bb) / (?bb * ?cc) = 1 / ?bb - 1 / ?cc" + using \sqrt (1 + (cmod b)\<^sup>2) > 0\ \sqrt (1 + (cmod c)\<^sup>2) > 0\ + by (simp add: field_simps) + show "1 / ?bb \ 1 / ?cc + cmod (b - c) / (?bb * ?cc)" + using divide_right_mono[OF cmod_diff_ge[of c b] *] + by (subst (asm) **) (simp add: field_simps norm_minus_commute) +qed + +lemma dist_fs_triangle_infinite2: + shows "1 / sqrt(1 + (cmod a)\<^sup>2) \ cmod (a - c) / (sqrt (1+(cmod a)\<^sup>2) * sqrt (1+(cmod c)\<^sup>2)) + 1 / sqrt(1 + (cmod c)\<^sup>2)" + using dist_fs_triangle_infinite1[of a c] + by simp + +lemma dist_fs_triangle_infinite3: + shows "cmod(a - b) / (sqrt (1+(cmod a)\<^sup>2) * sqrt (1+(cmod b)\<^sup>2)) \ 1 / sqrt(1 + (cmod a)\<^sup>2) + 1 / sqrt(1 + (cmod b)\<^sup>2)" +proof- + let ?aa = "sqrt (1 + (cmod a)\<^sup>2)" and ?bb = "sqrt (1 + (cmod b)\<^sup>2)" + have "?aa > 0" "?bb > 0" + by (metis add_strict_increasing real_sqrt_gt_0_iff zero_le_power2 zero_less_one)+ + hence *: "?aa * ?bb \ 0" + by simp + have **: "(?aa + ?bb) / (?aa * ?bb) = 1 / ?aa + 1 / ?bb" + using \?aa > 0\ \?bb > 0\ + by (simp add: field_simps) + show "cmod (a - b) / (?aa * ?bb) \ 1 / ?aa + 1 / ?bb" + using divide_right_mono[OF cmod_diff_le[of a b] *] + by (subst (asm) **) (simp add: field_simps norm_minus_commute) +qed + +lemma dist_fs_triangle: + shows "dist_fs A B \ dist_fs A C + dist_fs C B" +proof (cases "A = \\<^sub>h") + case True + show ?thesis + proof (cases "B = \\<^sub>h") + case True + show ?thesis + proof (cases "C = \\<^sub>h") + case True + show ?thesis + using \A = \\<^sub>h\ \B = \\<^sub>h\ \C = \\<^sub>h\ + by simp + next + case False + then obtain c where "C = of_complex c" + using inf_or_of_complex[of C] + by auto + show ?thesis + using \A = \\<^sub>h\ \B = \\<^sub>h\ \C = of_complex c\ + by (simp add: dist_fs_infinite2 dist_fs_sym) + qed + next + case False + then obtain b where "B = of_complex b" + using inf_or_of_complex[of B] + by auto + show ?thesis + proof (cases "C = \\<^sub>h") + case True + show ?thesis + using \A = \\<^sub>h\ \C = \\<^sub>h\ \B = of_complex b\ + by simp + next + case False + then obtain c where "C = of_complex c" + using inf_or_of_complex[of C] + by auto + show ?thesis + using \A = \\<^sub>h\ \B = of_complex b\ \C = of_complex c\ + using mult_left_mono[OF dist_fs_triangle_infinite1[of b c], of 2] + by (simp add: dist_fs_finite dist_fs_infinite1 dist_fs_infinite2 dist_fs_sym) + qed + qed +next + case False + then obtain a where "A = of_complex a" + using inf_or_of_complex[of A] + by auto + show ?thesis + proof (cases "B = \\<^sub>h") + case True + show ?thesis + proof (cases "C = \\<^sub>h") + case True + show ?thesis + using \B = \\<^sub>h\ \C = \\<^sub>h\ \A = of_complex a\ + by (simp add: dist_fs_infinite2) + next + case False + then obtain c where "C = of_complex c" + using inf_or_of_complex[of C] + by auto + show ?thesis + using \B = \\<^sub>h\ \C = of_complex c\ \A = of_complex a\ + using mult_left_mono[OF dist_fs_triangle_infinite2[of a c], of 2] + by (simp add: dist_fs_finite dist_fs_infinite1 dist_fs_infinite2) + qed + next + case False + then obtain b where "B = of_complex b" + using inf_or_of_complex[of B] + by auto + show ?thesis + proof (cases "C = \\<^sub>h") + case True + thus ?thesis + using \C = \\<^sub>h\ \B = of_complex b\ \A = of_complex a\ + using mult_left_mono[OF dist_fs_triangle_infinite3[of a b], of 2] + by (simp add: dist_fs_finite dist_fs_infinite1 dist_fs_infinite2) + next + case False + then obtain c where "C = of_complex c" + using inf_or_of_complex[of C] + by auto + show ?thesis + using \A = of_complex a\ \B = of_complex b\ \C = of_complex c\ + using mult_left_mono[OF dist_fs_triangle_finite[of a b c], of 2] + by (simp add: dist_fs_finite norm_minus_commute dist_fs_sym) + qed + qed +qed + +(* -------------------------------------------------------------------------- *) +subsubsection \$\mathbb{C}P^1$ with Fubini-Study metric is a metric space\ +(* -------------------------------------------------------------------------- *) + +text \Using the (already available) fact that $\mathbb{R}^3$ is a metric space (under the distance +function $\lambda\ x\ y.\ @{term norm}(x - y)$), it was not difficult to show that the type @{term +complex_homo} equipped with @{term dist_fs} is a metric space, i.e., an instantiation of the @{term +metric_space} locale.\ + +instantiation complex_homo :: metric_space +begin +definition "dist_complex_homo = dist_fs" +definition "(uniformity_complex_homo :: (complex_homo \ complex_homo) filter) = (INF e:{0<..}. principal {(x, y). dist_class.dist x y < e})" +definition "open_complex_homo (U :: complex_homo set) = (\ x \ U. eventually (\(x', y). x' = x \ y \ U) uniformity)" +instance +proof + fix x y :: complex_homo + show "(dist_class.dist x y = 0) = (x = y)" + unfolding dist_complex_homo_def + using dist_fs_zero1[of x] dist_fs_zero2[of x y] + by auto +next + fix x y z :: complex_homo + show "dist_class.dist x y \ dist_class.dist x z + dist_class.dist y z" + unfolding dist_complex_homo_def + using dist_fs_triangle[of x y z] + by (simp add: dist_fs_sym) +qed (simp_all add: open_complex_homo_def uniformity_complex_homo_def) +end + +(* -------------------------------------------------------------------------- *) +subsubsection \Chordal distance on the Riemann sphere\ +(* -------------------------------------------------------------------------- *) + +text \Distance of the two points is given by the length of the chord. We show that it corresponds to +the Fubini-Study metric in the plane.\ + +definition dist_riemann_sphere_r3 :: "R3 \ R3 \ real" where [simp]: + "dist_riemann_sphere_r3 M1 M2 = + (let (x1, y1, z1) = M1; + (x2, y2, z2) = M2 + in norm (x1 - x2, y1 - y2, z1 - z2))" + +lemma dist_riemann_sphere_r3_inner: + assumes "M1 \ unit_sphere" and "M2 \ unit_sphere" + shows "(dist_riemann_sphere_r3 M1 M2)\<^sup>2 = 2 - 2 * inner M1 M2" + using assms + apply (cases M1, cases M2) + apply (auto simp add: norm_prod_def) + apply (simp add: power2_eq_square field_simps) + done + + +lift_definition dist_riemann_sphere' :: "riemann_sphere \ riemann_sphere \ real" is dist_riemann_sphere_r3 + done + +lemma dist_riemann_sphere_ge_0 [simp]: + shows "dist_riemann_sphere' M1 M2 \ 0" + apply transfer + using norm_ge_zero + by (simp add: split_def Let_def) + +text \Using stereographic projection we prove the connection between chordal metric on the spehere +and Fubini-Study metric in the plane.\ + +lemma dist_stereographic_finite: + assumes "stereographic M1 = of_complex m1" and "stereographic M2 = of_complex m2" + shows "dist_riemann_sphere' M1 M2 = 2 * cmod (m1 - m2) / (sqrt (1 + (cmod m1)\<^sup>2) * sqrt (1 + (cmod m2)\<^sup>2))" + using assms +proof- + have *: "M1 = inv_stereographic (of_complex m1)" "M2 = inv_stereographic (of_complex m2)" + using inv_stereographic_is_inv assms + by (metis inv_stereographic_stereographic)+ + have "(1 + (cmod m1)\<^sup>2) \ 0" "(1 + (cmod m2)\<^sup>2) \ 0" + by (smt power2_less_0)+ + have "(1 + (cmod m1)\<^sup>2) > 0" "(1 + (cmod m2)\<^sup>2) > 0" + by (smt realpow_square_minus_le)+ + hence "(1 + (cmod m1)\<^sup>2) * (1 + (cmod m2)\<^sup>2) > 0" + by (metis norm_mult_less norm_zero power2_eq_square zero_power2) + hence ++: "sqrt ((1 + cmod m1 * cmod m1) * (1 + cmod m2 * cmod m2)) > 0" + using real_sqrt_gt_0_iff + by (simp add: power2_eq_square) + hence **: "(2 * cmod (m1 - m2) / sqrt ((1 + cmod m1 * cmod m1) * (1 + cmod m2 * cmod m2))) \ 0 \ cmod (m1 - m2) \ 0" + by (metis diff_self divide_nonneg_pos mult_2 norm_ge_zero norm_triangle_ineq4 norm_zero) + + have "(dist_riemann_sphere' M1 M2)\<^sup>2 * (1 + (cmod m1)\<^sup>2) * (1 + (cmod m2)\<^sup>2) = 4 * (cmod (m1 - m2))\<^sup>2" + using * + proof (transfer, transfer) + fix m1 m2 M1 M2 + assume us: "M1 \ unit_sphere" "M2 \ unit_sphere" and + *: "M1 = inv_stereographic_cvec_r3 (of_complex_cvec m1)" "M2 = inv_stereographic_cvec_r3 (of_complex_cvec m2)" + have "(1 + (cmod m1)\<^sup>2) \ 0" "(1 + (cmod m2)\<^sup>2) \ 0" + by (smt power2_less_0)+ + thus "(dist_riemann_sphere_r3 M1 M2)\<^sup>2 * (1 + (cmod m1)\<^sup>2) * (1 + (cmod m2)\<^sup>2) = + 4 * (cmod (m1 - m2))\<^sup>2" + apply (subst dist_riemann_sphere_r3_inner[OF us]) + apply (subst *)+ + apply (simp add: dist_riemann_sphere_r3_inner[OF us] complex_mult_cnj_cmod) + apply (subst left_diff_distrib[of 2]) + apply (subst left_diff_distrib[of "2*(1+(cmod m1)\<^sup>2)"]) + apply (subst distrib_right[of _ _ "(1 + (cmod m1)\<^sup>2)"]) + apply (subst distrib_right[of _ _ "(1 + (cmod m1)\<^sup>2)"]) + apply simp + apply (subst distrib_right[of _ _ "(1 + (cmod m2)\<^sup>2)"]) + apply (subst distrib_right[of _ _ "(1 + (cmod m2)\<^sup>2)"]) + apply (subst distrib_right[of _ _ "(1 + (cmod m2)\<^sup>2)"]) + apply simp + apply (subst (asm) cmod_square)+ + apply (subst cmod_square)+ + apply (simp add: field_simps) + done + qed + hence "(dist_riemann_sphere' M1 M2)\<^sup>2 = 4 * (cmod (m1 - m2))\<^sup>2 / ((1 + (cmod m1)\<^sup>2) * (1 + (cmod m2)\<^sup>2))" + using \(1 + (cmod m1)\<^sup>2) \ 0\ \(1 + (cmod m2)\<^sup>2) \ 0\ + using eq_divide_imp[of "(1 + (cmod m1)\<^sup>2) * (1 + (cmod m2)\<^sup>2)" "(dist_riemann_sphere' M1 M2)\<^sup>2" "4 * (cmod (m1 - m2))\<^sup>2"] + by simp + thus "dist_riemann_sphere' M1 M2 = 2 * cmod (m1 - m2) / (sqrt (1 + (cmod m1)\<^sup>2) * sqrt (1 + (cmod m2)\<^sup>2))" + using power2_eq_iff[of "dist_riemann_sphere' M1 M2" "2 * (cmod (m1 - m2)) / sqrt ((1 + (cmod m1)\<^sup>2) * (1 + (cmod m2)\<^sup>2))"] + using \(1 + (cmod m1)\<^sup>2) * (1 + (cmod m2)\<^sup>2) > 0\ \(1 + (cmod m1)\<^sup>2) > 0\ \(1 + (cmod m2)\<^sup>2) > 0\ + apply (auto simp add: power2_eq_square real_sqrt_mult[symmetric]) + using dist_riemann_sphere_ge_0[of M1 M2] ** + using ++ divide_le_0_iff by force +qed + + +lemma dist_stereographic_infinite: + assumes "stereographic M1 = \\<^sub>h" and "stereographic M2 = of_complex m2" + shows "dist_riemann_sphere' M1 M2 = 2 / sqrt (1 + (cmod m2)\<^sup>2)" +proof- + have *: "M1 = inv_stereographic \\<^sub>h" "M2 = inv_stereographic (of_complex m2)" + using inv_stereographic_is_inv assms + by (metis inv_stereographic_stereographic)+ + have "(1 + (cmod m2)\<^sup>2) \ 0" + by (smt power2_less_0) + have "(1 + (cmod m2)\<^sup>2) > 0" + by (smt realpow_square_minus_le)+ + hence "sqrt (1 + cmod m2 * cmod m2) > 0" + using real_sqrt_gt_0_iff + by (simp add: power2_eq_square) + hence **: "2 / sqrt (1 + cmod m2 * cmod m2) > 0" + by simp + + have "(dist_riemann_sphere' M1 M2)\<^sup>2 * (1 + (cmod m2)\<^sup>2) = 4" + using * + apply transfer + apply transfer + proof- + fix M1 M2 m2 + assume us: "M1 \ unit_sphere" "M2 \ unit_sphere" and + *: "M1 = inv_stereographic_cvec_r3 \\<^sub>v" "M2 = inv_stereographic_cvec_r3 (of_complex_cvec m2)" + have "(1 + (cmod m2)\<^sup>2) \ 0" + by (smt power2_less_0) + thus "(dist_riemann_sphere_r3 M1 M2)\<^sup>2 * (1 + (cmod m2)\<^sup>2) = 4" + apply (subst dist_riemann_sphere_r3_inner[OF us]) + apply (subst *)+ + apply (simp add: complex_mult_cnj_cmod) + apply (subst left_diff_distrib[of 2], simp) + done + qed + hence "(dist_riemann_sphere' M1 M2)\<^sup>2 = 4 / (1 + (cmod m2)\<^sup>2)" + using \(1 + (cmod m2)\<^sup>2) \ 0\ + by (simp add: field_simps) + thus "dist_riemann_sphere' M1 M2 = 2 / sqrt (1 + (cmod m2)\<^sup>2)" + using power2_eq_iff[of "dist_riemann_sphere' M1 M2" "2 / sqrt (1 + (cmod m2)\<^sup>2)"] + using \(1 + (cmod m2)\<^sup>2) > 0\ + apply (auto simp add: power2_eq_square real_sqrt_mult[symmetric]) + using dist_riemann_sphere_ge_0[of M1 M2] ** + by simp +qed + +lemma dist_rieman_sphere_zero [simp]: + shows "dist_riemann_sphere' M M = 0" + by transfer auto + +lemma dist_riemann_sphere_sym: + shows "dist_riemann_sphere' M1 M2 = dist_riemann_sphere' M2 M1" +proof transfer + fix M1 M2 :: R3 + obtain x1 y1 z1 x2 y2 z2 where MM: "(x1, y1, z1) = M1" "(x2, y2, z2) = M2" + by (cases "M1", cases "M2", auto) + show "dist_riemann_sphere_r3 M1 M2 = dist_riemann_sphere_r3 M2 M1" + using norm_minus_cancel[of "(x1 - x2, y1 - y2, z1 - z2)"] MM[symmetric] + by simp +qed + +text \Central theorem that connects the two metrics.\ +lemma dist_stereographic: + shows "dist_riemann_sphere' M1 M2 = dist_fs (stereographic M1) (stereographic M2)" +proof (cases "M1 = North") + case True + hence "stereographic M1 = \\<^sub>h" + by (simp add: stereographic_North) + show ?thesis + proof (cases "M2 = North") + case True + show ?thesis + using \M1 = North\ \M2 = North\ + by auto + next + case False + hence "stereographic M2 \ \\<^sub>h" + using stereographic_North[of M2] + by simp + then obtain m2 where "stereographic M2 = of_complex m2" + using inf_or_of_complex[of "stereographic M2"] + by auto + show ?thesis + using \stereographic M2 = of_complex m2\ \stereographic M1 = \\<^sub>h\ + using dist_fs_infinite1 dist_stereographic_infinite + by (simp add: dist_fs_sym) + qed +next + case False + hence "stereographic M1 \ \\<^sub>h" + by (simp add: stereographic_North) + then obtain m1 where "stereographic M1 = of_complex m1" + using inf_or_of_complex[of "stereographic M1"] + by auto + show ?thesis + proof (cases "M2 = North") + case True + hence "stereographic M2 = \\<^sub>h" + by (simp add: stereographic_North) + show ?thesis + using \stereographic M1 = of_complex m1\ \stereographic M2 = \\<^sub>h\ + using dist_fs_infinite2 dist_stereographic_infinite + by (subst dist_riemann_sphere_sym, simp add: dist_fs_sym) + next + case False + hence "stereographic M2 \ \\<^sub>h" + by (simp add: stereographic_North) + then obtain m2 where "stereographic M2 = of_complex m2" + using inf_or_of_complex[of "stereographic M2"] + by auto + show ?thesis + using \stereographic M1 = of_complex m1\ \stereographic M2 = of_complex m2\ + using dist_fs_finite dist_stereographic_finite + by simp + qed +qed + +text \Other direction\ +lemma dist_stereographic': + shows "dist_fs A B = dist_riemann_sphere' (inv_stereographic A) (inv_stereographic B)" + by (subst dist_stereographic) (metis stereographic_inv_stereographic) + +text \The @{term riemann_sphere} equipped with @{term dist_riemann_sphere'} is a metric space, i.e., +an instantiation of the @{term metric_space} locale.\ + +instantiation riemann_sphere :: metric_space +begin +definition "dist_riemann_sphere = dist_riemann_sphere'" +definition "(uniformity_riemann_sphere :: (riemann_sphere \ riemann_sphere) filter) = (INF e:{0<..}. principal {(x, y). dist_class.dist x y < e})" +definition "open_riemann_sphere (U :: riemann_sphere set) = (\ x \ U. eventually (\(x', y). x' = x \ y \ U) uniformity)" +instance +proof + fix x y :: riemann_sphere + show "(dist_class.dist x y = 0) = (x = y)" + unfolding dist_riemann_sphere_def + proof transfer + fix x y :: R3 + obtain x1 y1 z1 x2 y2 z2 where *: "(x1, y1, z1) = x" "(x2, y2, z2) = y" + by (cases x, cases y, auto) + assume "x \ unit_sphere" "y \ unit_sphere" + thus "(dist_riemann_sphere_r3 x y = 0) = (x = y)" + using norm_eq_zero[of "(x1 - y2, y1 - y2, z1 - z2)"] using *[symmetric] + by (simp add: zero_prod_def) + qed +next + fix x y z :: riemann_sphere + show "dist_class.dist x y \ dist_class.dist x z + dist_class.dist y z" + unfolding dist_riemann_sphere_def + proof transfer + fix x y z :: R3 + obtain x1 y1 z1 x2 y2 z2 x3 y3 z3 where MM: "(x1, y1, z1) = x" "(x2, y2, z2) = y" "(x3, y3, z3) = z" + by (cases "x", cases "y", cases "z", auto) + + assume "x \ unit_sphere" "y \ unit_sphere" "z \ unit_sphere" + thus "dist_riemann_sphere_r3 x y \ dist_riemann_sphere_r3 x z + dist_riemann_sphere_r3 y z" + using MM[symmetric] norm_minus_cancel[of "(x3 - x2, y3 - y2, z3 - z2)"] norm_triangle_ineq[of "(x1 - x3, y1 - y3, z1 - z3)" "(x3 - x2, y3 - y2, z3 - z2)"] + by simp + qed +qed (simp_all add: uniformity_riemann_sphere_def open_riemann_sphere_def) +end + +text \The @{term riemann_sphere} metric space is perfect, i.e., it does not have isolated points.\ +instantiation riemann_sphere :: perfect_space +begin +instance proof + fix M :: riemann_sphere + show "\ open {M}" + unfolding open_dist dist_riemann_sphere_def + apply (subst dist_riemann_sphere_sym) + proof transfer + fix M + assume "M \ unit_sphere" + obtain x y z where MM: "M = (x, y, z)" + by (cases "M") auto + then obtain \ \ where *: "x = cos \ * cos \" "y = cos \ * sin \" "z = sin \" "-pi / 2 \ \ \ \ \ pi / 2" + using \M \ unit_sphere\ + using ex_sphere_params[of x y z] + by auto + have "\ e. e > 0 \ (\y. y \ unit_sphere \ dist_riemann_sphere_r3 M y < e \ y \ M)" + proof- + fix e :: real + assume "e > 0" + then obtain \' where "1 - (e*e/2) < cos (\ - \')" "\ \ \'" "-pi/2 \ \'" "\' \ pi/2" + using ex_cos_gt[of \ "1 - (e*e/2)"] \- pi / 2 \ \ \ \ \ pi / 2\ + by auto + hence "sin \ \ sin \'" + using \-pi / 2 \ \ \ \ \ pi / 2\ sin_inj[of \ \'] + by auto + + have "2 - 2 * cos (\ - \') < e*e" + using mult_strict_right_mono[OF \1 - (e*e/2) < cos (\ - \')\, of 2] + by (simp add: field_simps) + have "2 - 2 * cos (\ - \') \ 0" + using cos_le_one[of "\ - \'"] + by (simp add: sign_simps) + let ?M' = "(cos \' * cos \, cos \' * sin \, sin \')" + have "dist_riemann_sphere_r3 M ?M' = sqrt ((cos \ - cos \')\<^sup>2 + (sin \ - sin \')\<^sup>2)" + using MM * sphere_params_on_sphere[of _ \' \] + using sin_cos_squared_add[of \] + apply (simp add: dist_riemann_sphere'_def Abs_riemann_sphere_inverse norm_prod_def) + apply (subst left_diff_distrib[symmetric])+ + apply (subst power_mult_distrib)+ + apply (subst distrib_left[symmetric]) + apply simp + done + also have "... = sqrt (2 - 2*cos (\ - \'))" + by (simp add: power2_eq_square field_simps cos_diff) + finally + have "(dist_riemann_sphere_r3 M ?M')\<^sup>2 = 2 - 2*cos (\ - \')" + using \2 - 2 * cos (\ - \') \ 0\ + by simp + hence "(dist_riemann_sphere_r3 M ?M')\<^sup>2 < e\<^sup>2" + using \2 - 2 * cos (\ - \') < e*e\ + by (simp add: power2_eq_square) + hence "dist_riemann_sphere_r3 M ?M' < e" + apply (rule power2_less_imp_less) + using \e > 0\ + by simp + moreover + have "M \ ?M'" + using MM \sin \ \ sin \'\ * + by simp + moreover + have "?M' \ unit_sphere" + using sphere_params_on_sphere by auto + ultimately + show "\y. y \ unit_sphere \ dist_riemann_sphere_r3 M y < e \ y \ M" + unfolding dist_riemann_sphere_def + by (rule_tac x="?M'" in exI, simp) + qed + thus "\ (\x\{M}. \e>0. \y\{x. x \ unit_sphere}. dist_riemann_sphere_r3 x y < e \ y \ {M})" + by auto + qed +qed +end + +text \The @{term complex_homo} metric space is perfect, i.e., it does not have isolated points.\ +instantiation complex_homo :: perfect_space +begin +instance proof + fix x::complex_homo + show "\ open {x}" + unfolding open_dist + proof (auto) + fix e::real + assume "e > 0" + thus "\ y. dist_class.dist y x < e \ y \ x" + using not_open_singleton[of "inv_stereographic x"] + unfolding open_dist + unfolding dist_complex_homo_def dist_riemann_sphere_def + apply (subst dist_stereographic', auto) + apply (erule_tac x=e in allE, auto) + apply (rule_tac x="stereographic y" in exI, auto) + done + qed +qed + +end + +lemma Lim_within: + shows "(f \ l) (at a within S) \ + (\e >0. \d>0. \x \ S. 0 < dist_class.dist x a \ dist_class.dist x a < d \ dist_class.dist (f x) l < e)" + by (auto simp: tendsto_iff eventually_at) + +lemma continuous_on_iff: + shows "continuous_on s f \ + (\x\s. \e>0. \d>0. \x'\s. dist_class.dist x' x < d \ dist_class.dist (f x') (f x) < e)" + unfolding continuous_on_def Lim_within + by (metis dist_pos_lt dist_self) + +text \Using the chordal metric in the extended plane, and the Euclidean metric on the sphere in +$\mathbb{R}^3$, the stereographic and inverse stereographic projections are proved to be +continuous.\ + +lemma "continuous_on UNIV stereographic" +unfolding continuous_on_iff +unfolding dist_complex_homo_def dist_riemann_sphere_def +by (subst dist_stereographic', auto) + +lemma "continuous_on UNIV inv_stereographic" +unfolding continuous_on_iff +unfolding dist_complex_homo_def dist_riemann_sphere_def +by (subst dist_stereographic, auto) + +(* -------------------------------------------------------------------------- *) +subsubsection \Chordal circles\ +(* -------------------------------------------------------------------------- *) + +text \Real circlines are sets of points that are equidistant from some given point in the chordal +metric. There are exactly two such points (two chordal centers). On the Riemann sphere, these two +points are obtained as intersections of the sphere and a line that goes trough center of the circle, +and its orthogonal to its plane.\ + +text \The circline for the given chordal center and radius.\ +definition chordal_circle_cvec_cmat :: "complex_vec \ real \ complex_mat" where + [simp]: "chordal_circle_cvec_cmat a r = + (let (a1, a2) = a + in ((4*a2*cnj a2 - (cor r)\<^sup>2*(a1*cnj a1 + a2*cnj a2)), (-4*a1*cnj a2), (-4*cnj a1*a2), (4*a1*cnj a1 - (cor r)\<^sup>2*(a1*cnj a1 + a2*cnj a2))))" + +lemma chordal_circle_cmat_hermitean_nonzero [simp]: + assumes "a \ vec_zero" + shows "chordal_circle_cvec_cmat a r \ hermitean_nonzero" + using assms + by (cases a) (auto simp add: hermitean_def mat_adj_def mat_cnj_def Let_def) + +lift_definition chordal_circle_hcoords_clmat :: "complex_homo_coords \ real \ circline_mat" is chordal_circle_cvec_cmat + using chordal_circle_cmat_hermitean_nonzero + by (simp del: chordal_circle_cvec_cmat_def) + +lift_definition chordal_circle :: "complex_homo \ real \ circline" is chordal_circle_hcoords_clmat +proof transfer + fix a b :: complex_vec and r :: real + assume *: "a \ vec_zero" "b \ vec_zero" + obtain a1 a2 where aa: "a = (a1, a2)" + by (cases a, auto) + obtain b1 b2 where bb: "b = (b1, b2)" + by (cases b, auto) + assume "a \\<^sub>v b" + then obtain k where "b = (k * a1, k * a2)" "k \ 0" + using aa bb + by auto + moreover + have "cor (Re (k * cnj k)) = k * cnj k" + by (metis complex_In_mult_cnj_zero complex_of_real_Re) + ultimately + show "circline_eq_cmat (chordal_circle_cvec_cmat a r) (chordal_circle_cvec_cmat b r)" + using * aa bb + by simp (rule_tac x="Re (k*cnj k)" in exI, auto simp add: Let_def field_simps) +qed + +lemma sqrt_1_plus_square: + shows "sqrt (1 + a\<^sup>2) \ 0" + by (smt real_sqrt_less_mono real_sqrt_zero realpow_square_minus_le) + +lemma + assumes "dist_fs z a = r" + shows "z \ circline_set (chordal_circle a r)" +proof (cases "a \ \\<^sub>h") + case True + then obtain a' where "a = of_complex a'" + using inf_or_of_complex + by auto + let ?A = "4 - (cor r)\<^sup>2 * (1 + (a'*cnj a'))" and ?B = "-4*a'" and ?C="-4*cnj a'" and ?D = "4*a'*cnj a' - (cor r)\<^sup>2 * (1 + (a'*cnj a'))" + have hh: "(?A, ?B, ?C, ?D) \ {H. hermitean H \ H \ mat_zero}" + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square) + hence *: "chordal_circle (of_complex a') r = mk_circline ?A ?B ?C ?D" + by (transfer, transfer, simp, rule_tac x=1 in exI, simp) + + show ?thesis + proof (cases "z \ \\<^sub>h") + case True + then obtain z' where "z = of_complex z'" + using inf_or_of_complex[of z] inf_or_of_complex[of a] + by auto + have "2 * cmod (z' - a') / (sqrt (1 + (cmod z')\<^sup>2) * sqrt (1 + (cmod a')\<^sup>2)) = r" + using dist_fs_finite[of z' a'] assms \z = of_complex z'\ \a = of_complex a'\ + by auto + hence "4 * (cmod (z' - a'))\<^sup>2 / ((1 + (cmod z')\<^sup>2) * (1 + (cmod a')\<^sup>2)) = r\<^sup>2 " + by (auto simp add: field_simps) + moreover + have "sqrt (1 + (cmod z')\<^sup>2) \ 0" "sqrt (1 + (cmod a')\<^sup>2) \ 0" + using sqrt_1_plus_square + by simp+ + hence "(1 + (cmod z')\<^sup>2) * (1 + (cmod a')\<^sup>2) \ 0" + by simp + ultimately + have "4 * (cmod (z' - a'))\<^sup>2 = r\<^sup>2 * ((1 + (cmod z')\<^sup>2) * (1 + (cmod a')\<^sup>2))" + by (simp add: field_simps) + hence "4 * Re ((z' - a')*cnj (z' - a')) = r\<^sup>2 * (1 + Re (z'*cnj z')) * (1 + Re (a'*cnj a'))" + by ((subst cmod_square[symmetric])+, simp) + hence "4 * (Re(z'*cnj z') - Re(a'*cnj z') - Re(cnj a'*z') + Re(a'*cnj a')) = r\<^sup>2 * (1 + Re (z'*cnj z')) * (1 + Re (a'*cnj a'))" + by (simp add: field_simps) + hence "Re (?A * z' * cnj z' + ?B * cnj z' + ?C * z' + ?D) = 0" + by (simp add: power2_eq_square field_simps) + hence "?A * z' * cnj z' + ?B * cnj z' + ?C * z' + ?D = 0" + by (subst complex_eq_if_Re_eq) (auto simp add: power2_eq_square) + hence "(cnj z' * ?A + ?C) * z' + (cnj z' * ?B + ?D) = 0" + by algebra + hence "z \ circline_set (mk_circline ?A ?B ?C ?D)" + using \z = of_complex z'\ hh + unfolding circline_set_def + by simp (transfer, transfer, simp add: vec_cnj_def) + thus ?thesis + using * + by (subst \a = of_complex a'\) simp + next + case False + hence "2 / sqrt (1 + (cmod a')\<^sup>2) = r" + using assms \a = of_complex a'\ + using dist_fs_infinite2[of a'] + by simp + moreover + have "sqrt (1 + (cmod a')\<^sup>2) \ 0" + using sqrt_1_plus_square + by simp + ultimately + have "2 = r * sqrt (1 + (cmod a')\<^sup>2)" + by (simp add: field_simps) + hence "4 = (r * sqrt (1 + (cmod a')\<^sup>2))\<^sup>2" + by simp + hence "4 = r\<^sup>2 * (1 + (cmod a')\<^sup>2)" + by (simp add: power_mult_distrib) + hence "Re (4 - (cor r)\<^sup>2 * (1 + (a' * cnj a'))) = 0" + by (subst (asm) cmod_square) (simp add: field_simps power2_eq_square) + hence "4 - (cor r)\<^sup>2 * (1 + (a'*cnj a')) = 0" + by (subst complex_eq_if_Re_eq) (auto simp add: power2_eq_square) + hence "circline_A0 (mk_circline ?A ?B ?C ?D)" + using hh + by (simp, transfer, transfer, simp) + hence "z \ circline_set (mk_circline ?A ?B ?C ?D)" + using inf_in_circline_set[of "mk_circline ?A ?B ?C ?D"] + using \\ z \ \\<^sub>h\ + by simp + thus ?thesis + using * + by (subst \a = of_complex a'\) simp + qed +next + case False + let ?A = "-(cor r)\<^sup>2" and ?B = "0" and ?C = "0" and ?D = "4 -(cor r)\<^sup>2" + have hh: "(?A, ?B, ?C, ?D) \ {H. hermitean H \ H \ mat_zero}" + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square) + hence *: "chordal_circle a r = mk_circline ?A ?B ?C ?D" + using \\ a \ \\<^sub>h\ + by simp (transfer, transfer, simp, rule_tac x=1 in exI, simp) + + show ?thesis + proof (cases "z = \\<^sub>h") + case True + show ?thesis + using assms \z = \\<^sub>h\ \\ a \ \\<^sub>h\ + using * hh + by (simp, subst inf_in_circline_set, transfer, transfer, simp) + next + case False + then obtain z' where "z = of_complex z'" + using inf_or_of_complex[of z] + by auto + have "2 / sqrt (1 + (cmod z')\<^sup>2) = r" + using assms \z = of_complex z'\\\ a \ \\<^sub>h\ + using dist_fs_infinite2[of z'] + by (simp add: dist_fs_sym) + moreover + have "sqrt (1 + (cmod z')\<^sup>2) \ 0" + using sqrt_1_plus_square + by simp + ultimately + have "2 = r * sqrt (1 + (cmod z')\<^sup>2)" + by (simp add: field_simps) + hence "4 = (r * sqrt (1 + (cmod z')\<^sup>2))\<^sup>2" + by simp + hence "4 = r\<^sup>2 * (1 + (cmod z')\<^sup>2)" + by (simp add: power_mult_distrib) + hence "Re (4 - (cor r)\<^sup>2 * (1 + (z' * cnj z'))) = 0" + by (subst (asm) cmod_square) (simp add: field_simps power2_eq_square) + hence "- (cor r)\<^sup>2 * z'*cnj z' + 4 - (cor r)\<^sup>2 = 0" + by (subst complex_eq_if_Re_eq) (auto simp add: power2_eq_square field_simps) + hence "z \ circline_set (mk_circline ?A ?B ?C ?D)" + using hh + unfolding circline_set_def + by (subst \z = of_complex z'\, simp) (transfer, transfer, auto simp add: vec_cnj_def field_simps) + thus ?thesis + using * + by simp + qed +qed + +lemma + assumes "z \ circline_set (chordal_circle a r)" and "r \ 0" + shows "dist_fs z a = r" +proof (cases "a = \\<^sub>h") + case False + then obtain a' where "a = of_complex a'" + using inf_or_of_complex + by auto + + let ?A = "4 - (cor r)\<^sup>2 * (1 + (a'*cnj a'))" and ?B = "-4*a'" and ?C="-4*cnj a'" and ?D = "4*a'*cnj a' - (cor r)\<^sup>2 * (1 + (a'*cnj a'))" + have hh: "(?A, ?B, ?C, ?D) \ {H. hermitean H \ H \ mat_zero}" + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square) + hence *: "chordal_circle (of_complex a') r = mk_circline ?A ?B ?C ?D" + by (transfer, transfer, simp, rule_tac x=1 in exI, simp) + + show ?thesis + proof (cases "z = \\<^sub>h") + case False + then obtain z' where "z = of_complex z'" + using inf_or_of_complex[of z] inf_or_of_complex[of a] + by auto + hence "z \ circline_set (mk_circline ?A ?B ?C ?D)" + using assms \a = of_complex a'\ * + by simp + hence "(cnj z' * ?A + ?C) * z' + (cnj z' * ?B + ?D) = 0" + using hh + unfolding circline_set_def + by (subst (asm) \z = of_complex z'\, simp) (transfer, transfer, simp add: vec_cnj_def) + hence "?A * z' * cnj z' + ?B * cnj z' + ?C * z' + ?D = 0" + by algebra + hence "Re (?A * z' * cnj z' + ?B * cnj z' +?C * z' +?D) = 0" + by (simp add: power2_eq_square field_simps) + hence "4 * Re ((z' - a')*cnj (z' - a')) = r\<^sup>2 * (1 + Re (z'*cnj z')) * (1 + Re (a'*cnj a'))" + by (simp add: field_simps power2_eq_square) + hence "4 * (cmod (z' - a'))\<^sup>2 = r\<^sup>2 * ((1 + (cmod z')\<^sup>2) * (1 + (cmod a')\<^sup>2))" + by (subst cmod_square)+ simp + moreover + have "sqrt (1 + (cmod z')\<^sup>2) \ 0" "sqrt (1 + (cmod a')\<^sup>2) \ 0" + using sqrt_1_plus_square + by simp+ + hence "(1 + (cmod z')\<^sup>2) * (1 + (cmod a')\<^sup>2) \ 0" + by simp + ultimately + have "4 * (cmod (z' - a'))\<^sup>2 / ((1 + (cmod z')\<^sup>2) * (1 + (cmod a')\<^sup>2)) = r\<^sup>2 " + by (simp add: field_simps) + hence "2 * cmod (z' - a') / (sqrt (1 + (cmod z')\<^sup>2) * sqrt (1 + (cmod a')\<^sup>2)) = r" + using \r \ 0\ + by (subst (asm) real_sqrt_eq_iff[symmetric]) (simp add: real_sqrt_mult real_sqrt_divide) + thus ?thesis + using \z = of_complex z'\ \a = of_complex a'\ + using dist_fs_finite[of z' a'] + by simp + next + case True + have "z \ circline_set (mk_circline ?A ?B ?C ?D)" + using assms \a = of_complex a'\ * + by simp + hence "circline_A0 (mk_circline ?A ?B ?C ?D)" + using inf_in_circline_set[of "mk_circline ?A ?B ?C ?D"] + using \z = \\<^sub>h\ + by simp + hence "4 - (cor r)\<^sup>2 * (1 + (a'*cnj a')) = 0" + using hh + by (transfer, transfer, simp) + hence "Re (4 - (cor r)\<^sup>2 * (1 + (a' * cnj a'))) = 0" + by simp + hence "4 = r\<^sup>2 * (1 + (cmod a')\<^sup>2)" + by (subst cmod_square) (simp add: power2_eq_square) + hence "2 = r * sqrt (1 + (cmod a')\<^sup>2)" + using \r \ 0\ + by (subst (asm) real_sqrt_eq_iff[symmetric]) (simp add: real_sqrt_mult) + moreover + have "sqrt (1 + (cmod a')\<^sup>2) \ 0" + using sqrt_1_plus_square + by simp + ultimately + have "2 / sqrt (1 + (cmod a')\<^sup>2) = r" + by (simp add: field_simps) + thus ?thesis + using \a = of_complex a'\ \z = \\<^sub>h\ + using dist_fs_infinite2[of a'] + by simp + qed +next + case True + let ?A = "-(cor r)\<^sup>2" and ?B = "0" and ?C = "0" and ?D = "4 -(cor r)\<^sup>2" + have hh: "(?A, ?B, ?C, ?D) \ {H. hermitean H \ H \ mat_zero}" + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square) + hence *: "chordal_circle a r = mk_circline ?A ?B ?C ?D" + using \a = \\<^sub>h\ + by simp (transfer, transfer, simp, rule_tac x=1 in exI, simp) + + show ?thesis + proof (cases "z = \\<^sub>h") + case True + thus ?thesis + using \a = \\<^sub>h\ assms * hh + by simp (subst (asm) inf_in_circline_set, transfer, transfer, simp) + next + case False + then obtain z' where "z = of_complex z'" + using inf_or_of_complex + by auto + hence "z \ circline_set (mk_circline ?A ?B ?C ?D)" + using assms * + by simp + hence "- (cor r)\<^sup>2 * z'*cnj z' + 4 - (cor r)\<^sup>2 = 0" + using hh + unfolding circline_set_def + apply (subst (asm) \z = of_complex z'\) + by (simp, transfer, transfer, simp add: vec_cnj_def, algebra) + hence "4 - (cor r)\<^sup>2 * (1 + (z'*cnj z')) = 0" + by (simp add: field_simps) + hence "Re (4 - (cor r)\<^sup>2 * (1 + (z' * cnj z'))) = 0" + by simp + hence "4 = r\<^sup>2 * (1 + (cmod z')\<^sup>2)" + by (subst cmod_square) (simp add: power2_eq_square) + hence "2 = r * sqrt (1 + (cmod z')\<^sup>2)" + using \r \ 0\ + by (subst (asm) real_sqrt_eq_iff[symmetric]) (simp add: real_sqrt_mult) + moreover + have "sqrt (1 + (cmod z')\<^sup>2) \ 0" + using sqrt_1_plus_square + by simp + ultimately + have "2 / sqrt (1 + (cmod z')\<^sup>2) = r" + by (simp add: field_simps) + thus ?thesis + using \z = of_complex z'\ \a = \\<^sub>h\ + using dist_fs_infinite2[of z'] + by (simp add: dist_fs_sym) + qed +qed + +text \Two chordal centers and radii for the given circline\ +definition chordal_circles_cmat :: "complex_mat \ (complex \ real) \ (complex \ real)" where + [simp]: "chordal_circles_cmat H = + (let (A, B, C, D) = H; + dsc = sqrt(Re ((D-A)\<^sup>2 + 4 * (B*cnj B))); + a1 = (A - D + cor dsc) / (2 * C); + r1 = sqrt((4 - Re((-4 * a1/B) * A)) / (1 + Re (a1*cnj a1))); + a2 = (A - D - cor dsc) / (2 * C); + r2 = sqrt((4 - Re((-4 * a2/B) * A)) / (1 + Re (a2*cnj a2))) + in ((a1, r1), (a2, r2)))" + +lift_definition chordal_circles_clmat :: "circline_mat \ (complex \ real) \ (complex \ real)" is chordal_circles_cmat + done + +lift_definition chordal_circles :: "ocircline \ (complex \ real) \ (complex \ real)" is chordal_circles_clmat +proof transfer + fix H1 H2 :: complex_mat + obtain A1 B1 C1 D1 where hh1: "(A1, B1, C1, D1) = H1" + by (cases H1) auto + obtain A2 B2 C2 D2 where hh2: "(A2, B2, C2, D2) = H2" + by (cases H2) auto + + assume "ocircline_eq_cmat H1 H2" + then obtain k where *: "k > 0" "A2 = cor k * A1" "B2 = cor k * B1" "C2 = cor k * C1" "D2 = cor k * D1" + using hh1[symmetric] hh2[symmetric] + by auto + let ?dsc1 = "sqrt (Re ((D1 - A1)\<^sup>2 + 4 * (B1 * cnj B1)))" and ?dsc2 = "sqrt (Re ((D2 - A2)\<^sup>2 + 4 * (B2 * cnj B2)))" + let ?a11 = "(A1 - D1 + cor ?dsc1) / (2 * C1)" and ?a12 = "(A2 - D2 + cor ?dsc2) / (2 * C2)" + let ?a21 = "(A1 - D1 - cor ?dsc1) / (2 * C1)" and ?a22 = "(A2 - D2 - cor ?dsc2) / (2 * C2)" + let ?r11 = "sqrt((4 - Re((-4 * ?a11/B1) * A1)) / (1 + Re (?a11*cnj ?a11)))" + let ?r12 = "sqrt((4 - Re((-4 * ?a12/B2) * A2)) / (1 + Re (?a12*cnj ?a12)))" + let ?r21 = "sqrt((4 - Re((-4 * ?a21/B1) * A1)) / (1 + Re (?a21*cnj ?a21)))" + let ?r22 = "sqrt((4 - Re((-4 * ?a22/B2) * A2)) / (1 + Re (?a22*cnj ?a22)))" + + have "Re ((D2 - A2)\<^sup>2 + 4 * (B2 * cnj B2)) = k\<^sup>2 * Re ((D1 - A1)\<^sup>2 + 4 * (B1 * cnj B1))" + using * + by (simp add: power2_eq_square field_simps) + hence "?dsc2 = k * ?dsc1" + using \k > 0\ + by (simp add: real_sqrt_mult) + hence "A2 - D2 + cor ?dsc2 = cor k * (A1 - D1 + cor ?dsc1)" "A2 - D2 - cor ?dsc2 = cor k * (A1 - D1 - cor ?dsc1)" "2*C2 = cor k * (2*C1)" + using * + by (auto simp add: field_simps) + hence "?a12 = ?a11" "?a22 = ?a21" + using \k > 0\ + by simp_all + moreover + have "Re((-4 * ?a12/B2) * A2) = Re((-4 * ?a11/B1) * A1)" + using * + by (subst \?a12 = ?a11\) (simp, simp add: field_simps) + have "?r12 = ?r11" + by (subst \Re((-4 * ?a12/B2) * A2) = Re((-4 * ?a11/B1) * A1)\, (subst \?a12 = ?a11\)+) simp + moreover + have "Re((-4 * ?a22/B2) * A2) = Re((-4 * ?a21/B1) * A1)" + using * + by (subst \?a22 = ?a21\) (simp, simp add: field_simps) + have "?r22 = ?r21" + by (subst \Re((-4 * ?a22/B2) * A2) = Re((-4 * ?a21/B1) * A1)\, (subst \?a22 = ?a21\)+) simp + moreover + have "chordal_circles_cmat H1 = ((?a11, ?r11), (?a21, ?r21))" + using hh1[symmetric] + unfolding chordal_circles_cmat_def Let_def + by (simp del: times_complex.sel) + moreover + have "chordal_circles_cmat H2 = ((?a12, ?r12), (?a22, ?r22))" + using hh2[symmetric] + unfolding chordal_circles_cmat_def Let_def + by (simp del: times_complex.sel) + ultimately + show "chordal_circles_cmat H1 = chordal_circles_cmat H2" + by metis +qed + +lemma chordal_circle_radius_positive: + assumes "hermitean (A, B, C, D)" and "Re (mat_det (A, B, C, D)) \ 0" and "B \ 0" and + "dsc = sqrt(Re ((D-A)\<^sup>2 + 4 * (B*cnj B)))" and + "a1 = (A - D + cor dsc) / (2 * C)" and "a2 = (A - D - cor dsc) / (2 * C)" + shows "Re (A*a1/B) \ -1 \ Re (A*a2/B) \ -1" +proof- + from assms have "is_real A" "is_real D" "C = cnj B" + using hermitean_elems + by auto + have *: "A*a1/B = ((A - D + cor dsc) / (2 * (B * cnj B))) * A" + using \B \ 0\ \C = cnj B\ \a1 = (A - D + cor dsc) / (2 * C)\ + by (simp add: field_simps) algebra + have **: "A*a2/B = ((A - D - cor dsc) / (2 * (B * cnj B))) * A" + using \B \ 0\ \C = cnj B\ \a2 = (A - D - cor dsc) / (2 * C)\ + by (simp add: field_simps) algebra + have "dsc \ 0" + proof- + have "0 \ Re ((D - A)\<^sup>2) + 4 * Re ((cor (cmod B))\<^sup>2)" + using \is_real A\ \is_real D\ + by (subst cor_squared, subst Re_complex_of_real) (simp add: power2_eq_square) + thus ?thesis + using \dsc = sqrt(Re ((D-A)\<^sup>2 + 4*(B*cnj B)))\ + by (subst (asm) complex_mult_cnj_cmod) simp + qed + hence "Re (A - D - cor dsc) \ Re (A - D + cor dsc)" + by simp + moreover + have "Re (2 * (B * cnj B)) > 0" + using \B \ 0\ + by (subst complex_mult_cnj_cmod, simp add: power2_eq_square) + ultimately + have xxx: "Re (A - D + cor dsc) / Re (2 * (B * cnj B)) \ Re (A - D - cor dsc) / Re (2 * (B * cnj B))" (is "?lhs \ ?rhs") + by (metis divide_right_mono less_eq_real_def) + + have "Re A * Re D \ Re (B*cnj B)" + using \Re (mat_det (A, B, C, D)) \ 0\ \C = cnj B\ \is_real A\ \is_real D\ + by simp + + + have "(Re (2 * (B * cnj B)) / Re A) / Re (2 * B * cnj B) = 1 / Re A" + using \Re (2 * (B * cnj B)) > 0\ + apply (subst divide_divide_eq_left) + apply (subst mult.assoc) + apply (subst nonzero_divide_mult_cancel_right) + by simp_all + + show ?thesis + proof (cases "Re A > 0") + case True + hence "Re (A*a1/B) \ Re (A*a2/B)" + using * ** \Re (2 * (B * cnj B)) > 0\ \B \ 0\ \is_real A\ \is_real D\ xxx + using mult_right_mono[of ?rhs ?lhs "Re A"] + apply simp + apply (subst Re_divide_real, simp, simp) + apply (subst Re_divide_real, simp, simp) + apply (subst Re_mult_real, simp)+ + apply simp + done + moreover + have "Re (A*a2/B) \ -1" + proof- + from \Re A * Re D \ Re (B*cnj B)\ + have "Re (A\<^sup>2) \ Re (B*cnj B) + Re ((A - D)*A)" + using \Re A > 0\ \is_real A\ \is_real D\ + by (simp add: power2_eq_square field_simps) + have "1 \ Re (B*cnj B) / Re (A\<^sup>2) + Re (A - D) / Re A" + using \Re A > 0\ \is_real A\ \is_real D\ + using divide_right_mono[OF \Re (A\<^sup>2) \ Re (B*cnj B) + Re ((A - D)*A)\, of "Re (A\<^sup>2)"] + by (simp add: power2_eq_square add_divide_distrib) + have "4 * Re(B*cnj B) \ 4 * (Re (B*cnj B))\<^sup>2 / Re (A\<^sup>2) + 2*Re (A - D) / Re A * 2 * Re(B*cnj B)" + using mult_right_mono[OF \1 \ Re (B*cnj B) / Re (A\<^sup>2) + Re (A - D) / Re A\, of "4 * Re (B*cnj B)"] + by (simp add: distrib_right) (simp add: power2_eq_square field_simps) + moreover + have "A \ 0" + using \Re A > 0\ + by auto + hence "4 * (Re (B*cnj B))\<^sup>2 / Re (A\<^sup>2) = Re (4 * (B*cnj B)\<^sup>2 / A\<^sup>2)" + using Re_divide_real[of "A\<^sup>2" "4 * (B*cnj B)\<^sup>2"] \Re A > 0\ \is_real A\ + by (auto simp add: power2_eq_square) + moreover + have "2*Re (A - D) / Re A * 2 * Re(B*cnj B) = Re (2 * (A - D) / A * 2 * B * cnj B)" + using \is_real A\ \is_real D\ \A \ 0\ + using Re_divide_real[of "A" "(4 * A - 4 * D) * B * cnj B"] + by (simp add: field_simps) + ultimately + have "Re ((D - A)\<^sup>2 + 4 * B*cnj B) \ Re((A - D)\<^sup>2 + 4 * (B*cnj B)\<^sup>2 / A\<^sup>2 + 2*(A - D) / A * 2 * B*cnj B)" + by (simp add: field_simps power2_eq_square) + hence "Re ((D - A)\<^sup>2 + 4 * B*cnj B) \ Re(((A - D) + 2 * B*cnj B / A)\<^sup>2)" + using \A \ 0\ + by (subst power2_sum) (simp add: power2_eq_square field_simps) + hence "dsc \ sqrt (Re(((A - D) + 2 * B*cnj B / A)\<^sup>2))" + using \dsc = sqrt(Re ((D-A)\<^sup>2 + 4*(B*cnj B)))\ + by simp + moreover + have "Re(((A - D) + 2 * B*cnj B / A)\<^sup>2) = (Re((A - D) + 2 * B*cnj B / A))\<^sup>2" + using \is_real A\ \is_real D\ div_reals + by (simp add: power2_eq_square) + ultimately + have "dsc \ \Re (A - D + 2 * B * cnj B / A)\" + by simp + moreover + have "Re (A - D + 2 * B * cnj B / A) \ 0" + proof- + have *: "Re (A\<^sup>2 + B*cnj B) \ 0" + using \is_real A\ + by (simp add: power2_eq_square) + also have "Re (A\<^sup>2 + 2*B*cnj B - A*D) \ Re (A\<^sup>2 + B*cnj B)" + using \Re A * Re D \ Re (B*cnj B)\ + using \is_real A\ \is_real D\ + by simp + finally + have "Re (A\<^sup>2 + 2*B*cnj B - A*D) \ 0" + by simp + show ?thesis + using divide_right_mono[OF \Re (A\<^sup>2 + 2*B*cnj B - A*D) \ 0\, of "Re A"] \Re A > 0\ \is_real A\ \A \ 0\ + by (simp add: add_divide_distrib diff_divide_distrib) (subst Re_divide_real, auto simp add: power2_eq_square field_simps) + qed + ultimately + have "dsc \ Re (A - D + 2 * B * cnj B / A)" + by simp + hence "- Re (2 * (B * cnj B) / A) \ Re ((A - D - cor dsc))" + by (simp add: field_simps) + hence *: "- (Re (2 * (B * cnj B)) / Re A) \ Re (A - D - cor dsc)" + using \is_real A\ \A \ 0\ + by (subst (asm) Re_divide_real, auto) + from divide_right_mono[OF this, of "Re (2 * B * cnj B)"] + have "- 1 / Re A \ Re (A - D - cor dsc) / Re (2 * B * cnj B)" + using \Re A > 0\ \B \ 0\ \A \ 0\ \0 < Re (2 * (B * cnj B))\ + using \(Re (2 * (B * cnj B)) / Re A) / Re (2 * B * cnj B) = 1 / Re A\ + by simp + from mult_right_mono[OF this, of "Re A"] + show ?thesis + using \is_real A\ \is_real D\ \B \ 0\ \Re A > 0\ \A \ 0\ + apply (subst **) + apply (subst Re_mult_real, simp) + apply (subst Re_divide_real, simp, simp) + apply (simp add: field_simps) + done + qed + ultimately + show ?thesis + by simp + next + case False + show ?thesis + proof (cases "Re A < 0") + case True + hence "Re (A*a1/B) \ Re (A*a2/B)" + using * ** \Re (2 * (B * cnj B)) > 0\ \B \ 0\ \is_real A\ \is_real D\ xxx + using mult_right_mono_neg[of ?rhs ?lhs "Re A"] + apply simp + apply (subst Re_divide_real, simp, simp) + apply (subst Re_divide_real, simp, simp) + apply (subst Re_mult_real, simp)+ + apply simp + done + moreover + have "Re (A*a1/B) \ -1" + proof- + from \Re A * Re D \ Re (B*cnj B)\ + have "Re (A\<^sup>2) \ Re (B*cnj B) - Re ((D - A)*A)" + using \Re A < 0\ \is_real A\ \is_real D\ + by (simp add: power2_eq_square field_simps) + hence "1 \ Re (B*cnj B) / Re (A\<^sup>2) - Re (D - A) / Re A" + using \Re A < 0\ \is_real A\ \is_real D\ + using divide_right_mono[OF \Re (A\<^sup>2) \ Re (B*cnj B) - Re ((D - A)*A)\, of "Re (A\<^sup>2)"] + by (simp add: power2_eq_square diff_divide_distrib) + have "4 * Re(B*cnj B) \ 4 * (Re (B*cnj B))\<^sup>2 / Re (A\<^sup>2) - 2*Re (D - A) / Re A * 2 * Re(B*cnj B)" + using mult_right_mono[OF \1 \ Re (B*cnj B) / Re (A\<^sup>2) - Re (D - A) / Re A\, of "4 * Re (B*cnj B)"] + by (simp add: left_diff_distrib) (simp add: power2_eq_square field_simps) + moreover + have "A \ 0" + using \Re A < 0\ + by auto + hence "4 * (Re (B*cnj B))\<^sup>2 / Re (A\<^sup>2) = Re (4 * (B*cnj B)\<^sup>2 / A\<^sup>2)" + using Re_divide_real[of "A\<^sup>2" "4 * (B*cnj B)\<^sup>2"] \Re A < 0\ \is_real A\ + by (auto simp add: power2_eq_square) + moreover + have "2*Re (D - A) / Re A * 2 * Re(B*cnj B) = Re (2 * (D - A) / A * 2 * B * cnj B)" + using \is_real A\ \is_real D\ \A \ 0\ + using Re_divide_real[of "A" "(4 * D - 4 * A) * B * cnj B"] + by (simp add: field_simps) + ultimately + have "Re ((D - A)\<^sup>2 + 4 * B*cnj B) \ Re((D - A)\<^sup>2 + 4 * (B*cnj B)\<^sup>2 / A\<^sup>2 - 2*(D - A) / A * 2 * B*cnj B)" + by (simp add: field_simps power2_eq_square) + hence "Re ((D - A)\<^sup>2 + 4 * B*cnj B) \ Re(((D - A) - 2 * B*cnj B / A)\<^sup>2)" + using \A \ 0\ + by (subst power2_diff) (simp add: power2_eq_square field_simps) + hence "dsc \ sqrt (Re(((D - A) - 2 * B*cnj B / A)\<^sup>2))" + using \dsc = sqrt(Re ((D-A)\<^sup>2 + 4*(B*cnj B)))\ + by simp + moreover + have "Re(((D - A) - 2 * B*cnj B / A)\<^sup>2) = (Re((D - A) - 2 * B*cnj B / A))\<^sup>2" + using \is_real A\ \is_real D\ div_reals + by (simp add: power2_eq_square) + ultimately + have "dsc \ \Re (D - A - 2 * B * cnj B / A)\" + by simp + moreover + have "Re (D - A - 2 * B * cnj B / A) \ 0" + proof- + have "Re (A\<^sup>2 + B*cnj B) \ 0" + using \is_real A\ + by (simp add: power2_eq_square) + also have "Re (A\<^sup>2 + 2*B*cnj B - A*D) \ Re (A\<^sup>2 + B*cnj B)" + using \Re A * Re D \ Re (B*cnj B)\ + using \is_real A\ \is_real D\ + by simp + finally have "Re (A\<^sup>2 + 2*B*cnj B - A*D) \ 0" + by simp + show ?thesis + using divide_right_mono_neg[OF \Re (A\<^sup>2 + 2*B*cnj B - A*D) \ 0\, of "Re A"] \Re A < 0\ \is_real A\ \A \ 0\ + by (simp add: add_divide_distrib diff_divide_distrib) (subst Re_divide_real, auto simp add: power2_eq_square field_simps) + qed + ultimately + have "dsc \ Re (D - A - 2 * B * cnj B / A)" + by simp + hence "- Re (2 * (B * cnj B) / A) \ Re ((A - D + cor dsc))" + by (simp add: field_simps) + hence "- (Re (2 * (B * cnj B)) / Re A) \ Re (A - D + cor dsc)" + using \is_real A\ \A \ 0\ + by (subst (asm) Re_divide_real, auto) + from divide_right_mono[OF this, of "Re (2 * B * cnj B)"] + have "- 1 / Re A \ Re (A - D + cor dsc) / Re (2 * B * cnj B)" + using \Re A < 0\ \B \ 0\ \A \ 0\ \0 < Re (2 * (B * cnj B))\ + using \(Re (2 * (B * cnj B)) / Re A) / Re (2 * B * cnj B) = 1 / Re A\ + by simp + from mult_right_mono_neg[OF this, of "Re A"] + show ?thesis + using \is_real A\ \is_real D\ \B \ 0\ \Re A < 0\ \A \ 0\ + apply (subst *) + apply (subst Re_mult_real, simp) + apply (subst Re_divide_real, simp, simp) + apply (simp add: field_simps) + done + qed + ultimately + show ?thesis + by simp + next + case False + hence "A = 0" + using \\ Re A > 0\ \is_real A\ + using complex_eq_if_Re_eq by auto + thus ?thesis + by simp + qed + qed +qed + + +lemma chordal_circle_det_positive: + fixes x y :: real + assumes "x * y < 0" + shows "x / (x - y) > 0" +proof (cases "x > 0") + case True + hence "y < 0" + using \x * y < 0\ + by (smt mult_nonneg_nonneg) + have "x - y > 0" + using \x > 0\ \y < 0\ + by auto + thus ?thesis + using \x > 0\ + by (metis zero_less_divide_iff) +next + case False + hence *: "y > 0 \ x < 0" + using \x * y < 0\ + using mult_nonpos_nonpos[of x y] + by (cases "x=0") force+ + + have "x - y < 0" + using * + by auto + thus ?thesis + using * + by (metis zero_less_divide_iff) +qed + +lemma chordal_circle1: + assumes "is_real A" and "is_real D" and "Re (A * D) < 0" and "r = sqrt(Re ((4*A)/(A-D)))" + shows "mk_circline A 0 0 D = chordal_circle \\<^sub>h r" +using assms +proof (transfer, transfer) + fix A D r + assume *: "is_real A" "is_real D" "Re (A * D) < 0" "r = sqrt (Re ((4*A)/(A-D)))" + hence "A \ 0 \ D \ 0" + by auto + hence "(A, 0, 0, D) \ hermitean_nonzero" + using eq_cnj_iff_real[of A] eq_cnj_iff_real[of D] * + unfolding hermitean_def + by (simp add: mat_adj_def mat_cnj_def) + moreover + have "(- (cor r)\<^sup>2, 0, 0, 4 - (cor r)\<^sup>2) \ hermitean_nonzero" + by (simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square) + moreover + have "A \ D" + using \Re (A * D) < 0\ \is_real A\ \is_real D\ + by auto + have "Re ((4*A)/(A-D)) \ 0" + proof- + have "Re A / Re (A - D) \ 0" + using \Re (A * D) < 0\ \is_real A\ \is_real D\ + using chordal_circle_det_positive[of "Re A" "Re D"] + by simp + thus ?thesis + using \is_real A\ \is_real D\ \A \ D\ + by (subst Re_divide_real, auto) + qed + moreover + have "- (cor (sqrt (Re (4 * A / (A - D)))))\<^sup>2 = cor (Re (4 / (D - A))) * A" + using \Re ((4*A)/(A-D)) \ 0\ \is_real A\ \is_real D\ \A \ D\ + by (subst cor_squared, subst real_sqrt_power[symmetric], simp) (simp add: Re_divide_real Re_mult_real minus_divide_right) + moreover + have "4 * (A - D) - 4 * A = 4 * -D" + by (simp add: field_simps) + hence "4 - 4 * A / (A - D) = -4 * D / (A - D)" + using \A \ D\ + by (smt ab_semigroup_mult_class.mult_ac(1) diff_divide_eq_iff eq_iff_diff_eq_0 mult_minus1 mult_minus1_right mult_numeral_1_right right_diff_distrib_numeral times_divide_eq_right) + hence "4 - 4 * A / (A - D) = 4 * D / (D - A)" + by (metis (hide_lams, no_types) minus_diff_eq minus_divide_left minus_divide_right minus_mult_left) + hence **: "4 - (cor (sqrt (Re (4 * A / (A - D)))))\<^sup>2 = cor (Re (4 / (D - A))) * D" + using \Re ((4*A)/(A-D)) \ 0\ \is_real A\ \is_real D\ \A \ D\ + by (subst cor_squared, subst real_sqrt_power[symmetric], simp) + ultimately + show "circline_eq_cmat (mk_circline_cmat A 0 0 D) (chordal_circle_cvec_cmat \\<^sub>v r)" + using * \is_real A\ \is_real D\ \A \ D\ \r = sqrt(Re ((4*A)/(A-D)))\ + by (simp, rule_tac x="Re(4/(D-A))" in exI, auto, simp_all add: **) +qed + +lemma chordal_circle2: + assumes "is_real A" and "is_real D" and "Re (A * D) < 0" and "r = sqrt(Re ((4*D)/(D-A)))" + shows "mk_circline A 0 0 D = chordal_circle 0\<^sub>h r" +using assms +proof (transfer, transfer) + fix A D r + assume *: "is_real A" "is_real D" "Re (A * D) < 0" "r = sqrt (Re ((4*D)/(D-A)))" + hence "A \ 0 \ D \ 0" + by auto + hence "(A, 0, 0, D) \ {H. hermitean H \ H \ mat_zero}" + using eq_cnj_iff_real[of A] eq_cnj_iff_real[of D] * + unfolding hermitean_def + by (simp add: mat_adj_def mat_cnj_def) + moreover + have "(4 - (cor r)\<^sup>2, 0, 0, - (cor r)\<^sup>2) \ {H. hermitean H \ H \ mat_zero}" + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square) + moreover + have "A \ D" + using \Re (A * D) < 0\ \is_real A\ \is_real D\ + by auto + have "Re((4*D)/(D-A)) \ 0" + proof- + have "Re D / Re (D - A) \ 0" + using \Re (A * D) < 0\ \is_real A\ \is_real D\ + using chordal_circle_det_positive[of "Re D" "Re A"] + by (simp add: field_simps) + thus ?thesis + using \is_real A\ \is_real D\ \A \ D\ + by (subst Re_divide_real, auto) + qed + have "4 * (D - A) - 4 * D = 4 * -A" + by (simp add: field_simps) + hence "4 - 4 * D / (D - A) = -4 * A / (D - A)" + using \A \ D\ + by (smt ab_semigroup_mult_class.mult_ac(1) diff_divide_eq_iff eq_iff_diff_eq_0 mult_minus1 mult_minus1_right mult_numeral_1_right right_diff_distrib_numeral times_divide_eq_right) + hence "4 - 4 * D / (D - A) = 4 * A / (A - D)" + by (metis (hide_lams, no_types) minus_diff_eq minus_divide_left minus_divide_right minus_mult_left) + hence **: "4 - (cor (sqrt (Re ((4*D)/(D-A)))))\<^sup>2 = cor (Re (4 / (A - D))) * A" + using \is_real A\ \is_real D\ \A \ D\ \Re (4 * D / (D - A)) \ 0\ + by (subst cor_squared, subst real_sqrt_power[symmetric], simp) + + moreover + have "- (cor (sqrt (Re ((4*D)/(D-A)))))\<^sup>2 = cor (Re (4 / (A - D))) * D" + using \is_real A\ \is_real D\ \A \ D\ \Re ((4*D)/(D-A)) \ 0\ + by (subst cor_squared, subst real_sqrt_power[symmetric], simp) (simp add: Re_divide_real minus_divide_right) + + ultimately + show "circline_eq_cmat (mk_circline_cmat A 0 0 D) (chordal_circle_cvec_cmat 0\<^sub>v r)" + using \is_real A\ \is_real D\ \A \ 0 \ D \ 0\ \r = sqrt (Re ((4*D)/(D-A)))\ + using * + by (simp, rule_tac x="Re (4/(A-D))" in exI, auto, simp_all add: **) +qed + +lemma chordal_circle': + assumes "B \ 0" and "(A, B, C, D) \ hermitean_nonzero" and "Re (mat_det (A, B, C, D)) \ 0" and + "C * a\<^sup>2 + (D - A) * a - B = 0" and "r = sqrt((4 - Re((-4 * a/B) * A)) / (1 + Re (a*cnj a)))" + shows "mk_circline A B C D = chordal_circle (of_complex a) r" +using assms +proof (transfer, transfer) + fix A B C D a :: complex and r :: real + + let ?k = "(-4) * a / B" + + assume *: "(A, B, C, D) \ {H. hermitean H \ H \ mat_zero}" and **: "B \ 0" "C * a\<^sup>2 + (D - A) * a - B = 0" and rr: "r = sqrt ((4 - Re (?k * A)) / (1 + Re (a * cnj a)))" and det: "Re (mat_det (A, B, C, D)) \ 0" + + have "is_real A" "is_real D" "C = cnj B" + using * hermitean_elems + by auto + + from ** have a12: "let dsc = sqrt(Re ((D-A)\<^sup>2 + 4 * (B*cnj B))) + in a = (A - D + cor dsc) / (2 * C) \ a = (A - D - cor dsc) / (2 * C)" + proof- + have "Re ((D-A)\<^sup>2 + 4 * (B*cnj B)) \ 0" + using \is_real A\ \is_real D\ + by (subst complex_mult_cnj_cmod) (simp add: power2_eq_square) + hence "ccsqrt ((D - A)\<^sup>2 - 4 * C * - B) = cor (sqrt (Re ((D - A)\<^sup>2 + 4 * (B * cnj B))))" + using csqrt_real[of "((D - A)\<^sup>2 + 4 * (B * cnj B))"] \is_real A\ \is_real D\ \C = cnj B\ + by (auto simp add: power2_eq_square field_simps) + thus ?thesis + using complex_quadratic_equation_two_roots[of C a "D - A" "-B"] + using \C * a\<^sup>2 + (D - A) * a - B = 0\ \B \ 0\ \C = cnj B\ + by (simp add: Let_def) + qed + + have "is_real ?k" + using a12 \C = cnj B\ \is_real A\ \is_real D\ + by (auto simp add: Let_def) + have "a \ 0" + using ** + by auto + hence "Re ?k \ 0" + using \is_real (-4*a / B)\ \B \ 0\ + by (metis complex.expand divide_eq_0_iff divisors_zero zero_complex.simps(1) zero_complex.simps(2) zero_neq_neg_numeral) + moreover + have "(-4) * a = cor (Re ?k) * B" + using complex_of_real_Re[OF \is_real (-4*a/B)\] \B \ 0\ + by simp + moreover + have "is_real (a/B)" + using \is_real ?k\ is_real_mult_real[of "-4" "a / B"] + by simp + hence "is_real (B * cnj a)" + using * \C = cnj B\ + by (metis (no_types, lifting) Im_complex_div_eq_0 complex_cnj_divide eq_cnj_iff_real hermitean_elems(3) mem_Collect_eq mult.commute) + hence "B * cnj a = cnj B * a" + using eq_cnj_iff_real[of "B * cnj a"] + by simp + hence "-4 * cnj a = cor (Re ?k) * C" + using \C = cnj B\ + using complex_of_real_Re[OF \is_real ?k\] \B \ 0\ + by (simp, simp add: field_simps) + moreover + have "1 + a * cnj a \ 0" + by (subst complex_mult_cnj_cmod) (smt cor_add of_real_0 of_real_1 of_real_eq_iff realpow_square_minus_le) + have "r\<^sup>2 = (4 - Re (?k * A)) / (1 + Re (a * cnj a))" + proof- + have "Re (a / B * A) \ -1" + using a12 chordal_circle_radius_positive[of A B C D] * \B \ 0\ det + by (auto simp add: Let_def field_simps) + from mult_right_mono_neg[OF this, of "-4"] + have "4 - Re (?k * A) \ 0" + using Re_mult_real[of "-4" "a / B * A"] + by (simp add: field_simps) + moreover + have "1 + Re (a * cnj a) > 0" + using \a \ 0\ complex_mult_cnj complex_neq_0 + by auto + ultimately + have "(4 - Re (?k * A)) / (1 + Re (a * cnj a)) \ 0" + by (metis divide_nonneg_pos) + thus ?thesis + using rr + by simp + qed + hence "r\<^sup>2 = Re ((4 - ?k * A) / (1 + a * cnj a))" + using \is_real ?k\ \is_real A\ \1 + a * cnj a \ 0\ + by (subst Re_divide_real, auto) + hence "(cor r)\<^sup>2 = (4 - ?k * A) / (1 + a * cnj a)" + using \is_real ?k\ \is_real A\ + using mult_reals[of ?k A] + by (simp add: cor_squared) + hence "4 - (cor r)\<^sup>2 * (a * cnj a + 1) = cor (Re ?k) * A" + using complex_of_real_Re[OF \is_real (-4*a/B)\] + using \1 + a * cnj a \ 0\ + by (simp add: field_simps) + moreover + + have "?k = cnj ?k" + using \is_real ?k\ + using eq_cnj_iff_real[of "-4*a/B"] + by simp + + have "?k\<^sup>2 = cor ((cmod ?k)\<^sup>2)" + using cor_cmod_real[OF \is_real ?k\] + unfolding power2_eq_square + by (subst cor_mult) (metis minus_mult_minus) + hence "?k\<^sup>2 = ?k * cnj ?k" + using complex_mult_cnj_cmod[of ?k] + by simp + hence ***: "a * cnj a = (cor ((Re ?k)\<^sup>2) * B * C) / 16" + using complex_of_real_Re[OF \is_real (-4*a/B)\] \C = cnj B\ \is_real (-4*a/B)\ \B \ 0\ + by simp + from ** have "cor ((Re ?k)\<^sup>2) * B * C - 4 * cor (Re ?k) * (D-A) - 16 = 0" + using complex_of_real_Re[OF \is_real ?k\] + by (simp add: power2_eq_square, simp add: field_simps, algebra) + hence "?k * (D-A) = 4 * (cor ((Re ?k)\<^sup>2) * B * C / 16 - 1)" + by (subst (asm) complex_of_real_Re[OF \is_real ?k\]) algebra + hence "?k * (D-A) = 4 * (a*cnj a - 1)" + by (subst (asm) ***[symmetric]) simp + + hence "4 * a * cnj a - (cor r)\<^sup>2 * (a * cnj a + 1) = cor (Re ?k) * D" + using \4 - (cor r)\<^sup>2 * (a * cnj a + 1) = cor (Re ?k) * A\ + using complex_of_real_Re[OF \is_real (-4*a/B)\] + by simp algebra + ultimately + show "circline_eq_cmat (mk_circline_cmat A B C D) (chordal_circle_cvec_cmat (of_complex_cvec a) r)" + using * \a \ 0\ + by (simp, rule_tac x="Re (-4*a / B)" in exI, simp) +qed + +end diff --git a/thys/Complex_Geometry/Circlines.thy b/thys/Complex_Geometry/Circlines.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Circlines.thy @@ -0,0 +1,2048 @@ +(* ---------------------------------------------------------------------------- *) +section \Circlines\ +(* ---------------------------------------------------------------------------- *) +theory Circlines + imports More_Set Moebius Hermitean_Matrices Elementary_Complex_Geometry +begin + +(* ----------------------------------------------------------------- *) +subsection \Definition of circlines\ +(* ----------------------------------------------------------------- *) + +text \In our formalization we follow the approach described by Schwerdtfeger +\cite{schwerdtfeger} and represent circlines by Hermitean, non-zero +$2\times 2$ matrices. In the original formulation, a matrix +$\left(\begin{array}{cc}A & B\\C & D\end{array}\right)$ corresponds to +the equation $A\cdot z\cdot \overline{z} + B\cdot \overline{z} + C\cdot z + D = 0$, +where $C = \overline{B}$ and $A$ and $D$ are real (as the matrix is +Hermitean).\ + +abbreviation hermitean_nonzero where + "hermitean_nonzero \ {H. hermitean H \ H \ mat_zero}" + +typedef circline_mat = hermitean_nonzero +by (rule_tac x="eye" in exI) (auto simp add: hermitean_def mat_adj_def mat_cnj_def) + +setup_lifting type_definition_circline_mat + + +definition circline_eq_cmat :: "complex_mat \ complex_mat \ bool" where + [simp]: "circline_eq_cmat A B \ (\ k::real. k \ 0 \ B = cor k *\<^sub>s\<^sub>m A)" + +lemma symp_circline_eq_cmat: "symp circline_eq_cmat" + unfolding symp_def +proof ((rule allI)+, rule impI) + fix x y + assume "circline_eq_cmat x y" + then obtain k where "k \ 0 \ y = cor k *\<^sub>s\<^sub>m x" + by auto + hence "1 / k \ 0 \ x = cor (1 / k) *\<^sub>s\<^sub>m y" + by auto + thus "circline_eq_cmat y x" + unfolding circline_eq_cmat_def + by blast +qed + +text\Hermitean non-zero matrices are equivalent only to such matrices\ +lemma circline_eq_cmat_hermitean_nonzero: + assumes "hermitean H \ H \ mat_zero" "circline_eq_cmat H H'" + shows "hermitean H' \ H' \ mat_zero" + using assms + by (metis circline_eq_cmat_def hermitean_mult_real nonzero_mult_real of_real_eq_0_iff) + + +lift_definition circline_eq_clmat :: "circline_mat \ circline_mat \ bool" is circline_eq_cmat + done + +lemma circline_eq_clmat_refl [simp]: "circline_eq_clmat H H" + by transfer (simp, rule_tac x="1" in exI, simp) + +quotient_type circline = circline_mat / circline_eq_clmat +proof (rule equivpI) + show "reflp circline_eq_clmat" + unfolding reflp_def + by transfer (auto, rule_tac x="1" in exI, simp) +next + show "symp circline_eq_clmat" + unfolding symp_def + by transfer (auto, (rule_tac x="1/k" in exI, simp)+) +next + show "transp circline_eq_clmat" + unfolding transp_def + by transfer (simp, safe, (rule_tac x="ka*k" in exI, simp)+) +qed + +text \Circline with specified matrix\ + +text \An auxiliary constructor @{term mk_circline} returns a circline (an +equivalence class) for given four complex numbers $A$, $B$, $C$ and +$D$ (provided that they form a Hermitean, non-zero matrix).\ + +definition mk_circline_cmat :: "complex \ complex \ complex \ complex \ complex_mat" where +[simp]: "mk_circline_cmat A B C D = + (let M = (A, B, C, D) + in if M \ hermitean_nonzero then + M + else + eye)" + +lift_definition mk_circline_clmat :: "complex \ complex \ complex \ complex \ circline_mat" is mk_circline_cmat + by (auto simp add: Let_def hermitean_def mat_adj_def mat_cnj_def) + +lift_definition mk_circline :: "complex \ complex \ complex \ complex \ circline" is mk_circline_clmat + done + +lemma ex_mk_circline: + shows "\ A B C D. H = mk_circline A B C D \ hermitean (A, B, C, D) \ (A, B, C, D) \ mat_zero" +proof (transfer, transfer) + fix H + assume *: "hermitean H \ H \ mat_zero" + obtain A B C D where "H = (A, B, C, D)" + by (cases " H", auto) + hence "circline_eq_cmat H (mk_circline_cmat A B C D) \ hermitean (A, B, C, D) \ (A, B, C, D) \ mat_zero" + using * + by auto + thus "\ A B C D. circline_eq_cmat H (mk_circline_cmat A B C D) \ hermitean (A, B, C, D) \ (A, B, C, D) \ mat_zero" + by blast +qed + +(* ----------------------------------------------------------------- *) +subsection \Circline type\ +(* ----------------------------------------------------------------- *) + +definition circline_type_cmat :: "complex_mat \ real" where + [simp]: "circline_type_cmat H = sgn (Re (mat_det H))" + +lift_definition circline_type_clmat :: "circline_mat \ real" is circline_type_cmat + done + +lift_definition circline_type :: "circline \ real" is circline_type_clmat + by transfer (simp, erule exE, simp add: sgn_mult) + +lemma circline_type: "circline_type H = -1 \ circline_type H = 0 \ circline_type H = 1" + by (transfer, transfer, simp add: sgn_if) + +lemma circline_type_mk_circline [simp]: + assumes "(A, B, C, D) \ hermitean_nonzero" + shows "circline_type (mk_circline A B C D) = sgn (Re (A*D - B*C))" + using assms + by (transfer, transfer, simp) + +(* ----------------------------------------------------------------- *) +subsection \Points on the circline\ +(* ----------------------------------------------------------------- *) + +text \Each circline determines a corresponding set of points. Again, a description given in +homogeneous coordinates is a bit better than the original description defined only for ordinary +complex numbers. The point with homogeneous coordinates $(z_1, z_2)$ will belong to the set of +circline points iff $A \cdot z_1\cdot \overline{z_1} + B\cdot \overline{z_1} \cdot z_2 + C\cdot z_1 \cdot\overline{z_2} + +D\cdot z_2 \cdot \overline{z_2} = 0$. Note that this is a quadratic form determined by a vector of +homogeneous coordinates and the Hermitean matrix.\ + +definition on_circline_cmat_cvec :: "complex_mat \ complex_vec \ bool" where + [simp]: "on_circline_cmat_cvec H z \ quad_form z H = 0" + +lift_definition on_circline_clmat_hcoords :: "circline_mat \ complex_homo_coords \ bool" is on_circline_cmat_cvec + done + +lift_definition on_circline :: "circline \ complex_homo \ bool" is on_circline_clmat_hcoords + by transfer (simp del: quad_form_def, (erule exE)+, simp del: quad_form_def add: quad_form_scale_m quad_form_scale_v) + +definition circline_set :: "circline \ complex_homo set" where + "circline_set H = {z. on_circline H z}" + +lemma circline_set_I [simp]: + assumes "on_circline H z" + shows "z \ circline_set H" + using assms + unfolding circline_set_def + by auto + +abbreviation circline_equation where + "circline_equation A B C D z1 z2 \ A*z1*cnj z1 + B*z2*cnj z1 + C*cnj z2*z1 + D*z2*cnj z2 = 0" + +lemma on_circline_cmat_cvec_circline_equation: + "on_circline_cmat_cvec (A, B, C, D) (z1, z2) \ circline_equation A B C D z1 z2" + by (simp add: vec_cnj_def field_simps) + +lemma circline_equation: + assumes "H = mk_circline A B C D" and "(A, B, C, D) \ hermitean_nonzero" + shows "of_complex z \ circline_set H \ circline_equation A B C D z 1" + using assms + unfolding circline_set_def + by simp (transfer, transfer, simp add: vec_cnj_def field_simps) + +text \Circlines trough 0 and inf.\ +text \The circline represents a line when $A=0$ or a circle, otherwise.\ + +definition circline_A0_cmat :: "complex_mat \ bool" where + [simp]: "circline_A0_cmat H \ (let (A, B, C, D) = H in A = 0)" +lift_definition circline_A0_clmat :: "circline_mat \ bool" is circline_A0_cmat + done +lift_definition circline_A0 :: "circline \ bool" is circline_A0_clmat + by transfer auto + +abbreviation is_line where + "is_line H \ circline_A0 H" + +abbreviation is_circle where + "is_circle H \ \ circline_A0 H" + +definition circline_D0_cmat :: "complex_mat \ bool" where + [simp]: "circline_D0_cmat H \ (let (A, B, C, D) = H in D = 0)" +lift_definition circline_D0_clmat :: "circline_mat \ bool" is circline_D0_cmat + done +lift_definition circline_D0 :: "circline \ bool" is circline_D0_clmat + by transfer auto + +lemma inf_on_circline: "on_circline H \\<^sub>h \ circline_A0 H" + by (transfer, transfer, auto simp add: vec_cnj_def) + +lemma + inf_in_circline_set: "\\<^sub>h \ circline_set H \ is_line H" + using inf_on_circline + unfolding circline_set_def + by simp + +lemma zero_on_circline: "on_circline H 0\<^sub>h \ circline_D0 H" + by (transfer, transfer, auto simp add: vec_cnj_def) + +lemma + zero_in_circline_set: "0\<^sub>h \ circline_set H \ circline_D0 H" + using zero_on_circline + unfolding circline_set_def + by simp + +(* ----------------------------------------------------------------- *) +subsection \Connection with circles and lines in the classic complex plane\ +(* ----------------------------------------------------------------- *) + +text \Every Euclidean circle and Euclidean line can be represented by a +circline.\ + +lemma classic_circline: + assumes "H = mk_circline A B C D" and "hermitean (A, B, C, D) \ (A, B, C, D) \ mat_zero" + shows "circline_set H - {\\<^sub>h} = of_complex ` circline (Re A) B (Re D)" +using assms +unfolding circline_set_def +proof (safe) + fix z + assume "hermitean (A, B, C, D)" "(A, B, C, D) \ mat_zero" "z \ circline (Re A) B (Re D)" + thus "on_circline (mk_circline A B C D) (of_complex z)" + using hermitean_elems[of A B C D] + by (transfer, transfer) (auto simp add: circline_def vec_cnj_def field_simps) +next + fix z + assume "of_complex z = \\<^sub>h" + thus False + by simp +next + fix z + assume "hermitean (A, B, C, D)" "(A, B, C, D) \ mat_zero" "on_circline (mk_circline A B C D) z" "z \ of_complex ` circline (Re A) B (Re D)" + moreover + have "z \ \\<^sub>h \ z \ of_complex ` circline (Re A) B (Re D)" + proof + assume "z \ \\<^sub>h" + show "z \ of_complex ` circline (Re A) B (Re D)" + proof + show "z = of_complex (to_complex z)" + using \z \ \\<^sub>h\ + by simp + next + show "to_complex z \ circline (Re A) B (Re D)" + using \on_circline (mk_circline A B C D) z\ \z \ \\<^sub>h\ + using \hermitean (A, B, C, D)\ \(A, B, C, D) \ mat_zero\ + proof (transfer, transfer) + fix A B C D and z :: complex_vec + obtain z1 z2 where zz: "z = (z1, z2)" + by (cases z, auto) + assume *: "z \ vec_zero" "\ z \\<^sub>v \\<^sub>v" + "on_circline_cmat_cvec (mk_circline_cmat A B C D) z" + "hermitean (A, B, C, D)" "(A, B, C, D) \ mat_zero" + have "z2 \ 0" + using \z \ vec_zero\ \\ z \\<^sub>v \\<^sub>v\ + using inf_cvec_z2_zero_iff zz + by blast + thus "to_complex_cvec z \ circline (Re A) B (Re D)" + using * zz + using hermitean_elems[of A B C D] + by (simp add: vec_cnj_def circline_def field_simps) + qed + qed + qed + ultimately + show "z = \\<^sub>h" + by simp +qed + +text \The matrix of the circline representing circle determined with center and radius.\ +definition mk_circle_cmat :: "complex \ real \ complex_mat" where + [simp]: "mk_circle_cmat a r = (1, -a, -cnj a, a*cnj a - cor r*cor r)" + +lift_definition mk_circle_clmat :: "complex \ real \ circline_mat" is mk_circle_cmat + by (simp add: hermitean_def mat_adj_def mat_cnj_def) + +lift_definition mk_circle :: "complex \ real \ circline" is mk_circle_clmat + done + +lemma is_circle_mk_circle: "is_circle (mk_circle a r)" + by (transfer, transfer, simp) + +lemma circline_set_mk_circle [simp]: + assumes "r \ 0" + shows "circline_set (mk_circle a r) = of_complex ` circle a r" +proof- + let ?A = "1" and ?B = "-a" and ?C = "-cnj a" and ?D = "a*cnj a - cor r*cor r" + have *: "(?A, ?B, ?C, ?D) \ {H. hermitean H \ H \ mat_zero}" + by (simp add: hermitean_def mat_adj_def mat_cnj_def) + have "mk_circle a r = mk_circline ?A ?B ?C ?D" + using * + by (transfer, transfer, simp) + hence "circline_set (mk_circle a r) - {\\<^sub>h} = of_complex ` circline ?A ?B (Re ?D)" + using classic_circline[of "mk_circle a r" ?A ?B ?C ?D] * + by simp + moreover + have "circline ?A ?B (Re ?D) = circle a r" + by (rule circline_circle[of ?A "Re ?D" "?B" "circline ?A ?B (Re ?D)" "a" "r*r" r], simp_all add: cmod_square \r \ 0\) + moreover + have "\\<^sub>h \ circline_set (mk_circle a r)" + using inf_in_circline_set[of "mk_circle a r"] is_circle_mk_circle[of a r] + by auto + ultimately + show ?thesis + unfolding circle_def + by simp +qed + +text \The matrix of the circline representing line determined with two (not equal) complex points.\ +definition mk_line_cmat :: "complex \ complex \ complex_mat" where + [simp]: "mk_line_cmat z1 z2 = + (if z1 \ z2 then + let B = \ * (z2 - z1) in (0, B, cnj B, -cnj_mix B z1) + else + eye)" + +lift_definition mk_line_clmat :: "complex \ complex \ circline_mat" is mk_line_cmat + by (auto simp add: Let_def hermitean_def mat_adj_def mat_cnj_def split: if_split_asm) + +lift_definition mk_line :: "complex \ complex \ circline" is mk_line_clmat + done + +lemma circline_set_mk_line [simp]: + assumes "z1 \ z2" + shows "circline_set (mk_line z1 z2) - {\\<^sub>h} = of_complex ` line z1 z2" +proof- + let ?A = "0" and ?B = "\*(z2 - z1)" + let ?C = "cnj ?B" and ?D = "-cnj_mix ?B z1" + have *: "(?A, ?B, ?C, ?D) \ {H. hermitean H \ H \ mat_zero}" + using assms + by (simp add: hermitean_def mat_adj_def mat_cnj_def) + have "mk_line z1 z2 = mk_circline ?A ?B ?C ?D" + using * assms + by (transfer, transfer, auto simp add: Let_def) + hence "circline_set (mk_line z1 z2) - {\\<^sub>h} = of_complex ` circline ?A ?B (Re ?D)" + using classic_circline[of "mk_line z1 z2" ?A ?B ?C ?D] * + by simp + moreover + have "circline ?A ?B (Re ?D) = line z1 z2" + using \z1 \ z2\ + using circline_line' + by simp + ultimately + show ?thesis + by simp +qed + +text \The set of points determined by a circline is always +either an Euclidean circle or an Euclidean line. \ + +text \Euclidean circle is determined by its center and radius.\ +type_synonym euclidean_circle = "complex \ real" + +definition euclidean_circle_cmat :: "complex_mat \ euclidean_circle" where + [simp]: "euclidean_circle_cmat H = (let (A, B, C, D) = H in (-B/A, sqrt(Re ((B*C - A*D)/(A*A)))))" + +lift_definition euclidean_circle_clmat :: "circline_mat \ euclidean_circle" is euclidean_circle_cmat + done + +lift_definition euclidean_circle :: "circline \ euclidean_circle" is euclidean_circle_clmat +proof transfer + fix H1 H2 + assume hh: "hermitean H1 \ H1 \ mat_zero" "hermitean H2 \ H2 \ mat_zero" + obtain A1 B1 C1 D1 where HH1: "H1 = (A1, B1, C1, D1)" + by (cases "H1") auto + obtain A2 B2 C2 D2 where HH2: "H2 = (A2, B2, C2, D2)" + by (cases "H2") auto + assume "circline_eq_cmat H1 H2" + then obtain k where "k \ 0" and *: "A2 = cor k * A1" "B2 = cor k * B1" "C2 = cor k * C1" "D2 = cor k * D1" + using HH1 HH2 + by auto + have "(cor k * B1 * (cor k * C1) - cor k * A1 * (cor k * D1)) = (cor k)\<^sup>2 * (B1*C1 - A1*D1)" + "(cor k * A1 * (cor k * A1)) = (cor k)\<^sup>2 * (A1*A1)" + by (auto simp add: field_simps power2_eq_square) + hence "(cor k * B1 * (cor k * C1) - cor k * A1 * (cor k * D1)) / + (cor k * A1 * (cor k * A1)) = (B1*C1 - A1*D1) / (A1*A1)" + using \k \ 0\ + by (simp add: power2_eq_square) + thus "euclidean_circle_cmat H1 = euclidean_circle_cmat H2" + using HH1 HH2 * hh + by auto +qed + +lemma classic_circle: + assumes "is_circle H" and "(a, r) = euclidean_circle H" and "circline_type H \ 0" + shows "circline_set H = of_complex ` circle a r" +proof- + obtain A B C D where *: "H = mk_circline A B C D" "hermitean (A, B, C, D)" "(A, B, C, D) \ mat_zero" + using ex_mk_circline[of H] + by auto + have "is_real A" "is_real D" "C = cnj B" + using * hermitean_elems + by auto + have "Re (A*D - B*C) \ 0" + using \circline_type H \ 0\ * + by simp + + hence **: "Re A * Re D \ (cmod B)\<^sup>2" + using \is_real A\ \is_real D\ \C = cnj B\ + by (simp add: cmod_square) + + have "A \ 0" + using \is_circle H\ * \is_real A\ + by simp (transfer, transfer, simp) + + hence "Re A \ 0" + using \is_real A\ + by (metis complex_surj zero_complex.code) + + have ***: "\\<^sub>h \ circline_set H" + using * inf_in_circline_set[of H] \is_circle H\ + by simp + + let ?a = "-B/A" + let ?r2 = "((cmod B)\<^sup>2 - Re A * Re D) / (Re A)\<^sup>2" + let ?r = "sqrt ?r2" + + have "?a = a \ ?r = r" + using \(a, r) = euclidean_circle H\ + using * \is_real A\ \is_real D\ \C = cnj B\ \A \ 0\ + apply simp + apply transfer + apply transfer + apply simp + apply (subst Re_divide_real) + apply (simp_all add: cmod_square, simp add: power2_eq_square) + done + + show ?thesis + using * ** *** \Re A \ 0\ \is_real A\ \C = cnj B\ \?a = a \ ?r = r\ + using classic_circline[of H A B C D] assms circline_circle[of "Re A" "Re D" B "circline (Re A) B (Re D)" ?a ?r2 ?r] + by (simp add: circle_def) +qed + +text \Euclidean line is represented by two points.\ +type_synonym euclidean_line = "complex \ complex" + +definition euclidean_line_cmat :: "complex_mat \ euclidean_line" where + [simp]: "euclidean_line_cmat H = + (let (A, B, C, D) = H; + z1 = -(D*B)/(2*B*C); + z2 = z1 + \ * sgn (if arg B > 0 then -B else B) + in (z1, z2))" + +lift_definition euclidean_line_clmat :: "circline_mat \ euclidean_line" is euclidean_line_cmat + done + +lift_definition euclidean_line :: "circline \ complex \ complex" is euclidean_line_clmat +proof transfer + fix H1 H2 + assume hh: "hermitean H1 \ H1 \ mat_zero" "hermitean H2 \ H2 \ mat_zero" + obtain A1 B1 C1 D1 where HH1: "H1 = (A1, B1, C1, D1)" + by (cases "H1") auto + obtain A2 B2 C2 D2 where HH2: "H2 = (A2, B2, C2, D2)" + by (cases "H2") auto + assume "circline_eq_cmat H1 H2" + then obtain k where "k \ 0" and *: "A2 = cor k * A1" "B2 = cor k * B1" "C2 = cor k * C1" "D2 = cor k * D1" + using HH1 HH2 + by auto + have 1: "B1 \ 0 \ 0 < arg B1 \ \ 0 < arg (- B1)" + using canon_ang_plus_pi1[of "arg B1"] arg_bounded[of B1] + by (auto simp add: arg_uminus) + have 2: "B1 \ 0 \ \ 0 < arg B1 \ 0 < arg (- B1)" + using canon_ang_plus_pi2[of "arg B1"] arg_bounded[of B1] + by (auto simp add: arg_uminus) + + show "euclidean_line_cmat H1 = euclidean_line_cmat H2" + using HH1 HH2 * \k \ 0\ + by (cases "k > 0") (auto simp add: Let_def, simp_all add: sgn_eq 1 2) +qed + +lemma classic_line: + assumes "is_line H" and "circline_type H < 0" and "(z1, z2) = euclidean_line H" + shows "circline_set H - {\\<^sub>h} = of_complex ` line z1 z2" +proof- + obtain A B C D where *: "H = mk_circline A B C D" "hermitean (A, B, C, D)" "(A, B, C, D) \ mat_zero" + using ex_mk_circline[of H] + by auto + have "is_real A" "is_real D" "C = cnj B" + using * hermitean_elems + by auto + have "Re A = 0" + using \is_line H\ * \is_real A\ \is_real D\ \C = cnj B\ + by simp (transfer, transfer, simp) + have "B \ 0" + using \Re A = 0\ \is_real A\ \is_real D\ \C = cnj B\ * \circline_type H < 0\ + using circline_type_mk_circline[of A B C D] + by auto + + let ?z1 = "- cor (Re D) * B / (2 * B * cnj B)" + let ?z2 = "?z1 + \ * sgn (if 0 < arg B then - B else B)" + have "z1 = ?z1 \ z2 = ?z2" + using \(z1, z2) = euclidean_line H\ * \is_real A\ \is_real D\ \C = cnj B\ + by simp (transfer, transfer, simp add: Let_def) + thus ?thesis + using * + using classic_circline[of H A B C D] circline_line[of "Re A" B "circline (Re A) B (Re D)" "Re D" ?z1 ?z2] \Re A = 0\ \B \ 0\ + by simp +qed + + +(* ----------------------------------------------------------------- *) +subsection \Some special circlines\ +(* ----------------------------------------------------------------- *) + +(* ---------------------------------------------------------------------------- *) +subsubsection \Unit circle\ +(* ---------------------------------------------------------------------------- *) + +definition unit_circle_cmat :: complex_mat where + [simp]: "unit_circle_cmat = (1, 0, 0, -1)" +lift_definition unit_circle_clmat :: circline_mat is unit_circle_cmat + by (simp add: hermitean_def mat_adj_def mat_cnj_def) +lift_definition unit_circle :: circline is unit_circle_clmat + done + +lemma on_circline_cmat_cvec_unit: + shows "on_circline_cmat_cvec unit_circle_cmat (z1, z2) \ + z1 * cnj z1 = z2 * cnj z2" + by (simp add: vec_cnj_def field_simps) + +lemma + one_on_unit_circle [simp]: "on_circline unit_circle 1\<^sub>h" and + ii_on_unit_circle [simp]: "on_circline unit_circle ii\<^sub>h" and + not_zero_on_unit_circle [simp]: "\ on_circline unit_circle 0\<^sub>h" + by (transfer, transfer, simp add: vec_cnj_def)+ + +lemma + one_in_unit_circle_set [simp]: "1\<^sub>h \ circline_set unit_circle" and + ii_in_unit_circle_set [simp]: "ii\<^sub>h \ circline_set unit_circle" and + zero_in_unit_circle_set [simp]: "0\<^sub>h \ circline_set unit_circle" + unfolding circline_set_def + by simp_all + +lemma is_circle_unit_circle [simp]: + shows "is_circle unit_circle" + by (transfer, transfer, simp) + +lemma not_inf_on_unit_circle' [simp]: + shows "\ on_circline unit_circle \\<^sub>h" + using is_circle_unit_circle inf_on_circline + by blast + +lemma not_inf_on_unit_circle'' [simp]: + shows "\\<^sub>h \ circline_set unit_circle" + by (simp add: inf_in_circline_set) + +lemma euclidean_circle_unit_circle [simp]: + shows "euclidean_circle unit_circle = (0, 1)" + by (transfer, transfer, simp) + +lemma circline_type_unit_circle [simp]: + shows "circline_type unit_circle = -1" + by (transfer, transfer, simp) + +lemma on_circline_unit_circle [simp]: + shows "on_circline unit_circle (of_complex z) \ cmod z = 1" + by (transfer, transfer, simp add: vec_cnj_def mult.commute) + +lemma circline_set_unit_circle [simp]: + shows "circline_set unit_circle = of_complex ` {z. cmod z = 1}" +proof- + show ?thesis + proof safe + fix x + assume "x \ circline_set unit_circle" + then obtain x' where "x = of_complex x'" + using inf_or_of_complex[of x] + by auto + thus "x \ of_complex ` {z. cmod z = 1}" + using \x \ circline_set unit_circle\ + unfolding circline_set_def + by auto + next + fix x + assume "cmod x = 1" + thus "of_complex x \ circline_set unit_circle" + unfolding circline_set_def + by auto + qed +qed + +lemma circline_set_unit_circle_I [simp]: + assumes "cmod z = 1" + shows "of_complex z \ circline_set unit_circle" + using assms + unfolding circline_set_unit_circle + by simp + +lemma inversion_unit_circle [simp]: + assumes "on_circline unit_circle x" + shows "inversion x = x" +proof- + obtain x' where "x = of_complex x'" "x' \ 0" + using inf_or_of_complex[of x] + using assms + by force + moreover + hence "x' * cnj x' = 1" + using assms + using circline_set_unit_circle + unfolding circline_set_def + by auto + hence "1 / cnj x' = x'" + using \x' \ 0\ + by (simp add: field_simps) + ultimately + show ?thesis + using assms + unfolding inversion_def + by simp +qed + +lemma inversion_id_iff_on_unit_circle: + shows "inversion a = a \ on_circline unit_circle a" + using inversion_id_iff[of a] inf_or_of_complex[of a] + by auto + +lemma on_unit_circle_conjugate [simp]: + shows "on_circline unit_circle (conjugate z) \ on_circline unit_circle z" + by (transfer, transfer, auto simp add: vec_cnj_def field_simps) + +lemma conjugate_unit_circle_set [simp]: + shows "conjugate ` (circline_set unit_circle) = circline_set unit_circle" + unfolding circline_set_def + by (auto simp add: image_iff, rule_tac x="conjugate x" in exI, simp) + +(* ---------------------------------------------------------------------------- *) +subsubsection \x-axis\ +(* ---------------------------------------------------------------------------- *) + +definition x_axis_cmat :: complex_mat where + [simp]: "x_axis_cmat = (0, \, -\, 0)" +lift_definition x_axis_clmat :: circline_mat is x_axis_cmat + by (simp add: hermitean_def mat_adj_def mat_cnj_def) +lift_definition x_axis :: circline is x_axis_clmat + done + +lemma special_points_on_x_axis' [simp]: + shows "on_circline x_axis 0\<^sub>h" and "on_circline x_axis 1\<^sub>h" and "on_circline x_axis \\<^sub>h" + by (transfer, transfer, simp add: vec_cnj_def)+ + +lemma special_points_on_x_axis'' [simp]: + shows "0\<^sub>h \ circline_set x_axis" and "1\<^sub>h \ circline_set x_axis" and "\\<^sub>h \ circline_set x_axis" + unfolding circline_set_def + by auto + +lemma is_line_x_axis [simp]: + shows "is_line x_axis" + by (transfer, transfer, simp) + +lemma circline_type_x_axis [simp]: + shows "circline_type x_axis = -1" + by (transfer, transfer, simp) + +lemma on_circline_x_axis: + shows "on_circline x_axis z \ (\ c. is_real c \ z = of_complex c) \ z = \\<^sub>h" +proof safe + fix z c + assume "is_real c" + thus "on_circline x_axis (of_complex c)" + proof (transfer, transfer) + fix c + assume "is_real c" + thus "on_circline_cmat_cvec x_axis_cmat (of_complex_cvec c)" + using eq_cnj_iff_real[of c] + by (simp add: vec_cnj_def) + qed +next + fix z + assume "on_circline x_axis z" "z \ \\<^sub>h" + thus "\c. is_real c \ z = of_complex c" + proof (transfer, transfer, safe) + fix a b + assume "(a, b) \ vec_zero" + "on_circline_cmat_cvec x_axis_cmat (a, b)" + "\ (a, b) \\<^sub>v \\<^sub>v" + hence "b \ 0" "cnj a * b = cnj b * a" using inf_cvec_z2_zero_iff + by (auto simp add: vec_cnj_def) + thus "\c. is_real c \ (a, b) \\<^sub>v of_complex_cvec c" + apply (rule_tac x="a/b" in exI) + apply (auto simp add: is_real_div field_simps) + apply (rule_tac x="1/b" in exI, simp) + done + qed +next + show "on_circline x_axis \\<^sub>h" + by auto +qed + +lemma on_circline_x_axis_I [simp]: + assumes "is_real z" + shows "on_circline x_axis (of_complex z)" + using assms + unfolding on_circline_x_axis + by auto + +lemma circline_set_x_axis: + shows "circline_set x_axis = of_complex ` {x. is_real x} \ {\\<^sub>h}" + using on_circline_x_axis + unfolding circline_set_def + by auto + +lemma circline_set_x_axis_I: + assumes "is_real z" + shows "of_complex z \ circline_set x_axis" + using assms + unfolding circline_set_x_axis + by auto + +lemma circline_equation_x_axis: + shows "of_complex z \ circline_set x_axis \ z = cnj z" + unfolding circline_set_x_axis +proof auto + fix x + assume "of_complex z = of_complex x" "is_real x" + hence "z = x" + using of_complex_inj[of z x] + by simp + thus "z = cnj z" + using eq_cnj_iff_real[of z] \is_real x\ + by auto +next + assume "z = cnj z" + thus "of_complex z \ of_complex ` {x. is_real x} " + using eq_cnj_iff_real[of z] + by auto +qed + +text \Positive and negative part of x-axis\ + +definition positive_x_axis where + "positive_x_axis = {z. z \ circline_set x_axis \ z \ \\<^sub>h \ Re (to_complex z) > 0}" + +definition negative_x_axis where + "negative_x_axis = {z. z \ circline_set x_axis \ z \ \\<^sub>h \ Re (to_complex z) < 0}" + +lemma circline_set_positive_x_axis_I [simp]: + assumes "is_real z" and "Re z > 0" + shows "of_complex z \ positive_x_axis" + using assms + unfolding positive_x_axis_def + by simp + +lemma circline_set_negative_x_axis_I [simp]: + assumes "is_real z" and "Re z < 0" + shows "of_complex z \ negative_x_axis" + using assms + unfolding negative_x_axis_def + by simp + +(* ---------------------------------------------------------------------------- *) +subsubsection \y-axis\ +(* ---------------------------------------------------------------------------- *) + +definition y_axis_cmat :: complex_mat where + [simp]: "y_axis_cmat = (0, 1, 1, 0)" +lift_definition y_axis_clmat :: circline_mat is y_axis_cmat + by (simp add: hermitean_def mat_adj_def mat_cnj_def) +lift_definition y_axis :: circline is y_axis_clmat + done + +lemma special_points_on_y_axis' [simp]: + shows "on_circline y_axis 0\<^sub>h" and "on_circline y_axis ii\<^sub>h" and "on_circline y_axis \\<^sub>h" + by (transfer, transfer, simp add: vec_cnj_def)+ + +lemma special_points_on_y_axis'' [simp]: + shows "0\<^sub>h \ circline_set y_axis" and "ii\<^sub>h \ circline_set y_axis" and "\\<^sub>h \ circline_set y_axis" + unfolding circline_set_def + by auto + +lemma on_circline_y_axis: + shows "on_circline y_axis z \ (\ c. is_imag c \ z = of_complex c) \ z = \\<^sub>h" +proof safe + fix z c + assume "is_imag c" + thus "on_circline y_axis (of_complex c)" + proof (transfer, transfer) + fix c + assume "is_imag c" + thus "on_circline_cmat_cvec y_axis_cmat (of_complex_cvec c)" + using eq_minus_cnj_iff_imag[of c] + by (simp add: vec_cnj_def) + qed +next + fix z + assume "on_circline y_axis z" "z \ \\<^sub>h" + thus "\c. is_imag c \ z = of_complex c" + proof (transfer, transfer, safe) + fix a b + assume "(a, b) \ vec_zero" + "on_circline_cmat_cvec y_axis_cmat (a, b)" + "\ (a, b) \\<^sub>v \\<^sub>v" + hence "b \ 0" "cnj a * b + cnj b * a = 0" + using inf_cvec_z2_zero_iff + by (blast, smt add.left_neutral add_cancel_right_right mult.commute mult.left_neutral mult_not_zero on_circline_cmat_cvec_circline_equation y_axis_cmat_def) + thus "\c. is_imag c \ (a, b) \\<^sub>v of_complex_cvec c" + using eq_minus_cnj_iff_imag[of "a / b"] + apply (rule_tac x="a/b" in exI) + apply (auto simp add: field_simps) + apply (rule_tac x="1/b" in exI, simp) + using add_eq_0_iff apply blast + apply (rule_tac x="1/b" in exI, simp) + done + qed +next + show "on_circline y_axis \\<^sub>h" + by simp +qed + +lemma on_circline_y_axis_I [simp]: + assumes "is_imag z" + shows "on_circline y_axis (of_complex z)" + using assms + unfolding on_circline_y_axis + by auto + +lemma circline_set_y_axis: + shows "circline_set y_axis = of_complex ` {x. is_imag x} \ {\\<^sub>h}" + using on_circline_y_axis + unfolding circline_set_def + by auto + +lemma circline_set_y_axis_I: + assumes "is_imag z" + shows "of_complex z \ circline_set y_axis" + using assms + unfolding circline_set_y_axis + by auto + +text \Positive and negative part of y-axis\ + +definition positive_y_axis where + "positive_y_axis = {z. z \ circline_set y_axis \ z \ \\<^sub>h \ Im (to_complex z) > 0}" + +definition negative_y_axis where + "negative_y_axis = {z. z \ circline_set y_axis \ z \ \\<^sub>h \ Im (to_complex z) < 0}" + +lemma circline_set_positive_y_axis_I [simp]: + assumes "is_imag z" and "Im z > 0" + shows "of_complex z \ positive_y_axis" + using assms + unfolding positive_y_axis_def + by simp + +lemma circline_set_negative_y_axis_I [simp]: + assumes "is_imag z" and "Im z < 0" + shows "of_complex z \ negative_y_axis" + using assms + unfolding negative_y_axis_def + by simp + +(* ---------------------------------------------------------------------------- *) +subsubsection \Point zero as a circline\ +(* ---------------------------------------------------------------------------- *) + +definition circline_point_0_cmat :: complex_mat where + [simp]: "circline_point_0_cmat = (1, 0, 0, 0)" +lift_definition circline_point_0_clmat :: circline_mat is circline_point_0_cmat + by (simp add: hermitean_def mat_adj_def mat_cnj_def) +lift_definition circline_point_0 :: circline is circline_point_0_clmat + done + +lemma circline_type_circline_point_0 [simp]: + shows "circline_type circline_point_0 = 0" + by (transfer, transfer, simp) + +lemma zero_in_circline_point_0 [simp]: + shows "0\<^sub>h \ circline_set circline_point_0" + unfolding circline_set_def + by auto (transfer, transfer, simp add: vec_cnj_def)+ + +(* ---------------------------------------------------------------------------- *) +subsubsection \Imaginary unit circle\ +(* ---------------------------------------------------------------------------- *) + +definition imag_unit_circle_cmat :: complex_mat where + [simp]: "imag_unit_circle_cmat = (1, 0, 0, 1)" +lift_definition imag_unit_circle_clmat :: circline_mat is imag_unit_circle_cmat + by (simp add: hermitean_def mat_adj_def mat_cnj_def) +lift_definition imag_unit_circle :: circline is imag_unit_circle_clmat + done + +lemma circline_type_imag_unit_circle [simp]: + shows "circline_type imag_unit_circle = 1" + by (transfer, transfer, simp) + +(* ----------------------------------------------------------------- *) +subsection \Intersection of circlines\ +(* ----------------------------------------------------------------- *) + +definition circline_intersection :: "circline \ circline \ complex_homo set" where + "circline_intersection H1 H2 = {z. on_circline H1 z \ on_circline H2 z}" + +lemma circline_equation_cancel_z2: + assumes "circline_equation A B C D z1 z2 " and "z2 \ 0" + shows "circline_equation A B C D (z1/z2) 1" + using assms + by (simp add: field_simps) + +lemma circline_equation_quadratic_equation: + assumes "circline_equation A B (cnj B) D z 1" and + "Re z = x" and "Im z = y" and "Re B = bx" and "Im B = by" + shows "A*x\<^sup>2 + A*y\<^sup>2 + 2*bx*x + 2*by*y + D = 0" + using assms +proof- + have "z = x + \*y" "B = bx + \*by" + using assms complex_eq + by auto + thus ?thesis + using assms + by (simp add: field_simps power2_eq_square) +qed + +lemma circline_intersection_symetry: + shows "circline_intersection H1 H2 = circline_intersection H2 H1" + unfolding circline_intersection_def + by auto + +(* ----------------------------------------------------------------- *) +subsection \Möbius action on circlines\ +(* ----------------------------------------------------------------- *) + +definition moebius_circline_cmat_cmat :: "complex_mat \ complex_mat \ complex_mat" where + [simp]: "moebius_circline_cmat_cmat M H = congruence (mat_inv M) H" + +lift_definition moebius_circline_mmat_clmat :: "moebius_mat \ circline_mat \ circline_mat" is moebius_circline_cmat_cmat + using mat_det_inv congruence_nonzero hermitean_congruence + by simp + +lift_definition moebius_circline :: "moebius \ circline \ circline" is moebius_circline_mmat_clmat +proof transfer + fix M M' H H' + assume "moebius_cmat_eq M M'" "circline_eq_cmat H H'" + thus "circline_eq_cmat (moebius_circline_cmat_cmat M H) (moebius_circline_cmat_cmat M' H')" + by (auto simp add: mat_inv_mult_sm) (rule_tac x="ka / Re (k * cnj k)" in exI, auto simp add: complex_mult_cnj_cmod power2_eq_square) +qed + +lemma moebius_preserve_circline_type [simp]: + shows "circline_type (moebius_circline M H) = circline_type H" +proof (transfer, transfer) + fix M H :: complex_mat + assume "mat_det M \ 0" "hermitean H \ H \ mat_zero" + thus "circline_type_cmat (moebius_circline_cmat_cmat M H) = circline_type_cmat H" + using Re_det_sgn_congruence[of "mat_inv M" "H"] mat_det_inv[of "M"] + by (simp del: congruence_def) +qed + +text \The central lemma in this section connects the action of Möbius transformations on points and +on circlines.\ + +lemma moebius_circline: + shows "{z. on_circline (moebius_circline M H) z} = + moebius_pt M ` {z. on_circline H z}" +proof safe + fix z + assume "on_circline H z" + thus "on_circline (moebius_circline M H) (moebius_pt M z)" + proof (transfer, transfer) + fix z :: complex_vec and M H :: complex_mat + assume hh: "hermitean H \ H \ mat_zero" "z \ vec_zero" "mat_det M \ 0" + let ?z = "M *\<^sub>m\<^sub>v z" + let ?H = "mat_adj (mat_inv M) *\<^sub>m\<^sub>m H *\<^sub>m\<^sub>m (mat_inv M)" + assume *: "on_circline_cmat_cvec H z" + hence "quad_form z H = 0" + by simp + hence "quad_form ?z ?H = 0" + using quad_form_congruence[of M z H] hh + by simp + thus "on_circline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)" + by simp + qed +next + fix z + assume "on_circline (moebius_circline M H) z" + hence "\ z'. z = moebius_pt M z' \ on_circline H z'" + proof (transfer, transfer) + fix z :: complex_vec and M H :: complex_mat + assume hh: "hermitean H \ H \ mat_zero" "z \ vec_zero" "mat_det M \ 0" + let ?iM = "mat_inv M" + let ?z' = "?iM *\<^sub>m\<^sub>v z" + assume *: "on_circline_cmat_cvec (moebius_circline_cmat_cmat M H) z" + have "?z' \ vec_zero" + using hh + using mat_det_inv mult_mv_nonzero + by auto + moreover + have "z \\<^sub>v moebius_pt_cmat_cvec M ?z'" + using hh eye_mv_l mat_inv_r + by simp + moreover + have "M *\<^sub>m\<^sub>v (?iM *\<^sub>m\<^sub>v z) = z" + using hh eye_mv_l mat_inv_r + by auto + hence "on_circline_cmat_cvec H ?z'" + using hh * + using quad_form_congruence[of M "?iM *\<^sub>m\<^sub>v z" H, symmetric] + unfolding moebius_circline_cmat_cmat_def + unfolding on_circline_cmat_cvec_def + by simp + ultimately + show "\z'\{v. v \ vec_zero}. z \\<^sub>v moebius_pt_cmat_cvec M z' \ on_circline_cmat_cvec H z'" + by blast + qed + thus "z \ moebius_pt M ` {z. on_circline H z}" + by auto +qed + +lemma on_circline_moebius_circline_I [simp]: + assumes "on_circline H z" + shows "on_circline (moebius_circline M H) (moebius_pt M z)" + using assms moebius_circline + by fastforce + +lemma circline_set_moebius_circline [simp]: + shows "circline_set (moebius_circline M H) = moebius_pt M ` circline_set H" + using moebius_circline[of M H] + unfolding circline_set_def + by auto + +lemma circline_set_moebius_circline_I [simp]: + assumes "z \ circline_set H" + shows "moebius_pt M z \ circline_set (moebius_circline M H)" + using assms + by simp + +lemma circline_set_moebius_circline_E: + assumes "moebius_pt M z \ circline_set (moebius_circline M H)" + shows "z \ circline_set H" + using assms + using moebius_pt_eq_I[of M z] + by auto + +lemma circline_set_moebius_circline_iff [simp]: + shows "moebius_pt M z \ circline_set (moebius_circline M H) \ + z \ circline_set H" + using moebius_pt_eq_I[of M z] + by auto + +lemma inj_moebius_circline: + shows "inj (moebius_circline M)" +unfolding inj_on_def +proof (safe) + fix H H' + assume "moebius_circline M H = moebius_circline M H'" + thus "H = H'" + proof (transfer, transfer) + fix M H H' :: complex_mat + assume hh: "mat_det M \ 0" + let ?iM = "mat_inv M" + assume "circline_eq_cmat (moebius_circline_cmat_cmat M H) (moebius_circline_cmat_cmat M H')" + then obtain k where "congruence ?iM H' = congruence ?iM (cor k *\<^sub>s\<^sub>m H)" "k \ 0" + by auto + thus "circline_eq_cmat H H'" + using hh inj_congruence[of ?iM H' "cor k *\<^sub>s\<^sub>m H"] mat_det_inv[of M] + by auto + qed +qed + +lemma moebius_circline_eq_I: + assumes "moebius_circline M H1 = moebius_circline M H2" + shows "H1 = H2" + using assms inj_moebius_circline[of M] + unfolding inj_on_def + by blast + +lemma moebius_circline_neq_I [simp]: + assumes "H1 \ H2" + shows "moebius_circline M H1 \ moebius_circline M H2" + using assms inj_moebius_circline[of M] + unfolding inj_on_def + by blast + +(* ---------------------------------------------------------------------------- *) +subsubsection \Group properties of Möbius action on ciclines\ +(* ---------------------------------------------------------------------------- *) + +text \Möbius actions on circlines have similar properties as Möbius actions on points.\ + +lemma moebius_circline_id [simp]: + shows "moebius_circline id_moebius H = H" + by (transfer, transfer) (simp add: mat_adj_def mat_cnj_def, rule_tac x=1 in exI, auto) + +lemma moebius_circline_comp [simp]: + shows "moebius_circline (moebius_comp M1 M2) H = moebius_circline M1 (moebius_circline M2 H)" + by (transfer, transfer) (simp add: mat_inv_mult_mm, rule_tac x=1 in exI, simp add: mult_mm_assoc) + +lemma moebius_circline_comp_inv_left [simp]: + shows "moebius_circline (moebius_inv M) (moebius_circline M H) = H" + by (subst moebius_circline_comp[symmetric], simp) + +lemma moebius_circline_comp_inv_right [simp]: + shows "moebius_circline M (moebius_circline (moebius_inv M) H) = H" + by (subst moebius_circline_comp[symmetric], simp) + +(* ----------------------------------------------------------------- *) +subsection \Action of Euclidean similarities on circlines\ +(* ----------------------------------------------------------------- *) + +lemma moebius_similarity_lines_to_lines [simp]: + assumes "a \ 0" + shows "\\<^sub>h \ circline_set (moebius_circline (moebius_similarity a b) H) \ + \\<^sub>h \ circline_set H" + using assms + by (metis circline_set_moebius_circline_iff moebius_similarity_inf) + +lemma moebius_similarity_lines_to_lines': + assumes "a \ 0" + shows "on_circline (moebius_circline (moebius_similarity a b) H) \\<^sub>h \ + \\<^sub>h \ circline_set H" + using moebius_similarity_lines_to_lines assms + unfolding circline_set_def + by simp + +(* ----------------------------------------------------------------- *) +subsection \Conjugation, recpiprocation and inversion of circlines\ +(* ----------------------------------------------------------------- *) + +text \Conjugation of circlines\ +definition conjugate_circline_cmat :: "complex_mat \ complex_mat" where + [simp]: "conjugate_circline_cmat = mat_cnj" +lift_definition conjugate_circline_clmat :: "circline_mat \ circline_mat" is conjugate_circline_cmat + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def) +lift_definition conjugate_circline :: "circline \ circline" is conjugate_circline_clmat + by transfer (metis circline_eq_cmat_def conjugate_circline_cmat_def hermitean_transpose mat_t_mult_sm) + +lemma conjugate_circline_set': + shows "conjugate ` circline_set H \ circline_set (conjugate_circline H)" +proof (safe) + fix z + assume "z \ circline_set H" + thus "conjugate z \ circline_set (conjugate_circline H)" + unfolding circline_set_def + apply simp + apply (transfer, transfer) + unfolding on_circline_cmat_cvec_def conjugate_cvec_def conjugate_circline_cmat_def + apply (subst quad_form_vec_cnj_mat_cnj, simp_all) + done +qed + +lemma conjugate_conjugate_circline [simp]: + shows "conjugate_circline (conjugate_circline H) = H" + by (transfer, transfer, force) + +lemma circline_set_conjugate_circline [simp]: + shows "circline_set (conjugate_circline H) = conjugate ` circline_set H" (is "?lhs = ?rhs") +proof (safe) + fix z + assume "z \ ?lhs" + show "z \ ?rhs" + proof + show "z = conjugate (conjugate z)" + by simp + next + show "conjugate z \ circline_set H" + using \z \ circline_set (conjugate_circline H)\ + using conjugate_circline_set'[of "conjugate_circline H"] + by auto + qed +next + fix z + assume "z \ circline_set H" + thus "conjugate z \ circline_set (conjugate_circline H)" + using conjugate_circline_set'[of H] + by auto +qed + +lemma on_circline_conjugate_circline [simp]: + shows "on_circline (conjugate_circline H) z \ on_circline H (conjugate z)" + using circline_set_conjugate_circline[of H] + unfolding circline_set_def + by force + +text \Inversion of circlines\ + +definition circline_inversion_cmat :: "complex_mat \ complex_mat" where + [simp]: "circline_inversion_cmat H = (let (A, B, C, D) = H in (D, B, C, A))" +lift_definition circline_inversion_clmat :: "circline_mat \ circline_mat" is circline_inversion_cmat + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def) +lift_definition circline_inversion :: "circline \ circline" is circline_inversion_clmat + by transfer auto + +lemma on_circline_circline_inversion [simp]: + shows "on_circline (circline_inversion H) z \ on_circline H (reciprocal (conjugate z))" + by (transfer, transfer, auto simp add: vec_cnj_def field_simps) + +lemma circline_set_circline_inversion [simp]: + shows "circline_set (circline_inversion H) = inversion ` circline_set H" + unfolding circline_set_def inversion_def + by (force simp add: comp_def image_iff) + +text \Reciprocal of circlines\ + +definition circline_reciprocal :: "circline \ circline" where + "circline_reciprocal = conjugate_circline \ circline_inversion" + +lemma circline_set_circline_reciprocal: + shows "circline_set (circline_reciprocal H) = reciprocal ` circline_set H" + unfolding circline_reciprocal_def comp_def + by (auto simp add: inversion_def image_iff) + +text \Rotation of circlines\ + +lemma rotation_pi_2_y_axis [simp]: + shows "moebius_circline (moebius_rotation (pi/2)) y_axis = x_axis" + unfolding moebius_rotation_def moebius_similarity_def + by (transfer, transfer, simp add: mat_adj_def mat_cnj_def) + +lemma rotation_minus_pi_2_y_axis [simp]: + shows "moebius_circline (moebius_rotation (-pi/2)) y_axis = x_axis" + unfolding moebius_rotation_def moebius_similarity_def + by (transfer, transfer, simp add: mat_adj_def mat_cnj_def, rule_tac x="-1" in exI, simp) + +lemma rotation_minus_pi_2_x_axis [simp]: + shows "moebius_circline (moebius_rotation (-pi/2)) x_axis = y_axis" + unfolding moebius_rotation_def moebius_similarity_def + by (transfer, transfer, simp add: mat_adj_def mat_cnj_def) + +lemma rotation_pi_2_x_axis [simp]: + shows "moebius_circline (moebius_rotation (pi/2)) x_axis = y_axis" + unfolding moebius_rotation_def moebius_similarity_def + by (transfer, transfer, simp add: mat_adj_def mat_cnj_def, rule_tac x="-1" in exI, simp) + +lemma rotation_minus_pi_2_positive_y_axis [simp]: + shows "(moebius_pt (moebius_rotation (-pi/2))) ` positive_y_axis = positive_x_axis" +proof safe + fix y + assume y: "y \ positive_y_axis" + have *: "Re (a * \ / b) < 0 \ Im (a / b) > 0" for a b + by (subst times_divide_eq_left [symmetric], subst mult.commute, subst Re_i_times) auto + from y * show "moebius_pt (moebius_rotation (-pi/2)) y \ positive_x_axis" + unfolding positive_y_axis_def positive_x_axis_def circline_set_def + unfolding moebius_rotation_def moebius_similarity_def + apply simp + apply transfer + apply transfer + apply (auto simp add: vec_cnj_def field_simps add_eq_0_iff) + done +next + fix x + assume x: "x \ positive_x_axis" + let ?y = "moebius_pt (moebius_rotation (pi/2)) x" + have *: "Im (a * \ / b) > 0 \ Re (a / b) > 0" for a b + by (subst times_divide_eq_left [symmetric], subst mult.commute, subst Im_i_times) auto + hence "?y \ positive_y_axis" + using \x \ positive_x_axis\ + unfolding positive_x_axis_def positive_y_axis_def + unfolding moebius_rotation_def moebius_similarity_def + unfolding circline_set_def + apply simp + apply transfer + apply transfer + apply (auto simp add: vec_cnj_def field_simps add_eq_0_iff) + done + thus "x \ moebius_pt (moebius_rotation (-pi/2)) ` positive_y_axis" + by (auto simp add: image_iff) (rule_tac x="?y" in bexI, simp_all) +qed + +(* ----------------------------------------------------------------- *) +subsection \Circline uniqueness\ +(* ----------------------------------------------------------------- *) + +(* ----------------------------------------------------------------- *) +subsubsection \Zero type circline uniqueness\ +(* ----------------------------------------------------------------- *) + +lemma unique_circline_type_zero_0': + shows "(circline_type circline_point_0 = 0 \ 0\<^sub>h \ circline_set circline_point_0) \ + (\ H. circline_type H = 0 \ 0\<^sub>h \ circline_set H \ H = circline_point_0)" +unfolding circline_set_def +proof (safe) + show "circline_type circline_point_0 = 0" + by (transfer, transfer, simp) +next + show "on_circline circline_point_0 0\<^sub>h" + using circline_set_def zero_in_circline_point_0 + by auto +next + fix H + assume "circline_type H = 0" "on_circline H 0\<^sub>h" + thus "H = circline_point_0" + proof (transfer, transfer) + fix H :: complex_mat + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases "H") auto + hence *: "C = cnj B" "is_real A" + using hh hermitean_elems[of A B C D] + by auto + assume "circline_type_cmat H = 0" "on_circline_cmat_cvec H 0\<^sub>v" + thus "circline_eq_cmat H circline_point_0_cmat" + using HH hh * + by (simp add: Let_def vec_cnj_def sgn_minus sgn_mult sgn_zero_iff) + (rule_tac x="1/Re A" in exI, cases A, cases B, simp add: Complex_eq sgn_zero_iff) + qed +qed + +lemma unique_circline_type_zero_0: + shows "\! H. circline_type H = 0 \ 0\<^sub>h \ circline_set H" + using unique_circline_type_zero_0' + by blast + +lemma unique_circline_type_zero: + shows "\! H. circline_type H = 0 \ z \ circline_set H" +proof- + obtain M where ++: "moebius_pt M z = 0\<^sub>h" + using ex_moebius_1[of z] + by auto + have +++: "z = moebius_pt (moebius_inv M) 0\<^sub>h" + by (subst ++[symmetric]) simp + then obtain H0 where *: "circline_type H0 = 0 \ 0\<^sub>h \ circline_set H0" and + **: "\ H'. circline_type H' = 0 \ 0\<^sub>h \ circline_set H' \ H' = H0" + using unique_circline_type_zero_0 + by auto + let ?H' = "moebius_circline (moebius_inv M) H0" + show ?thesis + unfolding Ex1_def + using * +++ + proof (rule_tac x="?H'" in exI, simp, safe) + fix H' + assume "circline_type H' = 0" "moebius_pt (moebius_inv M) 0\<^sub>h \ circline_set H'" + hence "0\<^sub>h \ circline_set (moebius_circline M H')" + using ++ +++ + by force + hence "moebius_circline M H' = H0" + using **[rule_format, of "moebius_circline M H'"] + using \circline_type H' = 0\ + by simp + thus "H' = moebius_circline (moebius_inv M) H0" + by auto + qed +qed + +(* ----------------------------------------------------------------- *) +subsubsection \Negative type circline uniqueness\ +(* ----------------------------------------------------------------- *) + +lemma unique_circline_01inf': + shows "0\<^sub>h \ circline_set x_axis \ 1\<^sub>h \ circline_set x_axis \ \\<^sub>h \ circline_set x_axis \ + (\ H. 0\<^sub>h \ circline_set H \ 1\<^sub>h \ circline_set H \ \\<^sub>h \ circline_set H \ H = x_axis)" +proof safe + fix H + assume "0\<^sub>h \ circline_set H" "1\<^sub>h \ circline_set H" "\\<^sub>h \ circline_set H" + thus "H = x_axis" + unfolding circline_set_def + apply simp + proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases H) auto + have *: "C = cnj B" "A = 0 \ D = 0 \ B \ 0" + using hermitean_elems[of A B C D] hh HH + by auto + obtain Bx By where "B = Complex Bx By" + by (cases B) auto + assume "on_circline_cmat_cvec H 0\<^sub>v" "on_circline_cmat_cvec H 1\<^sub>v" "on_circline_cmat_cvec H \\<^sub>v" + thus "circline_eq_cmat H x_axis_cmat" + using * HH \C = cnj B\ \B = Complex Bx By\ + by (simp add: Let_def vec_cnj_def Complex_eq) (rule_tac x="1/By" in exI, auto) + qed +qed simp_all + +lemma unique_circline_set: + assumes "A \ B" and "A \ C" and "B \ C" + shows "\! H. A \ circline_set H \ B \ circline_set H \ C \ circline_set H" +proof- + let ?P = "\ A B C. A \ B \ A \ C \ B \ C \ (\! H. A \ circline_set H \ B \ circline_set H \ C \ circline_set H)" + have "?P A B C" + proof (rule wlog_moebius_01inf[of ?P]) + fix M a b c + let ?M = "moebius_pt M" + assume "?P a b c" + show "?P (?M a) (?M b) (?M c)" + proof + assume "?M a \ ?M b \ ?M a \ ?M c \ ?M b \ ?M c" + hence "a \ b" "b \ c" "a \ c" + by auto + hence "\!H. a \ circline_set H \ b \ circline_set H \ c \ circline_set H" + using \?P a b c\ + by simp + then obtain H where + *: "a \ circline_set H \ b \ circline_set H \ c \ circline_set H" and + **: "\H'. a \ circline_set H' \ b \ circline_set H' \ c \ circline_set H' \ H' = H" + unfolding Ex1_def + by auto + let ?H' = "moebius_circline M H" + show "\! H. ?M a \ circline_set H \ moebius_pt M b \ circline_set H \ moebius_pt M c \ circline_set H" + unfolding Ex1_def + proof (rule_tac x="?H'" in exI, rule) + show "?M a \ circline_set ?H' \ ?M b \ circline_set ?H' \ ?M c \ circline_set ?H'" + using * + by auto + next + show "\H'. ?M a \ circline_set H' \ ?M b \ circline_set H' \ ?M c \ circline_set H' \ H' = ?H'" + proof (safe) + fix H' + let ?iH' = "moebius_circline (moebius_inv M) H'" + assume "?M a \ circline_set H'" "?M b \ circline_set H'" "?M c \ circline_set H'" + hence "a \ circline_set ?iH' \ b \ circline_set ?iH' \ c \ circline_set ?iH'" + by simp + hence "H = ?iH'" + using ** + by blast + thus "H' = moebius_circline M H" + by simp + qed + qed + qed + next + show "?P 0\<^sub>h 1\<^sub>h \\<^sub>h" + using unique_circline_01inf' + unfolding Ex1_def + by (safe, rule_tac x="x_axis" in exI) auto + qed fact+ + thus ?thesis + using assms + by simp +qed + +lemma zero_one_inf_x_axis [simp]: + assumes "0\<^sub>h \ circline_set H" and "1\<^sub>h \ circline_set H" and "\\<^sub>h \ circline_set H" + shows "H = x_axis" + using assms unique_circline_set[of "0\<^sub>h" "1\<^sub>h" "\\<^sub>h"] + by auto + +(* ----------------------------------------------------------------- *) +subsection \Circline set cardinality\ +(* ----------------------------------------------------------------- *) + +(* ----------------------------------------------------------------- *) +subsubsection \Diagonal circlines\ +(* ----------------------------------------------------------------- *) + +definition is_diag_circline_cmat :: "complex_mat \ bool" where + [simp]: "is_diag_circline_cmat H = (let (A, B, C, D) = H in B = 0 \ C = 0)" +lift_definition is_diag_circline_clmat :: "circline_mat \ bool" is is_diag_circline_cmat + done +lift_definition circline_diag :: "circline \ bool" is is_diag_circline_clmat + by transfer auto + +lemma circline_diagonalize: + shows "\ M H'. moebius_circline M H = H' \ circline_diag H'" +proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases "H") auto + hence HH_elems: "is_real A" "is_real D" "C = cnj B" + using hermitean_elems[of A B C D] hh + by auto + obtain M k1 k2 where *: "mat_det M \ 0" "unitary M" "congruence M H = (k1, 0, 0, k2)" "is_real k1" "is_real k2" + using hermitean_diagonizable[of H] hh + by auto + have "k1 \ 0 \ k2 \ 0" + using \congruence M H = (k1, 0, 0, k2)\ hh congruence_nonzero[of H M] \mat_det M \ 0\ + by auto + let ?M' = "mat_inv M" + let ?H' = "(k1, 0, 0, k2)" + have "circline_eq_cmat (moebius_circline_cmat_cmat ?M' H) ?H' \ is_diag_circline_cmat ?H'" + using * + by force + moreover + have "?H' \ hermitean_nonzero" + using * \k1 \ 0 \ k2 \ 0\ eq_cnj_iff_real[of k1] eq_cnj_iff_real[of k2] + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def) + moreover + have "mat_det ?M' \ 0" + using * mat_det_inv[of M] + by auto + ultimately + show "\M\{M. mat_det M \ 0}. + \H'\hermitean_nonzero. + circline_eq_cmat (moebius_circline_cmat_cmat M H) H' \ is_diag_circline_cmat H'" + by blast +qed + +lemma wlog_circline_diag: + assumes "\ H. circline_diag H \ P H" + "\ M H. P H \ P (moebius_circline M H)" + shows "P H" +proof- + obtain M H' where "moebius_circline M H = H'" "circline_diag H'" + using circline_diagonalize[of H] + by auto + hence "P (moebius_circline M H)" + using assms(1) + by simp + thus ?thesis + using assms(2)[of "moebius_circline M H" "moebius_inv M"] + by simp +qed + +(* ----------------------------------------------------------------- *) +subsubsection \Zero type circline set cardinality\ +(* ----------------------------------------------------------------- *) + +lemma circline_type_zero_card_eq1_0: + assumes "circline_type H = 0" and "0\<^sub>h \ circline_set H" + shows "circline_set H = {0\<^sub>h}" +using assms +unfolding circline_set_def +proof(safe) + fix z + assume "on_circline H z" "circline_type H = 0" "on_circline H 0\<^sub>h" + hence "H = circline_point_0" + using unique_circline_type_zero_0' + unfolding circline_set_def + by simp + thus "z = 0\<^sub>h" + using \on_circline H z\ + by (transfer, transfer) (case_tac z, case_tac H, force simp add: vec_cnj_def) +qed + + +lemma circline_type_zero_card_eq1: + assumes "circline_type H = 0" + shows "\ z. circline_set H = {z}" +proof- + have "\ z. on_circline H z" + using assms + proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases H) auto + hence "C = cnj B" "is_real A" "is_real D" + using hh hermitean_elems[of A B C D] + by auto + assume "circline_type_cmat H = 0" + hence "mat_det H = 0" + by (simp add: complex_eq_if_Re_eq hh mat_det_hermitean_real sgn_eq_0_iff) + hence "A*D = B*C" + using HH + by simp + show "Bex {v. v \ vec_zero} (on_circline_cmat_cvec H)" + proof (cases "A \ 0 \ B \ 0") + case True + thus ?thesis + using HH \A*D = B*C\ + by (rule_tac x="(-B, A)" in bexI) (auto simp add: Let_def vec_cnj_def field_simps) + next + case False + thus ?thesis + using HH \C = cnj B\ + by (rule_tac x="(1, 0)" in bexI) (simp_all add: Let_def vec_cnj_def) + qed + qed + then obtain z where "on_circline H z" + by auto + obtain M where "moebius_pt M z = 0\<^sub>h" + using ex_moebius_1[of z] + by auto + hence "0\<^sub>h \ circline_set (moebius_circline M H)" + using on_circline_moebius_circline_I[OF \on_circline H z\, of M] + unfolding circline_set_def + by simp + hence "circline_set (moebius_circline M H) = {0\<^sub>h}" + using circline_type_zero_card_eq1_0[of "moebius_circline M H"] \circline_type H = 0\ + by auto + hence "circline_set H = {z}" + using \moebius_pt M z = 0\<^sub>h\ + using bij_moebius_pt[of M] bij_image_singleton[of "moebius_pt M" "circline_set H" _ z] + by simp + thus ?thesis + by auto +qed + +(* ----------------------------------------------------------------- *) +subsubsection \Negative type circline set cardinality\ +(* ----------------------------------------------------------------- *) + +lemma quad_form_diagonal_iff: + assumes "k1 \ 0" and "is_real k1" and "is_real k2" and "Re k1 * Re k2 < 0" + shows "quad_form (z1, 1) (k1, 0, 0, k2) = 0 \ (\ \. z1 = rcis (sqrt (Re (-k2 /k1))) \)" +proof- + have "Re (-k2/k1) \ 0" + using \Re k1 * Re k2 < 0\ \is_real k1\ \is_real k2\ \k1 \ 0\ + using Re_divide_real[of k1 "-k2"] + by (smt divide_less_0_iff mult_nonneg_nonneg mult_nonpos_nonpos uminus_complex.simps(1)) + + have "quad_form (z1, 1) (k1, 0, 0, k2) = 0 \ (cor (cmod z1))\<^sup>2 = -k2 / k1" + using assms add_eq_0_iff[of k2 "k1*(cor (cmod z1))\<^sup>2"] + using eq_divide_imp[of k1 "(cor (cmod z1))\<^sup>2" "-k2"] + by (auto simp add: vec_cnj_def field_simps complex_mult_cnj_cmod) + also have "... \ (cmod z1)\<^sup>2 = Re (-k2 /k1)" + using assms + apply (subst complex_eq_if_Re_eq) + using Re_complex_of_real[of "(cmod z1)\<^sup>2"] div_reals + by auto + also have "... \ cmod z1 = sqrt (Re (-k2 /k1))" + by (metis norm_ge_zero real_sqrt_ge_0_iff real_sqrt_pow2 real_sqrt_power) + also have "... \ (\ \. z1 = rcis (sqrt (Re (-k2 /k1))) \)" + using rcis_cmod_arg[of z1, symmetric] assms abs_of_nonneg[of "sqrt (Re (-k2/k1))"] + using \Re (-k2/k1) \ 0\ + by auto + finally show ?thesis + . +qed + +lemma circline_type_neg_card_gt3_diag: + assumes "circline_type H < 0" and "circline_diag H" + shows "\ A B C. A \ B \ A \ C \ B \ C \ {A, B, C} \ circline_set H" + using assms + unfolding circline_set_def + apply (simp del: HOL.ex_simps) +proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases H) auto + hence HH_elems: "is_real A" "is_real D" "C = cnj B" + using hermitean_elems[of A B C D] hh + by auto + assume "circline_type_cmat H < 0" "is_diag_circline_cmat H" + hence "B = 0" "C = 0" "Re A * Re D < 0" "A \ 0" + using HH \is_real A\ \is_real D\ + by auto + + let ?x = "sqrt (Re (- D / A))" + let ?A = "(rcis ?x 0, 1)" + let ?B = "(rcis ?x (pi/2), 1)" + let ?C = "(rcis ?x pi, 1)" + from quad_form_diagonal_iff[OF \A \ 0\ \is_real A\ \is_real D\ \Re A * Re D < 0\] + have "quad_form ?A (A, 0, 0, D) = 0" "quad_form ?B (A, 0, 0, D) = 0" "quad_form ?C (A, 0, 0, D) = 0" + by (auto simp del: rcis_zero_arg) + hence "on_circline_cmat_cvec H ?A \ on_circline_cmat_cvec H ?B \ on_circline_cmat_cvec H ?C" + using HH \B = 0\ \C = 0\ + by simp + moreover + have "Re (D / A) < 0" + using \Re A * Re D < 0\ \A \ 0\ \is_real A\ \is_real D\ + using Re_divide_real[of A D] + by (metis Re_complex_div_lt_0 Re_mult_real div_reals eq_cnj_iff_real is_real_div) + hence "\ ?A \\<^sub>v ?B \ \ ?A \\<^sub>v ?C \ \ ?B \\<^sub>v ?C" + unfolding rcis_def + by (auto simp add: cis_def complex.corec) + moreover + have "?A \ vec_zero" "?B \ vec_zero" "?C \ vec_zero" + by auto + ultimately + show "\A\{v. v \ vec_zero}. \B\{v. v \ vec_zero}. \C\{v. v \ vec_zero}. + \ A \\<^sub>v B \ \ A \\<^sub>v C \ \ B \\<^sub>v C \ + on_circline_cmat_cvec H A \ on_circline_cmat_cvec H B \ on_circline_cmat_cvec H C" + by blast +qed + +lemma circline_type_neg_card_gt3: + assumes "circline_type H < 0" + shows "\ A B C. A \ B \ A \ C \ B \ C \ {A, B, C} \ circline_set H" +proof- + obtain M H' where "moebius_circline M H = H'" "circline_diag H'" + using circline_diagonalize[of H] assms + by auto + moreover + hence "circline_type H' < 0" + using assms moebius_preserve_circline_type + by auto + ultimately + obtain A B C where "A \ B" "A \ C" "B \ C" "{A, B, C} \ circline_set H'" + using circline_type_neg_card_gt3_diag[of H'] + by auto + let ?iM = "moebius_inv M" + have "moebius_circline ?iM H' = H" + using \moebius_circline M H = H'\[symmetric] + by simp + let ?A = "moebius_pt ?iM A" and ?B= "moebius_pt ?iM B" and ?C = "moebius_pt ?iM C" + have "?A \ circline_set H" "?B \ circline_set H" "?C \ circline_set H" + using \moebius_circline ?iM H' = H\[symmetric] \{A, B, C} \ circline_set H'\ + by simp_all + moreover + have "?A \ ?B" "?A \ ?C" "?B \ ?C" + using \A \ B\ \A \ C\ \B \ C\ + by auto + ultimately + show ?thesis + by auto +qed + +(* ----------------------------------------------------------------- *) +subsubsection \Positive type circline set cardinality\ +(* ----------------------------------------------------------------- *) + +lemma circline_type_pos_card_eq0_diag: + assumes "circline_diag H" and "circline_type H > 0" + shows "circline_set H = {}" +using assms +unfolding circline_set_def +apply simp +proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases H) auto + hence HH_elems: "is_real A" "is_real D" "C = cnj B" + using hermitean_elems[of A B C D] hh + by auto + assume "is_diag_circline_cmat H" "0 < circline_type_cmat H" + hence "B = 0" "C = 0" "Re A * Re D > 0" "A \ 0" + using HH \is_real A\ \is_real D\ + by auto + show "\x\{v. v \ vec_zero}. \ on_circline_cmat_cvec H x" + proof + fix x + assume "x \ {v. v \ vec_zero}" + obtain x1 x2 where xx: "x = (x1, x2)" + by (cases x, auto) + have "(Re A > 0 \ Re D > 0) \ (Re A < 0 \ Re D < 0)" + using \Re A * Re D > 0\ + by (metis linorder_neqE_linordered_idom mult_eq_0_iff zero_less_mult_pos zero_less_mult_pos2) + moreover + have "(Re (x1 * cnj x1) \ 0 \ Re (x2 * cnj x2) > 0) \ (Re (x1 * cnj x1) > 0 \ Re (x2 * cnj x2) \ 0)" + using \x \ {v. v \ vec_zero}\ xx + apply auto + apply (simp add: complex_neq_0 power2_eq_square)+ + done + ultimately + have "Re A * Re (x1 * cnj x1) + Re D * Re (x2 * cnj x2) \ 0" + by (smt mult_neg_pos mult_nonneg_nonneg mult_nonpos_nonneg mult_pos_pos) + hence "A * (x1 * cnj x1) + D * (x2 * cnj x2) \ 0" + using \is_real A\ \is_real D\ + by (metis Re_mult_real plus_complex.simps(1) zero_complex.simps(1)) + thus "\ on_circline_cmat_cvec H x" + using HH \B = 0\ \C = 0\ xx + by (simp add: vec_cnj_def field_simps) + qed +qed + +lemma circline_type_pos_card_eq0: + assumes "circline_type H > 0" + shows "circline_set H = {}" +proof- + obtain M H' where "moebius_circline M H = H'" "circline_diag H'" + using circline_diagonalize[of H] assms + by auto + moreover + hence "circline_type H' > 0" + using assms moebius_preserve_circline_type + by auto + ultimately + have "circline_set H' = {}" + using circline_type_pos_card_eq0_diag[of H'] + by auto + let ?iM = "moebius_inv M" + have "moebius_circline ?iM H' = H" + using \moebius_circline M H = H'\[symmetric] + by simp + thus ?thesis + using \circline_set H' = {}\ + by auto +qed + +(* ----------------------------------------------------------------- *) +subsubsection \Cardinality determines type\ +(* ----------------------------------------------------------------- *) + +lemma card_eq1_circline_type_zero: + assumes "\ z. circline_set H = {z}" + shows "circline_type H = 0" +proof (cases "circline_type H < 0") + case True + thus ?thesis + using circline_type_neg_card_gt3[of H] assms + by auto +next + case False + show ?thesis + proof (cases "circline_type H > 0") + case True + thus ?thesis + using circline_type_pos_card_eq0[of H] assms + by auto + next + case False + thus ?thesis + using \\ (circline_type H) < 0\ + by simp + qed +qed + +(* ----------------------------------------------------------------- *) +subsubsection \Circline set is injective\ +(* ----------------------------------------------------------------- *) + +lemma inj_circline_set: + assumes "circline_set H = circline_set H'" and "circline_set H \ {}" + shows "H = H'" +proof (cases "circline_type H < 0") + case True + then obtain A B C where "A \ B" "A \ C" "B \ C" "{A, B, C} \ circline_set H" + using circline_type_neg_card_gt3[of H] + by auto + hence "\!H. A \ circline_set H \ B \ circline_set H \ C \ circline_set H" + using unique_circline_set[of A B C] + by simp + thus ?thesis + using \circline_set H = circline_set H'\ \{A, B, C} \ circline_set H\ + by auto +next + case False + show ?thesis + proof (cases "circline_type H = 0") + case True + moreover + then obtain A where "{A} = circline_set H" + using circline_type_zero_card_eq1[of H] + by auto + moreover + hence "circline_type H' = 0" + using \circline_set H = circline_set H'\ card_eq1_circline_type_zero[of H'] + by auto + ultimately + show ?thesis + using unique_circline_type_zero[of A] \circline_set H = circline_set H'\ + by auto + next + case False + hence "circline_type H > 0" + using \\ (circline_type H < 0)\ + by auto + thus ?thesis + using \circline_set H \ {}\ circline_type_pos_card_eq0[of H] + by auto + qed +qed + +(* ----------------------------------------------------------------- *) +subsection \Circline points - cross ratio real\ +(* ----------------------------------------------------------------- *) + +lemma four_points_on_circline_iff_cross_ratio_real: + assumes "distinct [z, u, v, w]" + shows "is_real (to_complex (cross_ratio z u v w)) \ + (\ H. {z, u, v, w} \ circline_set H)" +proof- + have "\ z. distinct [z, u, v, w] \ is_real (to_complex (cross_ratio z u v w)) \ (\ H. {z, u, v, w} \ circline_set H)" + (is "?P u v w") + proof (rule wlog_moebius_01inf[of ?P u v w]) + fix M a b c + assume aa: "?P a b c" + let ?Ma = "moebius_pt M a" and ?Mb = "moebius_pt M b" and ?Mc = "moebius_pt M c" + show "?P ?Ma ?Mb ?Mc" + proof (rule allI, rule impI) + fix z + obtain d where *: "z = moebius_pt M d" + using bij_moebius_pt[of M] + unfolding bij_def + by auto + let ?Md = "moebius_pt M d" + assume "distinct [z, moebius_pt M a, moebius_pt M b, moebius_pt M c]" + hence "distinct [a, b, c, d]" + using * + by auto + moreover + have "(\ H. {d, a, b, c} \ circline_set H) \ (\ H. {z, ?Ma, ?Mb, ?Mc} \ circline_set H)" + using * + apply auto + apply (rule_tac x="moebius_circline M H" in exI, simp) + apply (rule_tac x="moebius_circline (moebius_inv M) H" in exI, simp) + done + ultimately + show "is_real (to_complex (cross_ratio z ?Ma ?Mb ?Mc)) = (\H. {z, ?Ma, ?Mb, ?Mc} \ circline_set H)" + using aa[rule_format, of d] * + by auto + qed + next + show "?P 0\<^sub>h 1\<^sub>h \\<^sub>h" + proof safe + fix z + assume "distinct [z, 0\<^sub>h, 1\<^sub>h, \\<^sub>h]" + hence "z \ \\<^sub>h" + by auto + assume "is_real (to_complex (cross_ratio z 0\<^sub>h 1\<^sub>h \\<^sub>h))" + hence "is_real (to_complex z)" + by simp + hence "z \ circline_set x_axis" + using of_complex_to_complex[symmetric, OF \z \ \\<^sub>h\] + using circline_set_x_axis + by auto + thus "\H. {z, 0\<^sub>h, 1\<^sub>h, \\<^sub>h} \ circline_set H" + by (rule_tac x=x_axis in exI, auto) + next + fix z H + assume *: "distinct [z, 0\<^sub>h, 1\<^sub>h, \\<^sub>h]" "{z, 0\<^sub>h, 1\<^sub>h, \\<^sub>h} \ circline_set H" + hence "H = x_axis" + by auto + hence "z \ circline_set x_axis" + using * + by auto + hence "is_real (to_complex z)" + using * circline_set_x_axis + by auto + thus "is_real (to_complex (cross_ratio z 0\<^sub>h 1\<^sub>h \\<^sub>h))" + by simp + qed + next + show "u \ v" "v \ w" "u \ w" + using assms + by auto + qed + thus ?thesis + using assms + by auto +qed + +(* ----------------------------------------------------------------- *) +subsection \Symmetric points wrt. circline\ +(* ----------------------------------------------------------------- *) + +text \In the extended complex plane there are no substantial differences between circles and lines, +so we will consider only one kind of relation and call two points \emph{circline symmetric} if they +are mapped to one another using either reflection or inversion over arbitrary line or circle. Points +are symmetric iff the bilinear form of their representation vectors and matrix is zero.\ + +definition circline_symmetric_cvec_cmat :: "complex_vec \ complex_vec \ complex_mat \ bool" where + [simp]: "circline_symmetric_cvec_cmat z1 z2 H \ bilinear_form z1 z2 H = 0" +lift_definition circline_symmetric_hcoords_clmat :: "complex_homo_coords \ complex_homo_coords \ circline_mat \ bool" is circline_symmetric_cvec_cmat + done +lift_definition circline_symmetric :: "complex_homo \ complex_homo \ circline \ bool" is circline_symmetric_hcoords_clmat + apply transfer + apply (simp del: bilinear_form_def) + apply (erule exE)+ + apply (simp add: bilinear_form_scale_m bilinear_form_scale_v1 bilinear_form_scale_v2 del: vec_cnj_sv quad_form_def bilinear_form_def) + done + +lemma symmetry_principle [simp]: + assumes "circline_symmetric z1 z2 H" + shows "circline_symmetric (moebius_pt M z1) (moebius_pt M z2) (moebius_circline M H)" + using assms + by (transfer, transfer, simp del: bilinear_form_def congruence_def) + +text \Symmetry wrt. @{term "unit_circle"}\ +lemma circline_symmetric_0inf_disc [simp]: + shows "circline_symmetric 0\<^sub>h \\<^sub>h unit_circle" + by (transfer, transfer, simp add: vec_cnj_def) + +lemma circline_symmetric_inv_homo_disc [simp]: + shows "circline_symmetric a (inversion a) unit_circle" + unfolding inversion_def + by (transfer, transfer) (case_tac a, auto simp add: vec_cnj_def) + +lemma circline_symmetric_inv_homo_disc': + assumes "circline_symmetric a a' unit_circle" + shows "a' = inversion a" + unfolding inversion_def + using assms +proof (transfer, transfer) + fix a a' + assume vz: "a \ vec_zero" "a' \ vec_zero" + obtain a1 a2 where aa: "a = (a1, a2)" + by (cases a, auto) + obtain a1' a2' where aa': "a' = (a1', a2')" + by (cases a', auto) + assume *: "circline_symmetric_cvec_cmat a a' unit_circle_cmat" + show "a' \\<^sub>v (conjugate_cvec \ reciprocal_cvec) a" + proof (cases "a1' = 0") + case True + thus ?thesis + using aa aa' vz * + by (auto simp add: vec_cnj_def field_simps) + next + case False + show ?thesis + proof (cases "a2 = 0") + case True + thus ?thesis + using \a1' \ 0\ + using aa aa' * vz + by (simp add: vec_cnj_def field_simps) + next + case False + thus ?thesis + using \a1' \ 0\ aa aa' * + by (simp add: vec_cnj_def field_simps) (rule_tac x="cnj a2 / a1'" in exI, simp add: field_simps) + qed + qed +qed + +lemma ex_moebius_circline_x_axis: + assumes "circline_type H < 0" + shows "\ M. moebius_circline M H = x_axis" +proof- + obtain A B C where *: "A \ B" "A \ C" "B \ C" "on_circline H A" "on_circline H B" "on_circline H C" + using circline_type_neg_card_gt3[OF assms] + unfolding circline_set_def + by auto + then obtain M where "moebius_pt M A = 0\<^sub>h" "moebius_pt M B = 1\<^sub>h" "moebius_pt M C = \\<^sub>h" + using ex_moebius_01inf by blast + hence "moebius_circline M H = x_axis" + using * + by (metis circline_set_I circline_set_moebius_circline rev_image_eqI unique_circline_01inf') + thus ?thesis + by blast +qed + +lemma wlog_circline_x_axis: + assumes "circline_type H < 0" + assumes "\ M H. P H \ P (moebius_circline M H)" + assumes "P x_axis" + shows "P H" +proof- + obtain M where "moebius_circline M H = x_axis" + using ex_moebius_circline_x_axis[OF assms(1)] + by blast + then obtain M' where "moebius_circline M' x_axis = H" + by (metis moebius_circline_comp_inv_left) + thus ?thesis + using assms(2)[of x_axis M'] assms(3) + by simp +qed + +lemma circline_intersection_at_most_2_points: + assumes "H1 \ H2" + shows "finite (circline_intersection H1 H2) \ card (circline_intersection H1 H2) \ 2" +proof (rule ccontr) + assume "\ ?thesis" + hence "infinite (circline_intersection H1 H2) \ card (circline_intersection H1 H2) > 2" + by auto + hence "\ A B C. A \ B \ B \ C \ A \ C \ {A, B, C} \ circline_intersection H1 H2" + proof + assume "card (circline_intersection H1 H2) > 2" + thus ?thesis + using card_geq_3_iff_contains_3_elems[of "circline_intersection H1 H2"] + by auto + next + assume "infinite (circline_intersection H1 H2)" + thus ?thesis + using infinite_contains_3_elems + by blast + qed + then obtain A B C where "A \ B" "B \ C" "A \ C" "{A, B, C} \ circline_intersection H1 H2" + by blast + hence "H2 = H1" + using circline_intersection_def mem_Collect_eq unique_circline_set by fastforce + thus False + using assms + by simp +qed + +end diff --git a/thys/Complex_Geometry/Circlines_Angle.thy b/thys/Complex_Geometry/Circlines_Angle.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Circlines_Angle.thy @@ -0,0 +1,387 @@ +theory Circlines_Angle + imports Oriented_Circlines Elementary_Complex_Geometry +begin + + +(* ----------------------------------------------------------------- *) +subsection \Angle between circlines\ +(* ----------------------------------------------------------------- *) + +text \Angle between circlines can be defined in purely algebraic terms (following Schwerdtfeger +\cite{schwerdtfeger}) and using this definitions many properties can be easily proved.\ + +fun mat_det_12 :: "complex_mat \ complex_mat \ complex" where + "mat_det_12 (A1, B1, C1, D1) (A2, B2, C2, D2) = A1*D2 + A2*D1 - B1*C2 - B2*C1" + +lemma mat_det_12_mm_l [simp]: + shows "mat_det_12 (M *\<^sub>m\<^sub>m A) (M *\<^sub>m\<^sub>m B) = mat_det M * mat_det_12 A B" + by (cases M, cases A, cases B) (simp add: field_simps) + +lemma mat_det_12_mm_r [simp]: + shows "mat_det_12 (A *\<^sub>m\<^sub>m M) (B *\<^sub>m\<^sub>m M) = mat_det M * mat_det_12 A B" + by (cases M, cases A, cases B) (simp add: field_simps) + +lemma mat_det_12_sm_l [simp]: + shows "mat_det_12 (k *\<^sub>s\<^sub>m A) B = k * mat_det_12 A B" + by (cases A, cases B) (simp add: field_simps) + +lemma mat_det_12_sm_r [simp]: + shows "mat_det_12 A (k *\<^sub>s\<^sub>m B) = k * mat_det_12 A B" + by (cases A, cases B) (simp add: field_simps) + +lemma mat_det_12_congruence [simp]: + shows "mat_det_12 (congruence M A) (congruence M B) = (cor ((cmod (mat_det M))\<^sup>2)) * mat_det_12 A B" + unfolding congruence_def + by ((subst mult_mm_assoc[symmetric])+, subst mat_det_12_mm_l, subst mat_det_12_mm_r, subst mat_det_adj) (auto simp add: field_simps complex_mult_cnj_cmod) + + +definition cos_angle_cmat :: "complex_mat \ complex_mat \ real" where + [simp]: "cos_angle_cmat H1 H2 = - Re (mat_det_12 H1 H2) / (2 * (sqrt (Re (mat_det H1 * mat_det H2))))" + +lift_definition cos_angle_clmat :: "circline_mat \ circline_mat \ real" is cos_angle_cmat + done + +lemma cos_angle_den_scale [simp]: + assumes "k1 > 0" and "k2 > 0" + shows "sqrt (Re ((k1\<^sup>2 * mat_det H1) * (k2\<^sup>2 * mat_det H2))) = + k1 * k2 * sqrt (Re (mat_det H1 * mat_det H2))" +proof- + let ?lhs = "(k1\<^sup>2 * mat_det H1) * (k2\<^sup>2 * mat_det H2)" + let ?rhs = "mat_det H1 * mat_det H2" + have 1: "?lhs = (k1\<^sup>2*k2\<^sup>2) * ?rhs" + by simp + hence "Re ?lhs = (k1\<^sup>2*k2\<^sup>2) * Re ?rhs" + by (simp add: field_simps) + thus ?thesis + using assms + by (simp add: real_sqrt_mult) +qed + +lift_definition cos_angle :: "ocircline \ ocircline \ real" is cos_angle_clmat +proof transfer + fix H1 H2 H1' H2' + assume "ocircline_eq_cmat H1 H1'" "ocircline_eq_cmat H2 H2'" + then obtain k1 k2 :: real where + *: "k1 > 0" "H1' = cor k1 *\<^sub>s\<^sub>m H1" + "k2 > 0" "H2' = cor k2 *\<^sub>s\<^sub>m H2" + by auto + thus "cos_angle_cmat H1 H2 = cos_angle_cmat H1' H2'" + unfolding cos_angle_cmat_def + apply (subst *)+ + apply (subst mat_det_12_sm_l, subst mat_det_12_sm_r) + apply (subst mat_det_mult_sm)+ + apply (subst power2_eq_square[symmetric])+ + apply (subst cos_angle_den_scale, simp, simp) + apply simp + done +qed + +text \Möbius transformations are conformal, meaning that they preserve oriented angle between +oriented circlines.\ + +lemma cos_angle_opposite1 [simp]: + shows "cos_angle (opposite_ocircline H) H' = - cos_angle H H'" + by (transfer, transfer, simp) + +lemma cos_angle_opposite2 [simp]: + shows "cos_angle H (opposite_ocircline H') = - cos_angle H H'" + by (transfer, transfer, simp) + +(* ----------------------------------------------------------------- *) +subsubsection \Connection with the elementary angle definition between circles\ +(* ----------------------------------------------------------------- *) + +text\We want to connect algebraic definition of an angle with a traditional one and +to prove equivalency between these two definitions. For the traditional definition of +an angle we follow the approach suggested by Needham \cite{needham}.\ + +lemma Re_sgn: + assumes "is_real A" and "A \ 0" + shows "Re (sgn A) = sgn_bool (Re A > 0)" +using assms +using More_Complex.Re_sgn complex_eq_if_Re_eq +by auto + +lemma Re_mult_real3: + assumes "is_real z1" and "is_real z2" and "is_real z3" + shows "Re (z1 * z2 * z3) = Re z1 * Re z2 * Re z3" + using assms + by (metis Re_mult_real mult_reals) + +lemma sgn_sqrt [simp]: + shows "sgn (sqrt x) = sgn x" + by (simp add: sgn_root sqrt_def) + +lemma real_circle_sgn_r: + assumes "is_circle H" and "(a, r) = euclidean_circle H" + shows "sgn r = - circline_type H" + using assms +proof (transfer, transfer) + fix H :: complex_mat and a r + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases H) auto + hence "is_real A" "is_real D" + using hermitean_elems hh + by auto + assume "\ circline_A0_cmat H" "(a, r) = euclidean_circle_cmat H" + hence "A \ 0" + using \\ circline_A0_cmat H\ HH + by simp + hence "Re A * Re A > 0" + using \is_real A\ + using complex_eq_if_Re_eq not_real_square_gt_zero + by fastforce + thus "sgn r = - circline_type_cmat H" + using HH \(a, r) = euclidean_circle_cmat H\ \is_real A\ \is_real D\ \A \ 0\ + by (simp add: Re_divide_real sgn_minus[symmetric]) +qed + +text \The definition of an angle using algebraic terms is not intuitive, and we want to connect it to +the more common definition given earlier that defines an +angle between circlines as the angle between tangent vectors in the point of the intersection of the +circlines.\ + +lemma cos_angle_eq_cos_ang_circ: + assumes + "is_circle (of_ocircline H1)" and "is_circle (of_ocircline H2)" and + "circline_type (of_ocircline H1) < 0" and "circline_type (of_ocircline H2) < 0" + "(a1, r1) = euclidean_circle (of_ocircline H1)" and "(a2, r2) = euclidean_circle (of_ocircline H2)" and + "of_complex E \ ocircline_set H1 \ ocircline_set H2" + shows "cos_angle H1 H2 = cos (ang_circ E a1 a2 (pos_oriented H1) (pos_oriented H2))" +proof- + let ?p1 = "pos_oriented H1" and ?p2 = "pos_oriented H2" + have "E \ circle a1 r1" "E \ circle a2 r2" + using classic_circle[of "of_ocircline H1" a1 r1] classic_circle[of "of_ocircline H2" a2 r2] + using assms of_complex_inj + by auto + hence *: "cdist E a1 = r1" "cdist E a2 = r2" + unfolding circle_def + by (simp_all add: norm_minus_commute) + have "r1 > 0" "r2 > 0" + using assms(1-6) real_circle_sgn_r[of "of_ocircline H1" a1 r1] real_circle_sgn_r[of "of_ocircline H2" a2 r2] + using sgn_greater + by fastforce+ + hence "E \ a1" "E \ a2" + using \cdist E a1 = r1\ \cdist E a2 = r2\ + by auto + + let ?k = "sgn_bool (?p1 = ?p2)" + let ?xx = "?k * (r1\<^sup>2 + r2\<^sup>2 - (cdist a2 a1)\<^sup>2) / (2 * r1 * r2)" + + have "cos (ang_circ E a1 a2 ?p1 ?p2) = ?xx" + using law_of_cosines[of a2 a1 E] * \r1 > 0\ \r2 > 0\ cos_ang_circ_simp[OF \E \ a1\ \E \ a2\] + by (subst (asm) ang_vec_opposite_opposite'[OF \E \ a1\[symmetric] \E \ a2\[symmetric], symmetric]) simp + moreover + have "cos_angle H1 H2 = ?xx" + using \r1 > 0\ \r2 > 0\ + using \(a1, r1) = euclidean_circle (of_ocircline H1)\ \(a2, r2) = euclidean_circle (of_ocircline H2)\ + using \is_circle (of_ocircline H1)\ \is_circle (of_ocircline H2)\ + using \circline_type (of_ocircline H1) < 0\ \circline_type (of_ocircline H2) < 0\ + proof (transfer, transfer) + fix a1 r1 H1 H2 a2 r2 + assume hh: "hermitean H1 \ H1 \ mat_zero" "hermitean H2 \ H2 \ mat_zero" + obtain A1 B1 C1 D1 where HH1: "H1 = (A1, B1, C1, D1)" + by (cases H1) auto + obtain A2 B2 C2 D2 where HH2: "H2 = (A2, B2, C2, D2)" + by (cases H2) auto + have *: "is_real A1" "is_real A2" "is_real D1" "is_real D2" "cnj B1 = C1" "cnj B2 = C2" + using hh hermitean_elems[of A1 B1 C1 D1] hermitean_elems[of A2 B2 C2 D2] HH1 HH2 + by auto + have "cnj A1 = A1" "cnj A2 = A2" + using \is_real A1\ \is_real A2\ + by (case_tac[!] A1, case_tac[!] A2, auto simp add: Complex_eq) + + assume "\ circline_A0_cmat (id H1)" "\ circline_A0_cmat (id H2)" + hence "A1 \ 0" "A2 \ 0" + using HH1 HH2 + by auto + hence "Re A1 \ 0" "Re A2 \ 0" + using \is_real A1\ \is_real A2\ + using complex.expand + by auto + + assume "circline_type_cmat (id H1) < 0" "circline_type_cmat (id H2) < 0" + assume "(a1, r1) = euclidean_circle_cmat (id H1)" "(a2, r2) = euclidean_circle_cmat (id H2)" + assume "r1 > 0" "r2 > 0" + + let ?D12 = "mat_det_12 H1 H2" and ?D1 = "mat_det H1" and ?D2 = "mat_det H2" + let ?x1 = "(cdist a2 a1)\<^sup>2 - r1\<^sup>2 - r2\<^sup>2" and ?x2 = "2*r1*r2" + let ?x = "?x1 / ?x2" + have *: "Re (?D12) / (2 * (sqrt (Re (?D1 * ?D2)))) = Re (sgn A1) * Re (sgn A2) * ?x" + proof- + let ?M1 = "(A1, B1, C1, D1)" and ?M2 = "(A2, B2, C2, D2)" + let ?d1 = "B1 * C1 - A1 * D1" and ?d2 = "B2 * C2 - A2 * D2" + have "Re ?d1 > 0" "Re ?d2 > 0" + using HH1 HH2 \circline_type_cmat (id H1) < 0\ \circline_type_cmat (id H2) < 0\ + by auto + hence **: "Re (?d1 / (A1 * A1)) > 0" "Re (?d2 / (A2 * A2)) > 0" + using \is_real A1\ \is_real A2\ \A1 \ 0\ \A2 \ 0\ + by (subst Re_divide_real, simp_all add: complex_neq_0 power2_eq_square)+ + have ***: "is_real (?d1 / (A1 * A1)) \ is_real (?d2 / (A2 * A2))" + using \is_real A1\ \is_real A2\ \A1 \ 0\ \A2 \ 0\ \cnj B1 = C1\[symmetric] \cnj B2 = C2\[symmetric] \is_real D1\ \is_real D2\ + by (subst div_reals, simp, simp, simp)+ + + have "cor ?x = mat_det_12 ?M1 ?M2 / (2 * sgn A1 * sgn A2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))" + proof- + have "A1*A2*cor ?x1 = mat_det_12 ?M1 ?M2" + proof- + have 1: "A1*A2*(cor ((cdist a2 a1)\<^sup>2)) = ((B2*A1 - A2*B1)*(C2*A1 - C1*A2)) / (A1*A2)" + using \(a1, r1) = euclidean_circle_cmat (id H1)\ \(a2, r2) = euclidean_circle_cmat (id H2)\ + unfolding cdist_def cmod_square + using HH1 HH2 * \A1 \ 0\ \A2 \ 0\ \cnj A1 = A1\ \cnj A2 = A2\ + unfolding Let_def + apply (subst complex_of_real_Re) + apply (simp add: field_simps) + apply (simp add: complex_mult_cnj_cmod power2_eq_square) + apply (simp add: field_simps) + done + have 2: "A1*A2*cor (-r1\<^sup>2) = A2*D1 - B1*C1*A2/A1" + using \(a1, r1) = euclidean_circle_cmat (id H1)\ + using HH1 ** * *** \A1 \ 0\ + by (simp add: power2_eq_square field_simps) + have 3: "A1*A2*cor (-r2\<^sup>2) = A1*D2 - B2*C2*A1/A2" + using \(a2, r2) = euclidean_circle_cmat (id H2)\ + using HH2 ** * *** \A2 \ 0\ + by (simp add: power2_eq_square field_simps) + have "A1*A2*cor((cdist a2 a1)\<^sup>2) + A1*A2*cor(-r1\<^sup>2) + A1*A2*cor(-r2\<^sup>2) = mat_det_12 ?M1 ?M2" + using \A1 \ 0\ \A2 \ 0\ + by (subst 1, subst 2, subst 3) (simp add: field_simps) + thus ?thesis + by (simp add: field_simps) + qed + + moreover + + have "A1 * A2 * cor (?x2) = 2 * sgn A1 * sgn A2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2))" + proof- + have 1: "sqrt (Re (?d1/ (A1 * A1))) = sqrt (Re ?d1) / \Re A1\" + using \A1 \ 0\ \is_real A1\ + by (subst Re_divide_real, simp, simp, subst real_sqrt_divide, simp) + + have 2: "sqrt (Re (?d2/ (A2 * A2))) = sqrt (Re ?d2) / \Re A2\" + using \A2 \ 0\ \is_real A2\ + by (subst Re_divide_real, simp, simp, subst real_sqrt_divide, simp) + have "sgn A1 = A1 / cor \Re A1\" + using \is_real A1\ + unfolding sgn_eq + by (simp add: cmod_eq_Re) + moreover + have "sgn A2 = A2 / cor \Re A2\" + using \is_real A2\ + unfolding sgn_eq + by (simp add: cmod_eq_Re) + ultimately + show ?thesis + using \(a1, r1) = euclidean_circle_cmat (id H1)\ \(a2, r2) = euclidean_circle_cmat (id H2)\ HH1 HH2 + using *** \is_real A1\ \is_real A2\ + by simp (subst 1, subst 2, simp) + qed + + ultimately + + have "(A1 * A2 * cor ?x1) / (A1 * A2 * (cor ?x2)) = + mat_det_12 ?M1 ?M2 / (2 * sgn A1 * sgn A2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))" + by simp + thus ?thesis + using \A1 \ 0\ \A2 \ 0\ + by simp + qed + hence "cor ?x * sgn A1 * sgn A2 = mat_det_12 ?M1 ?M2 / (2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))" + using \A1 \ 0\ \A2 \ 0\ + by (simp add: sgn_zero_iff) + moreover + have "Re (cor ?x * sgn A1 * sgn A2) = Re (sgn A1) * Re (sgn A2) * ?x" + proof- + have "is_real (cor ?x)" "is_real (sgn A1)" "is_real (sgn A2)" + using \is_real A1\ \is_real A2\ Im_complex_of_real[of ?x] + by auto + thus ?thesis + using Re_complex_of_real[of ?x] + by (subst Re_mult_real3, auto simp add: field_simps) + qed + moreover + have *: "sqrt (Re ?D1) * sqrt (Re ?D2) = sqrt (Re ?d1) * sqrt (Re ?d2)" + using HH1 HH2 + by (subst real_sqrt_mult[symmetric])+ (simp add: field_simps) + have "2 * (sqrt (Re (?D1 * ?D2))) \ 0" + using \Re ?d1 > 0\ \Re ?d2 > 0\ HH1 HH2 \is_real A1\ \is_real A2\ \is_real D1\ \is_real D2\ + using hh mat_det_hermitean_real[of "H1"] + by (subst Re_mult_real, auto) + hence **: "Re (?D12 / (2 * cor (sqrt (Re (?D1 * ?D2))))) = Re (?D12) / (2 * (sqrt (Re (?D1 * ?D2))))" + using \Re ?d1 > 0\ \Re ?d2 > 0\ HH1 HH2 \is_real A1\ \is_real A2\ \is_real D1\ \is_real D2\ + by (subst Re_divide_real) auto + have "Re (mat_det_12 ?M1 ?M2 / (2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))) = Re (?D12) / (2 * (sqrt (Re (?D1 * ?D2))))" + using HH1 HH2 hh mat_det_hermitean_real[of "H1"] + by (subst **[symmetric], subst Re_mult_real, simp, subst real_sqrt_mult, subst *, simp) + ultimately + show ?thesis + by simp + qed + have **: "pos_oriented_cmat H1 \ Re A1 > 0" "pos_oriented_cmat H2 \ Re A2 > 0" + using \Re A1 \ 0\ HH1 \Re A2 \ 0\ HH2 + by auto + show "cos_angle_cmat H1 H2 = sgn_bool (pos_oriented_cmat H1 = pos_oriented_cmat H2) * (r1\<^sup>2 + r2\<^sup>2 - (cdist a2 a1)\<^sup>2) / (2 * r1 * r2)" + unfolding Let_def + using \r1 > 0\ \r2 > 0\ + unfolding cos_angle_cmat_def + apply (subst divide_minus_left) + apply (subst *) + apply (subst Re_sgn[OF \is_real A1\ \A1 \ 0\], subst Re_sgn[OF \is_real A2\ \A2 \ 0\]) + apply (subst **, subst **) + apply (simp add: field_simps) + done + qed + ultimately + show ?thesis + by simp +qed + +(* ----------------------------------------------------------------- *) +subsection \Perpendicularity\ +(* ----------------------------------------------------------------- *) + +text \Two circlines are perpendicular if the intersect at right angle i.e., the angle with the cosine +0.\ + +definition perpendicular where + "perpendicular H1 H2 \ cos_angle (of_circline H1) (of_circline H2) = 0" + +lemma perpendicular_sym: + shows "perpendicular H1 H2 \ perpendicular H2 H1" + unfolding perpendicular_def + by (transfer, transfer, auto simp add: field_simps) + +(* ----------------------------------------------------------------- *) +subsection \Möbius transforms preserve angles and perpendicularity\ +(* ----------------------------------------------------------------- *) + +text \Möbius transformations are \emph{conformal} i.e., they preserve angles between circlines.\ + +lemma moebius_preserve_circline_angle [simp]: + shows "cos_angle (moebius_ocircline M H1) (moebius_ocircline M H2) = + cos_angle H1 H2 " +proof (transfer, transfer) + fix H1 H2 M :: complex_mat + assume hh: "mat_det M \ 0" + show "cos_angle_cmat (moebius_circline_cmat_cmat M H1) (moebius_circline_cmat_cmat M H2) = cos_angle_cmat H1 H2" + unfolding cos_angle_cmat_def moebius_circline_cmat_cmat_def + unfolding Let_def mat_det_12_congruence mat_det_congruence + using hh mat_det_inv[of M] + apply (subst cor_squared[symmetric])+ + apply (subst cos_angle_den_scale, simp) + apply (auto simp add: power2_eq_square real_sqrt_mult field_simps) + done +qed + +lemma perpendicular_moebius [simp]: + assumes "perpendicular H1 H2" + shows "perpendicular (moebius_circline M H1) (moebius_circline M H2)" + using assms + unfolding perpendicular_def + using moebius_preserve_circline_angle[of M "of_circline H1" "of_circline H2"] + using moebius_ocircline_circline[of M "of_circline H1"] + using moebius_ocircline_circline[of M "of_circline H2"] + by (auto simp del: moebius_preserve_circline_angle) + +end diff --git a/thys/Complex_Geometry/Elementary_Complex_Geometry.thy b/thys/Complex_Geometry/Elementary_Complex_Geometry.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Elementary_Complex_Geometry.thy @@ -0,0 +1,519 @@ +(* ----------------------------------------------------------------- *) +section \Elementary complex geometry\ +(* ----------------------------------------------------------------- *) + +text \In this section equations and basic properties of the most fundamental objects and relations in +geometry -- collinearity, lines, circles and circlines. These are defined by equations in +$\mathbb{C}$ (not extended by an infinite point). Later these equations will be generalized to +equations in the extended complex plane, over homogenous coordinates.\ + +theory Elementary_Complex_Geometry +imports More_Complex Linear_Systems Angles +begin + +(* ----------------------------------------------------------------- *) +subsection \Collinear points\ +(* ----------------------------------------------------------------- *) + +definition collinear :: "complex \ complex \ complex \ bool" where + "collinear z1 z2 z3 \ z1 = z2 \ Im ((z3 - z1) / (z2 - z1)) = 0" + +lemma collinear_ex_real: + shows "collinear z1 z2 z3 \ + (\ k::real. z1 = z2 \ z3 - z1 = complex_of_real k * (z2 - z1))" + unfolding collinear_def + by (metis Im_complex_of_real add_diff_cancel_right' complex_eq diff_zero legacy_Complex_simps(15) nonzero_mult_div_cancel_right right_minus_eq times_divide_eq_left zero_complex.code) + +text \Collinearity characterization using determinants\ +lemma collinear_det: + assumes "\ collinear z1 z2 z3" + shows "det2 (z3 - z1) (cnj (z3 - z1)) (z1 - z2) (cnj (z1 - z2)) \ 0" +proof- + from assms have "((z3 - z1) / (z2 - z1)) - cnj ((z3 - z1) / (z2 - z1)) \ 0" "z2 \ z1" + unfolding collinear_def + using Complex_Im_express_cnj[of "(z3 - z1) / (z2 - z1)"] + by (auto simp add: Complex_eq) + thus ?thesis + by (auto simp add: field_simps) +qed + +text \Properties of three collinear points\ + +lemma collinear_sym1: + shows "collinear z1 z2 z3 \ collinear z1 z3 z2" + unfolding collinear_def + using div_reals[of "1" "(z3 - z1)/(z2 - z1)"] div_reals[of "1" "(z2 - z1)/(z3 - z1)"] + by auto + +lemma collinear_sym2': + assumes "collinear z1 z2 z3" + shows "collinear z2 z1 z3" +proof- + obtain k where "z1 = z2 \ z3 - z1 = complex_of_real k * (z2 - z1)" + using assms + unfolding collinear_ex_real + by auto + thus ?thesis + proof + assume "z3 - z1 = complex_of_real k * (z2 - z1)" + thus ?thesis + unfolding collinear_ex_real + by (rule_tac x="1-k" in exI) (auto simp add: field_simps) + qed (simp add: collinear_def) +qed + +lemma collinear_sym2: + shows "collinear z1 z2 z3 \ collinear z2 z1 z3" + using collinear_sym2'[of z1 z2 z3] collinear_sym2'[of z2 z1 z3] + by auto + +text \Properties of four collinear points\ + +lemma collinear_trans1: + assumes "collinear z0 z2 z1" and "collinear z0 z3 z1" and "z0 \ z1" + shows "collinear z0 z2 z3" + using assms + unfolding collinear_ex_real + by (cases "z0 = z2", auto) (rule_tac x="k/ka" in exI, case_tac "ka = 0", auto simp add: field_simps) + + +(* ----------------------------------------------------------------- *) +subsection \Euclidean line\ +(* ----------------------------------------------------------------- *) + +text \Line is defined by using collinearity\ +definition line :: "complex \ complex \ complex set" where + "line z1 z2 = {z. collinear z1 z2 z}" + +lemma line_points_collinear: + assumes "z1 \ line z z'" and "z2 \ line z z'" and "z3 \ line z z'" and "z \ z'" + shows "collinear z1 z2 z3" + using assms + unfolding line_def + by (smt collinear_sym1 collinear_sym2' collinear_trans1 mem_Collect_eq) + +text \Parametric equation of a line\ +lemma line_param: + shows "z1 + cor k * (z2 - z1) \ line z1 z2" + unfolding line_def + by (auto simp add: collinear_def) + +text \Equation of the line containing two different given points\ +lemma line_equation: + assumes "z1 \ z2" and "\ = rot90 (z2 - z1)" + shows "line z1 z2 = {z. cnj \*z + \*cnj z - (cnj \ * z1 + \ * cnj z1) = 0}" +proof- + { + fix z + have "z \ line z1 z2 \ Im ((z - z1)/(z2 - z1)) = 0" + using assms + by (simp add: line_def collinear_def) + also have "... \ (z - z1)/(z2 - z1) = cnj ((z - z1)/(z2 - z1))" + using complex_diff_cnj[of "(z - z1)/(z2 - z1)"] + by auto + also have "... \ (z - z1)*(cnj z2 - cnj z1) = (cnj z - cnj z1)*(z2 - z1)" + using assms(1) + using \(z \ line z1 z2) = is_real ((z - z1) / (z2 - z1))\ calculation is_real_div + by auto + also have "... \ cnj(z2 - z1)*z - (z2 - z1)*cnj z - (cnj(z2 - z1)*z1 - (z2 - z1)*cnj z1) = 0" + by (simp add: field_simps) + also have "... \ cnj \ * z + \ * cnj z - (cnj \ * z1 + \ * cnj z1) = 0" + apply (subst assms)+ + apply (subst cnj_mix_minus)+ + by simp + finally have "z \ line z1 z2 \ cnj \ * z + \ * cnj z - (cnj \ * z1 + \ * cnj z1) = 0" + . + } + thus ?thesis + by auto +qed + +(* -------------------------------------------------------------------------- *) +subsection \Euclidean circle\ +(* -------------------------------------------------------------------------- *) + +text \Definition of the circle with given center and radius. It consists of all +points on the distance $r$ from the center $\mu$.\ +definition circle :: "complex \ real \ complex set" where + "circle \ r = {z. cmod (z - \) = r}" + +text \Equation of the circle centered at $\mu$ with the radius $r$.\ +lemma circle_equation: + assumes "r \ 0" + shows "circle \ r = {z. z*cnj z - z*cnj \ - cnj z*\ + \*cnj \ - cor (r*r) = 0}" +proof (safe) + fix z + assume "z \ circle \ r" + hence "(z - \)*cnj (z - \) = complex_of_real (r*r)" + unfolding circle_def + using complex_mult_cnj_cmod[of "z - \"] + by (auto simp add: power2_eq_square) + thus "z * cnj z - z * cnj \ - cnj z * \ + \ * cnj \ - cor (r * r) = 0" + by (auto simp add: field_simps) +next + fix z + assume "z * cnj z - z * cnj \ - cnj z * \ + \ * cnj \ - cor (r * r) = 0" + hence "(z - \)*cnj (z - \) = cor (r*r)" + by (auto simp add: field_simps) + thus "z \ circle \ r" + using assms + using complex_mult_cnj_cmod[of "z - \"] + using power2_eq_imp_eq[of "cmod (z - \)" r] + unfolding circle_def power2_eq_square[symmetric] complex_of_real_def + by auto +qed + +(* -------------------------------------------------------------------------- *) +subsection \Circline\ +(* -------------------------------------------------------------------------- *) + +text \A very important property of the extended complex plane is that it is possible to treat circles +and lines in a uniform way. The basic object is \emph{generalized circle}, or \emph{circline} for +short. We introduce circline equation given in $\mathbb{C}$, and it will later be generalized to an +equation in the extended complex plane $\overline{\mathbb{C}}$ given in matrix form using a +Hermitean matrix and a quadratic form over homogenous coordinates.\ + +definition circline where + "circline A BC D = {z. cor A*z*cnj z + cnj BC*z + BC*cnj z + cor D = 0}" + +text \Connection between circline and Euclidean circle\ + +text \Every circline with positive determinant and $A \neq 0$ represents an Euclidean circle\ + +lemma circline_circle: + assumes "A \ 0" and "A * D \ (cmod BC)\<^sup>2" + "cl = circline A BC D" and + "\ = -BC/cor A" and + "r2 = ((cmod BC)\<^sup>2 - A*D) / A\<^sup>2" and "r = sqrt r2" + shows "cl = circle \ r" +proof- + have *: "cl = {z. z * cnj z + cnj (BC / cor A) * z + (BC / cor A) * cnj z + cor (D / A) = 0}" + using \cl = circline A BC D\ \A \ 0\ + by (auto simp add: circline_def field_simps) + + have "r2 \ 0" + proof- + have "(cmod BC)\<^sup>2 - A * D \ 0" + using \A * D \ (cmod BC)\<^sup>2\ + by auto + thus ?thesis + using \A \ 0\ \r2 = ((cmod BC)\<^sup>2 - A*D) / A\<^sup>2\ + by (metis zero_le_divide_iff zero_le_power2) + qed + hence **: "r * r = r2" "r \ 0" + using \r = sqrt r2\ + by (auto simp add: real_sqrt_mult[symmetric]) + + have ***: "- \ * - cnj \ - cor r2 = cor (D / A)" + using \\ = - BC / complex_of_real A\ \r2 = ((cmod BC)\<^sup>2 - A * D) / A\<^sup>2\ + by (auto simp add: power2_eq_square complex_mult_cnj_cmod field_simps) + (simp add: add_divide_eq_iff assms(1)) + thus ?thesis + using \r2 = ((cmod BC)\<^sup>2 - A*D) / A\<^sup>2\ \\ = - BC / cor A\ + by (subst *, subst circle_equation[of r \, OF \r \ 0\], subst **) (auto simp add: field_simps power2_eq_square) +qed + +lemma circline_ex_circle: + assumes "A \ 0" and "A * D \ (cmod BC)\<^sup>2" and "cl = circline A BC D" + shows "\ \ r. cl = circle \ r" + using circline_circle[OF assms] + by auto + +text \Every Euclidean circle can be represented by a circline\ + +lemma circle_circline: + assumes "cl = circle \ r" and "r \ 0" + shows "cl = circline 1 (-\) ((cmod \)\<^sup>2 - r\<^sup>2)" +proof- + have "complex_of_real ((cmod \)\<^sup>2 - r\<^sup>2) = \ * cnj \ - complex_of_real (r\<^sup>2)" + by (auto simp add: complex_mult_cnj_cmod) + thus "cl = circline 1 (- \) ((cmod \)\<^sup>2 - r\<^sup>2)" + using assms + using circle_equation[of r \] + unfolding circline_def power2_eq_square + by (simp add: field_simps) +qed + +lemma circle_ex_circline: + assumes "cl = circle \ r" and "r \ 0" + shows "\ A BC D. A \ 0 \ A*D \ (cmod BC)\<^sup>2 \ cl = circline A BC D" + using circle_circline[OF assms] + using \r \ 0\ + by (rule_tac x=1 in exI, rule_tac x="-\" in exI, rule_tac x="Re (\ * cnj \) - (r * r)" in exI) (simp add: complex_mult_cnj_cmod power2_eq_square) + +text \Connection between circline and Euclidean line\ + +text \Every circline with a positive determinant and $A = 0$ represents an Euclidean line\ + +lemma circline_line: + assumes + "A = 0" and "BC \ 0" and + "cl = circline A BC D" and + "z1 = - cor D * BC / (2 * BC * cnj BC)" and + "z2 = z1 + \ * sgn (if arg BC > 0 then -BC else BC)" + shows + "cl = line z1 z2" +proof- + have "cl = {z. cnj BC*z + BC*cnj z + complex_of_real D = 0}" + using assms + by (simp add: circline_def) + have "{z. cnj BC*z + BC*cnj z + complex_of_real D = 0} = + {z. cnj BC*z + BC*cnj z - (cnj BC*z1 + BC*cnj z1) = 0}" + using \BC \ 0\ assms + by simp + moreover + have "z1 \ z2" + using \BC \ 0\ assms + by (auto simp add: sgn_eq) + moreover + have "\ k. k \ 0 \ BC = cor k*rot90 (z2 - z1)" + proof (cases "arg BC > 0") + case True + thus ?thesis + using assms + by (rule_tac x="(cmod BC)" in exI, auto simp add: Complex_scale4) + next + case False + thus ?thesis + using assms + by (rule_tac x="-(cmod BC)" in exI, simp) + (smt Complex.Re_sgn Im_sgn cis_arg complex_minus complex_surj mult_minus_right rcis_cmod_arg rcis_def) + qed + then obtain k where "cor k \ 0" "BC = cor k*rot90 (z2 - z1)" + by auto + moreover + have *: "\ z. cnj_mix (BC / cor k) z - cnj_mix (BC / cor k) z1 = (1/cor k) * (cnj_mix BC z - cnj_mix BC z1)" + using \cor k \ 0\ + by (simp add: field_simps) + hence "{z. cnj_mix BC z - cnj_mix BC z1 = 0} = {z. cnj_mix (BC / cor k) z - cnj_mix (BC / cor k) z1 = 0}" + using \cor k \ 0\ + by auto + ultimately + have "cl = line z1 z2" + using line_equation[of z1 z2 "BC/cor k"] \cl = {z. cnj BC*z + BC*cnj z + complex_of_real D = 0}\ + by auto + thus ?thesis + using \z1 \ z2\ + by blast +qed + +lemma circline_ex_line: + assumes "A = 0" and "BC \ 0" and "cl = circline A BC D" + shows "\ z1 z2. z1 \ z2 \ cl = line z1 z2" +proof- + let ?z1 = "- cor D * BC / (2 * BC * cnj BC)" + let ?z2 = "?z1 + \ * sgn (if 0 < arg BC then - BC else BC)" + have "?z1 \ ?z2" + using \BC \ 0\ + by (simp add: sgn_eq) + thus ?thesis + using circline_line[OF assms, of ?z1 ?z2] \BC \ 0\ + by (rule_tac x="?z1" in exI, rule_tac x="?z2" in exI, simp) +qed + +text \Every Euclidean line can be represented by a circline\ + +lemma line_ex_circline: + assumes "cl = line z1 z2" and "z1 \ z2" + shows "\ BC D. BC \ 0 \ cl = circline 0 BC D" +proof- + let ?BC = "rot90 (z2 - z1)" + let ?D = "Re (- 2 * scalprod z1 ?BC)" + show ?thesis + proof (rule_tac x="?BC" in exI, rule_tac x="?D" in exI, rule conjI) + show "?BC \ 0" + using \z1 \ z2\ rot90_ii[of "z2 - z1"] + by auto + next + have *: "complex_of_real (Re (- 2 * scalprod z1 (rot90 (z2 - z1)))) = - (cnj_mix z1 (rot90 (z2 - z1)))" + using rot90_ii[of "z2 - z1"] + by (cases z1, cases z2, simp add: Complex_eq field_simps) + show "cl = circline 0 ?BC ?D" + apply (subst assms, subst line_equation[of z1 z2 ?BC]) + unfolding circline_def + by (fact, simp, subst *, simp add: field_simps) + qed +qed + +lemma circline_line': + assumes "z1 \ z2" + shows "circline 0 (\ * (z2 - z1)) (Re (- cnj_mix (\ * (z2 - z1)) z1)) = line z1 z2" +proof- + let ?B = "\ * (z2 - z1)" + let ?D = "Re (- cnj_mix ?B z1)" + have "circline 0 ?B ?D = {z. cnj ?B*z + ?B*cnj z + complex_of_real ?D = 0}" + using assms + by (simp add: circline_def) + moreover + have "is_real (- cnj_mix (\ * (z2 - z1)) z1)" + using cnj_mix_real[of ?B z1] + by auto + hence "{z. cnj ?B*z + ?B*cnj z + complex_of_real ?D = 0} = + {z. cnj ?B*z + ?B*cnj z - (cnj ?B*z1 + ?B*cnj z1) = 0}" + apply (subst complex_of_real_Re, simp) + unfolding diff_conv_add_uminus + by simp + moreover + have "line z1 z2 = {z. cnj_mix (\ * (z2 - z1)) z - cnj_mix (\ * (z2 - z1)) z1 = 0}" + using line_equation[of z1 z2 ?B] assms + unfolding rot90_ii + by simp + ultimately + show ?thesis + by simp +qed + +(* ---------------------------------------------------------------------------- *) +subsection \Angle between two circles\ +(* ---------------------------------------------------------------------------- *) + +text \Given a center $\mu$ of an Euclidean circle and a point $E$ on it, we define the tangent vector +in $E$ as the radius vector $\overrightarrow{\mu E}$, rotated by $\pi/2$, clockwise or +counterclockwise, depending on the circle orientation. The Boolean @{term p} encodes the orientation +of the circle, and the function @{term "sgn_bool p"} returns $1$ when @{term p} is true, and +$-1$ when @{term p} is false.\ + +abbreviation sgn_bool where + "sgn_bool p \ if p then 1 else -1" + +definition circ_tang_vec :: "complex \ complex \ bool \ complex" where + "circ_tang_vec \ E p = sgn_bool p * \ * (E - \)" + +text \Tangent vector is orthogonal to the radius.\ +lemma circ_tang_vec_ortho: + shows "scalprod (E - \) (circ_tang_vec \ E p) = 0" + unfolding circ_tang_vec_def Let_def + by auto + +text \Changing the circle orientation gives the opposite tangent vector.\ +lemma circ_tang_vec_opposite_orient: + shows "circ_tang_vec \ E p = - circ_tang_vec \ E (\ p)" + unfolding circ_tang_vec_def + by auto + +text \Angle between two oriented circles at their common point $E$ is defined as the angle between +tangent vectors at $E$. Again we define three different angle measures.\ + +text \The oriented angle between two circles at the point $E$. The first circle is +centered at $\mu_1$ and its orientation is given by the Boolean $p_1$, +while the second circle is centered at $\mu_2$ and its orientation is given by +the Boolea $p_2$.\ +definition ang_circ where + "ang_circ E \1 \2 p1 p2 = \ (circ_tang_vec \1 E p1) (circ_tang_vec \2 E p2)" + +text \The unoriented angle between the two circles\ +definition ang_circ_c where + "ang_circ_c E \1 \2 p1 p2 = \c (circ_tang_vec \1 E p1) (circ_tang_vec \2 E p2)" + +text \The acute angle between the two circles\ +definition ang_circ_a where + "ang_circ_a E \1 \2 p1 p2 = \a (circ_tang_vec \1 E p1) (circ_tang_vec \2 E p2)" + +text \Explicit expression for oriented angle between two circles\ +lemma ang_circ_simp: + assumes "E \ \1" and "E \ \2" + shows "ang_circ E \1 \2 p1 p2 = + \arg (E - \2) - arg (E - \1) + sgn_bool p1 * pi / 2 - sgn_bool p2 * pi / 2\" + unfolding ang_circ_def ang_vec_def circ_tang_vec_def + apply (rule canon_ang_eq) + using assms + using arg_mult_2kpi[of "sgn_bool p2*\" "E - \2"] + using arg_mult_2kpi[of "sgn_bool p1*\" "E - \1"] + apply auto + apply (rule_tac x="x-xa" in exI, auto simp add: field_simps) + apply (rule_tac x="-1+x-xa" in exI, auto simp add: field_simps) + apply (rule_tac x="1+x-xa" in exI, auto simp add: field_simps) + apply (rule_tac x="x-xa" in exI, auto simp add: field_simps) + done + +text \Explicit expression for the cosine of angle between two circles\ +lemma cos_ang_circ_simp: + assumes "E \ \1" and "E \ \2" + shows "cos (ang_circ E \1 \2 p1 p2) = + sgn_bool (p1 = p2) * cos (arg (E - \2) - arg (E - \1))" + using assms + using cos_periodic_pi2[of "arg (E - \2) - arg (E - \1)"] + using cos_minus_pi[of "arg (E - \2) - arg (E - \1)"] + using ang_circ_simp[OF assms, of p1 p2] + by auto + +text \Explicit expression for the unoriented angle between two circles\ +lemma ang_circ_c_simp: + assumes "E \ \1" and "E \ \2" + shows "ang_circ_c E \1 \2 p1 p2 = + \\arg (E - \2) - arg (E - \1) + sgn_bool p1 * pi / 2 - sgn_bool p2 * pi / 2\\" + unfolding ang_circ_c_def ang_vec_c_def + using ang_circ_simp[OF assms] + unfolding ang_circ_def + by auto + +text \Explicit expression for the acute angle between two circles\ +lemma ang_circ_a_simp: + assumes "E \ \1" and "E \ \2" + shows "ang_circ_a E \1 \2 p1 p2 = + acute_ang (abs (canon_ang (arg(E - \2) - arg(E - \1) + (sgn_bool p1) * pi/2 - (sgn_bool p2) * pi/2)))" + unfolding ang_circ_a_def ang_vec_a_def + using ang_circ_c_simp[OF assms] + unfolding ang_circ_c_def + by auto + +text \Acute angle between two circles does not depend on the circle orientation.\ +lemma ang_circ_a_pTrue: + assumes "E \ \1" and "E \ \2" + shows "ang_circ_a E \1 \2 p1 p2 = ang_circ_a E \1 \2 True True" +proof (cases "p1") + case True + show ?thesis + proof (cases "p2") + case True + show ?thesis + using \p1\ \p2\ + by simp + next + case False + show ?thesis + using \p1\ \\ p2\ + unfolding ang_circ_a_def + using circ_tang_vec_opposite_orient[of \2 E p2] + using ang_vec_a_opposite2 + by simp + qed +next + case False + show ?thesis + proof (cases "p2") + case True + show ?thesis + using \\ p1\ \p2\ + unfolding ang_circ_a_def + using circ_tang_vec_opposite_orient[of \1 E p1] + using ang_vec_a_opposite1 + by simp + next + case False + show ?thesis + using \\ p1\ \\ p2\ + unfolding ang_circ_a_def + using circ_tang_vec_opposite_orient[of \1 E p1] circ_tang_vec_opposite_orient[of \2 E p2] + using ang_vec_a_opposite1 ang_vec_a_opposite2 + by simp + qed +qed + +text \Definition of the acute angle between the two unoriented circles \ +abbreviation ang_circ_a' where + "ang_circ_a' E \1 \2 \ ang_circ_a E \1 \2 True True" + +text \A very simple expression for the acute angle between the two circles\ +lemma ang_circ_a_simp1: + assumes "E \ \1" and "E \ \2" + shows "ang_circ_a E \1 \2 p1 p2 = \a (E - \1) (E - \2)" + unfolding ang_vec_a_def ang_vec_c_def ang_vec_def + by (subst ang_circ_a_pTrue[OF assms, of p1 p2], subst ang_circ_a_simp[OF assms, of True True]) (metis add_diff_cancel) + +lemma ang_circ_a'_simp: + assumes "E \ \1" and "E \ \2" + shows "ang_circ_a' E \1 \2 = \a (E - \1) (E - \2)" + by (rule ang_circ_a_simp1[OF assms]) + +end diff --git a/thys/Complex_Geometry/Hermitean_Matrices.thy b/thys/Complex_Geometry/Hermitean_Matrices.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Hermitean_Matrices.thy @@ -0,0 +1,418 @@ +(* -------------------------------------------------------------------------- *) +subsection \Hermitean matrices\ +(* -------------------------------------------------------------------------- *) + +text \Hermitean matrices over $\mathbb{C}$ generalize symmetric matrices over $\mathbb{R}$. Quadratic +forms with Hermitean matrices represent circles and lines in the extended complex plane (when +applied to homogenous coordinates).\ + +theory Hermitean_Matrices +imports Unitary_Matrices +begin + +definition hermitean :: "complex_mat \ bool" where + "hermitean A \ mat_adj A = A" + +lemma hermitean_transpose: + shows "hermitean A \ mat_transpose A = mat_cnj A" + unfolding hermitean_def + by (cases A) (auto simp add: mat_adj_def mat_cnj_def) + +text \Characterization of 2x2 Hermitean matrices elements. +All 2x2 Hermitean matrices are of the form +$$ +\left( +\begin{array}{cc} +A & B\\ +\overline{B} & D +\end{array} +\right), +$$ +for real $A$ and $D$ and complex $B$. +\ + +lemma hermitean_mk_circline [simp]: + shows "hermitean (cor A, B, cnj B, cor D)" + unfolding hermitean_def mat_adj_def mat_cnj_def + by simp + +lemma hermitean_mk_circline' [simp]: + assumes "is_real A" and "is_real D" + shows "hermitean (A, B, cnj B, D)" + using assms eq_cnj_iff_real + unfolding hermitean_def mat_adj_def mat_cnj_def + by force + +lemma hermitean_elems: + assumes "hermitean (A, B, C, D)" + shows "is_real A" and "is_real D" and "B = cnj C" and "cnj B = C" + using assms eq_cnj_iff_real[of A] eq_cnj_iff_real[of D] + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def) + +text \Operations that preserve the Hermitean property\ + +lemma hermitean_mat_cnj: + shows "hermitean H \ hermitean (mat_cnj H)" + by (cases H) (auto simp add: hermitean_def mat_adj_def mat_cnj_def) + +lemma hermitean_mult_real: + assumes "hermitean H" + shows "hermitean ((cor k) *\<^sub>s\<^sub>m H)" + using assms + unfolding hermitean_def + by simp + +lemma hermitean_congruence: + assumes "hermitean H" + shows "hermitean (congruence M H)" + using assms + unfolding hermitean_def + by (auto simp add: mult_mm_assoc) + +text \Identity matrix is Hermitean\ + +lemma hermitean_eye [simp]: + shows "hermitean eye" + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def) + +lemma hermitean_eye' [simp]: + shows "hermitean (1, 0, 0, 1)" + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def) + +text \Unit circle matrix is Hermitean\ + +lemma hermitean_unit_circle [simp]: + shows "hermitean (1, 0, 0, -1)" + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def) + +text \Hermitean matrices have real determinant\ +lemma mat_det_hermitean_real: + assumes "hermitean A" + shows "is_real (mat_det A)" + using assms + unfolding hermitean_def + by (metis eq_cnj_iff_real mat_det_adj) + +text \Zero matrix is the only Hermitean matrix with both determinant and trace equal +to zero\ +lemma hermitean_det_zero_trace_zero: + assumes "mat_det A = 0" and "mat_trace A = (0::complex)" and "hermitean A" + shows "A = mat_zero" +using assms +proof- + { + fix a d c + assume "a * d = cnj c * c" "a + d = 0" "cnj a = a" + from \a + d = 0\ have "d = -a" + by (metis add_eq_0_iff) + hence "- (cor (Re a))\<^sup>2 = (cor (cmod c))\<^sup>2" + using \cnj a = a\ eq_cnj_iff_real[of a] + using \a*d = cnj c * c\ + using complex_mult_cnj_cmod[of "cnj c"] + by (simp add: power2_eq_square) + hence "- (Re a)\<^sup>2 \ 0" + using zero_le_power2[of "cmod c"] + by (metis Re_complex_of_real cor_squared of_real_minus) + hence "a = 0" + using zero_le_power2[of "Re a"] + using \cnj a = a\ eq_cnj_iff_real[of a] + by (simp add: complex_eq_if_Re_eq) + } note * = this + obtain a b c d where "A = (a, b, c, d)" + by (cases A) auto + thus ?thesis + using *[of a d c] *[of d a c] + using assms \A = (a, b, c, d)\ + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def) +qed + +(* ---------------------------------------------------------------------------- *) +subsubsection \Bilinear and quadratic forms with Hermitean matrices\ +(* ---------------------------------------------------------------------------- *) + +text \A Hermitean matrix $(A, B, \overline{B}, D)$, for real $A$ and $D$, gives rise to bilinear form +$A\cdot \overline{v_{11}} \cdot v_{21}+\overline{B} \cdot \overline{v_{12}} \cdot v_{21} + +B \cdot \overline{v_{11}} \cdot v_{22}+D\cdot \overline{v_{12}}\cdot v_{22}$ (acting on vectors $(v_{11}, v_{12})$ and +$(v_{21}, v_{22})$) and to the quadratic form $A \cdot \overline{v_1} \cdot v_1+\overline{B}\cdot \overline{v_2}\cdot v_1 + +B\cdot \overline{v_1}\cdot v_2 + D\cdot \overline{v_2} \cdot v_2$ (acting on the vector $(v_1, v_2)$).\ + +lemma bilinear_form_hermitean_commute: + assumes "hermitean H" + shows "bilinear_form v1 v2 H = cnj (bilinear_form v2 v1 H)" +proof- + have "v2 *\<^sub>v\<^sub>m mat_cnj H *\<^sub>v\<^sub>v vec_cnj v1 = vec_cnj v1 *\<^sub>v\<^sub>v (mat_adj H *\<^sub>m\<^sub>v v2)" + by (subst mult_vv_commute, subst mult_mv_mult_vm, simp add: mat_adj_def mat_transpose_mat_cnj) + also + have "\ = bilinear_form v1 v2 H" + using assms + by (simp add: mult_vv_mv hermitean_def) + finally + show ?thesis + by (simp add: cnj_mult_vv vec_cnj_mult_vm) +qed + +lemma quad_form_hermitean_real: + assumes "hermitean H" + shows "is_real (quad_form z H)" + using assms + by (subst eq_cnj_iff_real[symmetric]) (simp del: quad_form_def add: hermitean_def) + +lemma quad_form_vec_cnj_mat_cnj: + assumes "hermitean H" + shows "quad_form (vec_cnj z) (mat_cnj H) = quad_form z H" + using assms + using cnj_mult_vv cnj_quad_form hermitean_def vec_cnj_mult_vm by auto + +(* ---------------------------------------------------------------------------- *) +subsubsection \Eigenvalues, eigenvectors and diagonalization of Hermitean matrices\ +(* ---------------------------------------------------------------------------- *) + +text \Hermitean matrices have real eigenvalues\ +lemma hermitean_eigenval_real: + assumes "hermitean H" and "eigenval k H" + shows "is_real k" +proof- + from assms obtain v where "v \ vec_zero" "H *\<^sub>m\<^sub>v v = k *\<^sub>s\<^sub>v v" + unfolding eigenval_def + by blast + have "k * (v *\<^sub>v\<^sub>v vec_cnj v) = (k *\<^sub>s\<^sub>v v) *\<^sub>v\<^sub>v (vec_cnj v)" + by (simp add: mult_vv_scale_sv1) + also have "... = (H *\<^sub>m\<^sub>v v) *\<^sub>v\<^sub>v (vec_cnj v)" + using \H *\<^sub>m\<^sub>v v = k *\<^sub>s\<^sub>v v\ + by simp + also have "... = v *\<^sub>v\<^sub>v (mat_transpose H *\<^sub>m\<^sub>v (vec_cnj v))" + by (simp add: mult_mv_vv) + also have "... = v *\<^sub>v\<^sub>v (vec_cnj (mat_cnj (mat_transpose H) *\<^sub>m\<^sub>v v))" + by (simp add: vec_cnj_mult_mv) + also have "... = v *\<^sub>v\<^sub>v (vec_cnj (H *\<^sub>m\<^sub>v v))" + using \hermitean H\ + by (simp add: hermitean_def mat_adj_def) + also have "... = v *\<^sub>v\<^sub>v (vec_cnj (k *\<^sub>s\<^sub>v v))" + using \H *\<^sub>m\<^sub>v v = k *\<^sub>s\<^sub>v v\ + by simp + finally have "k * (v *\<^sub>v\<^sub>v vec_cnj v) = cnj k * (v *\<^sub>v\<^sub>v vec_cnj v)" + by (simp add: mult_vv_scale_sv2) + hence "k = cnj k" + using \v \ vec_zero\ + using scalsquare_vv_zero[of v] + by (simp add: mult_vv_commute) + thus ?thesis + by (metis eq_cnj_iff_real) +qed + +text \Non-diagonal Hermitean matrices have distinct eigenvalues\ +lemma hermitean_distinct_eigenvals: + assumes "hermitean H" + shows "(\ k\<^sub>1 k\<^sub>2. k\<^sub>1 \ k\<^sub>2 \ eigenval k\<^sub>1 H \ eigenval k\<^sub>2 H) \ mat_diagonal H" +proof- + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases H) auto + show ?thesis + proof (cases "B = 0") + case True + thus ?thesis + using \hermitean H\ hermitean_elems[of A B C D] HH + by auto + next + case False + have "(mat_trace H)\<^sup>2 \ 4 * mat_det H" + proof (rule ccontr) + have "C = cnj B" "is_real A" "is_real D" + using hermitean_elems HH \hermitean H\ + by auto + assume "\ ?thesis" + hence "(A + D)\<^sup>2 = 4*(A*D - B*C)" + using HH + by auto + hence "(A - D)\<^sup>2 = - 4*B*cnj B" + using \C = cnj B\ + by (auto simp add: power2_eq_square field_simps) + hence "(A - D)\<^sup>2 / cor ((cmod B)\<^sup>2) = -4" + using \B \ 0\ complex_mult_cnj_cmod[of B] + by (auto simp add: field_simps) + hence "(Re A - Re D)\<^sup>2 / (cmod B)\<^sup>2 = -4" + using \is_real A\ \is_real D\ \B \ 0\ + using Re_divide_real[of "cor ((cmod B)\<^sup>2)" "(A - D)\<^sup>2"] + by (auto simp add: power2_eq_square) + thus False + by (metis abs_neg_numeral abs_power2 neg_numeral_neq_numeral power_divide) + qed + show ?thesis + apply (rule disjI1) + apply (subst eigen_equation)+ + using complex_quadratic_equation_monic_distinct_roots[of "-mat_trace H" "mat_det H"] \(mat_trace H)\<^sup>2 \ 4 * mat_det H\ + by auto + qed +qed + +text \Eigenvectors corresponding to different eigenvalues of Hermitean matrices are +orthogonal\ +lemma hermitean_ortho_eigenvecs: + assumes "hermitean H" + assumes "eigenpair k1 v1 H" and "eigenpair k2 v2 H" and "k1 \ k2" + shows "vec_cnj v2 *\<^sub>v\<^sub>v v1 = 0" and "vec_cnj v1 *\<^sub>v\<^sub>v v2 = 0" +proof- + from assms + have "v1 \ vec_zero" "H *\<^sub>m\<^sub>v v1 = k1 *\<^sub>s\<^sub>v v1" + "v2 \ vec_zero" "H *\<^sub>m\<^sub>v v2 = k2 *\<^sub>s\<^sub>v v2" + unfolding eigenpair_def + by auto + have real_k: "is_real k1" "is_real k2" + using assms + using hermitean_eigenval_real[of H k1] + using hermitean_eigenval_real[of H k2] + unfolding eigenpair_def eigenval_def + by blast+ + + have "vec_cnj (H *\<^sub>m\<^sub>v v2) = vec_cnj (k2 *\<^sub>s\<^sub>v v2)" + using \H *\<^sub>m\<^sub>v v2 = k2 *\<^sub>s\<^sub>v v2\ + by auto + hence "vec_cnj v2 *\<^sub>v\<^sub>m H = k2 *\<^sub>s\<^sub>v vec_cnj v2" + using \hermitean H\ real_k eq_cnj_iff_real[of k1] eq_cnj_iff_real[of k2] + unfolding hermitean_def + by (cases H, cases v2) (auto simp add: mat_adj_def mat_cnj_def vec_cnj_def) + have "k2 * (vec_cnj v2 *\<^sub>v\<^sub>v v1) = k1 * (vec_cnj v2 *\<^sub>v\<^sub>v v1)" + using \H *\<^sub>m\<^sub>v v1 = k1 *\<^sub>s\<^sub>v v1\ + using \vec_cnj v2 *\<^sub>v\<^sub>m H = k2 *\<^sub>s\<^sub>v vec_cnj v2\ + by (cases v1, cases v2, cases H) + (metis mult_vv_mv mult_vv_scale_sv1 mult_vv_scale_sv2) + thus "vec_cnj v2 *\<^sub>v\<^sub>v v1 = 0" + using \k1 \ k2\ + by simp + hence "cnj (vec_cnj v2 *\<^sub>v\<^sub>v v1) = 0" + by simp + thus "vec_cnj v1 *\<^sub>v\<^sub>v v2 = 0" + by (simp add: cnj_mult_vv mult_vv_commute) +qed + +text \Hermitean matrices are diagonizable by unitary matrices. Diagonal entries are +real and the sign of the determinant is preserved.\ +lemma hermitean_diagonizable: + assumes "hermitean H" + shows "\ k1 k2 M. mat_det M \ 0 \ unitary M \ congruence M H = (k1, 0, 0, k2) \ + is_real k1 \ is_real k2 \ sgn (Re k1 * Re k2) = sgn (Re (mat_det H))" +proof- + from assms + have "(\k\<^sub>1 k\<^sub>2. k\<^sub>1 \ k\<^sub>2 \ eigenval k\<^sub>1 H \ eigenval k\<^sub>2 H) \ mat_diagonal H" + using hermitean_distinct_eigenvals[of H] + by simp + thus ?thesis + proof + assume "\k\<^sub>1 k\<^sub>2. k\<^sub>1 \ k\<^sub>2 \ eigenval k\<^sub>1 H \ eigenval k\<^sub>2 H" + then obtain k1 k2 where "k1 \ k2" "eigenval k1 H" "eigenval k2 H" + using hermitean_distinct_eigenvals + by blast + then obtain v1 v2 where "eigenpair k1 v1 H" "eigenpair k2 v2 H" + "v1 \ vec_zero" "v2 \ vec_zero" + unfolding eigenval_def eigenpair_def + by blast + hence *: "vec_cnj v2 *\<^sub>v\<^sub>v v1 = 0" "vec_cnj v1 *\<^sub>v\<^sub>v v2 = 0" + using \k1 \ k2\ hermitean_ortho_eigenvecs \hermitean H\ + by auto + obtain v11 v12 v21 v22 where vv: "v1 = (v11, v12)" "v2 = (v21, v22)" + by (cases v1, cases v2) auto + let ?nv1' = "vec_cnj v1 *\<^sub>v\<^sub>v v1" and ?nv2' = "vec_cnj v2 *\<^sub>v\<^sub>v v2" + let ?nv1 = "cor (sqrt (Re ?nv1'))" + let ?nv2 = "cor (sqrt (Re ?nv2'))" + have "?nv1' \ 0" "?nv2' \ 0" + using \v1 \ vec_zero\ \v2 \ vec_zero\ vv + by (simp add: scalsquare_vv_zero)+ + moreover + have "is_real ?nv1'" "is_real ?nv2'" + using vv + by (auto simp add: vec_cnj_def) + ultimately + have "?nv1 \ 0" "?nv2 \ 0" + using complex_eq_if_Re_eq + by auto + have "Re (?nv1') \ 0" "Re (?nv2') \ 0" + using vv + by (auto simp add: vec_cnj_def) + obtain nv1 nv2 where "nv1 = ?nv1" "nv1 \ 0" "nv2 = ?nv2" "nv2 \ 0" + using \?nv1 \ 0\ \?nv2 \ 0\ + by auto + let ?M = "(1/nv1 * v11, 1/nv2 * v21, 1/nv1 * v12, 1/nv2 * v22)" + + have "is_real k1" "is_real k2" + using \eigenval k1 H\ \eigenval k2 H\ \hermitean H\ + by (auto simp add: hermitean_eigenval_real) + moreover + have "mat_det ?M \ 0" + proof (rule ccontr) + assume "\ ?thesis" + hence "v11 * v22 = v12 * v21" + using \nv1 \ 0\ \nv2 \ 0\ + by (auto simp add: field_simps) + hence "\ k. k \ 0 \ v2 = k *\<^sub>s\<^sub>v v1" + using vv \v1 \ vec_zero\ \v2 \ vec_zero\ + apply auto + apply (rule_tac x="v21/v11" in exI, force simp add: field_simps) + apply (rule_tac x="v21/v11" in exI, force simp add: field_simps) + apply (rule_tac x="v22/v12" in exI, force simp add: field_simps) + apply (rule_tac x="v22/v12" in exI, force simp add: field_simps) + done + thus False + using * \vec_cnj v1 *\<^sub>v\<^sub>v v2 = 0\ \vec_cnj v2 *\<^sub>v\<^sub>v v2 \ 0\ vv \?nv1' \ 0\ + by (metis mult_vv_scale_sv2 mult_zero_right) + qed + moreover + have "unitary ?M" + proof- + have **: "cnj nv1 * nv1 = ?nv1'" "cnj nv2 * nv2 = ?nv2'" + using \nv1 = ?nv1\ \nv1 \ 0\ \nv2 = ?nv2\ \nv2 \ 0\ \is_real ?nv1'\ \is_real ?nv2'\ + using \Re (?nv1') \ 0\ \Re (?nv2') \ 0\ + by auto + have ***: "cnj nv1 * nv2 \ 0" "cnj nv2 * nv1 \ 0" + using vv \nv1 = ?nv1\ \nv1 \ 0\ \nv2 = ?nv2\ \nv2 \ 0\ \is_real ?nv1'\ \is_real ?nv2'\ + by auto + + show ?thesis + unfolding unitary_def + using vv ** \?nv1' \ 0\ \?nv2' \ 0\ * *** + unfolding mat_adj_def mat_cnj_def vec_cnj_def + by simp (metis (no_types, lifting) add_divide_distrib divide_eq_0_iff divide_eq_1_iff) + qed + moreover + have "congruence ?M H = (k1, 0, 0, k2)" + proof- + have "mat_inv ?M *\<^sub>m\<^sub>m H *\<^sub>m\<^sub>m ?M = (k1, 0, 0, k2)" + proof- + have *: "H *\<^sub>m\<^sub>m ?M = ?M *\<^sub>m\<^sub>m (k1, 0, 0, k2)" + using \eigenpair k1 v1 H\ \eigenpair k2 v2 H\ vv \?nv1 \ 0\ \?nv2 \ 0\ + unfolding eigenpair_def vec_cnj_def + by (cases H) (smt mult_mm.simps vec_map.simps add.right_neutral add_cancel_left_left distrib_left fst_mult_sv mult.commute mult.left_commute mult_mv.simps mult_zero_right prod.sel(1) prod.sel(2) snd_mult_sv) + show ?thesis + using mult_mm_inv_l[of ?M "(k1, 0, 0, k2)" "H *\<^sub>m\<^sub>m ?M", OF \mat_det ?M \ 0\ *[symmetric], symmetric] + by (simp add: mult_mm_assoc) + qed + moreover + have "mat_inv ?M = mat_adj ?M" + using \mat_det ?M \ 0\ \unitary ?M\ mult_mm_inv_r[of ?M "mat_adj ?M" eye] + by (simp add: unitary_def) + ultimately + show ?thesis + by simp + qed + moreover + have "sgn (Re k1 * Re k2) = sgn (Re (mat_det H))" + using \congruence ?M H = (k1, 0, 0, k2)\ \is_real k1\ \is_real k2\ + using Re_det_sgn_congruence[of ?M H] \mat_det ?M \ 0\ \hermitean H\ + by simp + ultimately + show ?thesis + by (rule_tac x="k1" in exI, rule_tac x="k2" in exI, rule_tac x="?M" in exI) simp + next + assume "mat_diagonal H" + then obtain A D where "H = (A, 0, 0, D)" + by (cases H) auto + moreover + hence "is_real A" "is_real D" + using \hermitean H\ hermitean_elems[of A 0 0 D] + by auto + ultimately + show ?thesis + by (rule_tac x="A" in exI, rule_tac x="D" in exI, rule_tac x="eye" in exI) (simp add: unitary_def mat_adj_def mat_cnj_def) + qed +qed + +end diff --git a/thys/Complex_Geometry/Homogeneous_Coordinates.thy b/thys/Complex_Geometry/Homogeneous_Coordinates.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Homogeneous_Coordinates.thy @@ -0,0 +1,1358 @@ +(* ---------------------------------------------------------------------------- *) +section \Homogeneous coordinates in extended complex plane\ +(* ---------------------------------------------------------------------------- *) + +text \Extended complex plane $\mathbb{\overline{C}}$ is complex plane with an additional element +(treated as the infinite point). The extended complex plane $\mathbb{\overline{C}}$ is identified +with a complex projective line (the one-dimensional projective space over the complex field, sometimes denoted by $\mathbb{C}P^1$). +Each point of $\mathbb{\overline{C}}$ is represented by a pair of complex homogeneous coordinates (not +both equal to zero), and two pairs of homogeneous coordinates represent the same +point in $\mathbb{\overline{C}}$ iff they are proportional by a non-zero complex factor.\ + +theory Homogeneous_Coordinates +imports More_Complex Matrices +begin + +(* ---------------------------------------------------------------------------- *) +subsection \Definition of homogeneous coordinates\ +(* ---------------------------------------------------------------------------- *) + +text \Two complex vectors are equivalent iff they are proportional.\ + +definition complex_cvec_eq :: "complex_vec \ complex_vec \ bool" (infix "\\<^sub>v" 50) where + [simp]: "z1 \\<^sub>v z2 \ (\ k. k \ (0::complex) \ z2 = k *\<^sub>s\<^sub>v z1)" + +lemma complex_cvec_eq_mix: + assumes "(z1, z2) \ vec_zero" and "(w1, w2) \ vec_zero" + shows "(z1, z2) \\<^sub>v (w1, w2) \ z1*w2 = z2*w1" +proof safe + assume "(z1, z2) \\<^sub>v (w1, w2)" + thus "z1 * w2 = z2 * w1" + by auto +next + assume *: "z1 * w2 = z2 * w1" + show "(z1, z2) \\<^sub>v (w1, w2)" + proof (cases "z2 = 0") + case True + thus ?thesis + using * assms + by auto + next + case False + hence "w1 = (w2/z2)*z1 \ w2 = (w2/z2)*z2" "w2/z2 \ 0" + using * assms + by (auto simp add: field_simps) + thus "(z1, z2) \\<^sub>v (w1, w2)" + by (metis complex_cvec_eq_def mult_sv.simps) + qed +qed + +lemma complex_eq_cvec_reflp [simp]: + shows "reflp (\\<^sub>v)" + unfolding reflp_def complex_cvec_eq_def + by safe (rule_tac x="1" in exI, simp) + +lemma complex_eq_cvec_symp [simp]: + shows "symp (\\<^sub>v)" + unfolding symp_def complex_cvec_eq_def + by safe (rule_tac x="1/k" in exI, simp) + +lemma complex_eq_cvec_transp [simp]: + shows "transp (\\<^sub>v)" + unfolding transp_def complex_cvec_eq_def + by safe (rule_tac x="k*ka" in exI, simp) + +lemma complex_eq_cvec_equivp [simp]: + shows "equivp (\\<^sub>v)" + by (auto intro: equivpI) + +text \Non-zero pairs of complex numbers (also treated as non-zero complex vectors)\ + +typedef complex_homo_coords = "{v::complex_vec. v \ vec_zero}" + by (rule_tac x="(1, 0)" in exI, simp) + +setup_lifting type_definition_complex_homo_coords + +lift_definition complex_homo_coords_eq :: "complex_homo_coords \ complex_homo_coords \ bool" (infix "\" 50) is complex_cvec_eq + done + +lemma complex_homo_coords_eq_reflp [simp]: + shows "reflp (\)" + using complex_eq_cvec_reflp + unfolding reflp_def + by transfer blast + +lemma complex_homo_coords_eq_symp [simp]: + shows "symp (\)" + using complex_eq_cvec_symp + unfolding symp_def + by transfer blast + +lemma complex_homo_coords_eq_transp [simp]: + shows "transp (\)" + using complex_eq_cvec_transp + unfolding transp_def + by transfer blast + +lemma complex_homo_coords_eq_equivp: + shows "equivp (\)" + by (auto intro: equivpI) + +lemma complex_homo_coords_eq_refl [simp]: + shows "z \ z" + using complex_homo_coords_eq_reflp + unfolding reflp_def refl_on_def + by blast + +lemma complex_homo_coords_eq_sym: + assumes "z1 \ z2" + shows "z2 \ z1" + using assms complex_homo_coords_eq_symp + unfolding symp_def + by blast + +lemma complex_homo_coords_eq_trans: + assumes "z1 \ z2" and "z2 \ z3" + shows "z1 \ z3" + using assms complex_homo_coords_eq_transp + unfolding transp_def + by blast + +text \Quotient type of homogeneous coordinates\ +quotient_type + complex_homo = complex_homo_coords / "complex_homo_coords_eq" + by (rule complex_homo_coords_eq_equivp) + + +(* ---------------------------------------------------------------------------- *) +subsection \Some characteristic points in $\mathbb{C}P^1$\ +(* ---------------------------------------------------------------------------- *) + +text \Infinite point\ +definition inf_cvec :: "complex_vec" ("\\<^sub>v") where + [simp]: "inf_cvec = (1, 0)" +lift_definition inf_hcoords :: "complex_homo_coords" ("\\<^sub>h\<^sub>c") is inf_cvec + by simp +lift_definition inf :: "complex_homo" ("\\<^sub>h") is inf_hcoords +done + +lemma inf_cvec_z2_zero_iff: + assumes "(z1, z2) \ vec_zero" + shows "(z1, z2) \\<^sub>v \\<^sub>v \ z2 = 0" + using assms + by auto + +text \Zero\ +definition zero_cvec :: "complex_vec" ("0\<^sub>v") where + [simp]: "zero_cvec = (0, 1)" +lift_definition zero_hcoords :: "complex_homo_coords" ("0\<^sub>h\<^sub>c") is zero_cvec + by simp +lift_definition zero :: "complex_homo" ("0\<^sub>h") is zero_hcoords + done + +lemma zero_cvec_z1_zero_iff: + assumes "(z1, z2) \ vec_zero" + shows "(z1, z2) \\<^sub>v 0\<^sub>v \ z1 = 0" + using assms + by auto + +text \One\ +definition one_cvec :: "complex_vec" ("1\<^sub>v")where + [simp]: "one_cvec = (1, 1)" +lift_definition one_hcoords :: "complex_homo_coords" ("1\<^sub>h\<^sub>c") is one_cvec + by simp +lift_definition one :: "complex_homo" ("1\<^sub>h") is one_hcoords + done + +lemma zero_one_infty_not_equal [simp]: + shows "1\<^sub>h \ \\<^sub>h" and "0\<^sub>h \ \\<^sub>h" and "0\<^sub>h \ 1\<^sub>h" and "1\<^sub>h \ 0\<^sub>h" and "\\<^sub>h \ 0\<^sub>h" and "\\<^sub>h \ 1\<^sub>h" + by (transfer, transfer, simp)+ + +text \Imaginary unit\ +definition ii_cvec :: "complex_vec" ("ii\<^sub>v") where + [simp]: "ii_cvec = (\, 1)" +lift_definition ii_hcoords :: "complex_homo_coords" ("ii\<^sub>h\<^sub>c") is ii_cvec + by simp +lift_definition ii :: "complex_homo" ("ii\<^sub>h") is ii_hcoords + done + +lemma ex_3_different_points: + fixes z::complex_homo + shows "\ z1 z2. z \ z1 \ z1 \ z2 \ z \ z2" +proof (cases "z \ 0\<^sub>h \ z \ 1\<^sub>h") + case True + thus ?thesis + by (rule_tac x="0\<^sub>h" in exI, rule_tac x="1\<^sub>h" in exI, auto) +next + case False + hence "z = 0\<^sub>h \ z = 1\<^sub>h" + by simp + thus ?thesis + proof + assume "z = 0\<^sub>h" + thus ?thesis + by (rule_tac x="\\<^sub>h" in exI, rule_tac x="1\<^sub>h" in exI, auto) + next + assume "z = 1\<^sub>h" + thus ?thesis + by (rule_tac x="\\<^sub>h" in exI, rule_tac x="0\<^sub>h" in exI, auto) + qed +qed + +(* ---------------------------------------------------------------------------- *) +subsection \Connection to ordinary complex plane $\mathbb{C}$\ +(* ---------------------------------------------------------------------------- *) + +text \Conversion from complex\ + +definition of_complex_cvec :: "complex \ complex_vec" where + [simp]: "of_complex_cvec z = (z, 1)" +lift_definition of_complex_hcoords :: "complex \ complex_homo_coords" is of_complex_cvec + by simp +lift_definition of_complex :: "complex \ complex_homo" is of_complex_hcoords + done + +lemma of_complex_inj: + assumes "of_complex x = of_complex y" + shows "x = y" + using assms + by (transfer, transfer, simp) + +lemma of_complex_image_inj: + assumes "of_complex ` A = of_complex ` B" + shows "A = B" + using assms + using of_complex_inj + by auto + +lemma of_complex_not_inf [simp]: + shows "of_complex x \ \\<^sub>h" + by (transfer, transfer, simp) + +lemma inf_not_of_complex [simp]: + shows "\\<^sub>h \ of_complex x" + by (transfer, transfer, simp) + +lemma inf_or_of_complex: + shows "z = \\<^sub>h \ (\ x. z = of_complex x)" +proof (transfer, transfer) + fix z :: complex_vec + obtain z1 z2 where *: "z = (z1, z2)" + by (cases z) auto + assume "z \ vec_zero" + thus "z \\<^sub>v \\<^sub>v \ (\x. z \\<^sub>v of_complex_cvec x)" + using * + by (cases "z2 = 0", auto) +qed + +lemma of_complex_zero [simp]: + shows "of_complex 0 = 0\<^sub>h" + by (transfer, transfer, simp) + +lemma of_complex_one [simp]: + shows "of_complex 1 = 1\<^sub>h" + by (transfer, transfer, simp) + +lemma of_complex_ii [simp]: + shows "of_complex \ = ii\<^sub>h" + by (transfer, transfer, simp) + +lemma of_complex_zero_iff [simp]: + shows "of_complex x = 0\<^sub>h \ x = 0" + by (subst of_complex_zero[symmetric]) (auto simp add: of_complex_inj) + +lemma of_complex_one_iff [simp]: + shows "of_complex x = 1\<^sub>h \ x = 1" + by (subst of_complex_one[symmetric]) (auto simp add: of_complex_inj) + +lemma of_complex_ii_iff [simp]: + shows "of_complex x = ii\<^sub>h \ x = \" + by (subst of_complex_ii[symmetric]) (auto simp add: of_complex_inj) + +text \Conversion to complex\ + +definition to_complex_cvec :: "complex_vec \ complex" where + [simp]: "to_complex_cvec z = (let (z1, z2) = z in z1/z2)" +lift_definition to_complex_homo_coords :: "complex_homo_coords \ complex" is to_complex_cvec + done +lift_definition to_complex :: "complex_homo \ complex" is to_complex_homo_coords +proof- + fix z w + assume "z \ w" + thus "to_complex_homo_coords z = to_complex_homo_coords w" + by transfer auto +qed + +lemma to_complex_of_complex [simp]: + shows "to_complex (of_complex z) = z" + by (transfer, transfer, simp) + +lemma of_complex_to_complex [simp]: + assumes "z \ \\<^sub>h" + shows "(of_complex (to_complex z)) = z" + using assms +proof (transfer, transfer) + fix z :: complex_vec + obtain z1 z2 where *: "z = (z1, z2)" + by (cases z, auto) + assume "z \ vec_zero" "\ z \\<^sub>v \\<^sub>v" + hence "z2 \ 0" + using * + by (simp, erule_tac x="1/z1" in allE, auto) + thus "(of_complex_cvec (to_complex_cvec z)) \\<^sub>v z" + using * + by simp +qed + +lemma to_complex_zero_zero [simp]: + shows "to_complex 0\<^sub>h = 0" + by (metis of_complex_zero to_complex_of_complex) + +lemma to_complex_one_one [simp]: + shows "to_complex 1\<^sub>h = 1" + by (metis of_complex_one to_complex_of_complex) + +lemma to_complex_img_one [simp]: + shows "to_complex ii\<^sub>h = \" + by (metis of_complex_ii to_complex_of_complex) + +(* ---------------------------------------------------------------------------- *) +subsection \Arithmetic operations\ +(* ---------------------------------------------------------------------------- *) + +text \Due to the requirement of HOL that all functions are total, we could not define the function +only for the well-defined cases, and in the lifting proofs we must also handle the ill-defined +cases. For example, $\infty_h +_h \infty_h$ is ill-defined, but we must define it, so we define it +arbitrarily to be $\infty_h$.\ + +(* ---------------------------------------------------------------------------- *) +subsubsection \Addition\ +(* ---------------------------------------------------------------------------- *) + +text \$\infty_h\ +_h\ \infty_h$ is ill-defined. Since functions must be total, for formal reasons we +define it arbitrarily to be $\infty_h$.\ + +definition add_cvec :: "complex_vec \ complex_vec \ complex_vec" (infixl "+\<^sub>v" 60) where + [simp]: "add_cvec z w = (let (z1, z2) = z; (w1, w2) = w + in if z2 \ 0 \ w2 \ 0 then + (z1*w2 + w1*z2, z2*w2) + else + (1, 0))" +lift_definition add_hcoords :: "complex_homo_coords \ complex_homo_coords \ complex_homo_coords" (infixl "+\<^sub>h\<^sub>c" 60) is add_cvec + by (auto split: if_split_asm) + +lift_definition add :: "complex_homo \ complex_homo \ complex_homo" (infixl "+\<^sub>h" 60) is add_hcoords +proof transfer + fix z w z' w' :: complex_vec + obtain z1 z2 w1 w2 z'1 z'2 w'1 w'2 where + *: "z = (z1, z2)" "w = (w1, w2)" "z' = (z'1, z'2)" "w' = (w'1, w'2)" + by (cases z, auto, cases w, auto, cases z', auto, cases w', auto) + assume **: + "z \ vec_zero" "w \ vec_zero" "z \\<^sub>v z'" + "z' \ vec_zero" "w' \ vec_zero" "w \\<^sub>v w'" + show "z +\<^sub>v w \\<^sub>v z' +\<^sub>v w'" + proof (cases "z2 \ 0 \ w2 \ 0") + case True + hence "z'2 \ 0 \ w'2 \ 0" + using * ** + by auto + show ?thesis + using \z2 \ 0 \ w2 \ 0\ \z'2 \ 0 \ w'2 \ 0\ + using * ** + by simp ((erule exE)+, rule_tac x="k*ka" in exI, simp add: field_simps) + next + case False + hence "z'2 = 0 \ w'2 = 0" + using * ** + by auto + show ?thesis + using \\ (z2 \ 0 \ w2 \ 0)\ \z'2 = 0 \ w'2 = 0\ + using * ** + by auto + qed +qed + +lemma add_commute: + shows "z +\<^sub>h w = w +\<^sub>h z" + apply (transfer, transfer) + unfolding complex_cvec_eq_def + by (rule_tac x="1" in exI, auto split: if_split_asm) + +lemma add_zero_right [simp]: + shows "z +\<^sub>h 0\<^sub>h = z" + by (transfer, transfer, force) + +lemma add_zero_left [simp]: + shows "0\<^sub>h +\<^sub>h z = z" + by (subst add_commute) simp + +lemma of_complex_add_of_complex [simp]: + shows "(of_complex x) +\<^sub>h (of_complex y) = of_complex (x + y)" + by (transfer, transfer, simp) + +lemma of_complex_add_inf [simp]: + shows "(of_complex x) +\<^sub>h \\<^sub>h = \\<^sub>h" + by (transfer, transfer, simp) + +lemma inf_add_of_complex [simp]: + shows "\\<^sub>h +\<^sub>h (of_complex x) = \\<^sub>h" + by (subst add_commute) simp + +lemma inf_add_right: + assumes "z \ \\<^sub>h" + shows "z +\<^sub>h \\<^sub>h = \\<^sub>h" + using assms + using inf_or_of_complex[of z] + by auto + +lemma inf_add_left: + assumes "z \ \\<^sub>h" + shows "\\<^sub>h +\<^sub>h z = \\<^sub>h" + using assms + by (subst add_commute) (rule inf_add_right, simp) + +text \This is ill-defined, but holds by our definition\ +lemma inf_add_inf: + shows "\\<^sub>h +\<^sub>h \\<^sub>h = \\<^sub>h" + by (transfer, transfer, simp) + +(* ---------------------------------------------------------------------------- *) +subsubsection \Unary minus\ +(* ---------------------------------------------------------------------------- *) + +definition uminus_cvec :: "complex_vec \ complex_vec" ("~\<^sub>v") where + [simp]: "~\<^sub>v z = (let (z1, z2) = z in (-z1, z2))" +lift_definition uminus_hcoords :: "complex_homo_coords \ complex_homo_coords" ("~\<^sub>h\<^sub>c") is uminus_cvec + by auto +lift_definition uminus :: "complex_homo \ complex_homo" ("~\<^sub>h") is uminus_hcoords + by transfer auto + +lemma uminus_of_complex [simp]: + shows "~\<^sub>h (of_complex z) = of_complex (-z)" + by (transfer, transfer, simp) + +lemma uminus_zero [simp]: + shows "~\<^sub>h 0\<^sub>h = 0\<^sub>h" + by (transfer, transfer, simp) + +lemma uminus_inf [simp]: + shows "~\<^sub>h \\<^sub>h = \\<^sub>h" + apply (transfer, transfer) + unfolding complex_cvec_eq_def + by (rule_tac x="-1" in exI, simp) + +lemma uminus_inf_iff: + shows "~\<^sub>h z = \\<^sub>h \ z = \\<^sub>h" + apply (transfer, transfer) + by auto (rule_tac x="-1/a" in exI, auto) + +lemma uminus_id_iff: + shows "~\<^sub>h z = z \ z = 0\<^sub>h \ z = \\<^sub>h" + apply (transfer, transfer) + apply auto + apply (erule_tac x="1/a" in allE, simp) + apply (rule_tac x="-1" in exI, simp) + done + + +(* ---------------------------------------------------------------------------- *) +subsubsection \Subtraction\ +(* ---------------------------------------------------------------------------- *) + +text \Operation $\infty_h\ -_h\ \infty_h$ is ill-defined, but we define it arbitrarily to $0_h$. It breaks the connection between + subtraction with addition and unary minus, but seems more intuitive.\ + +definition sub :: "complex_homo \ complex_homo \ complex_homo" (infixl "-\<^sub>h" 60) where + "z -\<^sub>h w = (if z = \\<^sub>h \ w = \\<^sub>h then 0\<^sub>h else z +\<^sub>h (~\<^sub>h w))" + +lemma of_complex_sub_of_complex [simp]: + shows "(of_complex x) -\<^sub>h (of_complex y) = of_complex (x - y)" + unfolding sub_def + by simp + +lemma zero_sub_right[simp]: + shows "z -\<^sub>h 0\<^sub>h = z" + unfolding sub_def + by simp + +lemma zero_sub_left[simp]: + shows "0\<^sub>h -\<^sub>h of_complex x = of_complex (-x)" + by (subst of_complex_zero[symmetric], simp del: of_complex_zero) + +lemma zero_sub_one[simp]: + shows "0\<^sub>h -\<^sub>h 1\<^sub>h = of_complex (-1)" + by (metis of_complex_one zero_sub_left) + +lemma of_complex_sub_one [simp]: + shows "of_complex x -\<^sub>h 1\<^sub>h = of_complex (x - 1)" + by (metis of_complex_one of_complex_sub_of_complex) + +lemma sub_eq_zero [simp]: + assumes "z \ \\<^sub>h" + shows "z -\<^sub>h z = 0\<^sub>h" + using assms + using inf_or_of_complex[of z] + by auto + +lemma sub_eq_zero_iff: + assumes "z \ \\<^sub>h \ w \ \\<^sub>h" + shows "z -\<^sub>h w = 0\<^sub>h \ z = w" +proof + assume "z -\<^sub>h w = 0\<^sub>h" + thus "z = w" + using assms + unfolding sub_def + proof (transfer, transfer) + fix z w :: complex_vec + obtain z1 z2 w1 w2 where *: "z = (z1, z2)" "w = (w1, w2)" + by (cases z, auto, cases w, auto) + assume "z \ vec_zero" "w \ vec_zero" "\ z \\<^sub>v \\<^sub>v \ \ w \\<^sub>v \\<^sub>v" and + **: "(if z \\<^sub>v \\<^sub>v \ w \\<^sub>v \\<^sub>v then 0\<^sub>v else z +\<^sub>v ~\<^sub>v w) \\<^sub>v 0\<^sub>v" + have "z2 \ 0 \ w2 \ 0" + using * \\ z \\<^sub>v \\<^sub>v \ \ w \\<^sub>v \\<^sub>v\ \z \ vec_zero\ \w \ vec_zero\ + apply auto + apply (erule_tac x="1/z1" in allE, simp) + apply (erule_tac x="1/w1" in allE, simp) + done + + thus "z \\<^sub>v w" + using * ** + by simp (rule_tac x="w2/z2" in exI, auto simp add: field_simps) + qed +next + assume "z = w" + thus "z -\<^sub>h w = 0\<^sub>h" + using sub_eq_zero[of z] assms + by auto +qed + +lemma inf_sub_left [simp]: + assumes "z \ \\<^sub>h" + shows "\\<^sub>h -\<^sub>h z = \\<^sub>h" + using assms + using uminus_inf_iff + using inf_or_of_complex + unfolding sub_def + by force + +lemma inf_sub_right [simp]: + assumes "z \ \\<^sub>h" + shows "z -\<^sub>h \\<^sub>h = \\<^sub>h" + using assms + using inf_or_of_complex + unfolding sub_def + by force + +text \This is ill-defined, but holds by our definition\ +lemma inf_sub_inf: + shows "\\<^sub>h -\<^sub>h \\<^sub>h = 0\<^sub>h" + unfolding sub_def + by simp + +lemma sub_noteq_inf: + assumes "z \ \\<^sub>h" and "w \ \\<^sub>h" + shows "z -\<^sub>h w \ \\<^sub>h" + using assms + using inf_or_of_complex[of z] + using inf_or_of_complex[of w] + using inf_or_of_complex[of "z -\<^sub>h w"] + using of_complex_sub_of_complex + by auto + +lemma sub_eq_inf: + assumes "z -\<^sub>h w = \\<^sub>h" + shows "z = \\<^sub>h \ w = \\<^sub>h" + using assms sub_noteq_inf + by blast + +(* ---------------------------------------------------------------------------- *) +subsubsection \Multiplication\ +(* ---------------------------------------------------------------------------- *) + +text \Operations $0_h \cdot_h \infty_h$ and $\infty_h \cdot_h 0_h$ are ill defined. Since all +functions must be total, for formal reasons we define it arbitrarily to be $1_h$.\ + +definition mult_cvec :: "complex_vec \ complex_vec \ complex_vec" (infixl "*\<^sub>v" 70) where + [simp]: "z *\<^sub>v w = (let (z1, z2) = z; (w1, w2) = w + in if (z1 = 0 \ w2 = 0) \ (w1 = 0 \ z2 = 0) then + (1, 1) + else + (z1*w1, z2*w2))" +lift_definition mult_hcoords :: "complex_homo_coords \ complex_homo_coords \ complex_homo_coords" (infixl "*\<^sub>h\<^sub>c" 70) is mult_cvec + by (auto split: if_split_asm) + +lift_definition mult :: "complex_homo \ complex_homo \ complex_homo" (infixl "*\<^sub>h" 70) is mult_hcoords +proof transfer + fix z w z' w' :: complex_vec + obtain z1 z2 w1 w2 z'1 z'2 w'1 w'2 where + *: "z = (z1, z2)" "w = (w1, w2)" "z' = (z'1, z'2)" "w' = (w'1, w'2)" + by (cases z, auto, cases w, auto, cases z', auto, cases w', auto) + assume **: + "z \ vec_zero" "w \ vec_zero" "z \\<^sub>v z'" + "z' \ vec_zero" "w' \ vec_zero" "w \\<^sub>v w'" + show "z *\<^sub>v w \\<^sub>v z' *\<^sub>v w'" + proof (cases "(z1 = 0 \ w2 = 0) \ (w1 = 0 \ z2 = 0)") + case True + hence "(z'1 = 0 \ w'2 = 0) \ (w'1 = 0 \ z'2 = 0)" + using * ** + by auto + show ?thesis + using \(z1 = 0 \ w2 = 0) \ (w1 = 0 \ z2 = 0)\ \(z'1 = 0 \ w'2 = 0) \ (w'1 = 0 \ z'2 = 0)\ + using * ** + by simp + next + case False + hence "\((z'1 = 0 \ w'2 = 0) \ (w'1 = 0 \ z'2 = 0))" + using * ** + by auto + hence ***: "z *\<^sub>v w = (z1*w1, z2*w2)" "z' *\<^sub>v w' = (z'1*w'1, z'2*w'2)" + using \\((z1 = 0 \ w2 = 0) \ (w1 = 0 \ z2 = 0))\ \\((z'1 = 0 \ w'2 = 0) \ (w'1 = 0 \ z'2 = 0))\ + using * + by auto + show ?thesis + apply (subst ***)+ + using * ** + by simp ((erule exE)+, rule_tac x="k*ka" in exI, simp) + qed +qed + +lemma of_complex_mult_of_complex [simp]: + shows "(of_complex z1) *\<^sub>h (of_complex z2) = of_complex (z1 * z2)" + by (transfer, transfer, simp) + +lemma mult_commute: + shows "z1 *\<^sub>h z2 = z2 *\<^sub>h z1" + apply (transfer, transfer) + unfolding complex_cvec_eq_def + by (rule_tac x="1" in exI, auto split: if_split_asm) + +lemma mult_zero_left [simp]: + assumes "z \ \\<^sub>h" + shows "0\<^sub>h *\<^sub>h z = 0\<^sub>h" + using assms +proof (transfer, transfer) + fix z :: complex_vec + obtain z1 z2 where *: "z = (z1, z2)" + by (cases z, auto) + assume "z \ vec_zero" "\ (z \\<^sub>v \\<^sub>v)" + hence "z2 \ 0" + using * + by force + thus "0\<^sub>v *\<^sub>v z \\<^sub>v 0\<^sub>v" + using * + by simp +qed + +lemma mult_zero_right [simp]: + assumes "z \ \\<^sub>h" + shows "z *\<^sub>h 0\<^sub>h = 0\<^sub>h" + using mult_zero_left[OF assms] + by (simp add: mult_commute) + +lemma mult_inf_right [simp]: + assumes "z \ 0\<^sub>h" + shows "z *\<^sub>h \\<^sub>h = \\<^sub>h" +using assms +proof (transfer, transfer) + fix z :: complex_vec + obtain z1 z2 where *: "z = (z1, z2)" + by (cases z, auto) + assume "z \ vec_zero" "\ (z \\<^sub>v 0\<^sub>v)" + hence "z1 \ 0" + using * + by force + thus "z *\<^sub>v \\<^sub>v \\<^sub>v \\<^sub>v" + using * + by simp +qed + +lemma mult_inf_left [simp]: + assumes "z \ 0\<^sub>h" + shows "\\<^sub>h *\<^sub>h z = \\<^sub>h" + using mult_inf_right[OF assms] + by (simp add: mult_commute) + +lemma mult_one_left [simp]: + shows "1\<^sub>h *\<^sub>h z = z" + by (transfer, transfer, force) + +lemma mult_one_right [simp]: + shows "z *\<^sub>h 1\<^sub>h = z" + using mult_one_left[of z] + by (simp add: mult_commute) + +text \This is ill-defined, but holds by our definition\ +lemma inf_mult_zero: + shows "\\<^sub>h *\<^sub>h 0\<^sub>h = 1\<^sub>h" + by (transfer, transfer, simp) +lemma zero_mult_inf: + shows "0\<^sub>h *\<^sub>h \\<^sub>h = 1\<^sub>h" + by (transfer, transfer, simp) + +lemma mult_eq_inf: + assumes "z *\<^sub>h w = \\<^sub>h" + shows "z = \\<^sub>h \ w = \\<^sub>h" + using assms + using inf_or_of_complex[of z] + using inf_or_of_complex[of w] + using inf_or_of_complex[of "z *\<^sub>h w"] + using of_complex_mult_of_complex + by auto + +lemma mult_noteq_inf: + assumes "z \ \\<^sub>h" and "w \ \\<^sub>h" + shows "z *\<^sub>h w \ \\<^sub>h" + using assms mult_eq_inf + by blast + +subsubsection \Reciprocal\ +definition reciprocal_cvec :: "complex_vec \ complex_vec" where + [simp]: "reciprocal_cvec z = (let (z1, z2) = z in (z2, z1))" +lift_definition reciprocal_hcoords :: "complex_homo_coords \ complex_homo_coords" is reciprocal_cvec + by auto + +lift_definition reciprocal :: "complex_homo \ complex_homo" is reciprocal_hcoords + by transfer auto + +lemma reciprocal_involution [simp]: "reciprocal (reciprocal z) = z" + by (transfer, transfer, auto) + +lemma reciprocal_zero [simp]: "reciprocal 0\<^sub>h = \\<^sub>h" + by (transfer, transfer, simp) + +lemma reciprocal_inf [simp]: "reciprocal \\<^sub>h = 0\<^sub>h" + by (transfer, transfer, simp) + +lemma reciprocal_one [simp]: "reciprocal 1\<^sub>h = 1\<^sub>h" + by (transfer, transfer, simp) + +lemma reciprocal_inf_iff [iff]: "reciprocal z = \\<^sub>h \ z = 0\<^sub>h" + by (transfer, transfer, auto) + +lemma reciprocal_zero_iff [iff]: "reciprocal z = 0\<^sub>h \ z = \\<^sub>h" + by (transfer, transfer, auto) + +lemma reciprocal_of_complex [simp]: + assumes "z \ 0" + shows "reciprocal (of_complex z) = of_complex (1 / z)" + using assms + by (transfer, transfer, simp) + +lemma reciprocal_real: + assumes "is_real (to_complex z)" and "z \ 0\<^sub>h" and "z \ \\<^sub>h" + shows "Re (to_complex (reciprocal z)) = 1 / Re (to_complex z)" +proof- + obtain c where "z = of_complex c" "c \ 0" "is_real c" + using assms inf_or_of_complex[of z] + by auto + thus ?thesis + by (simp add: Re_divide_real) +qed + +lemma reciprocal_id_iff: + shows "reciprocal z = z \ z = of_complex 1 \ z = of_complex (-1)" +proof (cases "z = 0\<^sub>h") + case True + thus ?thesis + by (metis inf_not_of_complex of_complex_zero_iff reciprocal_inf_iff zero_neq_neg_one zero_neq_one) +next + case False + thus ?thesis + using inf_or_of_complex[of z] + by (smt complex_sqrt_1 of_complex_zero_iff reciprocal_inf_iff reciprocal_of_complex to_complex_of_complex) +qed + + +(* ---------------------------------------------------------------------------- *) +subsubsection \Division\ +(* ---------------------------------------------------------------------------- *) + +text \Operations $0_h :_h 0_h$ and $\infty_h :_h \infty_h$ are ill-defined. For formal reasons they +are defined to be $1_h$ (by the definition of multiplication).\ + +definition divide :: "complex_homo \ complex_homo \ complex_homo" (infixl ":\<^sub>h" 70) where + "x :\<^sub>h y = x *\<^sub>h (reciprocal y)" + +lemma divide_zero_right [simp]: + assumes "z \ 0\<^sub>h" + shows "z :\<^sub>h 0\<^sub>h = \\<^sub>h" + using assms + unfolding divide_def + by simp + +lemma divide_zero_left [simp]: + assumes "z \ 0\<^sub>h" + shows "0\<^sub>h :\<^sub>h z = 0\<^sub>h" + using assms + unfolding divide_def + by simp + +lemma divide_inf_right [simp]: + assumes "z \ \\<^sub>h" + shows "z :\<^sub>h \\<^sub>h = 0\<^sub>h" + using assms + unfolding divide_def + by simp + +lemma divide_inf_left [simp]: + assumes "z \ \\<^sub>h" + shows "\\<^sub>h :\<^sub>h z = \\<^sub>h" + using assms reciprocal_zero_iff[of z] mult_inf_left + unfolding divide_def + by simp + +lemma divide_eq_inf: + assumes "z :\<^sub>h w = \\<^sub>h" + shows "z = \\<^sub>h \ w = 0\<^sub>h" + using assms + using reciprocal_inf_iff[of w] mult_eq_inf + unfolding divide_def + by auto + +lemma inf_divide_zero [simp]: + shows "\\<^sub>h :\<^sub>h 0\<^sub>h = \\<^sub>h" + unfolding divide_def + by (transfer, simp) + +lemma zero_divide_inf [simp]: + shows "0\<^sub>h :\<^sub>h \\<^sub>h = 0\<^sub>h" + unfolding divide_def + by (transfer, simp) + +lemma divide_one_right [simp]: + shows "z :\<^sub>h 1\<^sub>h = z" + unfolding divide_def + by simp + +lemma of_complex_divide_of_complex [simp]: + assumes "z2 \ 0" + shows "(of_complex z1) :\<^sub>h (of_complex z2) = of_complex (z1 / z2)" +using assms + unfolding divide_def + apply transfer + apply transfer + by (simp, rule_tac x="1/z2" in exI, simp) + +lemma one_div_of_complex [simp]: + assumes "x \ 0" + shows "1\<^sub>h :\<^sub>h of_complex x = of_complex (1 / x)" + using assms + unfolding divide_def + by simp + +text \ This is ill-defined, but holds by our definition\ +lemma inf_divide_inf: + shows "\\<^sub>h :\<^sub>h \\<^sub>h = 1\<^sub>h" + unfolding divide_def + by (simp add: inf_mult_zero) + +text \ This is ill-defined, but holds by our definition\ +lemma zero_divide_zero: + shows "0\<^sub>h :\<^sub>h 0\<^sub>h = 1\<^sub>h" + unfolding divide_def + by (simp add: zero_mult_inf) + +(* ---------------------------------------------------------------------------- *) +subsubsection \Conjugate\ +(* ---------------------------------------------------------------------------- *) + +definition conjugate_cvec :: "complex_vec \ complex_vec" where + [simp]: "conjugate_cvec z = vec_cnj z" +lift_definition conjugate_hcoords :: "complex_homo_coords \ complex_homo_coords" is conjugate_cvec + by (auto simp add: vec_cnj_def) +lift_definition conjugate :: "complex_homo \ complex_homo" is conjugate_hcoords + by transfer (auto simp add: vec_cnj_def) + +lemma conjugate_involution [simp]: + shows "conjugate (conjugate z) = z" + by (transfer, transfer, auto) + +lemma conjugate_conjugate_comp [simp]: + shows "conjugate \ conjugate = id" + by (rule ext, simp) + +lemma inv_conjugate [simp]: + shows "inv conjugate = conjugate" + using inv_unique_comp[of conjugate conjugate] + by simp + +lemma conjugate_of_complex [simp]: + shows "conjugate (of_complex z) = of_complex (cnj z)" + by (transfer, transfer, simp add: vec_cnj_def) + +lemma conjugate_inf [simp]: + shows "conjugate \\<^sub>h = \\<^sub>h" + by (transfer, transfer, simp add: vec_cnj_def) + +lemma conjugate_zero [simp]: + shows "conjugate 0\<^sub>h = 0\<^sub>h" + by (transfer, transfer, simp add: vec_cnj_def) + +lemma conjugate_one [simp]: + shows "conjugate 1\<^sub>h = 1\<^sub>h" + by (transfer, transfer, simp add: vec_cnj_def) + +lemma conjugate_inj: + assumes "conjugate x = conjugate y" + shows "x = y" + using assms + using conjugate_involution[of x] conjugate_involution[of y] + by metis + +lemma bij_conjugate [simp]: + shows "bij conjugate" + unfolding bij_def inj_on_def +proof auto + fix x y + assume "conjugate x = conjugate y" + thus "x = y" + by (simp add: conjugate_inj) +next + fix x + show "x \ range conjugate" + by (metis conjugate_involution range_eqI) +qed + +lemma conjugate_id_iff: + shows "conjugate a = a \ is_real (to_complex a) \ a = \\<^sub>h" + using inf_or_of_complex[of a] + by (metis conjugate_inf conjugate_of_complex eq_cnj_iff_real to_complex_of_complex) + +subsubsection \Inversion\ + +text \Geometric inversion wrt. the unit circle\ + +definition inversion where + "inversion = conjugate \ reciprocal" + +lemma inversion_sym: + shows "inversion = reciprocal \ conjugate" + unfolding inversion_def + apply (rule ext, simp) + apply transfer + apply transfer + apply (auto simp add: vec_cnj_def) + using one_neq_zero + by blast+ + +lemma inversion_involution [simp]: + shows "inversion (inversion z) = z" +proof- + have *: "conjugate \ reciprocal = reciprocal \ conjugate" + using inversion_sym + by (simp add: inversion_def) + show ?thesis + unfolding inversion_def + by (subst *) simp +qed + +lemma inversion_inversion_id [simp]: + shows "inversion \ inversion = id" + by (rule ext, simp) + +lemma inversion_zero [simp]: + shows "inversion 0\<^sub>h = \\<^sub>h" + by (simp add: inversion_def) + +lemma inversion_infty [simp]: + shows "inversion \\<^sub>h = 0\<^sub>h" + by (simp add: inversion_def) + +lemma inversion_of_complex [simp]: + assumes "z \ 0" + shows "inversion (of_complex z) = of_complex (1 / cnj z)" + using assms + by (simp add: inversion_def) + +lemma is_real_inversion: + assumes "is_real x" and "x \ 0" + shows "is_real (to_complex (inversion (of_complex x)))" + using assms eq_cnj_iff_real[of x] + by simp + +lemma inversion_id_iff: + shows "a = inversion a \ a \ \\<^sub>h \ (to_complex a) * cnj (to_complex a) = 1" (is "?lhs = ?rhs") +proof + assume "a = inversion a" + thus ?rhs + unfolding inversion_def + using inf_or_of_complex[of a] + by (metis (full_types) comp_apply complex_cnj_cancel_iff complex_cnj_zero inversion_def inversion_infty inversion_of_complex inversion_sym nonzero_eq_divide_eq of_complex_zero reciprocal_zero to_complex_of_complex zero_one_infty_not_equal(5)) +next + assume ?rhs + thus ?lhs + using inf_or_of_complex[of a] + by (metis inversion_of_complex mult_not_zero nonzero_mult_div_cancel_right one_neq_zero to_complex_of_complex) +qed + +(* ---------------------------------------------------------------------------- *) +subsection \Ratio and cross-ratio\ +(* ---------------------------------------------------------------------------- *) + +(* ---------------------------------------------------------------------------- *) +subsubsection \Ratio\ +(* ---------------------------------------------------------------------------- *) + +text \Ratio of points $z$, $v$ and $w$ is usually defined as +$\frac{z-v}{z-w}$. Our definition introduces it in homogeneous +coordinates. It is well-defined if $z_1 \neq z_2 \vee z_1 \neq z_3$ and $z_1 \neq \infty_h$ and +$z_2 \neq \infty_h \vee z_3 \neq \infty_h$\ + +definition ratio :: "complex_homo \ complex_homo \ complex_homo \ complex_homo" where + "ratio za zb zc = (za -\<^sub>h zb) :\<^sub>h (za -\<^sub>h zc)" + +text \This is ill-defined, but holds by our definition\ +lemma + assumes "zb \ \\<^sub>h" and "zc \ \\<^sub>h" + shows "ratio \\<^sub>h zb zc = 1\<^sub>h" + using assms + using inf_sub_left[OF assms(1)] + using inf_sub_left[OF assms(2)] + unfolding ratio_def + by (simp add: inf_divide_inf) + +lemma + assumes "za \ \\<^sub>h" and "zc \ \\<^sub>h" + shows "ratio za \\<^sub>h zc = \\<^sub>h" + using assms + unfolding ratio_def + using inf_sub_right[OF assms(1)] + using sub_noteq_inf[OF assms] + using divide_inf_left + by simp + +lemma + assumes "za \ \\<^sub>h" and "zb \ \\<^sub>h" + shows "ratio za zb \\<^sub>h = 0\<^sub>h" + unfolding ratio_def + using sub_noteq_inf[OF assms] + using inf_sub_right[OF assms(1)] + using divide_inf_right + by simp + +lemma + assumes "z1 \ z2" and "z1 \ \\<^sub>h" + shows "ratio z1 z2 z1 = \\<^sub>h" + using assms + unfolding ratio_def + using divide_zero_right[of "z1 -\<^sub>h z2"] + using sub_eq_zero_iff[of z1 z2] + by simp + +(* ---------------------------------------------------------------------------- *) +subsubsection \Cross-ratio\ +(* ---------------------------------------------------------------------------- *) + +text \The cross-ratio is defined over 4 points $(z, u, v, w)$, usually as +$\frac{(z-u)(v-w)}{(z-w)(v-u)}$. We define it using homogeneous coordinates. Cross ratio is +ill-defined when $z = u \vee v = w$ and $z = w$ and $v = u$ i.e. when 3 points are equal. Since +function must be total, in that case we define it arbitrarily to 1.\ + +definition cross_ratio_cvec :: "complex_vec \ complex_vec \ complex_vec \ complex_vec \ complex_vec" where + [simp]: "cross_ratio_cvec z u v w = + (let (z', z'') = z; + (u', u'') = u; + (v', v'') = v; + (w', w'') = w; + n1 = z'*u'' - u'*z''; + n2 = v'*w'' - w'*v''; + d1 = z'*w'' - w'*z''; + d2 = v'*u'' - u'*v'' + in + if n1 * n2 \ 0 \ d1 * d2 \ 0 then + (n1 * n2, d1 * d2) + else + (1, 1))" + +lift_definition cross_ratio_hcoords :: "complex_homo_coords \ complex_homo_coords \ complex_homo_coords \ complex_homo_coords \ complex_homo_coords" is cross_ratio_cvec + by (auto split: if_split_asm) + +lift_definition cross_ratio :: "complex_homo \ complex_homo \ complex_homo \ complex_homo \ complex_homo" is cross_ratio_hcoords +proof transfer + fix z u v w z' u' v' w' :: complex_vec + obtain z1 z2 u1 u2 v1 v2 w1 w2 z'1 z'2 u'1 u'2 v'1 v'2 w'1 w'2 + where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)" + "z' = (z'1, z'2)" "u' = (u'1, u'2)" "v' = (v'1, v'2)" "w' = (w'1, w'2)" + by (cases z, auto, cases u, auto, cases v, auto, cases w, auto, + cases z', auto, cases u', auto, cases v', auto, cases w', auto) + let ?n1 = "z1*u2 - u1*z2" + let ?n2 = "v1*w2 - w1*v2" + let ?d1 = "z1*w2 - w1*z2" + let ?d2 = "v1*u2 - u1*v2" + let ?n1' = "z'1*u'2 - u'1*z'2" + let ?n2' = "v'1*w'2 - w'1*v'2" + let ?d1' = "z'1*w'2 - w'1*z'2" + let ?d2' = "v'1*u'2 - u'1*v'2" + + assume **: + "z \ vec_zero" "u \ vec_zero" "v \ vec_zero" "w \ vec_zero" + "z' \ vec_zero" "u' \ vec_zero" "v' \ vec_zero" "w' \ vec_zero" + "z \\<^sub>v z'" "v \\<^sub>v v'" "u \\<^sub>v u'" "w \\<^sub>v w'" + show "cross_ratio_cvec z u v w \\<^sub>v cross_ratio_cvec z' u' v' w'" + proof (cases "?n1*?n2 \ 0 \ ?d1*?d2 \ 0") + case True + hence "?n1'*?n2' \ 0 \ ?d1'*?d2' \ 0" + using * ** + by simp ((erule exE)+, simp) + show ?thesis + using \?n1*?n2 \ 0 \ ?d1*?d2 \ 0\ + using \?n1'*?n2' \ 0 \ ?d1'*?d2' \ 0\ + using * ** + by simp ((erule exE)+, rule_tac x="k*ka*kb*kc" in exI, simp add: field_simps) + next + case False + hence "\ (?n1'*?n2' \ 0 \ ?d1'*?d2' \ 0)" + using * ** + by simp ((erule exE)+, simp) + show ?thesis + using \\ (?n1*?n2 \ 0 \ ?d1*?d2 \ 0)\ + using \\ (?n1'*?n2' \ 0 \ ?d1'*?d2' \ 0)\ + using * ** + by simp blast + qed +qed + +lemma cross_ratio_01inf_id [simp]: + shows "cross_ratio z 0\<^sub>h 1\<^sub>h \\<^sub>h = z" +proof (transfer, transfer) + fix z :: complex_vec + obtain z1 z2 where *: "z = (z1, z2)" + by (cases z, auto) + assume "z \ vec_zero" + thus "cross_ratio_cvec z 0\<^sub>v 1\<^sub>v \\<^sub>v \\<^sub>v z" + using * + by simp (rule_tac x="-1" in exI, simp) +qed + +lemma cross_ratio_0: + assumes "u \ v" and "u \ w" + shows "cross_ratio u u v w = 0\<^sub>h" + using assms +proof (transfer, transfer) + fix u v w :: complex_vec + obtain u1 u2 v1 v2 w1 w2 + where *: "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)" + by (cases u, auto, cases v, auto, cases w, auto) + assume "u \ vec_zero" "v \ vec_zero" "w \ vec_zero" "\ u \\<^sub>v v" "\ u \\<^sub>v w" + thus "cross_ratio_cvec u u v w \\<^sub>v 0\<^sub>v" + using * complex_cvec_eq_mix[of u1 u2 v1 v2] complex_cvec_eq_mix[of u1 u2 w1 w2] + by (force simp add: mult.commute) +qed + +lemma cross_ratio_1: + assumes "u \ v" and "v \ w" + shows "cross_ratio v u v w = 1\<^sub>h" + using assms +proof (transfer, transfer) + fix u v w :: complex_vec + obtain u1 u2 v1 v2 w1 w2 + where *: "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)" + by (cases u, auto, cases v, auto, cases w, auto) + let ?n1 = "v1*u2 - u1*v2" + let ?n2 = "v1*w2 - w1*v2" + assume "u \ vec_zero" "v \ vec_zero" "w \ vec_zero" "\ u \\<^sub>v v" "\ v \\<^sub>v w" + hence "?n1 \ 0 \ ?n2 \ 0" + using * complex_cvec_eq_mix[of u1 u2 v1 v2] complex_cvec_eq_mix[of v1 v2 w1 w2] + by (auto simp add: field_simps) + thus "cross_ratio_cvec v u v w \\<^sub>v 1\<^sub>v" + using * + by simp (rule_tac x="1 / (?n1 * ?n2)" in exI, simp) +qed + +lemma cross_ratio_inf: + assumes "u \ w" and "v \ w" + shows "cross_ratio w u v w = \\<^sub>h" + using assms +proof (transfer, transfer) + fix u v w :: complex_vec + obtain u1 u2 v1 v2 w1 w2 + where *: "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)" + by (cases u, auto, cases v, auto, cases w, auto) + let ?n1 = "w1*u2 - u1*w2" + let ?n2 = "v1*w2 - w1*v2" + assume "u \ vec_zero" "v \ vec_zero" "w \ vec_zero" "\ u \\<^sub>v w" "\ v \\<^sub>v w" + hence "?n1 \ 0 \ ?n2 \ 0" + using * complex_cvec_eq_mix[of u1 u2 w1 w2] complex_cvec_eq_mix[of v1 v2 w1 w2] + by (auto simp add: field_simps) + thus "cross_ratio_cvec w u v w \\<^sub>v \\<^sub>v" + using * + by simp +qed + +lemma cross_ratio_0inf: + assumes "y \ 0" + shows "cross_ratio (of_complex x) 0\<^sub>h (of_complex y) \\<^sub>h = (of_complex (x / y))" + using assms + by (transfer, transfer) (simp, rule_tac x="-1/y" in exI, simp) + +lemma cross_ratio_commute_13: + shows "cross_ratio z u v w = reciprocal (cross_ratio v u z w)" + by (transfer, transfer, case_tac z, case_tac u, case_tac v, case_tac w, simp) + +lemma cross_ratio_commute_24: + shows "cross_ratio z u v w = reciprocal (cross_ratio z w v u)" + by (transfer, transfer, case_tac z, case_tac u, case_tac v, case_tac w, simp) + +lemma cross_ratio_not_inf: + assumes "z \ w" and "u \ v" + shows "cross_ratio z u v w \ \\<^sub>h" + using assms +proof (transfer, transfer) + fix z u v w + assume nz: "z \ vec_zero" "u \ vec_zero" "v \ vec_zero" "w \ vec_zero" + obtain z1 z2 u1 u2 v1 v2 w1 w2 where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)" + by (cases z, cases u, cases v, cases w, auto) + obtain x1 x2 where **: "cross_ratio_cvec z u v w = (x1, x2)" + by (cases "cross_ratio_cvec z u v w", auto) + assume "\ z \\<^sub>v w" "\ u \\<^sub>v v" + hence "z1*w2 \ z2*w1" "u1*v2 \ u2*v1" + using * nz complex_cvec_eq_mix + by blast+ + hence "x2 \ 0" + using * ** + by (auto split: if_split_asm) (simp add: field_simps) + thus "\ cross_ratio_cvec z u v w \\<^sub>v \\<^sub>v" + using inf_cvec_z2_zero_iff * ** + by simp +qed + +lemma cross_ratio_not_zero: + assumes "z \ u" and "v \ w" + shows "cross_ratio z u v w \ 0\<^sub>h" + using assms +proof (transfer, transfer) + fix z u v w + assume nz: "z \ vec_zero" "u \ vec_zero" "v \ vec_zero" "w \ vec_zero" + obtain z1 z2 u1 u2 v1 v2 w1 w2 where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)" + by (cases z, cases u, cases v, cases w, auto) + obtain x1 x2 where **: "cross_ratio_cvec z u v w = (x1, x2)" + by (cases "cross_ratio_cvec z u v w", auto) + assume "\ z \\<^sub>v u" "\ v \\<^sub>v w" + hence "z1*u2 \ z2*u1" "v1*w2 \ v2*w1" + using * nz complex_cvec_eq_mix + by blast+ + hence "x1 \ 0" + using * ** + by (auto split: if_split_asm) + thus "\ cross_ratio_cvec z u v w \\<^sub>v 0\<^sub>v" + using zero_cvec_z1_zero_iff * ** + by simp +qed + +lemma cross_ratio_real: + assumes "is_real z" and "is_real u" and "is_real v" and "is_real w" + assumes "z \ u \ v \ w \ z \ w \ u \ v" + shows "is_real (to_complex (cross_ratio (of_complex z) (of_complex u) (of_complex v) (of_complex w)))" + using assms + by (transfer, transfer, auto) + +lemma cross_ratio: + assumes "(z \ u \ v \ w) \ (z \ w \ u \ v)" and + "z \ \\<^sub>h" and "u \ \\<^sub>h" and "v \ \\<^sub>h" and "w \ \\<^sub>h" + shows "cross_ratio z u v w = ((z -\<^sub>h u) *\<^sub>h (v -\<^sub>h w)) :\<^sub>h ((z -\<^sub>h w) *\<^sub>h (v -\<^sub>h u))" + unfolding sub_def divide_def + using assms + apply transfer + apply simp + apply transfer +proof- + fix z u v w :: complex_vec + obtain z1 z2 u1 u2 v1 v2 w1 w2 + where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)" + by (cases z, auto, cases u, auto, cases v, auto, cases w, auto) + + let ?n1 = "z1*u2 - u1*z2" + let ?n2 = "v1*w2 - w1*v2" + let ?d1 = "z1*w2 - w1*z2" + let ?d2 = "v1*u2 - u1*v2" + assume **: "z \ vec_zero" "u \ vec_zero" "v \ vec_zero" "w \ vec_zero" + "\ z \\<^sub>v u \ \ v \\<^sub>v w \ \ z \\<^sub>v w \ \ u \\<^sub>v v" + "\ z \\<^sub>v \\<^sub>v" "\ u \\<^sub>v \\<^sub>v" "\ v \\<^sub>v \\<^sub>v" "\ w \\<^sub>v \\<^sub>v" + + hence ***: "?n1 * ?n2 \ 0 \ ?d1 * ?d2 \ 0" + using * + using complex_cvec_eq_mix[of z1 z2 u1 u2] complex_cvec_eq_mix[of v1 v2 w1 w2] + using complex_cvec_eq_mix[of z1 z2 w1 w2] complex_cvec_eq_mix[of u1 u2 v1 v2] + by (metis eq_iff_diff_eq_0 mult.commute mult_eq_0_iff) + + have ****: "z2 \ 0" "w2 \ 0" "u2 \ 0" "v2 \ 0" + using * **(1-4) **(6-9) + using inf_cvec_z2_zero_iff[of z1 z2] + using inf_cvec_z2_zero_iff[of u1 u2] + using inf_cvec_z2_zero_iff[of v1 v2] + using inf_cvec_z2_zero_iff[of w1 w2] + by blast+ + + have "cross_ratio_cvec z u v w = (?n1*?n2, ?d1*?d2)" + using * *** + by simp + moreover + let ?k = "z2*u2*v2*w2" + have "(z +\<^sub>v ~\<^sub>v u) *\<^sub>v (v +\<^sub>v ~\<^sub>v w) *\<^sub>v reciprocal_cvec ((z +\<^sub>v ~\<^sub>v w) *\<^sub>v (v +\<^sub>v ~\<^sub>v u)) = (?k * ?n1 * ?n2, ?k * ?d1 * ?d2)" + using * *** **** + by auto + ultimately + show "cross_ratio_cvec z u v w \\<^sub>v + (z +\<^sub>v ~\<^sub>v u) *\<^sub>v (v +\<^sub>v ~\<^sub>v w) *\<^sub>v reciprocal_cvec ((z +\<^sub>v ~\<^sub>v w) *\<^sub>v (v +\<^sub>v ~\<^sub>v u))" + using **** + unfolding complex_cvec_eq_def + by (rule_tac x="?k" in exI) simp +qed + +end + +(* +(* Although it seems useful, we did not use this. *) + +text \Transfer extended complex plane to complex plane\ + +definition HC :: "complex_homo \ complex \ bool" + where "HC = (\ h c. h = of_complex c)" + +lemma Domainp_HC [transfer_domain_rule]: "Domainp HC = (\ x. x \ \\<^sub>h)" + unfolding HC_def Domainp_iff[abs_def] + apply (rule ext) + using inf_or_of_complex + by auto + +lemma bi_unique_HC [transfer_rule]: "bi_unique HC" + using of_complex_inj + unfolding HC_def bi_unique_def + by auto + +lemma right_total_HC [transfer_rule]: "right_total HC" + unfolding HC_def right_total_def + by auto + +lemma HC_0 [transfer_rule]: "HC 0\<^sub>h 0" + unfolding HC_def + by simp + +lemma HC_1 [transfer_rule]: "HC 1\<^sub>h 1" + unfolding HC_def + by simp + +context includes lifting_syntax +begin +lemma HC_add [transfer_rule]: "(HC ===> HC ===> HC) (op +\<^sub>h) (op +)" + unfolding rel_fun_def HC_def + by auto + +lemma HC_mult [transfer_rule]: "(HC ===> HC ===> HC) (op *\<^sub>h) ( op * )" + unfolding rel_fun_def HC_def + by auto + +lemma HC_All [transfer_rule]: + "((HC ===> op =) ===> op =) (Ball {z. z \ \\<^sub>h}) All" + using inf_or_of_complex + unfolding rel_fun_def HC_def + by auto + +lemma HC_transfer_forall [transfer_rule]: + "((HC ===> op =) ===> op =) (transfer_bforall (\x. x \ \\<^sub>h)) transfer_forall" + using inf_or_of_complex + unfolding transfer_forall_def transfer_bforall_def + unfolding rel_fun_def HC_def + by auto +end +*) diff --git a/thys/Complex_Geometry/Linear_Systems.thy b/thys/Complex_Geometry/Linear_Systems.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Linear_Systems.thy @@ -0,0 +1,217 @@ +(* ---------------------------------------------------------------------------- *) +subsection \Systems of linear equations\ +(* ---------------------------------------------------------------------------- *) +(* TODO: merge with matrices *) + +text \In this section some simple properties of systems of linear equations with two or three unknowns are derived. +Existence and uniqueness of solutions of regular and singular homogenous and non-homogenous systems is characterized.\ + +theory Linear_Systems +imports Main +begin + +text \Determinant of 2x2 matrix\ +definition det2 :: "('a::field) \ 'a \ 'a \ 'a \ 'a" where + [simp]: "det2 a11 a12 a21 a22 \ a11*a22 - a12*a21" + +text \Regular homogenous system has only trivial solution\ +lemma regular_homogenous_system: + fixes a11 a12 a21 a22 x1 x2 :: "'a::field" + assumes "det2 a11 a12 a21 a22 \ 0" + assumes "a11*x1 + a12*x2 = 0" and + "a21*x1 + a22*x2 = 0" + shows "x1 = 0 \ x2 = 0" +proof (cases "a11 = 0") + case True + with assms(1) have "a12 \ 0" "a21 \ 0" + by auto + thus ?thesis + using \a11 = 0\ assms(2) assms(3) + by auto +next + case False + hence "x1 = - a12*x2 / a11" + using assms(2) + by (metis eq_neg_iff_add_eq_0 mult_minus_left nonzero_mult_div_cancel_left) + hence "a21 * (- a12 * x2 / a11) + a22 * x2 = 0" + using assms(3) + by simp + hence "a21 * (- a12 * x2) + a22 * x2 * a11 = 0" + using \a11 \ 0\ + by auto + hence "(a11*a22 - a12*a21)*x2 = 0" + by (simp add: field_simps) + thus ?thesis + using assms(1) assms(2) \a11 \ 0\ + by auto +qed + +text \Regular system has a unique solution\ +lemma regular_system: + fixes a11 a12 a21 a22 b1 b2 :: "'a::field" + assumes "det2 a11 a12 a21 a22 \ 0" + shows "\! x. a11*(fst x) + a12*(snd x) = b1 \ + a21*(fst x) + a22*(snd x) = b2" +proof + let ?d = "a11*a22 - a12*a21" and ?d1 = "b1*a22 - b2*a12" and ?d2 = "b2*a11 - b1*a21" + let ?x = "(?d1 / ?d, ?d2 / ?d)" + have "a11 * ?d1 + a12 * ?d2 = b1*?d" "a21 * ?d1 + a22 * ?d2 = b2*?d" + by (auto simp add: field_simps) + thus "a11 * fst ?x + a12 * snd ?x = b1 \ a21 * fst ?x + a22 * snd ?x = b2" + using assms + by (metis (hide_lams, no_types) det2_def add_divide_distrib eq_divide_imp fst_eqD snd_eqD times_divide_eq_right) + + fix x' + assume "a11 * fst x' + a12 * snd x' = b1 \ a21 * fst x' + a22 * snd x' = b2" + with \a11 * fst ?x + a12 * snd ?x = b1 \ a21 * fst ?x + a22 * snd ?x = b2\ + have "a11 * (fst x' - fst ?x) + a12 * (snd x' - snd ?x) = 0 \ a21 * (fst x' - fst ?x) + a22 * (snd x' - snd ?x) = 0" + by (auto simp add: field_simps) + thus "x' = ?x" + using regular_homogenous_system[OF assms, of "fst x' - fst ?x" "snd x' - snd ?x"] + by (cases x') auto +qed + +text \Singular system does not have a unique solution\ +lemma singular_system: + fixes a11 a12 a21 a22 ::"'a::field" + assumes "det2 a11 a12 a21 a22 = 0" and "a11 \ 0 \ a12 \ 0" + assumes x0: "a11*fst x0 + a12*snd x0 = b1" + "a21*fst x0 + a22*snd x0 = b2" + assumes x: "a11*fst x + a12*snd x = b1" + shows "a21*fst x + a22*snd x = b2" +proof (cases "a11 = 0") + case True + with assms have "a21 = 0" "a12 \ 0" + by auto + let ?k = "a22 / a12" + have "b2 = ?k * b1" + using x0 \a11 = 0\ \a21 = 0\ \a12 \ 0\ + by auto + thus ?thesis + using \a11 = 0\ \a21 = 0\ \a12 \ 0\ x + by auto +next + case False + let ?k = "a21 / a11" + from x + have "?k * a11 * fst x + ?k * a12 * snd x = ?k * b1" + using \a11 \ 0\ + by (auto simp add: field_simps) + moreover + have "a21 = ?k * a11" "a22 = ?k * a12" "b2 = ?k * b1" + using assms(1) x0 \a11 \ 0\ + by (auto simp add: field_simps) + ultimately + show ?thesis + by auto +qed + +text \All solutions of a homogenous system of 2 equations with 3 unknows are proportional\ +lemma linear_system_homogenous_3_2: + fixes a11 a12 a13 a21 a22 a23 x1 y1 z1 x2 y2 z2 :: "'a::field" + assumes "f1 = (\ x y z. a11 * x + a12 * y + a13 * z)" + assumes "f2 = (\ x y z. a21 * x + a22 * y + a23 * z)" + assumes "f1 x1 y1 z1 = 0" and "f2 x1 y1 z1 = 0" + assumes "f1 x2 y2 z2 = 0" and "f2 x2 y2 z2 = 0" + assumes "x2 \ 0 \ y2 \ 0 \ z2 \ 0" + assumes "det2 a11 a12 a21 a22 \ 0 \ det2 a11 a13 a21 a23 \ 0 \ det2 a12 a13 a22 a23 \ 0" + shows "\ k. x1 = k * x2 \ y1 = k * y2 \ z1 = k * z2" +proof- + let ?Dz = "det2 a11 a12 a21 a22" + let ?Dy = "det2 a11 a13 a21 a23" + let ?Dx = "det2 a12 a13 a22 a23" + + have "a21 * (f1 x1 y1 z1) - a11 * (f2 x1 y1 z1) = 0" + using assms + by simp + hence yz1: "?Dz*y1 + ?Dy*z1 = 0" + using assms + by (simp add: field_simps) + + have "a21 * (f1 x2 y2 z2) - a11 * (f2 x2 y2 z2) = 0" + using assms + by simp + hence yz2: "?Dz*y2 + ?Dy*z2 = 0" + using assms + by (simp add: field_simps) + + have "a22 * (f1 x1 y1 z1) - a12 * (f2 x1 y1 z1) = 0" + using assms + by simp + hence xz1: "-?Dz*x1 + ?Dx*z1 = 0" + using assms + by (simp add: field_simps) + + have "a22 * (f1 x2 y2 z2) - a12 * (f2 x2 y2 z2) = 0" + using assms + by simp + hence xz2: "-?Dz*x2 + ?Dx*z2 = 0" + using assms + by (simp add: field_simps) + + have "a23 * (f1 x1 y1 z1) - a13 * (f2 x1 y1 z1) = 0" + using assms + by simp + hence xy1: "?Dy*x1 + ?Dx*y1 = 0" + using assms + by (simp add: field_simps) + + have "a23 * (f1 x2 y2 z2) - a13 * (f2 x2 y2 z2) = 0" + using assms + by simp + hence xy2: "?Dy*x2 + ?Dx*y2 = 0" + using assms + by (simp add: field_simps) + + show ?thesis + using `?Dz \ 0 \ ?Dy \ 0 \ ?Dx \ 0` + proof safe + assume "?Dz \ 0" + + hence *: + "x2 = (?Dx / ?Dz) * z2" "y2 = - (?Dy / ?Dz) * z2" + "x1 = (?Dx / ?Dz) * z1" "y1 = - (?Dy / ?Dz) * z1" + using xy2 xz2 xy1 xz1 yz1 yz2 + by (simp_all add: field_simps) + + hence "z2 \ 0" + using `x2 \ 0 \ y2 \ 0 \ z2 \ 0` + by auto + + thus ?thesis + using * `?Dz \ 0` + by (rule_tac x="z1/z2" in exI) auto + next + assume "?Dy \ 0" + hence *: + "x2 = - (?Dx / ?Dy) * y2" "z2 = - (?Dz / ?Dy) * y2" + "x1 = - (?Dx / ?Dy) * y1" "z1 = - (?Dz / ?Dy) * y1" + using xy2 xz2 xy1 xz1 yz1 yz2 + by (simp_all add: field_simps) + + hence "y2 \ 0" + using `x2 \ 0 \ y2 \ 0 \ z2 \ 0` + by auto + + thus ?thesis + using * `?Dy \ 0` + by (rule_tac x="y1/y2" in exI) auto + next + assume "?Dx \ 0" + hence *: + "y2 = - (?Dy / ?Dx) * x2" "z2 = (?Dz / ?Dx) * x2" + "y1 = - (?Dy / ?Dx) * x1" "z1 = (?Dz / ?Dx) * x1" + using xy2 xz2 xy1 xz1 yz1 yz2 + by (simp_all add: field_simps) + + hence "x2 \ 0" + using `x2 \ 0 \ y2 \ 0 \ z2 \ 0` + by auto + + thus ?thesis + using * `?Dx \ 0` + by (rule_tac x="x1/x2" in exI) auto + qed +qed + +end diff --git a/thys/Complex_Geometry/Matrices.thy b/thys/Complex_Geometry/Matrices.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Matrices.thy @@ -0,0 +1,830 @@ +(* ---------------------------------------------------------------------------- *) +subsection \Vectors and Matrices in $\mathbb{C}^2$\ +(* ---------------------------------------------------------------------------- *) + +text \Representing vectors and matrices of arbitrary dimensions pose a challenge in formal theorem +proving \cite{harrison05}, but we only need to consider finite dimension spaces $\mathbb{C}^2$ and +$\mathbb{R}^3$.\ + +theory Matrices +imports More_Complex Linear_Systems Quadratic +begin + +(* ---------------------------------------------------------------------------- *) +subsubsection \Vectors in $\mathbb{C}^2$\ +(* ---------------------------------------------------------------------------- *) + +text \Type of complex vector\ + +type_synonym complex_vec = "complex \ complex" + +definition vec_zero :: "complex_vec" where + [simp]: "vec_zero = (0, 0)" + +text \Vector scalar multiplication\ + +fun mult_sv :: "complex \ complex_vec \ complex_vec" (infixl "*\<^sub>s\<^sub>v" 100) where + "k *\<^sub>s\<^sub>v (x, y) = (k*x, k*y)" + +lemma fst_mult_sv [simp]: + shows "fst (k *\<^sub>s\<^sub>v v) = k * fst v" + by (cases v) simp + +lemma snd_mult_sv [simp]: + shows "snd (k *\<^sub>s\<^sub>v v) = k * snd v" + by (cases v) simp + +lemma mult_sv_mult_sv [simp]: + shows "k1 *\<^sub>s\<^sub>v (k2 *\<^sub>s\<^sub>v v) = (k1*k2) *\<^sub>s\<^sub>v v" + by (cases v) simp + +lemma one_mult_sv [simp]: + shows "1 *\<^sub>s\<^sub>v v = v" + by (cases v) simp + +lemma mult_sv_ex_id1 [simp]: + shows "\ k::complex. k \ 0 \ k *\<^sub>s\<^sub>v v = v" + by (rule_tac x=1 in exI, simp) + +lemma mult_sv_ex_id2 [simp]: + shows "\ k::complex. k \ 0 \ v = k *\<^sub>s\<^sub>v v" + by (rule_tac x=1 in exI, simp) + +text \Scalar product of two vectors\ + +fun mult_vv :: "complex \ complex \ complex \ complex \ complex" (infixl "*\<^sub>v\<^sub>v" 100) where + "(x, y) *\<^sub>v\<^sub>v (a, b) = x*a + y*b" + +lemma mult_vv_commute: + shows "v1 *\<^sub>v\<^sub>v v2 = v2 *\<^sub>v\<^sub>v v1" + by (cases v1, cases v2) auto + +lemma mult_vv_scale_sv1: + shows "(k *\<^sub>s\<^sub>v v1) *\<^sub>v\<^sub>v v2 = k * (v1 *\<^sub>v\<^sub>v v2)" + by (cases v1, cases v2) (auto simp add: field_simps) + +lemma mult_vv_scale_sv2: + shows "v1 *\<^sub>v\<^sub>v (k *\<^sub>s\<^sub>v v2) = k * (v1 *\<^sub>v\<^sub>v v2)" + by (cases v1, cases v2) (auto simp add: field_simps) + +text \Conjugate vector\ + +fun vec_map where + "vec_map f (x, y) = (f x, f y)" + +definition vec_cnj where + "vec_cnj = vec_map cnj" + +lemma vec_cnj_vec_cnj [simp]: + shows "vec_cnj (vec_cnj v) = v" + by (cases v) (simp add: vec_cnj_def) + +lemma cnj_mult_vv: + shows "cnj (v1 *\<^sub>v\<^sub>v v2) = (vec_cnj v1) *\<^sub>v\<^sub>v (vec_cnj v2)" + by (cases v1, cases v2) (simp add: vec_cnj_def) + +lemma vec_cnj_sv [simp]: + shows "vec_cnj (k *\<^sub>s\<^sub>v A) = cnj k *\<^sub>s\<^sub>v vec_cnj A" + by (cases A) (auto simp add: vec_cnj_def) + +lemma scalsquare_vv_zero: + shows "(vec_cnj v) *\<^sub>v\<^sub>v v = 0 \ v = vec_zero" + apply (cases v) + apply (auto simp add: vec_cnj_def field_simps complex_mult_cnj_cmod power2_eq_square) + apply (simp only: cor_add[symmetric] cor_mult[symmetric] of_real_eq_0_iff, simp)+ + done + +(* ---------------------------------------------------------------------------- *) +subsubsection \Matrices in $\mathbb{C}^2$\ +(* ---------------------------------------------------------------------------- *) + +text \Type of complex matrices\ + +type_synonym complex_mat = "complex \ complex \ complex \ complex" + +text \Matrix scalar multiplication\ + +fun mult_sm :: "complex \ complex_mat \ complex_mat" (infixl "*\<^sub>s\<^sub>m" 100) where + "k *\<^sub>s\<^sub>m (a, b, c, d) = (k*a, k*b, k*c, k*d)" + +lemma mult_sm_distribution [simp]: + shows "k1 *\<^sub>s\<^sub>m (k2 *\<^sub>s\<^sub>m A) = (k1*k2) *\<^sub>s\<^sub>m A" + by (cases A) auto + +lemma mult_sm_neutral [simp]: + shows "1 *\<^sub>s\<^sub>m A = A" + by (cases A) auto + +lemma mult_sm_inv_l: + assumes "k \ 0" and "k *\<^sub>s\<^sub>m A = B" + shows "A = (1/k) *\<^sub>s\<^sub>m B" + using assms + by auto + +lemma mult_sm_ex_id1 [simp]: + shows "\ k::complex. k \ 0 \ k *\<^sub>s\<^sub>m M = M" + by (rule_tac x=1 in exI, simp) + +lemma mult_sm_ex_id2 [simp]: + shows "\ k::complex. k \ 0 \ M = k *\<^sub>s\<^sub>m M" + by (rule_tac x=1 in exI, simp) + +text \Matrix addition and subtraction\ + +definition mat_zero :: "complex_mat" where [simp]: "mat_zero = (0, 0, 0, 0)" + +fun mat_plus :: "complex_mat \ complex_mat \ complex_mat" (infixl "+\<^sub>m\<^sub>m" 100) where + "mat_plus (a1, b1, c1, d1) (a2, b2, c2, d2) = (a1+a2, b1+b2, c1+c2, d1+d2)" + +fun mat_minus :: "complex_mat \ complex_mat \ complex_mat" (infixl "-\<^sub>m\<^sub>m" 100) where + "mat_minus (a1, b1, c1, d1) (a2, b2, c2, d2) = (a1-a2, b1-b2, c1-c2, d1-d2)" + +fun mat_uminus :: "complex_mat \ complex_mat" where + "mat_uminus (a, b, c, d) = (-a, -b, -c, -d)" + +lemma nonzero_mult_real: + assumes "A \ mat_zero" and "k \ 0" + shows "k *\<^sub>s\<^sub>m A \ mat_zero" + using assms + by (cases A) simp + +text \Matrix multiplication.\ + +fun mult_mm :: "complex_mat \ complex_mat \ complex_mat" (infixl "*\<^sub>m\<^sub>m" 100) where + "(a1, b1, c1, d1) *\<^sub>m\<^sub>m (a2, b2, c2, d2) = + (a1*a2 + b1*c2, a1*b2 + b1*d2, c1*a2+d1*c2, c1*b2+d1*d2)" + +lemma mult_mm_assoc: + shows "A *\<^sub>m\<^sub>m (B *\<^sub>m\<^sub>m C) = (A *\<^sub>m\<^sub>m B) *\<^sub>m\<^sub>m C" + by (cases A, cases B, cases C) (auto simp add: field_simps) + +lemma mult_assoc_5: + shows "A *\<^sub>m\<^sub>m (B *\<^sub>m\<^sub>m C *\<^sub>m\<^sub>m D) *\<^sub>m\<^sub>m E = (A *\<^sub>m\<^sub>m B) *\<^sub>m\<^sub>m C *\<^sub>m\<^sub>m (D *\<^sub>m\<^sub>m E)" + by (simp only: mult_mm_assoc) + +lemma mat_zero_r [simp]: + shows "A *\<^sub>m\<^sub>m mat_zero = mat_zero" + by (cases A) simp + +lemma mat_zero_l [simp]: + shows "mat_zero *\<^sub>m\<^sub>m A = mat_zero" + by (cases A) simp + +definition eye :: "complex_mat" where + [simp]: "eye = (1, 0, 0, 1)" + +lemma mat_eye_l: + shows "eye *\<^sub>m\<^sub>m A = A" + by (cases A) auto + +lemma mat_eye_r: + shows "A *\<^sub>m\<^sub>m eye = A" + by (cases A) auto + +lemma mult_mm_sm [simp]: + shows "A *\<^sub>m\<^sub>m (k *\<^sub>s\<^sub>m B) = k *\<^sub>s\<^sub>m (A *\<^sub>m\<^sub>m B)" + by (cases A, cases B) (simp add: field_simps) + +lemma mult_sm_mm [simp]: + shows "(k *\<^sub>s\<^sub>m A) *\<^sub>m\<^sub>m B = k *\<^sub>s\<^sub>m (A *\<^sub>m\<^sub>m B)" + by (cases A, cases B) (simp add: field_simps) + +lemma mult_sm_eye_mm [simp]: + shows "k *\<^sub>s\<^sub>m eye *\<^sub>m\<^sub>m A = k *\<^sub>s\<^sub>m A" + by (cases A) simp + +text \Matrix determinant\ + +fun mat_det where "mat_det (a, b, c, d) = a*d - b*c" + +lemma mat_det_mult [simp]: + shows "mat_det (A *\<^sub>m\<^sub>m B) = mat_det A * mat_det B" + by (cases A, cases B) (auto simp add: field_simps) + +lemma mat_det_mult_sm [simp]: + shows "mat_det (k *\<^sub>s\<^sub>m A) = (k*k) * mat_det A" + by (cases A) (auto simp add: field_simps) + +text \Matrix inverse\ + +fun mat_inv :: "complex_mat \ complex_mat" where + "mat_inv (a, b, c, d) = (1/(a*d - b*c)) *\<^sub>s\<^sub>m (d, -b, -c, a)" + +lemma mat_inv_r: + assumes "mat_det A \ 0" + shows "A *\<^sub>m\<^sub>m (mat_inv A) = eye" + using assms +proof (cases A, auto simp add: field_simps) + fix a b c d :: complex + assume "a * (a * (d * d)) + b * (b * (c * c)) = a * (b * (c * (d * 2)))" + hence "(a*d - b*c)*(a*d - b*c) = 0" + by (auto simp add: field_simps) + hence *: "a*d - b*c = 0" + by auto + assume "a*d \ b*c" + with * show False + by auto +qed + +lemma mat_inv_l: + assumes "mat_det A \ 0" + shows "(mat_inv A) *\<^sub>m\<^sub>m A = eye" + using assms +proof (cases A, auto simp add: field_simps) + fix a b c d :: complex + assume "a * (a * (d * d)) + b * (b * (c * c)) = a * (b * (c * (d * 2)))" + hence "(a*d - b*c)*(a*d - b*c) = 0" + by (auto simp add: field_simps) + hence *: "a*d - b*c = 0" + by auto + assume "a*d \ b*c" + with * show False + by auto +qed + +lemma mat_det_inv: + assumes "mat_det A \ 0" + shows "mat_det (mat_inv A) = 1 / mat_det A" +proof- + have "mat_det eye = mat_det A * mat_det (mat_inv A)" + using mat_inv_l[OF assms, symmetric] + by simp + thus ?thesis + using assms + by (simp add: field_simps) +qed + +lemma mult_mm_inv_l: + assumes "mat_det A \ 0" and "A *\<^sub>m\<^sub>m B = C" + shows "B = mat_inv A *\<^sub>m\<^sub>m C" + using assms mat_eye_l[of B] + by (auto simp add: mult_mm_assoc mat_inv_l) + +lemma mult_mm_inv_r: + assumes "mat_det B \ 0" and "A *\<^sub>m\<^sub>m B = C" + shows "A = C *\<^sub>m\<^sub>m mat_inv B" + using assms mat_eye_r[of A] + by (auto simp add: mult_mm_assoc[symmetric] mat_inv_r) + +lemma mult_mm_non_zero_l: + assumes "mat_det A \ 0" and "B \ mat_zero" + shows "A *\<^sub>m\<^sub>m B \ mat_zero" + using assms mat_zero_r + using mult_mm_inv_l[OF assms(1), of B mat_zero] + by auto + +lemma mat_inv_mult_mm: + assumes "mat_det A \ 0" and "mat_det B \ 0" + shows "mat_inv (A *\<^sub>m\<^sub>m B) = mat_inv B *\<^sub>m\<^sub>m mat_inv A" + using assms +proof- + have "(A *\<^sub>m\<^sub>m B) *\<^sub>m\<^sub>m (mat_inv B *\<^sub>m\<^sub>m mat_inv A) = eye" + using assms + by (metis mat_inv_r mult_mm_assoc mult_mm_inv_r) + thus ?thesis + using mult_mm_inv_l[of "A *\<^sub>m\<^sub>m B" "mat_inv B *\<^sub>m\<^sub>m mat_inv A" eye] assms mat_eye_r + by simp +qed + +lemma mult_mm_cancel_l: + assumes "mat_det M \ 0" "M *\<^sub>m\<^sub>m A = M *\<^sub>m\<^sub>m B" + shows "A = B" + using assms + by (metis mult_mm_inv_l) + +lemma mult_mm_cancel_r: + assumes "mat_det M \ 0" "A *\<^sub>m\<^sub>m M = B *\<^sub>m\<^sub>m M" + shows "A = B" + using assms + by (metis mult_mm_inv_r) + +lemma mult_mm_non_zero_r: + assumes "A \ mat_zero" and "mat_det B \ 0" + shows "A *\<^sub>m\<^sub>m B \ mat_zero" + using assms mat_zero_l + using mult_mm_inv_r[OF assms(2), of A mat_zero] + by auto + +lemma mat_inv_mult_sm: + assumes "k \ 0" + shows "mat_inv (k *\<^sub>s\<^sub>m A) = (1 / k) *\<^sub>s\<^sub>m mat_inv A" +proof- + obtain a b c d where "A = (a, b, c, d)" + by (cases A) auto + thus ?thesis + using assms + by auto (subst mult.assoc[of k a "k*d"], subst mult.assoc[of k b "k*c"], subst right_diff_distrib[of k "a*(k*d)" "b*(k*c)", symmetric], simp, simp add: field_simps)+ +qed + +lemma mat_inv_inv [simp]: + assumes "mat_det M \ 0" + shows "mat_inv (mat_inv M) = M" +proof- + have "mat_inv M *\<^sub>m\<^sub>m M = eye" + using mat_inv_l[OF assms] + by simp + thus ?thesis + using assms mat_det_inv[of M] + using mult_mm_inv_l[of "mat_inv M" M eye] mat_eye_r + by (auto simp del: eye_def) +qed + +text \Matrix transpose\ + +fun mat_transpose where + "mat_transpose (a, b, c, d) = (a, c, b, d)" + +lemma mat_t_mat_t [simp]: + shows "mat_transpose (mat_transpose A) = A" + by (cases A) auto + +lemma mat_t_mult_sm [simp]: + shows "mat_transpose (k *\<^sub>s\<^sub>m A) = k *\<^sub>s\<^sub>m (mat_transpose A)" + by (cases A) simp + +lemma mat_t_mult_mm [simp]: + shows "mat_transpose (A *\<^sub>m\<^sub>m B) = mat_transpose B *\<^sub>m\<^sub>m mat_transpose A" + by (cases A, cases B) auto + +lemma mat_inv_transpose: + shows "mat_transpose (mat_inv M) = mat_inv (mat_transpose M)" + by (cases M) auto + +lemma mat_det_transpose [simp]: + fixes M :: "complex_mat" + shows "mat_det (mat_transpose M) = mat_det M" + by (cases M) auto + +text \Diagonal matrices definition\ + +fun mat_diagonal where + "mat_diagonal (A, B, C, D) = (B = 0 \ C = 0)" + +text \Matrix conjugate\ + +fun mat_map where + "mat_map f (a, b, c, d) = (f a, f b, f c, f d)" + +definition mat_cnj where + "mat_cnj = mat_map cnj" + +lemma mat_cnj_cnj [simp]: + shows "mat_cnj (mat_cnj A) = A" + unfolding mat_cnj_def + by (cases A) auto + +lemma mat_cnj_sm [simp]: + shows "mat_cnj (k *\<^sub>s\<^sub>m A) = cnj k *\<^sub>s\<^sub>m (mat_cnj A)" + by (cases A) (simp add: mat_cnj_def) + +lemma mat_det_cnj [simp]: + shows "mat_det (mat_cnj A) = cnj (mat_det A)" + by (cases A) (simp add: mat_cnj_def) + +lemma nonzero_mat_cnj: + shows "mat_cnj A = mat_zero \ A = mat_zero" + by (cases A) (auto simp add: mat_cnj_def) + +lemma mat_inv_cnj: + shows "mat_cnj (mat_inv M) = mat_inv (mat_cnj M)" + unfolding mat_cnj_def + by (cases M) auto + +text \Matrix adjoint - the conjugate traspose matrix ($A^* = \overline{A^t}$)\ + +definition mat_adj where + "mat_adj A = mat_cnj (mat_transpose A)" + +lemma mat_adj_mult_mm [simp]: + shows "mat_adj (A *\<^sub>m\<^sub>m B) = mat_adj B *\<^sub>m\<^sub>m mat_adj A" + by (cases A, cases B) (auto simp add: mat_adj_def mat_cnj_def) + +lemma mat_adj_mult_sm [simp]: + shows "mat_adj (k *\<^sub>s\<^sub>m A) = cnj k *\<^sub>s\<^sub>m mat_adj A" + by (cases A) (auto simp add: mat_adj_def mat_cnj_def) + +lemma mat_det_adj: + shows "mat_det (mat_adj A) = cnj (mat_det A)" + by (cases A) (auto simp add: mat_adj_def mat_cnj_def) + +lemma mat_adj_inv: + assumes "mat_det M \ 0" + shows "mat_adj (mat_inv M) = mat_inv (mat_adj M)" + by (cases M) (auto simp add: mat_adj_def mat_cnj_def) + +lemma mat_transpose_mat_cnj: + shows "mat_transpose (mat_cnj A) = mat_adj A" + by (cases A) (auto simp add: mat_adj_def mat_cnj_def) + +lemma mat_adj_adj [simp]: + shows "mat_adj (mat_adj A) = A" + unfolding mat_adj_def + by (subst mat_transpose_mat_cnj) (simp add: mat_adj_def) + +lemma mat_adj_eye [simp]: + shows "mat_adj eye = eye" + by (auto simp add: mat_adj_def mat_cnj_def) + +text \Matrix trace\ + +fun mat_trace where + "mat_trace (a, b, c, d) = a + d" + +text \Multiplication of matrix and a vector\ + +fun mult_mv :: "complex_mat \ complex_vec \ complex_vec" (infixl "*\<^sub>m\<^sub>v" 100) where + "(a, b, c, d) *\<^sub>m\<^sub>v (x, y) = (x*a + y*b, x*c + y*d)" + +fun mult_vm :: "complex_vec \ complex_mat \ complex_vec" (infixl "*\<^sub>v\<^sub>m" 100) where + "(x, y) *\<^sub>v\<^sub>m (a, b, c, d) = (x*a + y*c, x*b + y*d)" + +lemma eye_mv_l [simp]: + shows "eye *\<^sub>m\<^sub>v v = v" + by (cases v) simp + +lemma mult_mv_mv [simp]: + shows "B *\<^sub>m\<^sub>v (A *\<^sub>m\<^sub>v v) = (B *\<^sub>m\<^sub>m A) *\<^sub>m\<^sub>v v" + by (cases v, cases A, cases B) (auto simp add: field_simps) + +lemma mult_vm_vm [simp]: + shows "(v *\<^sub>v\<^sub>m A) *\<^sub>v\<^sub>m B = v *\<^sub>v\<^sub>m (A *\<^sub>m\<^sub>m B)" + by (cases v, cases A, cases B) (auto simp add: field_simps) + +lemma mult_mv_inv: + assumes "x = A *\<^sub>m\<^sub>v y" and "mat_det A \ 0" + shows "y = (mat_inv A) *\<^sub>m\<^sub>v x" + using assms + by (cases y) (simp add: mat_inv_l) + +lemma mult_vm_inv: + assumes "x = y *\<^sub>v\<^sub>m A" and "mat_det A \ 0" + shows "y = x *\<^sub>v\<^sub>m (mat_inv A) " + using assms + by (cases y) (simp add: mat_inv_r) + +lemma mult_mv_cancel_l: + assumes "mat_det A \ 0" and "A *\<^sub>m\<^sub>v v = A *\<^sub>m\<^sub>v v'" + shows "v = v'" + using assms + using mult_mv_inv + by blast + +lemma mult_vm_cancel_r: + assumes "mat_det A \ 0" and "v *\<^sub>v\<^sub>m A = v' *\<^sub>v\<^sub>m A" + shows "v = v'" + using assms + using mult_vm_inv + by blast + +lemma vec_zero_l [simp]: + shows "A *\<^sub>m\<^sub>v vec_zero = vec_zero" + by (cases A) simp + +lemma vec_zero_r [simp]: + shows "vec_zero *\<^sub>v\<^sub>m A = vec_zero" + by (cases A) simp + +lemma mult_mv_nonzero: + assumes "v \ vec_zero" and "mat_det A \ 0" + shows "A *\<^sub>m\<^sub>v v \ vec_zero" + apply (rule ccontr) + using assms mult_mv_inv[of vec_zero A v] mat_inv_l vec_zero_l + by auto + +lemma mult_vm_nonzero: + assumes "v \ vec_zero" and "mat_det A \ 0" + shows "v *\<^sub>v\<^sub>m A \ vec_zero" + apply (rule ccontr) + using assms mult_vm_inv[of vec_zero v A] mat_inv_r vec_zero_r + by auto + +lemma mult_sv_mv: + shows "k *\<^sub>s\<^sub>v (A *\<^sub>m\<^sub>v v) = (A *\<^sub>m\<^sub>v (k *\<^sub>s\<^sub>v v))" + by (cases A, cases v) (simp add: field_simps) + +lemma mult_mv_mult_vm: + shows "A *\<^sub>m\<^sub>v x = x *\<^sub>v\<^sub>m (mat_transpose A)" + by (cases A, cases x) auto + +lemma mult_mv_vv: + shows "A *\<^sub>m\<^sub>v v1 *\<^sub>v\<^sub>v v2 = v1 *\<^sub>v\<^sub>v (mat_transpose A *\<^sub>m\<^sub>v v2)" + by (cases v1, cases v2, cases A) (auto simp add: field_simps) + +lemma mult_vv_mv: + shows "x *\<^sub>v\<^sub>v (A *\<^sub>m\<^sub>v y) = (x *\<^sub>v\<^sub>m A) *\<^sub>v\<^sub>v y" + by (cases x, cases y, cases A) (auto simp add: field_simps) + +lemma vec_cnj_mult_mv: + shows "vec_cnj (A *\<^sub>m\<^sub>v x) = (mat_cnj A) *\<^sub>m\<^sub>v (vec_cnj x)" + by (cases A, cases x) (auto simp add: vec_cnj_def mat_cnj_def) + +lemma vec_cnj_mult_vm: + shows "vec_cnj (v *\<^sub>v\<^sub>m A) = vec_cnj v *\<^sub>v\<^sub>m mat_cnj A" + unfolding vec_cnj_def mat_cnj_def + by (cases A, cases v, auto) + +(* ---------------------------------------------------------------------------- *) +subsubsection \Eigenvalues and eigenvectors\ +(* ---------------------------------------------------------------------------- *) + +definition eigenpair where + [simp]: "eigenpair k v H \ v \ vec_zero \ H *\<^sub>m\<^sub>v v = k *\<^sub>s\<^sub>v v" + +definition eigenval where + [simp]: "eigenval k H \ (\ v. v \ vec_zero \ H *\<^sub>m\<^sub>v v = k *\<^sub>s\<^sub>v v)" + +lemma eigen_equation: + shows "eigenval k H \ k\<^sup>2 - mat_trace H * k + mat_det H = 0" (is "?lhs \ ?rhs") +proof- + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases H) auto + show ?thesis + proof + assume ?lhs + then obtain v where "v \ vec_zero" "H *\<^sub>m\<^sub>v v = k *\<^sub>s\<^sub>v v" + unfolding eigenval_def + by blast + obtain v1 v2 where vv: "v = (v1, v2)" + by (cases v) auto + from \H *\<^sub>m\<^sub>v v = k *\<^sub>s\<^sub>v v\ have "(H -\<^sub>m\<^sub>m (k *\<^sub>s\<^sub>m eye)) *\<^sub>m\<^sub>v v = vec_zero" + using HH vv + by (auto simp add: field_simps) + hence "mat_det (H -\<^sub>m\<^sub>m (k *\<^sub>s\<^sub>m eye)) = 0" + using \v \ vec_zero\ vv HH + using regular_homogenous_system[of "A - k" B C "D - k" v1 v2] + unfolding det2_def + by (auto simp add: field_simps) + thus ?rhs + using HH + by (auto simp add: power2_eq_square field_simps) + next + assume ?rhs + hence *: "mat_det (H -\<^sub>m\<^sub>m (k *\<^sub>s\<^sub>m eye)) = 0" + using HH + by (auto simp add: field_simps power2_eq_square) + show ?lhs + proof (cases "H -\<^sub>m\<^sub>m (k *\<^sub>s\<^sub>m eye) = mat_zero") + case True + thus ?thesis + using HH + by (auto) (rule_tac x=1 in exI, simp) + next + case False + hence "(A - k \ 0 \ B \ 0) \ (D - k \ 0 \ C \ 0)" + using HH + by auto + thus ?thesis + proof + assume "A - k \ 0 \ B \ 0" + hence "C * B + (D - k) * (k - A) = 0" + using * singular_system[of "A-k" "D-k" B C "(0, 0)" 0 0 "(B, k-A)"] HH + by (auto simp add: field_simps) + hence "(B, k-A) \ vec_zero" "(H -\<^sub>m\<^sub>m (k *\<^sub>s\<^sub>m eye)) *\<^sub>m\<^sub>v (B, k-A) = vec_zero" + using HH \A - k \ 0 \ B \ 0\ + by (auto simp add: field_simps) + then obtain v where "v \ vec_zero \ (H -\<^sub>m\<^sub>m (k *\<^sub>s\<^sub>m eye)) *\<^sub>m\<^sub>v v = vec_zero" + by blast + thus ?thesis + using HH + unfolding eigenval_def + by (rule_tac x="v" in exI) (case_tac v, simp add: field_simps) + next + assume "D - k \ 0 \ C \ 0" + hence "C * B + (D - k) * (k - A) = 0" + using * singular_system[of "D-k" "A-k" C B "(0, 0)" 0 0 "(C, k-D)"] HH + by (auto simp add: field_simps) + hence "(k-D, C) \ vec_zero" "(H -\<^sub>m\<^sub>m (k *\<^sub>s\<^sub>m eye)) *\<^sub>m\<^sub>v (k-D, C) = vec_zero" + using HH \D - k \ 0 \ C \ 0\ + by (auto simp add: field_simps) + then obtain v where "v \ vec_zero \ (H -\<^sub>m\<^sub>m (k *\<^sub>s\<^sub>m eye)) *\<^sub>m\<^sub>v v = vec_zero" + by blast + thus ?thesis + using HH + unfolding eigenval_def + by (rule_tac x="v" in exI) (case_tac v, simp add: field_simps) + qed + qed + qed +qed + +(* ---------------------------------------------------------------------------- *) +subsubsection \Bilinear and Quadratic forms, Congruence, and Similarity\ +(* ---------------------------------------------------------------------------- *) + +text \Bilinear forms\ + +definition bilinear_form where + [simp]: "bilinear_form v1 v2 H = (vec_cnj v1) *\<^sub>v\<^sub>m H *\<^sub>v\<^sub>v v2" + +lemma bilinear_form_scale_m: + shows "bilinear_form v1 v2 (k *\<^sub>s\<^sub>m H) = k * bilinear_form v1 v2 H" + by (cases v1, cases v2, cases H) (simp add: vec_cnj_def field_simps) + +lemma bilinear_form_scale_v1: + shows "bilinear_form (k *\<^sub>s\<^sub>v v1) v2 H = cnj k * bilinear_form v1 v2 H" + by (cases v1, cases v2, cases H) (simp add: vec_cnj_def field_simps) + +lemma bilinear_form_scale_v2: + shows "bilinear_form v1 (k *\<^sub>s\<^sub>v v2) H = k * bilinear_form v1 v2 H" + by (cases v1, cases v2, cases H) (simp add: vec_cnj_def field_simps) + +text \Quadratic forms\ + +definition quad_form where + [simp]: "quad_form v H = (vec_cnj v) *\<^sub>v\<^sub>m H *\<^sub>v\<^sub>v v" + +lemma quad_form_bilinear_form: + shows "quad_form v H = bilinear_form v v H" + by simp + +lemma quad_form_scale_v: + shows "quad_form (k *\<^sub>s\<^sub>v v) H = cor ((cmod k)\<^sup>2) * quad_form v H" + using bilinear_form_scale_v1 bilinear_form_scale_v2 + by (simp add: complex_mult_cnj_cmod field_simps) + +lemma quad_form_scale_m: + shows "quad_form v (k *\<^sub>s\<^sub>m H) = k * quad_form v H" + using bilinear_form_scale_m + by simp + +lemma cnj_quad_form [simp]: + shows "cnj (quad_form z H) = quad_form z (mat_adj H)" + by (cases H, cases z) (auto simp add: mat_adj_def mat_cnj_def vec_cnj_def field_simps) + +text \Matrix congruence\ + +text \Two matrices are congruent iff they represent the same quadratic form with respect to different +bases (for example if one circline can be transformed to another by a Möbius trasformation).\ + +definition congruence where + [simp]: "congruence M H \ mat_adj M *\<^sub>m\<^sub>m H *\<^sub>m\<^sub>m M" + +lemma congruence_nonzero: + assumes "H \ mat_zero" and "mat_det M \ 0" + shows "congruence M H \ mat_zero" + using assms + unfolding congruence_def + by (subst mult_mm_non_zero_r, subst mult_mm_non_zero_l) (auto simp add: mat_det_adj) + +lemma congruence_congruence: + shows "congruence M1 (congruence M2 H) = congruence (M2 *\<^sub>m\<^sub>m M1) H" + unfolding congruence_def + apply (subst mult_mm_assoc) + apply (subst mult_mm_assoc) + apply (subst mat_adj_mult_mm) + apply (subst mult_mm_assoc) + by simp + +lemma congruence_eye [simp]: + shows "congruence eye H = H" + by (cases H) (simp add: mat_adj_def mat_cnj_def) + +lemma congruence_congruence_inv [simp]: + assumes "mat_det M \ 0" + shows "congruence M (congruence (mat_inv M) H) = H" + using assms congruence_congruence[of M "mat_inv M" H] + using mat_inv_l[of M] mat_eye_l mat_eye_r + unfolding congruence_def + by (simp del: eye_def) + +lemma congruence_inv: + assumes "mat_det M \ 0" and "congruence M H = H'" + shows "congruence (mat_inv M) H' = H" + using assms + using \mat_det M \ 0\ mult_mm_inv_l[of "mat_adj M" "H *\<^sub>m\<^sub>m M" "H'"] + using mult_mm_inv_r[of M "H" "mat_inv (mat_adj M) *\<^sub>m\<^sub>m H'"] + by (simp add: mat_det_adj mult_mm_assoc mat_adj_inv) + +lemma congruence_scale_m [simp]: + shows "congruence M (k *\<^sub>s\<^sub>m H) = k *\<^sub>s\<^sub>m (congruence M H)" + by (cases M, cases H) (auto simp add: mat_adj_def mat_cnj_def field_simps) + +lemma inj_congruence: + assumes "mat_det M \ 0" and "congruence M H = congruence M H'" + shows "H = H'" +proof- + have "H *\<^sub>m\<^sub>m M = H' *\<^sub>m\<^sub>m M " + using assms + using mult_mm_cancel_l[of "mat_adj M" "H *\<^sub>m\<^sub>m M" "H' *\<^sub>m\<^sub>m M"] + by (simp add: mat_det_adj mult_mm_assoc) + thus ?thesis + using assms + using mult_mm_cancel_r[of "M" "H" "H'"] + by simp +qed + +lemma mat_det_congruence [simp]: + "mat_det (congruence M H) = (cor ((cmod (mat_det M))\<^sup>2)) * mat_det H" + using complex_mult_cnj_cmod[of "mat_det M"] + by (auto simp add: mat_det_adj field_simps) + +lemma det_sgn_congruence [simp]: + assumes "mat_det M \ 0" + shows "sgn (mat_det (congruence M H)) = sgn (mat_det H)" + using assms + by (subst mat_det_congruence, auto simp add: sgn_mult power2_eq_square) (simp add: sgn_of_real) + +lemma Re_det_sgn_congruence [simp]: + assumes "mat_det M \ 0" + shows "sgn (Re (mat_det (congruence M H))) = sgn (Re (mat_det H))" +proof- + have *: "Re (mat_det (congruence M H)) = (cmod (mat_det M))\<^sup>2 * Re (mat_det H)" + by (subst mat_det_congruence, subst Re_mult_real, rule Im_complex_of_real) (subst Re_complex_of_real, simp) + show ?thesis + using assms + by (subst *) (auto simp add: sgn_mult) +qed + +text \Transforming a matrix $H$ by a regular matrix $M$ preserves its bilinear and quadratic forms.\ + +lemma bilinear_form_congruence [simp]: + assumes "mat_det M \ 0" + shows "bilinear_form (M *\<^sub>m\<^sub>v v1) (M *\<^sub>m\<^sub>v v2) (congruence (mat_inv M) H) = + bilinear_form v1 v2 H" +proof- + have "mat_det (mat_adj M) \ 0" + using assms + by (simp add: mat_det_adj) + show ?thesis + unfolding bilinear_form_def congruence_def + apply (subst mult_mv_mult_vm) + apply (subst vec_cnj_mult_vm) + apply (subst mat_adj_def[symmetric]) + apply (subst mult_vm_vm) + apply (subst mult_vv_mv) + apply (subst mult_vm_vm) + apply (subst mat_adj_inv[OF \mat_det M \ 0\]) + apply (subst mult_assoc_5) + apply (subst mat_inv_r[OF \mat_det (mat_adj M) \ 0\]) + apply (subst mat_inv_l[OF \mat_det M \ 0\]) + apply (subst mat_eye_l, subst mat_eye_r) + by simp +qed + +lemma quad_form_congruence [simp]: + assumes "mat_det M \ 0" + shows "quad_form (M *\<^sub>m\<^sub>v z) (congruence (mat_inv M) H) = quad_form z H" + using bilinear_form_congruence[OF assms] + by simp + + +text \Similar matrices\ + +text \Two matrices are similar iff they represent the same linear operator with respect to (possibly) +different bases (e.g., if they represent the same Möbius transformation after changing the +coordinate system)\ + +definition similarity where + "similarity A M = mat_inv A *\<^sub>m\<^sub>m M *\<^sub>m\<^sub>m A" + +lemma mat_det_similarity [simp]: + assumes "mat_det A \ 0" + shows "mat_det (similarity A M) = mat_det M" + using assms + unfolding similarity_def + by (simp add: mat_det_inv) + +lemma mat_trace_similarity [simp]: + assumes "mat_det A \ 0" + shows "mat_trace (similarity A M) = mat_trace M" +proof- + obtain a b c d where AA: "A = (a, b, c, d)" + by (cases A) auto + obtain mA mB mC mD where MM: "M = (mA, mB, mC, mD)" + by (cases M) auto + have "mA * (a * d) / (a * d - b * c) + mD * (a * d) / (a * d - b * c) = + mA + mD + mA * (b * c) / (a * d - b * c) + mD * (b * c) / (a * d - b * c)" + using assms AA + by (simp add: field_simps) + thus ?thesis + using AA MM + by (simp add: field_simps similarity_def) +qed + +lemma similarity_eye [simp]: + shows "similarity eye M = M" + unfolding similarity_def + using mat_eye_l mat_eye_r + by auto + + +lemma similarity_eye' [simp]: + shows "similarity (1, 0, 0, 1) M = M" + unfolding eye_def[symmetric] + by (simp del: eye_def) + +lemma similarity_comp [simp]: + assumes "mat_det A1 \ 0" and "mat_det A2 \ 0" + shows "similarity A1 (similarity A2 M) = similarity (A2*\<^sub>m\<^sub>mA1) M" + using assms + unfolding similarity_def + by (simp add: mult_mm_assoc mat_inv_mult_mm) + +lemma similarity_inv: + assumes "similarity A M1 = M2" and "mat_det A \ 0" + shows "similarity (mat_inv A) M2 = M1" + using assms + unfolding similarity_def + by (metis mat_det_mult mult_mm_assoc mult_mm_inv_l mult_mm_inv_r mult_zero_left) + +end diff --git a/thys/Complex_Geometry/Moebius.thy b/thys/Complex_Geometry/Moebius.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Moebius.thy @@ -0,0 +1,1535 @@ +(* -------------------------------------------------------------------------- *) +section \Möbius transformations\ +(* -------------------------------------------------------------------------- *) + +text \Möbius transformations (also called homographic, linear fractional, or bilinear +transformations) are the fundamental transformations of the extended complex plane. Here they are +introduced algebraically. Each transformation is represented by a regular (non-singular, +non-degenerate) $2\times 2$ matrix that acts linearly on homogeneous coordinates. As proportional +homogeneous coordinates represent same points of $\mathbb{\overline{C}}$, proportional matrices will +represent the same Möbius transformation.\ + +theory Moebius +imports Homogeneous_Coordinates +begin + +(* -------------------------------------------------------------------------- *) +subsection \Definition of Möbius transformations\ +(* -------------------------------------------------------------------------- *) + +typedef moebius_mat = "{M::complex_mat. mat_det M \ 0}" + by (rule_tac x="eye" in exI, simp) + +setup_lifting type_definition_moebius_mat + +definition moebius_cmat_eq :: "complex_mat \ complex_mat \ bool" where + [simp]: "moebius_cmat_eq A B \ (\ k::complex. k \ 0 \ B = k *\<^sub>s\<^sub>m A)" + +lift_definition moebius_mat_eq :: "moebius_mat \ moebius_mat \ bool" is moebius_cmat_eq + done + +lemma moebius_mat_eq_refl [simp]: + shows "moebius_mat_eq x x" + by transfer simp + +quotient_type moebius = moebius_mat / moebius_mat_eq +proof (rule equivpI) + show "reflp moebius_mat_eq" + unfolding reflp_def + by transfer auto +next + show "symp moebius_mat_eq" + unfolding symp_def + by transfer (auto simp add: symp_def, rule_tac x="1/k" in exI, simp) +next + show "transp moebius_mat_eq" + unfolding transp_def + by transfer (auto simp add: transp_def, rule_tac x="ka*k" in exI, simp) +qed + +definition mk_moebius_cmat :: "complex \ complex \ complex \ complex \ complex_mat" where + [simp]: "mk_moebius_cmat a b c d = + (let M = (a, b, c, d) + in if mat_det M \ 0 then + M + else + eye)" + +lift_definition mk_moebius_mat :: "complex \ complex \ complex \ complex \ moebius_mat" is mk_moebius_cmat + by simp + +lift_definition mk_moebius :: "complex \ complex \ complex \ complex \ moebius" is mk_moebius_mat + done + +lemma ex_mk_moebius: + shows "\ a b c d. M = mk_moebius a b c d \ mat_det (a, b, c, d) \ 0" +proof (transfer, transfer) + fix M :: complex_mat + assume "mat_det M \ 0" + obtain a b c d where "M = (a, b, c, d)" + by (cases M, auto) + hence "moebius_cmat_eq M (mk_moebius_cmat a b c d) \ mat_det (a, b, c, d) \ 0" + using \mat_det M \ 0\ + by auto (rule_tac x=1 in exI, simp) + thus "\a b c d. moebius_cmat_eq M (mk_moebius_cmat a b c d) \ mat_det (a, b, c, d) \ 0" + by blast +qed + +(* -------------------------------------------------------------------------- *) +subsection \Action on points\ +(* -------------------------------------------------------------------------- *) + +text \Möbius transformations are given as the action of Möbius group on the points of the +extended complex plane (in homogeneous coordinates).\ + +definition moebius_pt_cmat_cvec :: "complex_mat \ complex_vec \ complex_vec" where + [simp]: "moebius_pt_cmat_cvec M z = M *\<^sub>m\<^sub>v z" + +lift_definition moebius_pt_mmat_hcoords :: "moebius_mat \ complex_homo_coords \ complex_homo_coords" is moebius_pt_cmat_cvec + by auto algebra+ + +lift_definition moebius_pt :: "moebius \ complex_homo \ complex_homo" is moebius_pt_mmat_hcoords +proof transfer + fix M M' x x' + assume "moebius_cmat_eq M M'" "x \\<^sub>v x'" + thus "moebius_pt_cmat_cvec M x \\<^sub>v moebius_pt_cmat_cvec M' x'" + by (cases "M", cases "x", auto simp add: field_simps) (rule_tac x="k*ka" in exI, simp) +qed + +lemma bij_moebius_pt [simp]: + shows "bij (moebius_pt M)" + unfolding bij_def inj_on_def surj_def +proof safe + fix x y + assume "moebius_pt M x = moebius_pt M y" + thus "x = y" + proof (transfer, transfer) + fix M x y + assume "mat_det M \ 0" "moebius_pt_cmat_cvec M x \\<^sub>v moebius_pt_cmat_cvec M y" + thus "x \\<^sub>v y" + using mult_sv_mv[of _ M x] mult_mv_inv[of _ M] + unfolding moebius_pt_cmat_cvec_def + by (metis complex_cvec_eq_def) + qed +next + fix y + show "\x. y = moebius_pt M x" + proof (transfer, transfer) + fix y :: complex_vec and M :: complex_mat + assume *: "y \ vec_zero" "mat_det M \ 0" + let ?iM = "mat_inv M" + let ?x = "?iM *\<^sub>m\<^sub>v y" + have "?x \ vec_zero" + using * + by (metis mat_det_mult mat_eye_r mat_inv_r mult_cancel_right1 mult_mv_nonzero) + moreover + have "y \\<^sub>v moebius_pt_cmat_cvec M ?x" + by (simp del: eye_def add: mat_inv_r[OF \mat_det M \ 0\]) + ultimately + show "\x\{v. v \ vec_zero}. y \\<^sub>v moebius_pt_cmat_cvec M x" + by (rule_tac x="?x" in bexI, simp_all) + qed +qed + +lemma moebius_pt_eq_I: + assumes "moebius_pt M z1 = moebius_pt M z2" + shows "z1 = z2" + using assms + using bij_moebius_pt[of M] + unfolding bij_def inj_on_def + by blast + +lemma moebius_pt_neq_I [simp]: + assumes "z1 \ z2" + shows "moebius_pt M z1 \ moebius_pt M z2" + using assms + by (auto simp add: moebius_pt_eq_I) + +definition is_moebius :: "(complex_homo \ complex_homo) \ bool" where + "is_moebius f \ (\ M. f = moebius_pt M)" + +text \In the classic literature Möbius transformations are often expressed in the form +$\frac{az+b}{cz+d}$. The following lemma shows that when restricted to finite points, the action +of Möbius transformations is bilinear.\ + +lemma moebius_pt_bilinear: + assumes "mat_det (a, b, c, d) \ 0" + shows "moebius_pt (mk_moebius a b c d) z = + (if z \ \\<^sub>h then + ((of_complex a) *\<^sub>h z +\<^sub>h (of_complex b)) :\<^sub>h + ((of_complex c) *\<^sub>h z +\<^sub>h (of_complex d)) + else + (of_complex a) :\<^sub>h + (of_complex c))" + unfolding divide_def + using assms +proof (transfer, transfer) + fix a b c d :: complex and z :: complex_vec + obtain z1 z2 where zz: "z = (z1, z2)" + by (cases z, auto) + assume *: "mat_det (a, b, c, d) \ 0" "z \ vec_zero" + let ?oc = "of_complex_cvec" + show "moebius_pt_cmat_cvec (mk_moebius_cmat a b c d) z \\<^sub>v + (if \ z \\<^sub>v \\<^sub>v + then (?oc a *\<^sub>v z +\<^sub>v ?oc b) *\<^sub>v + reciprocal_cvec (?oc c *\<^sub>v z +\<^sub>v ?oc d) + else ?oc a *\<^sub>v + reciprocal_cvec (?oc c))" + proof (cases "z \\<^sub>v \\<^sub>v") + case True + thus ?thesis + using zz * + by auto + next + case False + hence "z2 \ 0" + using zz inf_cvec_z2_zero_iff \z \ vec_zero\ + by auto + thus ?thesis + using zz * False + using regular_homogenous_system[of a b c d z1 z2] + by auto + qed +qed + +(* -------------------------------------------------------------------------- *) +subsection \Möbius group\ +(* -------------------------------------------------------------------------- *) + +text \Möbius elements form a group under composition. This group is called the \emph{projective +general linear group} and denoted by $PGL(2, \mathbb{C})$ (the group $SGL(2, \mathbb{C})$ containing elements +with the determinant $1$ can also be considered).\ + +text \Identity Möbius transformation is represented by the identity matrix.\ + +definition id_moebius_cmat :: "complex_mat" where + [simp]: "id_moebius_cmat = eye" + +lift_definition id_moebius_mmat :: "moebius_mat" is id_moebius_cmat + by simp + +lift_definition id_moebius :: "moebius" is id_moebius_mmat + done + +lemma moebius_pt_moebius_id [simp]: + shows "moebius_pt id_moebius = id" + unfolding id_def + apply (rule ext, transfer, transfer) + using eye_mv_l + by simp + +lemma mk_moeibus_id [simp]: + shows "mk_moebius a 0 0 a = id_moebius" + by (transfer, transfer, simp) + +text \The inverse Möbius transformation is obtained by taking the inverse representative matrix.\ + +definition moebius_inv_cmat :: "complex_mat \ complex_mat" where + [simp]: "moebius_inv_cmat M = mat_inv M" + +lift_definition moebius_inv_mmat :: "moebius_mat \ moebius_mat" is moebius_inv_cmat + by (simp add: mat_det_inv) + +lift_definition moebius_inv :: "moebius \ moebius" is "moebius_inv_mmat" +proof (transfer) + fix x y + assume "moebius_cmat_eq x y" + thus "moebius_cmat_eq (moebius_inv_cmat x) (moebius_inv_cmat y)" + by (auto simp add: mat_inv_mult_sm) (rule_tac x="1/k" in exI, simp) +qed + +lemma moebius_inv: + shows "moebius_pt (moebius_inv M) = inv (moebius_pt M)" +proof (rule inv_equality[symmetric]) + fix x + show "moebius_pt (moebius_inv M) (moebius_pt M x) = x" + proof (transfer, transfer) + fix M::complex_mat and x::complex_vec + assume "mat_det M \ 0" "x \ vec_zero" + show "moebius_pt_cmat_cvec (moebius_inv_cmat M) (moebius_pt_cmat_cvec M x) \\<^sub>v x" + using eye_mv_l + by (simp add: mat_inv_l[OF \mat_det M \ 0\]) + qed +next + fix y + show "moebius_pt M (moebius_pt (moebius_inv M) y) = y" + proof (transfer, transfer) + fix M::complex_mat and y::complex_vec + assume "mat_det M \ 0" "y \ vec_zero" + show "moebius_pt_cmat_cvec M (moebius_pt_cmat_cvec (moebius_inv_cmat M) y) \\<^sub>v y" + using eye_mv_l + by (simp add: mat_inv_r[OF \mat_det M \ 0\]) + qed +qed + +lemma is_moebius_inv [simp]: + assumes "is_moebius m" + shows "is_moebius (inv m)" + using assms + using moebius_inv + unfolding is_moebius_def + by metis + +lemma moebius_inv_mk_moebus [simp]: + assumes "mat_det (a, b, c, d) \ 0" + shows "moebius_inv (mk_moebius a b c d) = + mk_moebius (d/(a*d-b*c)) (-b/(a*d-b*c)) (-c/(a*d-b*c)) (a/(a*d-b*c))" + using assms + by (transfer, transfer) (auto, rule_tac x=1 in exI, simp_all add: field_simps) + +text \Composition of Möbius elements is obtained by multiplying their representing matrices.\ + +definition moebius_comp_cmat :: "complex_mat \ complex_mat \ complex_mat" where + [simp]: "moebius_comp_cmat M1 M2 = M1 *\<^sub>m\<^sub>m M2" + +lift_definition moebius_comp_mmat :: "moebius_mat \ moebius_mat \ moebius_mat" is moebius_comp_cmat + by simp + +lift_definition moebius_comp :: "moebius \ moebius \ moebius" is moebius_comp_mmat + by transfer (simp, (erule exE)+, rule_tac x="k*ka" in exI, simp add: field_simps) + +lemma moebius_comp: + shows "moebius_pt (moebius_comp M1 M2) = moebius_pt M1 \ moebius_pt M2" + unfolding comp_def + by (rule ext, transfer, transfer, simp) + +lemma moebius_pt_comp [simp]: + shows "moebius_pt (moebius_comp M1 M2) z = moebius_pt M1 (moebius_pt M2 z)" + by (auto simp add: moebius_comp) + +lemma is_moebius_comp [simp]: + assumes "is_moebius m1" and "is_moebius m2" + shows "is_moebius (m1 \ m2)" + using assms + unfolding is_moebius_def + using moebius_comp + by metis + +lemma moebius_comp_mk_moebius [simp]: + assumes "mat_det (a, b, c, d) \ 0" and "mat_det (a', b', c', d') \ 0" + shows "moebius_comp (mk_moebius a b c d) (mk_moebius a' b' c' d') = + mk_moebius (a * a' + b * c') (a * b' + b * d') (c * a' + d * c') (c * b' + d * d')" + using mat_det_mult[of "(a, b, c, d)" "(a', b', c', d')"] + using assms + by (transfer, transfer) (auto, rule_tac x=1 in exI, simp) + +instantiation moebius :: group_add +begin +definition plus_moebius :: "moebius \ moebius \ moebius" where + [simp]: "plus_moebius = moebius_comp" + +definition uminus_moebius :: "moebius \ moebius" where + [simp]: "uminus_moebius = moebius_inv" + +definition zero_moebius :: "moebius" where + [simp]: "zero_moebius = id_moebius" + +definition minus_moebius :: "moebius \ moebius \ moebius" where + [simp]: "minus_moebius A B = A + (-B)" + +instance proof + fix a b c :: moebius + show "a + b + c = a + (b + c)" + unfolding plus_moebius_def + proof (transfer, transfer) + fix a b c :: complex_mat + assume "mat_det a \ 0" "mat_det b \ 0" "mat_det c \ 0" + show "moebius_cmat_eq (moebius_comp_cmat (moebius_comp_cmat a b) c) (moebius_comp_cmat a (moebius_comp_cmat b c))" + by simp (rule_tac x="1" in exI, simp add: mult_mm_assoc) + qed +next + fix a :: moebius + show "a + 0 = a" + unfolding plus_moebius_def zero_moebius_def + proof (transfer, transfer) + fix A :: complex_mat + assume "mat_det A \ 0" + thus "moebius_cmat_eq (moebius_comp_cmat A id_moebius_cmat) A" + using mat_eye_r + by simp + qed +next + fix a :: moebius + show "0 + a = a" + unfolding plus_moebius_def zero_moebius_def + proof (transfer, transfer) + fix A :: complex_mat + assume "mat_det A \ 0" + thus "moebius_cmat_eq (moebius_comp_cmat id_moebius_cmat A) A" + using mat_eye_l + by simp + qed +next + fix a :: moebius + show "- a + a = 0" + unfolding plus_moebius_def uminus_moebius_def zero_moebius_def + proof (transfer, transfer) + fix a :: complex_mat + assume "mat_det a \ 0" + thus "moebius_cmat_eq (moebius_comp_cmat (moebius_inv_cmat a) a) id_moebius_cmat" + by (simp add: mat_inv_l) + qed +next + fix a b :: moebius + show "a + - b = a - b" + unfolding minus_moebius_def + by simp +qed +end + +text \Composition with inverse\ + +lemma moebius_comp_inv_left [simp]: + shows "moebius_comp (moebius_inv M) M = id_moebius" + by (metis left_minus plus_moebius_def uminus_moebius_def zero_moebius_def) + +lemma moebius_comp_inv_right [simp]: + shows "moebius_comp M (moebius_inv M) = id_moebius" + by (metis right_minus plus_moebius_def uminus_moebius_def zero_moebius_def) + +lemma moebius_pt_comp_inv_left [simp]: + shows "moebius_pt (moebius_inv M) (moebius_pt M z) = z" + by (subst moebius_pt_comp[symmetric], simp) + +lemma moebius_pt_comp_inv_right [simp]: + shows "moebius_pt M (moebius_pt (moebius_inv M) z) = z" + by (subst moebius_pt_comp[symmetric], simp) + +lemma moebius_pt_comp_inv_image_left [simp]: + shows "moebius_pt (moebius_inv M) ` moebius_pt M ` A = A" + by force + +lemma moebius_pt_comp_inv_image_right [simp]: + shows "moebius_pt M ` moebius_pt (moebius_inv M) ` A = A" + by force + +lemma moebius_pt_invert: + assumes "moebius_pt M z1 = z2" + shows "moebius_pt (moebius_inv M) z2 = z1" + using assms[symmetric] + by simp + +lemma moebius_pt_moebius_inv_in_set [simp]: + assumes "moebius_pt M z \ A" + shows "z \ moebius_pt (moebius_inv M) ` A" + using assms + using image_iff + by fastforce + +(* -------------------------------------------------------------------------- *) +subsection \Special kinds of Möbius transformations\ +(* -------------------------------------------------------------------------- *) + +(* -------------------------------------------------------------------------- *) +subsubsection \Reciprocal (1/z) as a Möbius transformation\ +(* -------------------------------------------------------------------------- *) + +definition moebius_reciprocal :: "moebius" where + "moebius_reciprocal = mk_moebius 0 1 1 0" + +lemma moebius_reciprocal [simp]: + shows "moebius_pt moebius_reciprocal = reciprocal" + unfolding moebius_reciprocal_def + by (rule ext, transfer, transfer) (force simp add: split_def) + +lemma moebius_reciprocal_inv [simp]: + shows "moebius_inv moebius_reciprocal = moebius_reciprocal" + unfolding moebius_reciprocal_def + by (transfer, transfer) simp + +(* -------------------------------------------------------------------------- *) +subsubsection \Euclidean similarities as a Möbius transform\ +(* -------------------------------------------------------------------------- *) + +text\Euclidean similarities include Euclidean isometries (translations and rotations) and +dilatations.\ + +definition moebius_similarity :: "complex \ complex \ moebius" where + "moebius_similarity a b = mk_moebius a b 0 1" + +lemma moebius_pt_moebius_similarity [simp]: + assumes "a \ 0" + shows "moebius_pt (moebius_similarity a b) z = (of_complex a) *\<^sub>h z +\<^sub>h (of_complex b)" + unfolding moebius_similarity_def + using assms + using mult_inf_right[of "of_complex a"] + by (subst moebius_pt_bilinear, auto) + +text \Their action is a linear transformation of $\mathbb{C}.$\ +lemma moebius_pt_moebius_similarity': + assumes "a \ 0" + shows "moebius_pt (moebius_similarity a b) = (\ z. (of_complex a) *\<^sub>h z +\<^sub>h (of_complex b))" + using moebius_pt_moebius_similarity[OF assms, symmetric] + by simp + +lemma is_moebius_similarity': + assumes "a \ 0\<^sub>h" and "a \ \\<^sub>h" and "b \ \\<^sub>h" + shows "(\ z. a *\<^sub>h z +\<^sub>h b) = moebius_pt (moebius_similarity (to_complex a) (to_complex b))" +proof- + obtain ka kb where *: "a = of_complex ka" "ka \ 0" "b = of_complex kb" + using assms + using inf_or_of_complex[of a] inf_or_of_complex[of b] + by auto + thus ?thesis + unfolding is_moebius_def + using moebius_pt_moebius_similarity'[of ka kb] + by simp +qed + +lemma is_moebius_similarity: + assumes "a \ 0\<^sub>h" and "a \ \\<^sub>h" and "b \ \\<^sub>h" + shows "is_moebius (\ z. a *\<^sub>h z +\<^sub>h b)" + using is_moebius_similarity'[OF assms] + unfolding is_moebius_def + by auto + +text \Euclidean similarities form a group.\ + +lemma moebius_similarity_id [simp]: + shows "moebius_similarity 1 0 = id_moebius" + unfolding moebius_similarity_def + by simp + +lemma moebius_similarity_inv [simp]: + assumes "a \ 0" + shows "moebius_inv (moebius_similarity a b) = moebius_similarity (1/a) (-b/a)" + using assms + unfolding moebius_similarity_def + by simp + +lemma moebius_similarity_uminus [simp]: + assumes "a \ 0" + shows "- moebius_similarity a b = moebius_similarity (1/a) (-b/a)" + using assms + by simp + +lemma moebius_similarity_comp [simp]: + assumes "a \ 0" and "c \ 0" + shows "moebius_comp (moebius_similarity a b) (moebius_similarity c d) = moebius_similarity (a*c) (a*d+b)" + using assms + unfolding moebius_similarity_def + by simp + +lemma moebius_similarity_plus [simp]: + assumes "a \ 0" and "c \ 0" + shows "moebius_similarity a b + moebius_similarity c d = moebius_similarity (a*c) (a*d+b)" + using assms + by simp + +text \Euclidean similarities are the only Möbius group elements such that their action leaves the +$\infty_{h}$ fixed.\ +lemma moebius_similarity_inf [simp]: + assumes "a \ 0" + shows "moebius_pt (moebius_similarity a b) \\<^sub>h = \\<^sub>h" + using assms + unfolding moebius_similarity_def + by (transfer, transfer, simp) + +lemma moebius_similarity_only_inf_to_inf: + assumes "a \ 0" "moebius_pt (moebius_similarity a b) z = \\<^sub>h" + shows "z = \\<^sub>h" + using assms + using inf_or_of_complex[of z] + by auto + +lemma moebius_similarity_inf_iff [simp]: + assumes "a \ 0" + shows "moebius_pt (moebius_similarity a b) z = \\<^sub>h \ z = \\<^sub>h" + using assms + using moebius_similarity_only_inf_to_inf[of a b z] + by auto + +lemma inf_fixed_only_moebius_similarity: + assumes "moebius_pt M \\<^sub>h = \\<^sub>h" + shows "\ a b. a \ 0 \ M = moebius_similarity a b" + using assms + unfolding moebius_similarity_def +proof (transfer, transfer) + fix M :: complex_mat + obtain a b c d where MM: "M = (a, b, c, d)" + by (cases M, auto) + assume "mat_det M \ 0" "moebius_pt_cmat_cvec M \\<^sub>v \\<^sub>v \\<^sub>v" + hence *: "c = 0" "a \ 0 \ d \ 0" + using MM + by auto + show "\a b. a \ 0 \ moebius_cmat_eq M (mk_moebius_cmat a b 0 1)" + proof (rule_tac x="a/d" in exI, rule_tac x="b/d" in exI) + show "a/d \ 0 \ moebius_cmat_eq M (mk_moebius_cmat (a / d) (b / d) 0 1)" + using MM * + by simp (rule_tac x="1/d" in exI, simp) + qed +qed + +text \Euclidean similarities include translations, rotations, and dilatations.\ + +(* -------------------------------------------------------------------------- *) +subsubsection \Translation\ +(* -------------------------------------------------------------------------- *) + +definition moebius_translation where + "moebius_translation v = moebius_similarity 1 v" + +lemma moebius_translation_comp [simp]: + shows "moebius_comp (moebius_translation v1) (moebius_translation v2) = moebius_translation (v1 + v2)" + unfolding moebius_translation_def + by (simp add: field_simps) + +lemma moebius_translation_plus [simp]: + shows "(moebius_translation v1) + (moebius_translation v2) = moebius_translation (v1 + v2)" + by simp + +lemma moebius_translation_zero [simp]: + shows "moebius_translation 0 = id_moebius" + unfolding moebius_translation_def moebius_similarity_id + by simp + +lemma moebius_translation_inv [simp]: + shows "moebius_inv (moebius_translation v1) = moebius_translation (-v1)" + using moebius_translation_comp[of v1 "-v1"] moebius_translation_zero + using minus_unique[of "moebius_translation v1" "moebius_translation (-v1)"] + by simp + +lemma moebius_translation_uminus [simp]: + shows "- (moebius_translation v1) = moebius_translation (-v1)" + by simp + +lemma moebius_translation_inv_translation [simp]: + shows "moebius_pt (moebius_translation v) (moebius_pt (moebius_translation (-v)) z) = z" + using moebius_translation_inv[symmetric, of v] + by (simp del: moebius_translation_inv) + +lemma moebius_inv_translation_translation [simp]: + shows "moebius_pt (moebius_translation (-v)) (moebius_pt (moebius_translation v) z) = z" + using moebius_translation_inv[symmetric, of v] + by (simp del: moebius_translation_inv) + +lemma moebius_pt_moebius_translation [simp]: + shows "moebius_pt (moebius_translation v) (of_complex z) = of_complex (z + v)" + unfolding moebius_translation_def + by (simp add: field_simps) + +lemma moebius_pt_moebius_translation_inf [simp]: + shows "moebius_pt (moebius_translation v) \\<^sub>h = \\<^sub>h" + unfolding moebius_translation_def + by simp + +(* -------------------------------------------------------------------------- *) +subsubsection \Rotation\ +(* -------------------------------------------------------------------------- *) + +definition moebius_rotation where + "moebius_rotation \ = moebius_similarity (cis \) 0" + +lemma moebius_rotation_comp [simp]: + shows "moebius_comp (moebius_rotation \1) (moebius_rotation \2) = moebius_rotation (\1 + \2)" + unfolding moebius_rotation_def + using moebius_similarity_comp[of "cis \1" "cis \2" 0 0] + by (simp add: cis_mult) + +lemma moebius_rotation_plus [simp]: + shows "(moebius_rotation \1) + (moebius_rotation \2) = moebius_rotation (\1 + \2)" + by simp + +lemma moebius_rotation_zero [simp]: + shows "moebius_rotation 0 = id_moebius" + unfolding moebius_rotation_def + using moebius_similarity_id + by simp + +lemma moebius_rotation_inv [simp]: + shows "moebius_inv (moebius_rotation \) = moebius_rotation (- \)" + using moebius_rotation_comp[of \ "-\"] moebius_rotation_zero + using minus_unique[of "moebius_rotation \" "moebius_rotation (-\)"] + by simp + +lemma moebius_rotation_uminus [simp]: + shows "- (moebius_rotation \) = moebius_rotation (- \)" + by simp + +lemma moebius_rotation_inv_rotation [simp]: + shows "moebius_pt (moebius_rotation \) (moebius_pt (moebius_rotation (-\)) z) = z" + using moebius_rotation_inv[symmetric, of \] + by (simp del: moebius_rotation_inv) + +lemma moebius_inv_rotation_rotation [simp]: + shows "moebius_pt (moebius_rotation (-\)) (moebius_pt (moebius_rotation \) z) = z" + using moebius_rotation_inv[symmetric, of \] + by (simp del: moebius_rotation_inv) + +lemma moebius_pt_moebius_rotation [simp]: + shows "moebius_pt (moebius_rotation \) (of_complex z) = of_complex (cis \ * z)" + unfolding moebius_rotation_def + by simp + +lemma moebius_pt_moebius_rotation_inf [simp]: + shows "moebius_pt (moebius_rotation v) \\<^sub>h = \\<^sub>h" + unfolding moebius_rotation_def + by simp + +lemma moebius_pt_rotation_inf_iff [simp]: + shows "moebius_pt (moebius_rotation v) x = \\<^sub>h \ x = \\<^sub>h" + unfolding moebius_rotation_def + using cis_neq_zero moebius_similarity_only_inf_to_inf + by (simp del: moebius_pt_moebius_similarity) + +lemma moebius_pt_moebius_rotation_zero [simp]: + shows "moebius_pt (moebius_rotation \) 0\<^sub>h = 0\<^sub>h" + unfolding moebius_rotation_def + by simp + +lemma moebius_pt_moebius_rotation_zero_iff [simp]: + shows "moebius_pt (moebius_rotation \) x = 0\<^sub>h \ x = 0\<^sub>h" + using moebius_pt_invert[of "moebius_rotation \" x "0\<^sub>h"] + by auto + +lemma moebius_rotation_preserve_cmod [simp]: + assumes "u \ \\<^sub>h" + shows "cmod (to_complex (moebius_pt (moebius_rotation \) u)) = cmod (to_complex u)" + using assms + using inf_or_of_complex[of u] + by auto + +(* -------------------------------------------------------------------------- *) +subsubsection \Dilatation\ +(* -------------------------------------------------------------------------- *) + +definition moebius_dilatation where + "moebius_dilatation a = moebius_similarity (cor a) 0" + +lemma moebius_dilatation_comp [simp]: + assumes "a1 > 0" and "a2 > 0" + shows "moebius_comp (moebius_dilatation a1) (moebius_dilatation a2) = moebius_dilatation (a1 * a2)" + using assms + unfolding moebius_dilatation_def + by simp + +lemma moebius_dilatation_plus [simp]: + assumes "a1 > 0" and "a2 > 0" + shows "(moebius_dilatation a1) + (moebius_dilatation a2) = moebius_dilatation (a1 * a2)" + using assms + by simp + +lemma moebius_dilatation_zero [simp]: + shows "moebius_dilatation 1 = id_moebius" + unfolding moebius_dilatation_def + using moebius_similarity_id + by simp + +lemma moebius_dilatation_inverse [simp]: + assumes "a > 0" + shows "moebius_inv (moebius_dilatation a) = moebius_dilatation (1/a)" + using assms + unfolding moebius_dilatation_def + by simp + +lemma moebius_dilatation_uminus [simp]: + assumes "a > 0" + shows "- (moebius_dilatation a) = moebius_dilatation (1/a)" + using assms + by simp + +lemma moebius_pt_dilatation [simp]: + assumes "a \ 0" + shows "moebius_pt (moebius_dilatation a) (of_complex z) = of_complex (cor a * z)" + using assms + unfolding moebius_dilatation_def + by simp + +(* -------------------------------------------------------------------------- *) +subsubsection \Rotation-dilatation\ +(* -------------------------------------------------------------------------- *) + +definition moebius_rotation_dilatation where + "moebius_rotation_dilatation a = moebius_similarity a 0" + +lemma moebius_rotation_dilatation: + assumes "a \ 0" + shows "moebius_rotation_dilatation a = moebius_rotation (arg a) + moebius_dilatation (cmod a)" + using assms + unfolding moebius_rotation_dilatation_def moebius_rotation_def moebius_dilatation_def + by simp + +(* -------------------------------------------------------------------------- *) +subsubsection \Conjugate Möbius\ +(* -------------------------------------------------------------------------- *) + +text \Conjugation is not a Möbius transformation, and conjugate Möbius transformations (obtained +by conjugating each matrix element) do not represent conjugation function (although they are +somewhat related).\ + +lift_definition conjugate_moebius_mmat :: "moebius_mat \ moebius_mat" is mat_cnj + by auto +lift_definition conjugate_moebius :: "moebius \ moebius" is conjugate_moebius_mmat + by transfer (auto simp add: mat_cnj_def) + +lemma conjugate_moebius: + shows "conjugate \ moebius_pt M = moebius_pt (conjugate_moebius M) \ conjugate" + apply (rule ext, simp) + apply (transfer, transfer) + using vec_cnj_mult_mv by auto + + +(* -------------------------------------------------------------------------- *) +subsection \Decomposition of M\"obius transformations\ +(* -------------------------------------------------------------------------- *) + +text \Every Euclidean similarity can be decomposed using translations, rotations, and dilatations.\ +lemma similarity_decomposition: + assumes "a \ 0" + shows "moebius_similarity a b = (moebius_translation b) + (moebius_rotation (arg a)) + (moebius_dilatation (cmod a))" +proof- + have "moebius_similarity a b = (moebius_translation b) + (moebius_rotation_dilatation a)" + using assms + unfolding moebius_rotation_dilatation_def moebius_translation_def moebius_similarity_def + by auto + thus ?thesis + using moebius_rotation_dilatation [OF assms] + by (auto simp add: add.assoc simp del: plus_moebius_def) +qed + +text \A very important fact is that every Möbius transformation can be +composed of Euclidean similarities and a reciprocation.\ +lemma moebius_decomposition: + assumes "c \ 0" and "a*d - b*c \ 0" + shows "mk_moebius a b c d = + moebius_translation (a/c) + + moebius_rotation_dilatation ((b*c - a*d)/(c*c)) + + moebius_reciprocal + + moebius_translation (d/c)" + using assms + unfolding moebius_rotation_dilatation_def moebius_translation_def moebius_similarity_def plus_moebius_def moebius_reciprocal_def + by (simp add: field_simps) (transfer, transfer, auto simp add: field_simps, rule_tac x="1/c" in exI, simp) + +lemma moebius_decomposition_similarity: + assumes "a \ 0" + shows "mk_moebius a b 0 d = moebius_similarity (a/d) (b/d)" + using assms + unfolding moebius_similarity_def + by (transfer, transfer, auto, rule_tac x="1/d" in exI, simp) + +text \Decomposition is used in many proofs. Namely, to show that every Möbius transformation has +some property, it suffices to show that reciprocation and all Euclidean similarities have that +property, and that the property is preserved under compositions.\ +lemma wlog_moebius_decomposition: + assumes + trans: "\ v. P (moebius_translation v)" and + rot: "\ \. P (moebius_rotation \)" and + dil: "\ k. P (moebius_dilatation k)" and + recip: "P (moebius_reciprocal)" and + comp: "\ M1 M2. \P M1; P M2\ \ P (M1 + M2)" + shows "P M" +proof- + obtain a b c d where "M = mk_moebius a b c d" "mat_det (a, b, c, d) \ 0" + using ex_mk_moebius[of M] + by auto + show ?thesis + proof (cases "c = 0") + case False + show ?thesis + using moebius_decomposition[of c a d b] \mat_det (a, b, c, d) \ 0\ \c \ 0\ \M = mk_moebius a b c d\ + using moebius_rotation_dilatation[of "(b*c - a*d) / (c*c)"] + using trans[of "a/c"] rot[of "arg ((b*c - a*d) / (c*c))"] dil[of "cmod ((b*c - a*d) / (c*c))"] recip + using comp + by (simp add: trans) + next + case True + hence "M = moebius_similarity (a/d) (b/d)" + using \M = mk_moebius a b c d\ \mat_det (a, b, c, d) \ 0\ + using moebius_decomposition_similarity + by auto + thus ?thesis + using \c = 0\ \mat_det (a, b, c, d) \ 0\ + using similarity_decomposition[of "a/d" "b/d"] + using trans[of "b/d"] rot[of "arg (a/d)"] dil[of "cmod (a/d)"] comp + by simp + qed +qed + +(* -------------------------------------------------------------------------- *) +subsection \Cross ratio and Möbius existence\ +(* -------------------------------------------------------------------------- *) + +text \For any fixed three points $z1$, $z2$ and $z3$, @{term "cross_ratio z z1 z2 z3"} can be seen as +a function of a single variable $z$.\ + + +lemma is_moebius_cross_ratio: + assumes "z1 \ z2" and "z2 \ z3" and "z1 \ z3" + shows "is_moebius (\ z. cross_ratio z z1 z2 z3)" +proof- + have "\ M. \ z. cross_ratio z z1 z2 z3 = moebius_pt M z" + using assms + proof (transfer, transfer) + fix z1 z2 z3 + assume vz: "z1 \ vec_zero" "z2 \ vec_zero" "z3 \ vec_zero" + obtain z1' z1'' where zz1: "z1 = (z1', z1'')" + by (cases z1, auto) + obtain z2' z2'' where zz2: "z2 = (z2', z2'')" + by (cases z2, auto) + obtain z3' z3'' where zz3: "z3 = (z3', z3'')" + by (cases z3, auto) + + let ?m23 = "z2'*z3''-z3'*z2''" + let ?m21 = "z2'*z1''-z1'*z2''" + let ?m13 = "z1'*z3''-z3'*z1''" + let ?M = "(z1''*?m23, -z1'*?m23, z3''*?m21, -z3'*?m21)" + assume "\ z1 \\<^sub>v z2" "\ z2 \\<^sub>v z3" "\ z1 \\<^sub>v z3" + hence *: "?m23 \ 0" "?m21 \ 0" "?m13 \ 0" + using vz zz1 zz2 zz3 + using complex_cvec_eq_mix[of z1' z1'' z2' z2''] + using complex_cvec_eq_mix[of z1' z1'' z3' z3''] + using complex_cvec_eq_mix[of z2' z2'' z3' z3''] + by (auto simp del: complex_cvec_eq_def simp add: field_simps) + + have "mat_det ?M = ?m21*?m23*?m13" + by (simp add: field_simps) + hence "mat_det ?M \ 0" + using * + by simp + moreover + have "\z\{v. v \ vec_zero}. cross_ratio_cvec z z1 z2 z3 \\<^sub>v moebius_pt_cmat_cvec ?M z" + proof + fix z + assume "z \ {v. v \ vec_zero}" + hence "z \ vec_zero" + by simp + obtain z' z'' where zz: "z = (z', z'')" + by (cases z, auto) + + let ?m01 = "z'*z1''-z1'*z''" + let ?m03 = "z'*z3''-z3'*z''" + + have "?m01 \ 0 \ ?m03 \ 0" + proof (cases "z'' = 0 \ z1'' = 0 \ z3'' = 0") + case True + thus ?thesis + using * \z \ vec_zero\ zz + by auto + next + case False + hence 1: "z'' \ 0 \ z1'' \ 0 \ z3'' \ 0" + by simp + show ?thesis + proof (rule ccontr) + assume "\ ?thesis" + hence "z' * z1'' - z1' * z'' = 0" "z' * z3'' - z3' * z'' = 0" + by auto + hence "z1'/z1'' = z3'/z3''" + using 1 zz \z \ vec_zero\ + by (metis frac_eq_eq right_minus_eq) + thus False + using * 1 + using frac_eq_eq + by auto + qed + qed + note * = * this + show "cross_ratio_cvec z z1 z2 z3 \\<^sub>v moebius_pt_cmat_cvec ?M z" + using * zz zz1 zz2 zz3 mult_mv_nonzero[of "z" ?M] \mat_det ?M \ 0\ + by simp (rule_tac x="1" in exI, simp add: field_simps) + qed + ultimately + show "\M\{M. mat_det M \ 0}. + \z\{v. v \ vec_zero}. cross_ratio_cvec z z1 z2 z3 \\<^sub>v moebius_pt_cmat_cvec M z" + by blast + qed + thus ?thesis + by (auto simp add: is_moebius_def) +qed + +text \Using properties of the cross-ratio, it is shown that there is a Möbius transformation +mapping any three different points to $0_{hc}$, $1_{hc}$ and $\infty_{hc}$, respectively.\ +lemma ex_moebius_01inf: + assumes "z1 \ z2" and "z1 \ z3" and "z2 \ z3" + shows "\ M. ((moebius_pt M z1 = 0\<^sub>h) \ (moebius_pt M z2 = 1\<^sub>h) \ (moebius_pt M z3 = \\<^sub>h))" + using assms + using is_moebius_cross_ratio[OF \z1 \ z2\ \z2 \ z3\ \z1 \ z3\] + using cross_ratio_0[OF \z1 \ z2\ \z1 \ z3\] cross_ratio_1[OF \z1 \ z2\ \z2 \ z3\] cross_ratio_inf[OF \z1 \ z3\ \z2 \ z3\] + by (metis is_moebius_def) + +text \There is a Möbius transformation mapping any three different points to any three different +points.\ +lemma ex_moebius: + assumes "z1 \ z2" and "z1 \ z3" and "z2 \ z3" + "w1 \ w2" and "w1 \ w3" and "w2 \ w3" + shows "\ M. ((moebius_pt M z1 = w1) \ (moebius_pt M z2 = w2) \ (moebius_pt M z3 = w3))" +proof- + obtain M1 where *: "moebius_pt M1 z1 = 0\<^sub>h \ moebius_pt M1 z2 = 1\<^sub>h \ moebius_pt M1 z3 = \\<^sub>h" + using ex_moebius_01inf[OF assms(1-3)] + by auto + obtain M2 where **: "moebius_pt M2 w1 = 0\<^sub>h \ moebius_pt M2 w2 = 1\<^sub>h \ moebius_pt M2 w3 = \\<^sub>h" + using ex_moebius_01inf[OF assms(4-6)] + by auto + let ?M = "moebius_comp (moebius_inv M2) M1" + show ?thesis + using * ** + by (rule_tac x="?M" in exI, auto simp add: moebius_pt_invert) +qed + +lemma ex_moebius_1: + shows "\ M. moebius_pt M z1 = w1" +proof- + obtain z2 z3 where "z1 \ z2" "z1 \ z3" "z2 \ z3" + using ex_3_different_points[of z1] + by auto + moreover + obtain w2 w3 where "w1 \ w2" "w1 \ w3" "w2 \ w3" + using ex_3_different_points[of w1] + by auto + ultimately + show ?thesis + using ex_moebius[of z1 z2 z3 w1 w2 w3] + by auto +qed + +text \The next lemma turns out to have very important applications in further proof development, as +it enables so called ,,without-loss-of-generality (wlog)'' reasoning \cite{wlog}. Namely, if the +property is preserved under Möbius transformations, then instead of three arbitrary different +points one can consider only the case of points $0_{hc}$, $1_{hc}$, and $\infty_{hc}$.\ +lemma wlog_moebius_01inf: + fixes M::moebius + assumes "P 0\<^sub>h 1\<^sub>h \\<^sub>h" and "z1 \ z2" and "z2 \ z3" and "z1 \ z3" + "\ M a b c. P a b c \ P (moebius_pt M a) (moebius_pt M b) (moebius_pt M c)" + shows "P z1 z2 z3" +proof- + from assms obtain M where *: + "moebius_pt M z1 = 0\<^sub>h" "moebius_pt M z2 = 1\<^sub>h" "moebius_pt M z3 = \\<^sub>h" + using ex_moebius_01inf[of z1 z2 z3] + by auto + have **: "moebius_pt (moebius_inv M) 0\<^sub>h = z1" "moebius_pt (moebius_inv M) 1\<^sub>h = z2" "moebius_pt (moebius_inv M) \\<^sub>h = z3" + by (subst *[symmetric], simp)+ + thus ?thesis + using assms + by auto +qed + +(* -------------------------------------------------------------------------- *) +subsection \Fixed points and Möbius transformation uniqueness\ +(* -------------------------------------------------------------------------- *) + +lemma three_fixed_points_01inf: + assumes "moebius_pt M 0\<^sub>h = 0\<^sub>h" and "moebius_pt M 1\<^sub>h = 1\<^sub>h" and "moebius_pt M \\<^sub>h = \\<^sub>h" + shows "M = id_moebius" + using assms + by (transfer, transfer, auto) + +lemma three_fixed_points: + assumes "z1 \ z2" and "z1 \ z3" and "z2 \ z3" + assumes "moebius_pt M z1 = z1" and "moebius_pt M z2 = z2" and "moebius_pt M z3 = z3" + shows "M = id_moebius" +proof- + from assms obtain M' where *: "moebius_pt M' z1 = 0\<^sub>h" "moebius_pt M' z2 = 1\<^sub>h" "moebius_pt M' z3 = \\<^sub>h" + using ex_moebius_01inf[of z1 z2 z3] + by auto + have **: "moebius_pt (moebius_inv M') 0\<^sub>h = z1" "moebius_pt (moebius_inv M') 1\<^sub>h = z2" "moebius_pt (moebius_inv M') \\<^sub>h = z3" + by (subst *[symmetric], simp)+ + + have "M' + M + (-M') = 0" + unfolding zero_moebius_def + apply (rule three_fixed_points_01inf) + using * ** assms + by (simp add: moebius_comp[symmetric])+ + thus ?thesis + by (metis eq_neg_iff_add_eq_0 minus_add_cancel zero_moebius_def) +qed + +lemma unique_moebius_three_points: + assumes "z1 \ z2" and "z1 \ z3" and "z2 \ z3" + assumes "moebius_pt M1 z1 = w1" and "moebius_pt M1 z2 = w2" and "moebius_pt M1 z3 = w3" + "moebius_pt M2 z1 = w1" and "moebius_pt M2 z2 = w2" and "moebius_pt M2 z3 = w3" + shows "M1 = M2" +proof- + let ?M = "moebius_comp (moebius_inv M2) M1" + have "moebius_pt ?M z1 = z1" + using \moebius_pt M1 z1 = w1\ \moebius_pt M2 z1 = w1\ + by (auto simp add: moebius_pt_invert) + moreover + have "moebius_pt ?M z2 = z2" + using \moebius_pt M1 z2 = w2\ \moebius_pt M2 z2 = w2\ + by (auto simp add: moebius_pt_invert) + moreover + have "moebius_pt ?M z3 = z3" + using \moebius_pt M1 z3 = w3\ \moebius_pt M2 z3 = w3\ + by (auto simp add: moebius_pt_invert) + ultimately + have "?M = id_moebius" + using assms three_fixed_points + by auto + thus ?thesis + by (metis add_minus_cancel left_minus plus_moebius_def uminus_moebius_def zero_moebius_def) +qed + +text \There is a unique Möbius transformation mapping three different points to other three +different points.\ + +lemma ex_unique_moebius_three_points: + assumes "z1 \ z2" and "z1 \ z3" and "z2 \ z3" + "w1 \ w2" and "w1 \ w3" and "w2 \ w3" + shows "\! M. ((moebius_pt M z1 = w1) \ (moebius_pt M z2 = w2) \ (moebius_pt M z3 = w3))" +proof- + obtain M where *: "moebius_pt M z1 = w1 \ moebius_pt M z2 = w2 \ moebius_pt M z3 = w3" + using ex_moebius[OF assms] + by auto + show ?thesis + unfolding Ex1_def + proof (rule_tac x="M" in exI, rule) + show "\y. moebius_pt y z1 = w1 \ moebius_pt y z2 = w2 \ moebius_pt y z3 = w3 \ y = M" + using * + using unique_moebius_three_points[OF assms(1-3)] + by simp + qed (simp add: *) +qed + +lemma ex_unique_moebius_three_points_fun: + assumes "z1 \ z2" and "z1 \ z3" and "z2 \ z3" + "w1 \ w2" and "w1 \ w3" and "w2 \ w3" + shows "\! f. is_moebius f \ (f z1 = w1) \ (f z2 = w2) \ (f z3 = w3)" +proof- + obtain M where "moebius_pt M z1 = w1" "moebius_pt M z2 = w2" "moebius_pt M z3 = w3" + using ex_unique_moebius_three_points[OF assms] + by auto + thus ?thesis + using ex_unique_moebius_three_points[OF assms] + unfolding Ex1_def + by (rule_tac x="moebius_pt M" in exI) (auto simp add: is_moebius_def) +qed + +text \Different Möbius transformations produce different actions.\ +lemma unique_moebius_pt: + assumes "moebius_pt M1 = moebius_pt M2" + shows "M1 = M2" + using assms unique_moebius_three_points[of "0\<^sub>h" "1\<^sub>h" "\\<^sub>h"] + by auto + +lemma is_cross_ratio_01inf: + assumes "z1 \ z2" and "z1 \ z3" and "z2 \ z3" and "is_moebius f" + assumes "f z1 = 0\<^sub>h" and "f z2 = 1\<^sub>h" and "f z3 = \\<^sub>h" + shows "f = (\ z. cross_ratio z z1 z2 z3)" + using assms + using cross_ratio_0[OF \z1 \ z2\ \z1 \ z3\] cross_ratio_1[OF \z1 \ z2\ \z2 \ z3\] cross_ratio_inf[OF \z1 \ z3\ \z2 \ z3\] + using is_moebius_cross_ratio[OF \z1 \ z2\ \z2 \ z3\ \z1 \ z3\] + using ex_unique_moebius_three_points_fun[OF \z1 \ z2\ \z1 \ z3\ \z2 \ z3\, of "0\<^sub>h" "1\<^sub>h" "\\<^sub>h"] + by auto + +text \Möbius transformations preserve cross-ratio.\ +lemma moebius_preserve_cross_ratio [simp]: + assumes "z1 \ z2" and "z1 \ z3" and "z2 \ z3" + shows "cross_ratio (moebius_pt M z) (moebius_pt M z1) (moebius_pt M z2) (moebius_pt M z3) = + cross_ratio z z1 z2 z3" +proof- + let ?f = "\ z. cross_ratio z z1 z2 z3" + let ?M = "moebius_pt M" + let ?iM = "inv ?M" + have "(?f \ ?iM) (?M z1) = 0\<^sub>h" + using bij_moebius_pt[of M] cross_ratio_0[OF \z1 \ z2\ \z1 \ z3\] + by (simp add: bij_def) + moreover + have "(?f \ ?iM) (?M z2) = 1\<^sub>h" + using bij_moebius_pt[of M] cross_ratio_1[OF \z1 \ z2\ \z2 \ z3\] + by (simp add: bij_def) + moreover + have "(?f \ ?iM) (?M z3) = \\<^sub>h" + using bij_moebius_pt[of M] cross_ratio_inf[OF \z1 \ z3\ \z2 \ z3\] + by (simp add: bij_def) + moreover + have "is_moebius (?f \ ?iM)" + by (rule is_moebius_comp, rule is_moebius_cross_ratio[OF \z1 \ z2\ \z2 \ z3\ \z1 \ z3\], rule is_moebius_inv, auto simp add: is_moebius_def) + moreover + have "?M z1 \ ?M z2" "?M z1 \ ?M z3" "?M z2 \ ?M z3" + using assms + by simp_all + ultimately + have "?f \ ?iM = (\ z. cross_ratio z (?M z1) (?M z2) (?M z3))" + using assms + using is_cross_ratio_01inf[of "?M z1" "?M z2" "?M z3" "?f \ ?iM"] + by simp + moreover + have "(?f \ ?iM) (?M z) = cross_ratio z z1 z2 z3" + using bij_moebius_pt[of M] + by (simp add: bij_def) + moreover + have "(\ z. cross_ratio z (?M z1) (?M z2) (?M z3)) (?M z) = cross_ratio (?M z) (?M z1) (?M z2) (?M z3)" + by simp + ultimately + show ?thesis + by simp +qed + +lemma conjugate_cross_ratio [simp]: + assumes "z1 \ z2" and "z1 \ z3" and "z2 \ z3" + shows "cross_ratio (conjugate z) (conjugate z1) (conjugate z2) (conjugate z3) = + conjugate (cross_ratio z z1 z2 z3)" +proof- + let ?f = "\ z. cross_ratio z z1 z2 z3" + let ?M = "conjugate" + let ?iM = "conjugate" + have "(conjugate \ ?f \ ?iM) (?M z1) = 0\<^sub>h" + using cross_ratio_0[OF \z1 \ z2\ \z1 \ z3\] + by simp + moreover + have "(conjugate \ ?f \ ?iM) (?M z2) = 1\<^sub>h" + using cross_ratio_1[OF \z1 \ z2\ \z2 \ z3\] + by simp + moreover + have "(conjugate \ ?f \ ?iM) (?M z3) = \\<^sub>h" + using cross_ratio_inf[OF \z1 \ z3\ \z2 \ z3\] + by simp + moreover + have "is_moebius (conjugate \ ?f \ ?iM)" + proof- + obtain M where "?f = moebius_pt M" + using is_moebius_cross_ratio[OF \z1 \ z2\ \z2 \ z3\ \z1 \ z3\] + by (auto simp add: is_moebius_def) + thus ?thesis + using conjugate_moebius[of M] + by (auto simp add: comp_assoc is_moebius_def) + qed + moreover + have "?M z1 \ ?M z2" "?M z1 \ ?M z3" "?M z2 \ ?M z3" + using assms + by (auto simp add: conjugate_inj) + ultimately + have "conjugate \ ?f \ ?iM = (\ z. cross_ratio z (?M z1) (?M z2) (?M z3))" + using assms + using is_cross_ratio_01inf[of "?M z1" "?M z2" "?M z3" "conjugate \ ?f \ ?iM"] + by simp + moreover + have "(conjugate \ ?f \ ?iM) (?M z) = conjugate (cross_ratio z z1 z2 z3)" + by simp + moreover + have "(\ z. cross_ratio z (?M z1) (?M z2) (?M z3)) (?M z) = cross_ratio (?M z) (?M z1) (?M z2) (?M z3)" + by simp + ultimately + show ?thesis + by simp +qed + +lemma cross_ratio_reciprocal [simp]: + assumes "u \ v" and "v \ w" and "u \ w" + shows "cross_ratio (reciprocal z) (reciprocal u) (reciprocal v) (reciprocal w) = + cross_ratio z u v w" + using assms + by (subst moebius_reciprocal[symmetric])+ (simp del: moebius_reciprocal) + +lemma cross_ratio_inversion [simp]: + assumes "u \ v" and "v \ w" and "u \ w" + shows "cross_ratio (inversion z) (inversion u) (inversion v) (inversion w) = + conjugate (cross_ratio z u v w)" +proof- + have "reciprocal u \ reciprocal v" "reciprocal u \ reciprocal w" "reciprocal v \ reciprocal w" + using assms + by ((subst moebius_reciprocal[symmetric])+, simp del: moebius_reciprocal)+ + thus ?thesis + using assms + unfolding inversion_def + by simp +qed + + +lemma fixed_points_0inf': + assumes "moebius_pt M 0\<^sub>h = 0\<^sub>h" and "moebius_pt M \\<^sub>h = \\<^sub>h" + shows "\ k::complex_homo. (k \ 0\<^sub>h \ k \ \\<^sub>h) \ (\ z. moebius_pt M z = k *\<^sub>h z)" +using assms +proof (transfer, transfer) + fix M :: complex_mat + assume "mat_det M \ 0" + obtain a b c d where MM: "M = (a, b, c, d)" + by (cases M) auto + assume "moebius_pt_cmat_cvec M 0\<^sub>v \\<^sub>v 0\<^sub>v" "moebius_pt_cmat_cvec M \\<^sub>v \\<^sub>v \\<^sub>v" + hence *: "b = 0" "c = 0" "a \ 0 \ d \ 0" + using MM + by auto + let ?z = "(a, d)" + have "?z \ vec_zero" + using * + by simp + moreover + have "\ ?z \\<^sub>v 0\<^sub>v \ \ ?z \\<^sub>v \\<^sub>v" + using * + by simp + moreover + have "\z\{v. v \ vec_zero}. moebius_pt_cmat_cvec M z \\<^sub>v ?z *\<^sub>v z" + using MM \mat_det M \ 0\ * + by force + ultimately + show "\k\{v. v \ vec_zero}. + (\ k \\<^sub>v 0\<^sub>v \ \ k \\<^sub>v \\<^sub>v) \ + (\z\{v. v \ vec_zero}. moebius_pt_cmat_cvec M z \\<^sub>v k *\<^sub>v z)" + by blast +qed + +lemma fixed_points_0inf: + assumes "moebius_pt M 0\<^sub>h = 0\<^sub>h" and "moebius_pt M \\<^sub>h = \\<^sub>h" + shows "\ k::complex_homo. (k \ 0\<^sub>h \ k \ \\<^sub>h) \ moebius_pt M = (\ z. k *\<^sub>h z)" + using fixed_points_0inf'[OF assms] + by auto + +lemma ex_cross_ratio: + assumes "u \ v" and "u \ w" and "v \ w" + shows "\ z. cross_ratio z u v w = c" +proof- + obtain M where "(\ z. cross_ratio z u v w) = moebius_pt M" + using assms is_moebius_cross_ratio[of u v w] + unfolding is_moebius_def + by auto + hence *: "\ z. cross_ratio z u v w = moebius_pt M z" + by metis + let ?z = "moebius_pt (-M) c" + have "cross_ratio ?z u v w = c" + using * + by auto + thus ?thesis + by auto +qed + +lemma unique_cross_ratio: + assumes "u \ v" and "v \ w" and "u \ w" + assumes "cross_ratio z u v w = cross_ratio z' u v w" + shows "z = z'" +proof- + obtain M where "(\ z. cross_ratio z u v w) = moebius_pt M" + using is_moebius_cross_ratio[OF assms(1-3)] + unfolding is_moebius_def + by auto + hence "moebius_pt M z = moebius_pt M z'" + using assms(4) + by metis + thus ?thesis + using moebius_pt_eq_I + by metis +qed + +lemma ex1_cross_ratio: + assumes "u \ v" and "u \ w" and "v \ w" + shows "\! z. cross_ratio z u v w = c" + using assms ex_cross_ratio[OF assms, of c] unique_cross_ratio[of u v w] + by blast + +(* -------------------------------------------------------------------------- *) +subsection \Pole\ +(* -------------------------------------------------------------------------- *) + +definition is_pole :: "moebius \ complex_homo \ bool" where + "is_pole M z \ moebius_pt M z = \\<^sub>h" + +lemma ex1_pole: + shows "\! z. is_pole M z" + using bij_moebius_pt[of M] + unfolding is_pole_def bij_def inj_on_def surj_def + unfolding Ex1_def + by (metis UNIV_I) + +definition pole :: "moebius \ complex_homo" where + "pole M = (THE z. is_pole M z)" + +lemma pole_mk_moebius: + assumes "is_pole (mk_moebius a b c d) z" and "c \ 0" and "a*d - b*c \ 0" + shows "z = of_complex (-d/c)" +proof- + let ?t1 = "moebius_translation (a / c)" + let ?rd = "moebius_rotation_dilatation ((b * c - a * d) / (c * c))" + let ?r = "moebius_reciprocal" + let ?t2 = "moebius_translation (d / c)" + have "moebius_pt (?rd + ?r + ?t2) z = \\<^sub>h" + using assms + unfolding is_pole_def + apply (subst (asm) moebius_decomposition) + apply (auto simp add: moebius_comp[symmetric] moebius_translation_def) + apply (subst moebius_similarity_only_inf_to_inf[of 1 "a/c"], auto) + done + hence "moebius_pt (?r + ?t2) z = \\<^sub>h" + using \a*d - b*c \ 0\ \c \ 0\ + unfolding moebius_rotation_dilatation_def + by (simp del: moebius_pt_moebius_similarity) + hence "moebius_pt ?t2 z = 0\<^sub>h" + by simp + thus ?thesis + using moebius_pt_invert[of ?t2 z "0\<^sub>h"] + by simp ((subst (asm) of_complex_zero[symmetric])+, simp del: of_complex_zero) +qed + +lemma pole_similarity: + assumes "is_pole (moebius_similarity a b) z" and "a \ 0" + shows "z = \\<^sub>h" + using assms + unfolding is_pole_def + using moebius_similarity_only_inf_to_inf[of a b z] + by simp + +(* -------------------------------------------------------------------------- *) +subsection \Homographies and antihomographies\ +(* -------------------------------------------------------------------------- *) + +text \Inversion is not a Möbius transformation (it is a canonical example of so called +anti-Möbius transformations, or antihomographies). All antihomographies are compositions of +homographies and conjugation. The fundamental theorem of projective geometry (that we shall not +prove) states that all automorphisms (bijective functions that preserve the cross-ratio) of +$\mathbb{C}P^1$ are either homographies or antihomographies.\ + +definition is_homography :: "(complex_homo \ complex_homo) \ bool" where + "is_homography f \ is_moebius f" + +definition is_antihomography :: "(complex_homo \ complex_homo) \ bool" where + "is_antihomography f \ (\ f'. is_moebius f' \ f = f' \ conjugate)" + +text \Conjugation is not a Möbius transformation, but is antihomograhpy.\ +lemma not_moebius_conjugate: + shows "\ is_moebius conjugate" +proof + assume "is_moebius conjugate" + then obtain M where *: "moebius_pt M = conjugate" + unfolding is_moebius_def + by metis + hence "moebius_pt M 0\<^sub>h = 0\<^sub>h" "moebius_pt M 1\<^sub>h = 1\<^sub>h" "moebius_pt M \\<^sub>h = \\<^sub>h" + by auto + hence "M = id_moebius" + using three_fixed_points_01inf + by auto + hence "conjugate = id" + using * + by simp + moreover + have "conjugate ii\<^sub>h \ ii\<^sub>h" + using of_complex_inj[of "\" "-\"] + by (subst of_complex_ii[symmetric])+ (auto simp del: of_complex_ii) + ultimately + show False + by simp +qed + +lemma conjugation_is_antihomography[simp]: + shows "is_antihomography conjugate" + unfolding is_antihomography_def + by (rule_tac x="id" in exI, metis fun.map_id0 id_apply is_moebius_def moebius_pt_moebius_id) + +lemma inversion_is_antihomography [simp]: + shows "is_antihomography inversion" + using moebius_reciprocal + unfolding inversion_sym is_antihomography_def is_moebius_def + by metis + +text \Functions cannot simultaneously be homographies and antihomographies - the disjunction is exclusive.\ +lemma homography_antihomography_exclusive: + assumes "is_antihomography f" + shows "\ is_homography f" +proof + assume "is_homography f" + then obtain M where "f = moebius_pt M" + unfolding is_homography_def is_moebius_def + by auto + then obtain M' where "moebius_pt M = moebius_pt M' \ conjugate" + using assms + unfolding is_antihomography_def is_moebius_def + by auto + hence "conjugate = moebius_pt (-M') \ moebius_pt M" + by auto + hence "conjugate = moebius_pt (-M' + M)" + by (simp add: moebius_comp) + thus False + using not_moebius_conjugate + unfolding is_moebius_def + by metis +qed + + +(* -------------------------------------------------------------------------- *) +subsection \Classification of Möbius transformations\ +(* -------------------------------------------------------------------------- *) + +text \Möbius transformations can be classified to parabolic, elliptic and loxodromic. We do not +develop this part of the theory in depth.\ + +lemma similarity_scale_1: + assumes "k \ 0" + shows "similarity (k *\<^sub>s\<^sub>m I) M = similarity I M" + using assms + unfolding similarity_def + using mat_inv_mult_sm[of k I] + by simp + +lemma similarity_scale_2: + shows "similarity I (k *\<^sub>s\<^sub>m M) = k *\<^sub>s\<^sub>m (similarity I M)" + unfolding similarity_def + by auto + +lemma mat_trace_mult_sm [simp]: + shows "mat_trace (k *\<^sub>s\<^sub>m M) = k * mat_trace M" + by (cases M) (simp add: field_simps) + +definition moebius_mb_cmat :: "complex_mat \ complex_mat \ complex_mat" where + [simp]: "moebius_mb_cmat I M = similarity I M" + +lift_definition moebius_mb_mmat :: "moebius_mat \ moebius_mat \ moebius_mat" is moebius_mb_cmat + by (simp add: similarity_def mat_det_inv) + +lift_definition moebius_mb :: "moebius \ moebius \ moebius" is moebius_mb_mmat +proof transfer + fix M M' I I' + assume "moebius_cmat_eq M M'" "moebius_cmat_eq I I'" + thus "moebius_cmat_eq (moebius_mb_cmat I M) (moebius_mb_cmat I' M')" + by (auto simp add: similarity_scale_1 similarity_scale_2) +qed + +definition similarity_invar_cmat :: "complex_mat \ complex" where + [simp]: "similarity_invar_cmat M = (mat_trace M)\<^sup>2 / mat_det M - 4" + +lift_definition similarity_invar_mmat :: "moebius_mat \ complex" is similarity_invar_cmat + done + +lift_definition similarity_invar :: "moebius \ complex" is similarity_invar_mmat + by transfer (auto simp add: power2_eq_square field_simps) + +lemma similarity_invar_moeibus_mb: + shows "similarity_invar (moebius_mb I M) = similarity_invar M" + by (transfer, transfer, simp) + +definition similar :: "moebius \ moebius \ bool" where + "similar M1 M2 \ (\ I. moebius_mb I M1 = M2)" + +lemma similar_refl [simp]: + shows "similar M M" + unfolding similar_def + by (rule_tac x="id_moebius" in exI) (transfer, transfer, simp) + +lemma similar_sym: + assumes "similar M1 M2" + shows "similar M2 M1" +proof- + from assms obtain I where "M2 = moebius_mb I M1" + unfolding similar_def + by auto + hence "M1 = moebius_mb (moebius_inv I) M2" + proof (transfer, transfer) + fix M2 I M1 + assume "moebius_cmat_eq M2 (moebius_mb_cmat I M1)" "mat_det I \ 0" + then obtain k where "k \ 0" "similarity I M1 = k *\<^sub>s\<^sub>m M2" + by auto + thus "moebius_cmat_eq M1 (moebius_mb_cmat (moebius_inv_cmat I) M2)" + using similarity_inv[of I M1 "k *\<^sub>s\<^sub>m M2", OF _ \mat_det I \ 0\] + by (auto simp add: similarity_scale_2) (rule_tac x="1/k" in exI, simp) + qed + thus ?thesis + unfolding similar_def + by auto +qed + +lemma similar_trans: + assumes "similar M1 M2" and "similar M2 M3" + shows "similar M1 M3" +proof- + obtain I1 I2 where "moebius_mb I1 M1 = M2" "moebius_mb I2 M2 = M3" + using assms + by (auto simp add: similar_def) + thus ?thesis + unfolding similar_def + proof (rule_tac x="moebius_comp I1 I2" in exI, transfer, transfer) + fix I1 I2 M1 M2 M3 + assume "moebius_cmat_eq (moebius_mb_cmat I1 M1) M2" + "moebius_cmat_eq (moebius_mb_cmat I2 M2) M3" + "mat_det I1 \ 0" "mat_det I2 \ 0" + thus "moebius_cmat_eq (moebius_mb_cmat (moebius_comp_cmat I1 I2) M1) M3" + by (auto simp add: similarity_scale_2) (rule_tac x="ka*k" in exI, simp) + qed +qed + +end diff --git a/thys/Complex_Geometry/More_Complex.thy b/thys/Complex_Geometry/More_Complex.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/More_Complex.thy @@ -0,0 +1,1264 @@ +(* -------------------------------------------------------------------------- *) +subsection \Library Additions for Complex Numbers\ +(* -------------------------------------------------------------------------- *) + +text \Some additional lemmas about complex numbers.\ + +theory More_Complex + imports Complex_Main More_Transcendental Canonical_Angle +begin + +text \Conjugation and @{term cis}\ + +declare cis_cnj[simp] + +lemma rcis_cnj: + shows "cnj a = rcis (cmod a) (- arg a)" + by (subst rcis_cmod_arg[of a, symmetric]) (simp add: rcis_def) + +lemmas complex_cnj = complex_cnj_diff complex_cnj_mult complex_cnj_add complex_cnj_divide complex_cnj_minus + +text \Some properties for @{term complex_of_real}. Also, since it is often used in our +formalization we abbreviate it to @{term cor}.\ + +abbreviation cor :: "real \ complex" where + "cor \ complex_of_real" + +lemma cor_neg_one [simp]: + shows "cor (-1) = -1" + by simp + +lemma neg_cor_neg_one [simp]: + shows "- cor (-1) = 1" + by simp + +lemma cmod_cis [simp]: + assumes "a \ 0" + shows "cor (cmod a) * cis (arg a) = a" + using assms + by (metis rcis_cmod_arg rcis_def) + +lemma cis_cmod [simp]: + assumes "a \ 0" + shows "cis (arg a) * cor (cmod a) = a" + using assms cmod_cis[of a] + by (simp add: field_simps) + +lemma cor_add: + shows "cor (a + b) = cor a + cor b" + by (rule of_real_add) + +lemma cor_mult: + shows "cor (a * b) = cor a * cor b" + by (rule of_real_mult) + +lemma cor_squared: + shows "(cor x)\<^sup>2 = cor (x\<^sup>2)" + by (simp add: power2_eq_square) + +lemma cor_sqrt_mult_cor_sqrt [simp]: + shows "cor (sqrt A) * cor (sqrt A) = cor \A\" + by (metis cor_mult real_sqrt_abs2 real_sqrt_mult) + +lemma cor_eq_0: "cor x + \ * cor y = 0 \ x = 0 \ y = 0" + by (metis Complex_eq Im_complex_of_real Im_i_times Re_complex_of_real add_cancel_left_left of_real_eq_0_iff plus_complex.sel(2) zero_complex.code) + +lemma one_plus_square_neq_zero [simp]: + shows "1 + (cor x)\<^sup>2 \ 0" + by (metis (hide_lams, no_types) of_real_1 of_real_add of_real_eq_0_iff of_real_power power_one sum_power2_eq_zero_iff zero_neq_one) + +text \Additional lemmas about @{term Complex} constructor. Following newer versions of Isabelle, +these should be deprecated.\ + +lemma complex_real_two [simp]: + shows "Complex 2 0 = 2" + by (simp add: Complex_eq) + +lemma complex_double [simp]: + shows "(Complex a b) * 2 = Complex (2*a) (2*b)" + by (simp add: Complex_eq) + +lemma complex_half [simp]: + shows "(Complex a b) / 2 = Complex (a/2) (b/2)" + by (subst complex_eq_iff) auto + +lemma Complex_scale1: + shows "Complex (a * b) (a * c) = cor a * Complex b c" + unfolding complex_of_real_def + unfolding Complex_eq + by (auto simp add: field_simps) + +lemma Complex_scale2: + shows "Complex (a * c) (b * c) = Complex a b * cor c" + unfolding complex_of_real_def + unfolding Complex_eq + by (auto simp add: field_simps) + +lemma Complex_scale3: + shows "Complex (a / b) (a / c) = cor a * Complex (1 / b) (1 / c)" + unfolding complex_of_real_def + unfolding Complex_eq + by (auto simp add: field_simps) + +lemma Complex_scale4: + shows "c \ 0 \ Complex (a / c) (b / c) = Complex a b / cor c" + unfolding complex_of_real_def + unfolding Complex_eq + by (auto simp add: field_simps power2_eq_square) + +lemma Complex_Re_express_cnj: + shows "Complex (Re z) 0 = (z + cnj z) / 2" + by (cases z) (simp add: Complex_eq) + +lemma Complex_Im_express_cnj: + shows "Complex 0 (Im z) = (z - cnj z)/2" + by (cases z) (simp add: Complex_eq) + +text \Additional properties of @{term cmod}.\ + +lemma complex_mult_cnj_cmod: + shows "z * cnj z = cor ((cmod z)\<^sup>2)" + using complex_norm_square + by auto + +lemma cmod_square: + shows "(cmod z)\<^sup>2 = Re (z * cnj z)" + using complex_mult_cnj_cmod[of z] + by (simp add: power2_eq_square) + +lemma cor_cmod_power_4 [simp]: + shows "cor (cmod z) ^ 4 = (z * cnj z)\<^sup>2" + by (metis complex_norm_square cor_squared numeral_times_numeral power2_eq_square semiring_norm(11) semiring_norm(13) semiring_normalization_rules(36)) + +lemma cnjE: + assumes "x \ 0" + shows "cnj x = cor ((cmod x)\<^sup>2) / x" + using complex_mult_cnj_cmod[of x] assms + by (auto simp add: field_simps) + +lemma cmod_mult [simp]: + shows "cmod (a * b) = cmod a * cmod b" + by (rule norm_mult) + +lemma cmod_divide [simp]: + shows "cmod (a / b) = cmod a / cmod b" + by (rule norm_divide) + +lemma cmod_cor_divide [simp]: + shows "cmod (z / cor k) = cmod z / \k\" + by auto + +lemma cmod_mult_minus_left_distrib [simp]: + shows "cmod (z*z1 - z*z2) = cmod z * cmod(z1 - z2)" + by (metis bounded_bilinear.diff_right bounded_bilinear_mult cmod_mult) + +lemma cmod_eqI: + assumes "z1 * cnj z1 = z2 * cnj z2" + shows "cmod z1 = cmod z2" + using assms + by (subst complex_mod_sqrt_Re_mult_cnj)+ auto + +lemma cmod_eqE: + assumes "cmod z1 = cmod z2" + shows "z1 * cnj z1 = z2 * cnj z2" +proof- + from assms have "cor ((cmod z1)\<^sup>2) = cor ((cmod z2)\<^sup>2)" + by auto + thus ?thesis + using complex_mult_cnj_cmod + by auto +qed + +lemma cmod_eq_one [simp]: + shows "cmod a = 1 \ a*cnj a = 1" + by (metis cmod_eqE cmod_eqI complex_cnj_one monoid_mult_class.mult.left_neutral norm_one) + +text \We introduce @{term is_real} (the imaginary part of complex number is zero) and @{term is_imag} +(real part of complex number is zero) operators and prove some of their properties.\ + +abbreviation is_real where + "is_real z \ Im z = 0" + +abbreviation is_imag where + "is_imag z \ Re z = 0" + +lemma real_imag_0: + assumes "is_real a" "is_imag a" + shows "a = 0" + using assms + by (simp add: complex.expand) + +lemma complex_eq_if_Re_eq: + assumes "is_real z1" and "is_real z2" + shows "z1 = z2 \ Re z1 = Re z2" + using assms + by (cases z1, cases z2) auto + +lemma mult_reals [simp]: + assumes "is_real a" and "is_real b" + shows "is_real (a * b)" + using assms + by auto + +lemma div_reals [simp]: + assumes "is_real a" and "is_real b" + shows "is_real (a / b)" + using assms + by (simp add: complex_is_Real_iff) + +lemma complex_of_real_Re [simp]: + assumes "is_real k" + shows "cor (Re k) = k" + using assms + by (cases k) (auto simp add: complex_of_real_def) + +lemma cor_cmod_real: + assumes "is_real a" + shows "cor (cmod a) = a \ cor (cmod a) = -a" + using assms + unfolding cmod_def + by (cases "Re a > 0") auto + +lemma eq_cnj_iff_real: + shows "cnj z = z \ is_real z" + by (cases z) (simp add: Complex_eq) + +lemma eq_minus_cnj_iff_imag: + shows "cnj z = -z \ is_imag z" + by (cases z) (simp add: Complex_eq) + +lemma Re_divide_real: + assumes "is_real b" and "b \ 0" + shows "Re (a / b) = (Re a) / (Re b)" + using assms + by (simp add: complex_is_Real_iff) + +lemma Re_mult_real: + assumes "is_real a" + shows "Re (a * b) = (Re a) * (Re b)" + using assms + by simp + +lemma Im_mult_real: + assumes "is_real a" + shows "Im (a * b) = (Re a) * (Im b)" + using assms + by simp + +lemma Im_divide_real: + assumes "is_real b" and "b \ 0" + shows "Im (a / b) = (Im a) / (Re b)" + using assms + by (simp add: complex_is_Real_iff) + +lemma Re_half [simp]: + shows "Re (x / 2) = Re x / 2" + by (rule Re_divide_numeral) + +lemma Re_double [simp]: + shows "Re (2 * x) = 2 * Re x" + using Re_mult_real[of "2" x] + by simp + +lemma Im_half [simp]: + shows "Im (z / 2) = Im z / 2" + by (subst Im_divide_real, auto) + +lemma Im_double [simp]: + shows "Im (2 * z) = 2 * Im z" + using Im_mult_real[of "2" z] + by simp + +lemma Re_sgn: + assumes "is_real R" + shows "Re (sgn R) = sgn (Re R)" + using assms + by (metis Re_sgn complex_of_real_Re norm_of_real real_sgn_eq) + +lemma is_real_div: + assumes "b \ 0" + shows "is_real (a / b) \ a*cnj b = b*cnj a" + using assms + by (metis complex_cnj_divide complex_cnj_zero_iff eq_cnj_iff_real frac_eq_eq mult.commute) + +lemma is_real_mult_real: + assumes "is_real a" and "a \ 0" + shows "is_real b \ is_real (a * b)" + using assms + by (cases a, auto simp add: Complex_eq) + +lemma Im_express_cnj: + shows "Im z = (z - cnj z) / (2 * \)" + by (simp add: complex_diff_cnj field_simps) + +lemma Re_express_cnj: + shows "Re z = (z + cnj z) / 2" + by (simp add: complex_add_cnj) + +text \Rotation of complex number for 90 degrees in the positive direction.\ + +abbreviation rot90 where + "rot90 z \ Complex (-Im z) (Re z)" + +lemma rot90_ii: + shows "rot90 z = z * \" + by (metis Complex_mult_i complex_surj) + +text \With @{term cnj_mix} we introduce scalar product between complex vectors. This operation shows +to be useful to succinctly express some conditions.\ + +abbreviation cnj_mix where + "cnj_mix z1 z2 \ cnj z1 * z2 + z1 * cnj z2" + +abbreviation scalprod where + "scalprod z1 z2 \ cnj_mix z1 z2 / 2" + +lemma cnj_mix_minus: + shows "cnj z1*z2 - z1*cnj z2 = \ * cnj_mix (rot90 z1) z2" + by (cases z1, cases z2) (simp add: Complex_eq field_simps) + +lemma cnj_mix_minus': + shows "cnj z1*z2 - z1*cnj z2 = rot90 (cnj_mix (rot90 z1) z2)" + by (cases z1, cases z2) (simp add: Complex_eq field_simps) + +lemma cnj_mix_real [simp]: + shows "is_real (cnj_mix z1 z2)" + by (cases z1, cases z2) simp + +lemma scalprod_real [simp]: + shows "is_real (scalprod z1 z2)" + using cnj_mix_real + by simp + +text \Additional properties of @{term cis} function.\ + +lemma cis_minus_pi2 [simp]: + shows "cis (-pi/2) = -\" + by (simp add: cis_inverse[symmetric]) + +lemma cis_pi2_minus_x [simp]: + shows "cis (pi/2 - x) = \ * cis(-x)" + using cis_divide[of "pi/2" x, symmetric] + using cis_divide[of 0 x, symmetric] + by simp + +lemma cis_pm_pi [simp]: + shows "cis (x - pi) = - cis x" and "cis (x + pi) = - cis x" + by (simp add: cis.ctr complex_minus)+ + + +lemma cis_times_cis_opposite [simp]: + shows "cis \ * cis (- \) = 1" + by (simp add: cis_mult) + +text \@{term cis} repeats only after $2k\pi$\ +lemma cis_eq: + assumes "cis a = cis b" + shows "\ k::int. a - b = 2 * k * pi" + using assms sin_cos_eq[of a b] + using cis.sel[of a] cis.sel[of b] + by (cases "cis a", cases "cis b") auto + +text \@{term cis} is injective on $(-\pi, \pi]$.\ +lemma cis_inj: + assumes "-pi < \" and "\ \ pi" and "-pi < \'" and "\' \ pi" + assumes "cis \ = cis \'" + shows "\ = \'" + using assms + by (metis arg_unique sgn_cis) + +text \@{term cis} of an angle combined with @{term cis} of the opposite angle\ + +lemma cis_diff_cis_opposite [simp]: + shows "cis \ - cis (- \) = 2 * \ * sin \" + using Im_express_cnj[of "cis \"] + by simp + +lemma cis_opposite_diff_cis [simp]: + shows "cis (-\) - cis (\) = - 2 * \ * sin \" + using cis_diff_cis_opposite[of "-\"] + by simp + +lemma cis_add_cis_opposite [simp]: + shows "cis \ + cis (-\) = 2 * cos \" +proof- + have "2 * cos \ = (cis \ + cnj (cis \))" + using Re_express_cnj[of "cis \"] + by (simp add: field_simps) + thus ?thesis + by simp +qed + +text \@{term cis} equal to 1 or -1\ +lemma cis_one [simp]: + assumes "sin \ = 0" and "cos \ = 1" + shows "cis \ = 1" + using assms + by (auto simp add: cis.ctr one_complex.code) + +lemma cis_minus_one [simp]: + assumes "sin \ = 0" and "cos \ = -1" + shows "cis \ = -1" + using assms + by (auto simp add: cis.ctr Complex_eq_neg_1) + +(* -------------------------------------------------------------------------- *) +subsubsection \Additional properties of complex number argument\ +(* -------------------------------------------------------------------------- *) + +text \@{term arg} of real numbers\ + +lemma is_real_arg1: + assumes "arg z = 0 \ arg z = pi" + shows "is_real z" + using assms + using rcis_cmod_arg[of z] Im_rcis[of "cmod z" "arg z"] + by auto + +lemma is_real_arg2: + assumes "is_real z" + shows "arg z = 0 \ arg z = pi" +proof (cases "z = 0") + case True + thus ?thesis + by (auto simp add: arg_zero) +next + case False + hence "sin (arg z) = 0" + using assms rcis_cmod_arg[of z] Im_rcis[of "cmod z" "arg z"] + by auto + thus ?thesis + using arg_bounded[of z] + using sin_0_iff_canon + by simp +qed + +lemma arg_complex_of_real_positive [simp]: + assumes "k > 0" + shows "arg (cor k) = 0" +proof- + have "cos (arg (Complex k 0)) > 0" + using assms + using rcis_cmod_arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "arg (Complex k 0)"] + by (smt complex.sel(1) mult_nonneg_nonpos norm_ge_zero) + thus ?thesis + using assms is_real_arg2[of "cor k"] + unfolding complex_of_real_def + by auto +qed + +lemma arg_complex_of_real_negative [simp]: + assumes "k < 0" + shows "arg (cor k) = pi" +proof- + have "cos (arg (Complex k 0)) < 0" + using \k < 0\ rcis_cmod_arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "arg (Complex k 0)"] + by (smt complex.sel(1) mult_nonneg_nonneg norm_ge_zero) + thus ?thesis + using assms is_real_arg2[of "cor k"] + unfolding complex_of_real_def + by auto +qed + +lemma arg_0_iff: + shows "z \ 0 \ arg z = 0 \ is_real z \ Re z > 0" + by (smt arg_complex_of_real_negative arg_complex_of_real_positive arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps) + +lemma arg_pi_iff: + shows "arg z = pi \ is_real z \ Re z < 0" + by (smt arg_complex_of_real_negative arg_complex_of_real_positive arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps) + + +text \@{term arg} of imaginary numbers\ + +lemma is_imag_arg1: + assumes "arg z = pi/2 \ arg z = -pi/2" + shows "is_imag z" + using assms + using rcis_cmod_arg[of z] Re_rcis[of "cmod z" "arg z"] + by (metis cos_minus cos_pi_half minus_divide_left mult_eq_0_iff) + +lemma is_imag_arg2: + assumes "is_imag z" and "z \ 0" + shows "arg z = pi/2 \ arg z = -pi/2" +proof- + have "cos (arg z) = 0" + using assms + by (metis Re_rcis no_zero_divisors norm_eq_zero rcis_cmod_arg) + thus ?thesis + using arg_bounded[of z] + using cos_0_iff_canon[of "arg z"] + by simp +qed + +lemma arg_complex_of_real_times_i_positive [simp]: + assumes "k > 0" + shows "arg (cor k * \) = pi / 2" +proof- + have "sin (arg (Complex 0 k)) > 0" + using \k > 0\ rcis_cmod_arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "arg (Complex 0 k)"] + by (smt complex.sel(2) mult_nonneg_nonpos norm_ge_zero) + thus ?thesis + using assms is_imag_arg2[of "cor k * \"] + using arg_zero complex_of_real_i + by force +qed + +lemma arg_complex_of_real_times_i_negative [simp]: + assumes "k < 0" + shows "arg (cor k * \) = - pi / 2" +proof- + have "sin (arg (Complex 0 k)) < 0" + using \k < 0\ rcis_cmod_arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "arg (Complex 0 k)"] + by (smt complex.sel(2) mult_nonneg_nonneg norm_ge_zero) + thus ?thesis + using assms is_imag_arg2[of "cor k * \"] + using arg_zero complex_of_real_i[of k] + by (smt complex.sel(1) sin_pi_half sin_zero) +qed + +lemma arg_pi2_iff: + shows "z \ 0 \ arg z = pi / 2 \ is_imag z \ Im z > 0" + by (smt Im_rcis Re_i_times Re_rcis arcsin_minus_1 cos_pi_half divide_minus_left mult.commute mult_cancel_right1 rcis_cmod_arg is_imag_arg2 sin_arcsin sin_pi_half zero_less_mult_pos zero_less_norm_iff) + +lemma arg_minus_pi2_iff: + shows "z \ 0 \ arg z = - pi / 2 \ is_imag z \ Im z < 0" + by (smt arg_pi2_iff complex.expand divide_cancel_right pi_neq_zero is_imag_arg1 is_imag_arg2 zero_complex.simps(1) zero_complex.simps(2)) + +lemma arg_ii [simp]: + shows "arg \ = pi/2" +proof- + have "\ = cis (arg \)" + using rcis_cmod_arg[of \] + by (simp add: rcis_def) + hence "cos (arg \) = 0" "sin (arg \) = 1" + by (metis cis.simps(1) imaginary_unit.simps(1), metis cis.simps(2) imaginary_unit.simps(2)) + thus ?thesis + using cos_0_iff_canon[of "arg \"] arg_bounded[of \] + by auto +qed + +lemma arg_minus_ii [simp]: + shows "arg (-\) = -pi/2" +proof- + have "-\ = cis (arg (- \))" + using rcis_cmod_arg[of "-\"] + by (simp add: rcis_def) + hence "cos (arg (-\)) = 0" "sin (arg (-\)) = -1" + using cis.simps[of "arg (-\)"] + by auto + thus ?thesis + using cos_0_iff_canon[of "arg (-\)"] arg_bounded[of "-\"] + by fastforce +qed + +text \Argument is a canonical angle\ + +lemma canon_ang_arg: + shows "\arg z\ = arg z" + using canon_ang_id[of "arg z"] arg_bounded + by simp + +lemma arg_cis: + shows "arg (cis \) = \\\" +proof (rule canon_ang_eqI[symmetric]) + show "- pi < arg (cis \) \ arg (cis \) \ pi" + using arg_bounded + by simp +next + show "\ k::int. arg (cis \) - \ = 2*k*pi" + proof- + have "cis (arg (cis \)) = cis \" + using cis_arg[of "cis \"] + by auto + thus ?thesis + using cis_eq + by auto + qed +qed + +text \Cosine and sine of @{term arg}\ + +lemma cos_arg: + assumes "z \ 0" + shows "cos (arg z) = Re z / cmod z" + by (metis Complex.Re_sgn cis.simps(1) assms cis_arg) + +lemma sin_arg: + assumes "z \ 0" + shows "sin (arg z) = Im z / cmod z" + by (metis Complex.Im_sgn cis.simps(2) assms cis_arg) + +text \Argument of product\ + +lemma cis_arg_mult: + assumes "z1 * z2 \ 0" + shows "cis (arg (z1 * z2)) = cis (arg z1 + arg z2)" +proof- + have "z1 * z2 = cor (cmod z1) * cor (cmod z2) * cis (arg z1) * cis (arg z2)" + using rcis_cmod_arg[of z1, symmetric] rcis_cmod_arg[of z2, symmetric] + unfolding rcis_def + by algebra + hence "z1 * z2 = cor (cmod (z1 * z2)) * cis (arg z1 + arg z2)" + using cis_mult[of "arg z1" "arg z2"] + by auto + hence "cor (cmod (z1 * z2)) * cis (arg z1 + arg z2) = cor (cmod (z1 * z2)) * cis (arg (z1 * z2))" + using assms + using rcis_cmod_arg[of "z1*z2"] + unfolding rcis_def + by auto + thus ?thesis + using mult_cancel_left[of "cor (cmod (z1 * z2))" "cis (arg z1 + arg z2)" "cis (arg (z1 * z2))"] + using assms + by auto +qed + +lemma arg_mult_2kpi: + assumes "z1 * z2 \ 0" + shows "\ k::int. arg (z1 * z2) = arg z1 + arg z2 + 2*k*pi" +proof- + have "cis (arg (z1*z2)) = cis (arg z1 + arg z2)" + by (rule cis_arg_mult[OF assms]) + thus ?thesis + using cis_eq[of "arg (z1*z2)" "arg z1 + arg z2"] + by (auto simp add: field_simps) +qed + +lemma arg_mult: + assumes "z1 * z2 \ 0" + shows "arg(z1 * z2) = \arg z1 + arg z2\" +proof- + obtain k::int where "arg(z1 * z2) = arg z1 + arg z2 + 2*k*pi" + using arg_mult_2kpi[of z1 z2] + using assms + by auto + hence "\arg(z1 * z2)\ = \arg z1 + arg z2\" + using canon_ang_eq + by(simp add:field_simps) + thus ?thesis + using canon_ang_arg[of "z1*z2"] + by auto +qed + +lemma arg_mult_real_positive [simp]: + assumes "k > 0" + shows "arg (cor k * z) = arg z" +proof (cases "z = 0") + case True + thus ?thesis + by (auto simp add: arg_zero) +next + case False + thus ?thesis + using assms + using arg_mult[of "cor k" z] + by (auto simp add: canon_ang_arg) +qed + +lemma arg_mult_real_negative [simp]: + assumes "k < 0" + shows "arg (cor k * z) = arg (-z)" +proof (cases "z = 0") + case True + thus ?thesis + by (auto simp add: arg_zero) +next + case False + thus ?thesis + using assms + using arg_mult[of "cor k" z] + using arg_mult[of "-1" z] + using arg_complex_of_real_negative[of k] arg_complex_of_real_negative[of "-1"] + by auto +qed + +lemma arg_div_real_positive [simp]: + assumes "k > 0" + shows "arg (z / cor k) = arg z" +proof(cases "z = 0") + case True + thus ?thesis + by auto +next + case False + thus ?thesis + using assms + using arg_mult_real_positive[of "1/k" z] + by auto +qed + +lemma arg_div_real_negative [simp]: + assumes "k < 0" + shows "arg (z / cor k) = arg (-z)" +proof(cases "z = 0") + case True + thus ?thesis + by auto +next + case False + thus ?thesis + using assms + using arg_mult_real_negative[of "1/k" z] + by auto +qed + +lemma arg_mult_eq: + assumes "z * z1 \ 0" and "z * z2 \ 0" + assumes "arg (z * z1) = arg (z * z2)" + shows "arg z1 = arg z2" +proof- + from assms have "\arg z + arg z1\ = \arg z + arg z2\" + by (simp add: arg_mult) + then obtain x::int where *: "arg z1 - arg z2 = 2 * x * pi" + using canon_ang_eqE[of "arg z + arg z1" "arg z + arg z2"] + by auto + moreover + have "arg z1 - arg z2 < 2*pi" "arg z1 - arg z2 > -2*pi" + using arg_bounded[of z1] arg_bounded[of z2] + by auto + ultimately + have "-1 < x" "x < 1" + using divide_strict_right_mono[of "-pi" "pi * x" pi] + by auto + hence "x = 0" + by auto + thus ?thesis + using * + by simp +qed + +text \Argument of conjugate\ + +lemma arg_cnj_pi: + assumes "arg z = pi" + shows "arg (cnj z) = pi" +proof- + have "cos (arg (cnj z)) = cos (arg z)" + using rcis_cmod_arg[of z, symmetric] Re_rcis[of "cmod z" "arg z"] + using rcis_cmod_arg[of "cnj z", symmetric] Re_rcis[of "cmod (cnj z)" "arg (cnj z)"] + by auto + hence "arg (cnj z) = arg z \ arg(cnj z) = -arg z" + using arg_bounded[of z] arg_bounded[of "cnj z"] + by (metis arccos_cos arccos_cos2 less_eq_real_def linorder_le_cases minus_minus) + thus ?thesis + using assms + using arg_bounded[of "cnj z"] + by auto +qed + +lemma arg_cnj_not_pi: + assumes "arg z \ pi" + shows "arg (cnj z) = -arg z" +proof(cases "arg z = 0") + case True + thus ?thesis + using eq_cnj_iff_real[of z] is_real_arg1[of z] by force +next + case False + have "cos (arg (cnj z)) = cos (arg z)" + using rcis_cmod_arg[of z] Re_rcis[of "cmod z" "arg z"] + using rcis_cmod_arg[of "cnj z"] Re_rcis[of "cmod (cnj z)" "arg (cnj z)"] + by auto + hence "arg (cnj z) = arg z \ arg(cnj z) = -arg z" + using arg_bounded[of z] arg_bounded[of "cnj z"] + by (metis arccos_cos arccos_cos2 less_eq_real_def linorder_le_cases minus_minus) + moreover + have "sin (arg (cnj z)) = -sin (arg z)" + using rcis_cmod_arg[of z] Im_rcis[of "cmod z" "arg z"] + using rcis_cmod_arg[of "cnj z"] Im_rcis[of "cmod (cnj z)" "arg (cnj z)"] + using calculation eq_cnj_iff_real is_real_arg2 + by force + hence "arg (cnj z) \ arg z" + using sin_0_iff_canon[of "arg (cnj z)"] arg_bounded False assms + by auto + ultimately + show ?thesis + by auto +qed + +text \Argument of reciprocal\ + +lemma arg_inv_not_pi: + assumes "z \ 0" and "arg z \ pi" + shows "arg (1 / z) = - arg z" +proof- + have "1/z = cnj z / cor ((cmod z)\<^sup>2 )" + using \z \ 0\ complex_mult_cnj_cmod[of z] + by (auto simp add:field_simps) + thus ?thesis + using arg_div_real_positive[of "(cmod z)\<^sup>2" "cnj z"] \z \ 0\ + using arg_cnj_not_pi[of z] \arg z \ pi\ + by auto +qed + +lemma arg_inv_pi: + assumes "z \ 0" and "arg z = pi" + shows "arg (1 / z) = pi" +proof- + have "1/z = cnj z / cor ((cmod z)\<^sup>2 )" + using \z \ 0\ complex_mult_cnj_cmod[of z] + by (auto simp add:field_simps) + thus ?thesis + using arg_div_real_positive[of "(cmod z)\<^sup>2" "cnj z"] \z \ 0\ + using arg_cnj_pi[of z] \arg z = pi\ + by auto +qed + +lemma arg_inv_2kpi: + assumes "z \ 0" + shows "\ k::int. arg (1 / z) = - arg z + 2*k*pi" + using arg_inv_pi[OF assms] + using arg_inv_not_pi[OF assms] + by (cases "arg z = pi") (rule_tac x="1" in exI, simp, rule_tac x="0" in exI, simp) + +lemma arg_inv: + assumes "z \ 0" + shows "arg (1 / z) = \- arg z\" +proof- + obtain k::int where "arg(1 / z) = - arg z + 2*k*pi" + using arg_inv_2kpi[of z] + using assms + by auto + hence "\arg(1 / z)\ = \- arg z\" + using canon_ang_eq + by(simp add:field_simps) + thus ?thesis + using canon_ang_arg[of "1 / z"] + by auto +qed + +text \Argument of quotient\ + +lemma arg_div_2kpi: + assumes "z1 \ 0" and "z2 \ 0" + shows "\ k::int. arg (z1 / z2) = arg z1 - arg z2 + 2*k*pi" +proof- + obtain x1 where "arg (z1 * (1 / z2)) = arg z1 + arg (1 / z2) + 2 * real_of_int x1 * pi" + using assms arg_mult_2kpi[of z1 "1/z2"] + by auto + moreover + obtain x2 where "arg (1 / z2) = - arg z2 + 2 * real_of_int x2 * pi" + using assms arg_inv_2kpi[of z2] + by auto + ultimately + show ?thesis + by (rule_tac x="x1 + x2" in exI, simp add: field_simps) +qed + +lemma arg_div: + assumes "z1 \ 0" and "z2 \ 0" + shows "arg(z1 / z2) = \arg z1 - arg z2\" +proof- + obtain k::int where "arg(z1 / z2) = arg z1 - arg z2 + 2*k*pi" + using arg_div_2kpi[of z1 z2] + using assms + by auto + hence "canon_ang(arg(z1 / z2)) = canon_ang(arg z1 - arg z2)" + using canon_ang_eq + by(simp add:field_simps) + thus ?thesis + using canon_ang_arg[of "z1/z2"] + by auto +qed + +text \Argument of opposite\ + +lemma arg_uminus: + assumes "z \ 0" + shows "arg (-z) = \arg z + pi\" + using assms + using arg_mult[of "-1" z] + using arg_complex_of_real_negative[of "-1"] + by (auto simp add: field_simps) + +lemma arg_uminus_opposite_sign: + assumes "z \ 0" + shows "arg z > 0 \ \ arg (-z) > 0" +proof (cases "arg z = 0") + case True + thus ?thesis + using assms + by (simp add: arg_uminus) +next + case False + show ?thesis + proof (cases "arg z > 0") + case True + thus ?thesis + using assms + using arg_bounded[of z] + using canon_ang_plus_pi1[of "arg z"] + by (simp add: arg_uminus) + next + case False + thus ?thesis + using \arg z \ 0\ + using assms + using arg_bounded[of z] + using canon_ang_plus_pi2[of "arg z"] + by (simp add: arg_uminus) + qed +qed + +text \Sign of argument is the same as the sign of the Imaginary part\ + +lemma arg_Im_sgn: + assumes "\ is_real z" + shows "sgn (arg z) = sgn (Im z)" +proof- + have "z \ 0" + using assms + by auto + then obtain r \ where polar: "z = cor r * cis \" "\ = arg z" "r > 0" + by (smt cmod_cis mult_eq_0_iff norm_ge_zero of_real_0) + hence "Im z = r * sin \" + by (metis Im_mult_real Re_complex_of_real cis.simps(2) Im_complex_of_real) + hence "Im z > 0 \ sin \ > 0" "Im z < 0 \ sin \ < 0" + using \r > 0\ + using mult_pos_pos mult_nonneg_nonneg zero_less_mult_pos mult_less_cancel_left + by smt+ + moreover + have "\ \ pi" "\ \ 0" + using \\ is_real z\ polar cis_pi + by force+ + hence "sin \ > 0 \ \ > 0" "\ < 0 \ sin \ < 0" + using \\ = arg z\ \\ \ 0\ \\ \ pi\ + using arg_bounded[of z] + by (smt sin_gt_zero sin_le_zero sin_pi_minus sin_0_iff_canon sin_ge_zero)+ + ultimately + show ?thesis + using \\ = arg z\ + by auto +qed + + +subsubsection \Complex square root\ + +definition + "ccsqrt z = rcis (sqrt (cmod z)) (arg z / 2)" + +lemma square_ccsqrt [simp]: + shows "(ccsqrt x)\<^sup>2 = x" + unfolding ccsqrt_def + by (subst DeMoivre2) (simp add: rcis_cmod_arg) + +lemma ex_complex_sqrt: + shows "\ s::complex. s*s = z" + unfolding power2_eq_square[symmetric] + by (rule_tac x="csqrt z" in exI) simp + +lemma ccsqrt: + assumes "s * s = z" + shows "s = ccsqrt z \ s = -ccsqrt z" +proof (cases "s = 0") + case True + thus ?thesis + using assms + unfolding ccsqrt_def + by simp +next + case False + then obtain k::int where "cmod s * cmod s = cmod z" "2 * arg s - arg z = 2*k*pi" + using assms + using rcis_cmod_arg[of z] rcis_cmod_arg[of s] + using arg_mult[of s s] + using canon_ang(3)[of "2*arg s"] + by (auto simp add: norm_mult arg_mult) + have *: "sqrt (cmod z) = cmod s" + using \cmod s * cmod s = cmod z\ + by (smt norm_not_less_zero real_sqrt_abs2) + + have **: "arg z / 2 = arg s - k*pi" + using \2 * arg s - arg z = 2*k*pi\ + by simp + + have "cis (arg s - k*pi) = cis (arg s) \ cis (arg s - k*pi) = -cis (arg s)" + proof (cases "even k") + case True + hence "cis (arg s - k*pi) = cis (arg s)" + by (simp add: cis_def complex.corec cos_diff sin_diff) + thus ?thesis + by simp + next + case False + hence "cis (arg s - k*pi) = -cis (arg s)" + by (simp add: cis_def complex.corec Complex_eq cos_diff sin_diff) + thus ?thesis + by simp + qed + thus ?thesis + proof + assume ***: "cis (arg s - k * pi) = cis (arg s)" + hence "s = ccsqrt z" + using rcis_cmod_arg[of s] + unfolding ccsqrt_def rcis_def + by (subst *, subst **, subst ***, simp) + thus ?thesis + by simp + next + assume ***: "cis (arg s - k * pi) = -cis (arg s)" + hence "s = - ccsqrt z" + using rcis_cmod_arg[of s] + unfolding ccsqrt_def rcis_def + by (subst *, subst **, subst ***, simp) + thus ?thesis + by simp + qed +qed + +lemma null_ccsqrt [simp]: + shows "ccsqrt x = 0 \ x = 0" + unfolding ccsqrt_def + by auto + +lemma ccsqrt_mult: + shows "ccsqrt (a * b) = ccsqrt a * ccsqrt b \ + ccsqrt (a * b) = - ccsqrt a * ccsqrt b" +proof (cases "a = 0 \ b = 0") + case True + thus ?thesis + by auto +next + case False + obtain k::int where "arg a + arg b - \arg a + arg b\ = 2 * real_of_int k * pi" + using canon_ang(3)[of "arg a + arg b"] + by auto + hence *: "\arg a + arg b\ = arg a + arg b - 2 * (real_of_int k) * pi" + by (auto simp add: field_simps) + + have "cis (\arg a + arg b\ / 2) = cis (arg a / 2 + arg b / 2) \ cis (\arg a + arg b\ / 2) = - cis (arg a / 2 + arg b / 2)" + using cos_even_kpi[of k] cos_odd_kpi[of k] + by ((subst *)+, (subst diff_divide_distrib)+, (subst add_divide_distrib)+) + (cases "even k", auto simp add: cis_def complex.corec Complex_eq cos_diff sin_diff) + thus ?thesis + using False + unfolding ccsqrt_def + by (simp add: rcis_mult real_sqrt_mult arg_mult) + (auto simp add: rcis_def) +qed + +lemma csqrt_real: + assumes "is_real x" + shows "(Re x \ 0 \ ccsqrt x = cor (sqrt (Re x))) \ + (Re x < 0 \ ccsqrt x = \ * cor (sqrt (- (Re x))))" +proof (cases "x = 0") + case True + thus ?thesis + by auto +next + case False + show ?thesis + proof (cases "Re x > 0") + case True + hence "arg x = 0" + using \is_real x\ + by (metis arg_complex_of_real_positive complex_of_real_Re) + thus ?thesis + using \Re x > 0\ \is_real x\ + unfolding ccsqrt_def + by (simp add: cmod_eq_Re) + next + case False + hence "Re x < 0" + using \x \ 0\ \is_real x\ + using complex_eq_if_Re_eq by auto + hence "arg x = pi" + using \is_real x\ + by (metis arg_complex_of_real_negative complex_of_real_Re) + thus ?thesis + using \Re x < 0\ \is_real x\ + unfolding ccsqrt_def rcis_def + by (simp add: cis_def complex.corec Complex_eq cmod_eq_Re) + qed +qed + + +text \Rotation of complex vector to x-axis.\ + +lemma is_real_rot_to_x_axis: + assumes "z \ 0" + shows "is_real (cis (-arg z) * z)" +proof (cases "arg z = pi") + case True + thus ?thesis + using is_real_arg1[of z] + by auto +next + case False + hence "\- arg z\ = - arg z" + using canon_ang_eqI[of "- arg z" "-arg z"] + using arg_bounded[of z] + by (auto simp add: field_simps) + hence "arg (cis (- (arg z)) * z) = 0" + using arg_mult[of "cis (- (arg z))" z] \z \ 0\ + using arg_cis[of "- arg z"] + by simp + thus ?thesis + using is_real_arg1[of "cis (- arg z) * z"] + by auto +qed + +lemma positive_rot_to_x_axis: + assumes "z \ 0" + shows "Re (cis (-arg z) * z) > 0" + using assms + by (smt Re_complex_of_real cis_rcis_eq mult_cancel_right1 rcis_cmod_arg rcis_mult rcis_zero_arg zero_less_norm_iff) + +text \Inequalities involving @{term cmod}.\ + +lemma cmod_1_plus_mult_le: + shows "cmod (1 + z*w) \ sqrt((1 + (cmod z)\<^sup>2) * (1 + (cmod w)\<^sup>2))" +proof- + have "Re ((1+z*w)*(1+cnj z*cnj w)) \ Re (1+z*cnj z)* Re (1+w*cnj w)" + proof- + have "Re ((w - cnj z)*cnj(w - cnj z)) \ 0" + by (subst complex_mult_cnj_cmod) (simp add: power2_eq_square) + hence "Re (z*w + cnj z * cnj w) \ Re (w*cnj w) + Re(z*cnj z)" + by (simp add: field_simps) + thus ?thesis + by (simp add: field_simps) + qed + hence "(cmod (1 + z * w))\<^sup>2 \ (1 + (cmod z)\<^sup>2) * (1 + (cmod w)\<^sup>2)" + by (subst cmod_square)+ simp + thus ?thesis + by (metis abs_norm_cancel real_sqrt_abs real_sqrt_le_iff) +qed + +lemma cmod_diff_ge: + shows "cmod (b - c) \ sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2)" +proof- + have "(cmod (b - c))\<^sup>2 + (1/2*Im(b*cnj c - c*cnj b))\<^sup>2 \ 0" + by simp + hence "(cmod (b - c))\<^sup>2 \ - (1/2*Im(b*cnj c - c*cnj b))\<^sup>2" + by simp + hence "(cmod (b - c))\<^sup>2 \ (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c) " + by (auto simp add: power2_eq_square field_simps) + hence "Re ((b - c)*(cnj b - cnj c)) \ (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c)" + by (subst (asm) cmod_square) simp + moreover + have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) = 1 + Re(b*cnj b) + Re(c*cnj c) + Re(b*cnj b*c*cnj c)" + by (subst cmod_square)+ (simp add: field_simps power2_eq_square) + moreover + have "(1 + Re (scalprod b c))\<^sup>2 = 1 + 2*Re(scalprod b c) + ((Re (scalprod b c))\<^sup>2)" + by (subst power2_sum) simp + hence "(1 + Re (scalprod b c))\<^sup>2 = 1 + Re(b*cnj c + c*cnj b) + (1/2 * Re (b*cnj c + c*cnj b))\<^sup>2" + by simp + ultimately + have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) \ (1 + Re (scalprod b c))\<^sup>2" + by (simp add: field_simps) + moreover + have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \ 0" + by (metis one_power2 real_sqrt_sum_squares_mult_ge_zero) + ultimately + have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \ 1 + Re (scalprod b c)" + by (metis power2_le_imp_le real_sqrt_ge_0_iff real_sqrt_pow2_iff) + hence "Re ((b - c) * (cnj b - cnj c)) \ 1 + Re (c*cnj c) + 1 + Re (b*cnj b) - 2*sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2))" + by (simp add: field_simps) + hence *: "(cmod (b - c))\<^sup>2 \ (sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2))\<^sup>2" + apply (subst cmod_square)+ + apply (subst (asm) cmod_square)+ + apply (subst power2_diff) + apply (subst real_sqrt_pow2, simp) + apply (subst real_sqrt_pow2, simp) + apply (simp add: real_sqrt_mult) + done + thus ?thesis + proof (cases "sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2) > 0") + case True + thus ?thesis + using power2_le_imp_le[OF *] + by simp + next + case False + hence "0 \ sqrt (1 + (cmod b)\<^sup>2) - sqrt (1 + (cmod c)\<^sup>2)" + by (metis less_eq_real_def linorder_neqE_linordered_idom) + moreover + have "cmod (b - c) \ 0" + by simp + ultimately + show ?thesis + by (metis add_increasing monoid_add_class.add.right_neutral) + qed +qed + +lemma cmod_diff_le: + shows "cmod (b - c) \ sqrt (1 + (cmod b)\<^sup>2) + sqrt (1 + (cmod c)\<^sup>2)" +proof- + have "(cmod (b + c))\<^sup>2 + (1/2*Im(b*cnj c - c*cnj b))\<^sup>2 \ 0" + by simp + hence "(cmod (b + c))\<^sup>2 \ - (1/2*Im(b*cnj c - c*cnj b))\<^sup>2" + by simp + hence "(cmod (b + c))\<^sup>2 \ (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c) " + by (auto simp add: power2_eq_square field_simps) + hence "Re ((b + c)*(cnj b + cnj c)) \ (1/2*Re(b*cnj c + c*cnj b))\<^sup>2 - Re(b*cnj b*c*cnj c)" + by (subst (asm) cmod_square) simp + moreover + have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) = 1 + Re(b*cnj b) + Re(c*cnj c) + Re(b*cnj b*c*cnj c)" + by (subst cmod_square)+ (simp add: field_simps power2_eq_square) + moreover + have ++: "2*Re(scalprod b c) = Re(b*cnj c + c*cnj b)" + by simp + have "(1 - Re (scalprod b c))\<^sup>2 = 1 - 2*Re(scalprod b c) + ((Re (scalprod b c))\<^sup>2)" + by (subst power2_diff) simp + hence "(1 - Re (scalprod b c))\<^sup>2 = 1 - Re(b*cnj c + c*cnj b) + (1/2 * Re (b*cnj c + c*cnj b))\<^sup>2" + by (subst ++[symmetric]) simp + ultimately + have "(1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2) \ (1 - Re (scalprod b c))\<^sup>2" + by (simp add: field_simps) + moreover + have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \ 0" + by (metis one_power2 real_sqrt_sum_squares_mult_ge_zero) + ultimately + have "sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2)) \ 1 - Re (scalprod b c)" + by (metis power2_le_imp_le real_sqrt_ge_0_iff real_sqrt_pow2_iff) + hence "Re ((b - c) * (cnj b - cnj c)) \ 1 + Re (c*cnj c) + 1 + Re (b*cnj b) + 2*sqrt((1 + (cmod b)\<^sup>2) * (1 + (cmod c)\<^sup>2))" + by (simp add: field_simps) + hence *: "(cmod (b - c))\<^sup>2 \ (sqrt (1 + (cmod b)\<^sup>2) + sqrt (1 + (cmod c)\<^sup>2))\<^sup>2" + apply (subst cmod_square)+ + apply (subst (asm) cmod_square)+ + apply (subst power2_sum) + apply (subst real_sqrt_pow2, simp) + apply (subst real_sqrt_pow2, simp) + apply (simp add: real_sqrt_mult) + done + thus ?thesis + using power2_le_imp_le[OF *] + by simp +qed + + +text \Definition of Euclidean distance between two complex numbers.\ + +definition cdist where + [simp]: "cdist z1 z2 \ cmod (z2 - z1)" + +text \Misc. properties of complex numbers.\ + +lemma ex_complex_to_complex [simp]: + fixes z1 z2 :: complex + assumes "z1 \ 0" and "z2 \ 0" + shows "\k. k \ 0 \ z2 = k * z1" + using assms + by (rule_tac x="z2/z1" in exI) simp + +lemma ex_complex_to_one [simp]: + fixes z::complex + assumes "z \ 0" + shows "\k. k \ 0 \ k * z = 1" + using assms + by (rule_tac x="1/z" in exI) simp + +lemma ex_complex_to_complex2 [simp]: + fixes z::complex + shows "\k. k \ 0 \ k * z = z" + by (rule_tac x="1" in exI) simp + +lemma complex_sqrt_1: + fixes z::complex + assumes "z \ 0" + shows "z = 1 / z \ z = 1 \ z = -1" + using assms + using nonzero_eq_divide_eq square_eq_iff + by fastforce + +end diff --git a/thys/Complex_Geometry/More_Set.thy b/thys/Complex_Geometry/More_Set.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/More_Set.thy @@ -0,0 +1,123 @@ +(* ---------------------------------------------------------------------------- *) +subsection \Library Aditions for Set Cardinality\ +(* ---------------------------------------------------------------------------- *) + +text \In this sections some additional simple lemmas about set cardinality are proved.\ + +theory More_Set +imports Main +begin + +text \Every infinite set has at least two different elements\ +lemma infinite_contains_2_elems: + assumes "infinite A" + shows "\ x y. x \ y \ x \ A \ y \ A" +proof(rule ccontr) + assume *: " \x y. x \ y \ x \ A \ y \ A" + have "\ x. x \ A " + using assms + by (simp add: ex_in_conv infinite_imp_nonempty) + hence "card A = 1" + using * + by (metis assms ex_in_conv finite_insert infinite_imp_nonempty insertCI mk_disjoint_insert) + thus False + using assms + by simp +qed + +text \Every infinite set has at least three different elements\ +lemma infinite_contains_3_elems: + assumes "infinite A" + shows "\ x y z. x \ y \ x \ z \ y \ z \ x \ A \ y \ A \ z \ A" +proof(rule ccontr) + assume " \x y z. x \ y \ x \ z \ y \ z \ x \ A \ y \ A \ z \ A" + hence "card A = 2" + by (smt DiffE assms finite_insert infinite_contains_2_elems insert_Diff insert_iff) + thus False + using assms + by simp +qed + +text \Every set with cardinality greater than 1 has at least two different elements\ +lemma card_geq_2_iff_contains_2_elems: + shows "card A \ 2 \ finite A \ (\ x y. x \ y \ x \ A \ y \ A)" +proof + assume *: "finite A \ (\ x y. x \ y \ x \ A \ y \ A)" + thus "card A \ 2" + proof - + obtain a :: 'a and b :: 'a where + f1: "a \ b \ a \ A \ b \ A" + using * + by blast + then have "0 < card (A - {b})" + by (metis * card_eq_0_iff ex_in_conv finite_insert insertE insert_Diff neq0_conv) + then show ?thesis + using f1 by (simp add: *) + qed +next + assume *: " 2 \ card A" + hence "finite A" + using card_infinite + by force + moreover + have "\x y. x \ y \ x \ A \ y \ A" + proof(rule ccontr) + assume " \x y. x \ y \ x \ A \ y \ A" + hence "card A \ 1" + by (metis One_nat_def card.empty card.insert card_mono finite.emptyI finite_insert insertCI le_SucI subsetI) + thus False + using * + by auto + qed + ultimately + show "finite A \ (\ x y. x \ y \ x \ A \ y \ A)" + by simp +qed + +text \Set cardinality is at least 3 if and only if it contains three different elements\ +lemma card_geq_3_iff_contains_3_elems: + shows "card A \ 3 \ finite A \ (\ x y z. x \ y \ x \ z \ y \ z \ x \ A \ y \ A \ z \ A)" +proof + assume *: "card A \ 3" + hence "finite A" + using card_infinite + by force + moreover + have "\ x y z. x \ y \ x \ z \ y \ z \ x \ A \ y \ A \ z \ A" + proof(rule ccontr) + assume "\x y z. x \ y \ x \ z \ y \ z \ x \ A \ y \ A \ z \ A" + hence "card A \ 2" + by (smt DiffE Suc_leI card.remove card_geq_2_iff_contains_2_elems insert_iff le_cases not_le) + thus False + using * + by auto + qed + ultimately + show "finite A \ (\ x y z. x \ y \ x \ z \ y \ z \ x \ A \ y \ A \ z \ A)" + by simp +next + assume *: "finite A \ (\ x y z. x \ y \ x \ z \ y \ z \ x \ A \ y \ A \ z \ A)" + thus "card A \ 3" + by (smt "*" Suc_eq_numeral Suc_le_mono card.remove card_geq_2_iff_contains_2_elems finite_insert insert_Diff insert_iff pred_numeral_simps(3)) +qed + +text \Set cardinality of A is equal to 2 if and only if A={x, y} for two different elements x and y\ +lemma card_eq_2_iff_doubleton: "card A = 2 \ (\ x y. x \ y \ A = {x, y})" + using card_geq_2_iff_contains_2_elems[of A] + using card_geq_3_iff_contains_3_elems[of A] + by auto (rule_tac x=x in exI, rule_tac x=y in exI, auto) + +lemma card_eq_2_doubleton: + assumes "card A = 2" and "x \ y" and "x \ A" and "y \ A" + shows "A = {x, y}" + using assms + using card_eq_2_iff_doubleton[of A] + by auto + +text \Bijections map singleton to singleton sets\ + +lemma bij_image_singleton: + shows "\f ` A = {b}; f a = b; bij f\ \ A = {a}" + by (metis (mono_tags) bij_betw_imp_inj_on image_empty image_insert inj_vimage_image_eq) + +end \ No newline at end of file diff --git a/thys/Complex_Geometry/More_Transcendental.thy b/thys/Complex_Geometry/More_Transcendental.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/More_Transcendental.thy @@ -0,0 +1,409 @@ +(* ---------------------------------------------------------------------------- *) +section \Introduction\ +(* ---------------------------------------------------------------------------- *) + +text \The complex plane or some of its parts (e.g., the unit disc or the upper half plane) are often +taken as the domain in which models of various geometries (both Euclidean and non-Euclidean ones) +are formalized. The complex plane gives simpler and more compact formulas than the Cartesian plane. +Within complex plane is easier to describe geometric objects and perform the calculations (usually +shedding some new light on the subject). We give a formalization of the extended complex +plane (given both as a complex projective space and as the Riemann sphere), its objects (points, +circles and lines), and its transformations (Möbius transformations).\ + +(* ---------------------------------------------------------------------------- *) +section \Related work\ +(* ---------------------------------------------------------------------------- *) + +text\During the last decade, there have been many results in formalizing +geometry in proof-assistants. Parts of Hilbert’s seminal book +,,Foundations of Geometry'' \cite{hilbert} have been formalized both +in Coq and Isabelle/Isar. Formalization of first two groups of axioms +in Coq, in an intuitionistic setting was done by Dehlinger et +al. \cite{hilbert-coq}. First formalization in Isabelle/HOL was done +by Fleuriot and Meikele \cite{hilbert-isabelle}, and some further +developments were made in master thesis of Scott \cite{hilbert-scott}. +Large fragments of Tarski's geometry \cite{tarski} have been +formalized in Coq by Narboux et al. \cite{narboux-tarski}. Within Coq, +there are also formalizations of von Plato’s constructive geometry by +Kahn \cite{vonPlato,von-plato-formalization}, French high school +geometry by Guilhot \cite{guilhot} and ruler and compass geometry by +Duprat \cite{duprat2008}, etc. + +In our previous work \cite{petrovic2012formalizing}, we have already +formally investigated a Cartesian model of Euclidean geometry. +\ + +(* ---------------------------------------------------------------------------- *) +section \Background theories\ +(* ---------------------------------------------------------------------------- *) + +text \In this section we introduce some basic mathematical notions and prove some lemmas needed in the rest of our +formalization. We describe: + + \<^item> trigonometric functions, + + \<^item> complex numbers, + + \<^item> systems of two and three linear equations with two unknowns (over arbitrary fields), + + \<^item> quadratic equations (over real and complex numbers), systems of quadratic and real + equations, and systems of two quadratic equations, + + \<^item> two-dimensional vectors and matrices over complex numbers. +\ + +(* -------------------------------------------------------------------------- *) +subsection \Library Additions for Trigonometric Functions\ +(* -------------------------------------------------------------------------- *) + +theory More_Transcendental + imports Complex_Main +begin + +text \Additional properties of @{term sin} and @{term cos} functions that are later used in proving +conjectures for argument of complex number.\ + +text \Sign of trigonometric functions on some characteristic intervals.\ + +lemma cos_lt_zero_on_pi2_pi [simp]: + assumes "x > pi/2" and "x \ pi" + shows "cos x < 0" + using cos_gt_zero_pi[of "pi - x"] assms + by simp + +text \Value of trigonometric functions in points $k\pi$ and $\frac{\pi}{2} + k\pi$.\ + +lemma sin_kpi [simp]: + fixes k::int + shows "sin (k * pi) = 0" + by (simp add: sin_zero_iff_int2) + +lemma cos_odd_kpi [simp]: + fixes k::int + assumes "odd k" + shows "cos (k * pi) = -1" +proof (cases "k \ 0") + case True + hence "odd (nat k)" + using \odd k\ + by (auto simp add: even_nat_iff) + thus ?thesis + using \k \ 0\ cos_npi[of "nat k"] + by auto +next + case False + hence "-k \ 0" "odd (nat (-k))" + using \odd k\ + by (auto simp add: even_nat_iff) + thus ?thesis + using cos_npi[of "nat (-k)"] + by auto +qed + +lemma cos_even_kpi [simp]: + fixes k::int + assumes "even k" + shows "cos (k * pi) = 1" +proof (cases "k \ 0") + case True + hence "even (nat k)" + using \even k\ + by (simp add: even_nat_iff) + thus ?thesis + using \k \ 0\ cos_npi[of "nat k"] + by auto +next + case False + hence "-k \ 0" "even (nat (-k))" + using \even k\ + by (auto simp add: even_nat_iff) + thus ?thesis + using cos_npi[of "nat (-k)"] + by auto +qed + +lemma sin_pi2_plus_odd_kpi [simp]: + fixes k::int + assumes "odd k" + shows "sin (pi / 2 + k * pi) = -1" + using assms + by (simp add: sin_add) + +lemma sin_pi2_plus_even_kpi [simp]: + fixes k::int + assumes "even k" + shows "sin (pi / 2 + k * pi) = 1" + using assms + by (simp add: sin_add) + +text \Solving trigonometric equations and systems with special values (0, 1, or -1) of sine and cosine functions\ + +lemma cos_0_iff_canon: + assumes "cos \ = 0" and "-pi < \" and "\ \ pi" + shows "\ = pi/2 \ \ = -pi/2" +proof- + obtain k::int where "odd k" "\ = k * pi/2" + using cos_zero_iff_int[of \] assms(1) + by auto + thus ?thesis + proof (cases "k > 1 \ k < -1") + case True + hence "k \ 3 \ k \ -3" + using \odd k\ + by (smt dvd_refl even_minus) + hence "\ \ 3*pi/2 \ \ \ -3*pi/2" + using mult_right_mono[of k "-3" "pi / 2"] + using \\ = k * pi/2\ + by auto + thus ?thesis + using \- pi < \\ \\ \ pi\ + by auto + next + case False + hence "k = -1 \ k = 0 \ k = 1" + by auto + hence "k = -1 \ k = 1" + using \odd k\ + by auto + thus ?thesis + using \\ = k * pi/2\ + by auto + qed +qed + +lemma sin_0_iff_canon: + assumes "sin \ = 0" and "-pi < \" and "\ \ pi" + shows "\ = 0 \ \ = pi" +proof- + obtain k::int where "even k" "\ = k * pi/2" + using sin_zero_iff_int[of \] assms(1) + by auto + thus ?thesis + proof (cases "k > 2 \ k < 0") + case True + hence "k \ 4 \ k \ -2" + using \even k\ + by (smt evenE) + hence "\ \ 2*pi \ \ \ -pi" + proof + assume "4 \ k" + hence "4 * pi/2 \ \" + using mult_right_mono[of "4" "k" "pi/2"] + by (subst \\ = k * pi/2\) auto + thus ?thesis + by simp + next + assume "k \ -2" + hence "-2*pi/2 \ \" + using mult_right_mono[of "k" "-2" "pi/2"] + by (subst \\ = k * pi/2\, auto) + thus ?thesis + by simp + qed + thus ?thesis + using \- pi < \\ \\ \ pi\ + by auto + next + case False + hence "k = 0 \ k = 1 \ k = 2" + by auto + hence "k = 0 \ k = 2" + using \even k\ + by auto + thus ?thesis + using \\ = k * pi/2\ + by auto + qed +qed + +lemma cos0_sin1: + assumes "cos \ = 0" and "sin \ = 1" + shows "\ k::int. \ = pi/2 + 2*k*pi" +proof- + from \cos \ = 0\ + obtain k::int where "odd k" "\ = k * (pi / 2)" + using cos_zero_iff_int[of "\"] + by auto + then obtain k'::int where "k = 2*k' + 1" + using oddE by blast + hence "\ = pi/2 + (k' * pi)" + using \\ = k * (pi / 2)\ + by (auto simp add: field_simps) + hence "even k'" + using \sin \ = 1\ sin_pi2_plus_odd_kpi[of k'] + by auto + thus ?thesis + using \\ = pi /2 + (k' * pi)\ + unfolding even_iff_mod_2_eq_zero + by auto +qed + +lemma cos1_sin0: + assumes "cos \ = 1" and "sin \ = 0" + shows "\ k::int. \ = 2*k*pi" +proof- + from \sin \ = 0\ + obtain k::int where "even k" "\ = k * (pi / 2)" + using sin_zero_iff_int[of "\"] + by auto + then obtain k'::int where "k = 2*k'" + using evenE by blast + hence "\ = k' * pi" + using \\ = k * (pi / 2)\ + by (auto simp add: field_simps) + hence "even k'" + using \cos \ = 1\ cos_odd_kpi[of k'] + by auto + thus ?thesis + using \\ = k' * pi\ + using assms(1) cos_one_2pi_int by auto +qed + +(* TODO: add lemmas for cos = -1, sin = 0 and cos = 0, sin = -1 *) + + +text \Sine is injective on $[-\frac{\pi}{2}, \frac{\pi}{2}]$\ + +lemma sin_inj: + assumes "-pi/2 \ \ \ \ \ pi/2" and "-pi/2 \ \' \ \' \ pi/2" + assumes "\ \ \'" + shows "sin \ \ sin \'" + using assms + using sin_monotone_2pi[of \ \'] sin_monotone_2pi[of \' \] + by (cases "\ < \'") auto + +text \Periodicity of trigonometric functions\ + +text \The following are available in HOL-Decision\_Procs.Approximation\_Bounds, but we want to avoid +that dependency\ + +lemma sin_periodic_nat [simp]: + fixes n :: nat + shows "sin (x + n * (2 * pi)) = sin x" +proof (induct n arbitrary: x) + case (Suc n) + have split_pi_off: "x + (Suc n) * (2 * pi) = (x + n * (2 * pi)) + 2 * pi" + unfolding Suc_eq_plus1 distrib_right + by (auto simp add: field_simps) + show ?case unfolding split_pi_off using Suc by auto +qed auto + +lemma sin_periodic_int [simp]: + fixes i :: int + shows "sin (x + i * (2 * pi)) = sin x" +proof(cases "0 \ i") + case True + thus ?thesis + using sin_periodic_nat[of x "nat i"] + by auto +next + case False hence i_nat: "i = - real (nat (-i))" by auto + have "sin x = sin (x + i * (2 * pi) - i * (2 * pi))" by auto + also have "\ = sin (x + i * (2 * pi))" + unfolding i_nat mult_minus_left diff_minus_eq_add by (rule sin_periodic_nat) + finally show ?thesis by auto +qed + +lemma cos_periodic_nat [simp]: + fixes n :: nat + shows "cos (x + n * (2 * pi)) = cos x" +proof (induct n arbitrary: x) + case (Suc n) + have split_pi_off: "x + (Suc n) * (2 * pi) = (x + n * (2 * pi)) + 2 * pi" + unfolding Suc_eq_plus1 distrib_right + by (auto simp add: field_simps) + show ?case unfolding split_pi_off using Suc by auto +qed auto + +lemma cos_periodic_int [simp]: + fixes i :: int + shows "cos (x + i * (2 * pi)) = cos x" +proof(cases "0 \ i") + case True + thus ?thesis + using cos_periodic_nat[of x "nat i"] + by auto +next + case False hence i_nat: "i = - real (nat (-i))" by auto + have "cos x = cos (x + i * (2 * pi) - i * (2 * pi))" by auto + also have "\ = cos (x + i * (2 * pi))" + unfolding i_nat mult_minus_left diff_minus_eq_add by (rule cos_periodic_nat) + finally show ?thesis by auto +qed + +text \Values of both sine and cosine are repeated only after multiples of $2\cdot \pi$\ + +lemma sin_cos_eq: + fixes a b :: real + assumes "cos a = cos b" and "sin a = sin b" + shows "\ k::int. a - b = 2*k*pi" +proof- + from assms have "sin (a - b) = 0" "cos (a - b) = 1" + using sin_diff[of a b] cos_diff[of a b] + by auto + thus ?thesis + using cos1_sin0 + by auto +qed + +text \The following two lemmas are consequences of surjectivity of cosine for the range $[-1, 1]$.\ + +lemma ex_cos_eq: + assumes "-pi/2 \ \ \ \ \ pi/2" + assumes "a \ 0" and "a < 1" + shows "\ \'. -pi/2 \ \' \ \' \ pi/2 \ \' \ \ \ cos (\ - \') = a" +proof- + have "arccos a > 0" "arccos a \ pi/2" + using \a \ 0\ \a < 1\ + using arccos_lt_bounded arccos_le_pi2 + by auto + + show ?thesis + proof (cases "\ - arccos a \ - pi/2") + case True + thus ?thesis + using assms \arccos a > 0\ \arccos a \ pi/2\ + by (rule_tac x = "\ - arccos a" in exI) auto + next + case False + thus ?thesis + using assms \arccos a > 0\ \arccos a \ pi/2\ + by (rule_tac x = "\ + arccos a" in exI) auto + qed +qed + +lemma ex_cos_gt: + assumes "-pi/2 \ \ \ \ \ pi/2" + assumes "a < 1" + shows "\ \'. -pi/2 \ \' \ \' \ pi/2 \ \' \ \ \ cos (\ - \') > a" +proof- + have "\ a'. a' \ 0 \ a' > a \ a' < 1" + using \a < 1\ + using divide_strict_right_mono[of "2*a + (1 - a)" 2 2] + by (rule_tac x="if a < 0 then 0 else a + (1-a)/2" in exI) (auto simp add: field_simps) + then obtain a' where "a' \ 0" "a' > a" "a' < 1" + by auto + thus ?thesis + using ex_cos_eq[of \ a'] assms + by auto +qed + +text \The function @{term atan2} is a generalization of @{term arctan} that takes a pair of coordinates +of non-zero points returns its angle in the range $[-\pi, \pi)$.\ + +definition atan2 where + "atan2 y x = + (if x > 0 then arctan (y/x) + else if x < 0 then + if y > 0 then arctan (y/x) + pi else arctan (y/x) - pi + else + if y > 0 then pi/2 else if y < 0 then -pi/2 else 0)" + +lemma atan2_bounded: + shows "-pi \ atan2 y x \ atan2 y x < pi" + using arctan_bounded[of "y/x"] zero_le_arctan_iff[of "y/x"] arctan_le_zero_iff[of "y/x"] zero_less_arctan_iff[of "y/x"] arctan_less_zero_iff[of "y/x"] + using divide_neg_neg[of y x] divide_neg_pos[of y x] divide_pos_pos[of y x] divide_pos_neg[of y x] + unfolding atan2_def + by (simp (no_asm_simp)) auto + +end diff --git a/thys/Complex_Geometry/Oriented_Circlines.thy b/thys/Complex_Geometry/Oriented_Circlines.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Oriented_Circlines.thy @@ -0,0 +1,1373 @@ +(* -------------------------------------------------------------------------- *) +section \Oriented circlines\ +(* -------------------------------------------------------------------------- *) +theory Oriented_Circlines +imports Circlines +begin + +(* ----------------------------------------------------------------- *) +subsection \Oriented circlines definition\ +(* ----------------------------------------------------------------- *) + +text \In this section we describe how the orientation is introduced for the circlines. Similarly as +the set of circline points, the set of disc points is introduced using the quadratic form induced by +the circline matrix --- the set of points of the circline disc is the set of points such that +satisfy that $A\cdot z\cdot \overline{z} + B\cdot \overline{z} + C\cdot z + D < 0$, where +$(A, B, C, D)$ is a circline matrix representative Hermitean matrix. As the +set of disc points must be invariant to the choice of representative, it is clear that oriented +circlines matrices are equivalent only if they are proportional by a positive real factor (recall +that unoriented circline allowed arbitrary non-zero real factors).\ + +definition ocircline_eq_cmat :: "complex_mat \ complex_mat \ bool" where + [simp]: "ocircline_eq_cmat A B \(\ k::real. k > 0 \ B = cor k *\<^sub>s\<^sub>m A)" +lift_definition ocircline_eq_clmat :: "circline_mat \ circline_mat \ bool" is ocircline_eq_cmat + done + +lemma ocircline_eq_cmat_id [simp]: + shows "ocircline_eq_cmat H H" + by (simp, rule_tac x=1 in exI, simp) + +quotient_type ocircline = circline_mat / ocircline_eq_clmat +proof (rule equivpI) + show "reflp ocircline_eq_clmat" + unfolding reflp_def + by transfer (auto, rule_tac x="1" in exI, simp) +next + show "symp ocircline_eq_clmat" + unfolding symp_def + by transfer (simp only: ocircline_eq_cmat_def, safe, rule_tac x="1/k" in exI, simp) +next + show "transp ocircline_eq_clmat" + unfolding transp_def + by transfer (simp only: ocircline_eq_cmat_def, safe, rule_tac x="k*ka" in exI, simp) +qed + +(* ----------------------------------------------------------------- *) +subsection \Points on oriented circlines\ +(* ----------------------------------------------------------------- *) + +text \Boundary of the circline.\ + +lift_definition on_ocircline :: "ocircline \ complex_homo \ bool" is on_circline_clmat_hcoords + by transfer (simp del: quad_form_def, (erule exE)+, simp add: quad_form_scale_m quad_form_scale_v del: quad_form_def) + +definition ocircline_set :: "ocircline \ complex_homo set" where + "ocircline_set H = {z. on_ocircline H z}" + +lemma ocircline_set_I [simp]: + assumes "on_ocircline H z" + shows "z \ ocircline_set H" + using assms + unfolding ocircline_set_def + by simp + +(* ----------------------------------------------------------------- *) +subsection \Disc and disc complement - in and out points\ +(* ----------------------------------------------------------------- *) + +text \Interior and the exterior of an oriented circline.\ + +definition in_ocircline_cmat_cvec :: "complex_mat \ complex_vec \ bool" where + [simp]: "in_ocircline_cmat_cvec H z \ Re (quad_form z H) < 0" +lift_definition in_ocircline_clmat_hcoords :: "circline_mat \ complex_homo_coords \ bool" is in_ocircline_cmat_cvec + done +lift_definition in_ocircline :: "ocircline \ complex_homo \ bool" is in_ocircline_clmat_hcoords +proof transfer + fix H H' z z' + assume hh: "hermitean H \ H \ mat_zero" and "hermitean H' \ H' \ mat_zero" and + "z \ vec_zero" and "z' \ vec_zero" + assume "ocircline_eq_cmat H H'" and "z \\<^sub>v z'" + then obtain k k' where + *: "0 < k" "H' = cor k *\<^sub>s\<^sub>m H" "k' \ 0" "z' = k' *\<^sub>s\<^sub>v z" + by auto + hence "quad_form z' H' = cor k * cor ((cmod k')\<^sup>2) * quad_form z H" + by (simp add: quad_form_scale_v quad_form_scale_m del: vec_cnj_sv quad_form_def) + hence "Re (quad_form z' H') = k * (cmod k')\<^sup>2 * Re (quad_form z H)" + using hh quad_form_hermitean_real[of H] + by (simp add: power2_eq_square) + thus "in_ocircline_cmat_cvec H z = in_ocircline_cmat_cvec H' z'" + using \k > 0\ \k' \ 0\ + using mult_less_0_iff + by fastforce +qed + +definition disc :: "ocircline \ complex_homo set" where + "disc H = {z. in_ocircline H z}" + +lemma disc_I [simp]: + assumes "in_ocircline H z" + shows "z \ disc H" + using assms + unfolding disc_def + by simp + +definition out_ocircline_cmat_cvec :: "complex_mat \ complex_vec \ bool" where + [simp]: "out_ocircline_cmat_cvec H z \ Re (quad_form z H) > 0" +lift_definition out_ocircline_clmat_hcoords :: "circline_mat \ complex_homo_coords \ bool" is out_ocircline_cmat_cvec + done +lift_definition out_ocircline :: "ocircline \ complex_homo \ bool" is out_ocircline_clmat_hcoords +proof transfer + fix H H' z z' + assume hh: "hermitean H \ H \ mat_zero" "hermitean H' \ H' \ mat_zero" + "z \ vec_zero" "z' \ vec_zero" + assume "ocircline_eq_cmat H H'" "z \\<^sub>v z'" + then obtain k k' where + *: "0 < k" "H' = cor k *\<^sub>s\<^sub>m H" "k' \ 0" "z' = k' *\<^sub>s\<^sub>v z" + by auto + hence "quad_form z' H' = cor k * cor ((cmod k')\<^sup>2) * quad_form z H" + by (simp add: quad_form_scale_v quad_form_scale_m del: vec_cnj_sv quad_form_def) + hence "Re (quad_form z' H') = k * (cmod k')\<^sup>2 * Re (quad_form z H)" + using hh quad_form_hermitean_real[of H] + by (simp add: power2_eq_square) + thus "out_ocircline_cmat_cvec H z = out_ocircline_cmat_cvec H' z'" + using \k > 0\ \k' \ 0\ + using zero_less_mult_pos + by fastforce +qed + +definition disc_compl :: "ocircline \ complex_homo set" where + "disc_compl H = {z. out_ocircline H z}" + +text \These three sets are mutually disjoint and they fill up the entire plane.\ + +lemma disc_compl_I [simp]: + assumes "out_ocircline H z" + shows "z \ disc_compl H" + using assms + unfolding disc_compl_def + by simp + +lemma in_on_out: + shows "in_ocircline H z \ on_ocircline H z \ out_ocircline H z" + apply (transfer, transfer) + using quad_form_hermitean_real + using complex_eq_if_Re_eq + by auto + +lemma in_on_out_univ: + shows "disc H \ disc_compl H \ ocircline_set H = UNIV" + unfolding disc_def disc_compl_def ocircline_set_def + using in_on_out[of H] + by auto + +lemma disc_inter_disc_compl [simp]: + shows "disc H \ disc_compl H = {}" + unfolding disc_def disc_compl_def + by auto (transfer, transfer, simp) + +lemma disc_inter_ocircline_set [simp]: + shows "disc H \ ocircline_set H = {}" + unfolding disc_def ocircline_set_def + by auto (transfer, transfer, simp) + +lemma disc_compl_inter_ocircline_set [simp]: + shows "disc_compl H \ ocircline_set H = {}" + unfolding disc_compl_def ocircline_set_def + by auto (transfer, transfer, simp) + +(* ----------------------------------------------------------------- *) +subsection \Opposite orientation\ +(* ----------------------------------------------------------------- *) + +text \Finding opposite circline is idempotent, and opposite circlines share the same set of points, +but exchange disc and its complement.\ + +definition opposite_ocircline_cmat :: "complex_mat \ complex_mat" where + [simp]: "opposite_ocircline_cmat H = (-1) *\<^sub>s\<^sub>m H" +lift_definition opposite_ocircline_clmat :: "circline_mat \ circline_mat" is opposite_ocircline_cmat + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def) +lift_definition opposite_ocircline :: "ocircline \ ocircline" is opposite_ocircline_clmat + by transfer auto + +lemma opposite_ocircline_involution [simp]: + shows "opposite_ocircline (opposite_ocircline H) = H" + by (transfer, transfer) (auto, rule_tac x="1" in exI, simp) + +lemma on_circline_opposite_ocircline_cmat [simp]: + assumes "hermitean H \ H \ mat_zero" and "z \ vec_zero" + shows "on_circline_cmat_cvec (opposite_ocircline_cmat H) z = on_circline_cmat_cvec H z" + using assms + by (simp add: quad_form_scale_m del: quad_form_def) + +lemma on_circline_opposite_ocircline [simp]: + shows "on_ocircline (opposite_ocircline H) z \ on_ocircline H z" + using on_circline_opposite_ocircline_cmat + by (transfer, transfer, simp) + +lemma ocircline_set_opposite_ocircline [simp]: + shows "ocircline_set (opposite_ocircline H) = ocircline_set H" + unfolding ocircline_set_def + by auto + +lemma disc_compl_opposite_ocircline [simp]: + shows "disc_compl (opposite_ocircline H) = disc H" + unfolding disc_def disc_compl_def + apply auto + apply (transfer, transfer) + apply (auto simp add: quad_form_scale_m simp del: quad_form_def) + apply (transfer ,transfer) + apply (auto simp add: quad_form_scale_m simp del: quad_form_def) + done + +lemma disc_opposite_ocircline [simp]: + shows "disc (opposite_ocircline H) = disc_compl H" + using disc_compl_opposite_ocircline[of "opposite_ocircline H"] + by simp + +(* ----------------------------------------------------------------- *) +subsection \Positive orientation. Conversion between unoriented and oriented circlines\ +(* ----------------------------------------------------------------- *) + +text \Given an oriented circline, one can trivially obtain its unoriented counterpart, and these two +share the same set of points.\ + +lift_definition of_ocircline :: "ocircline \ circline" is "id::circline_mat \ circline_mat" + by transfer (simp, erule exE, force) + +lemma of_ocircline_opposite_ocircline [simp]: + shows "of_ocircline (opposite_ocircline H) = of_ocircline H" + by (transfer, transfer) (simp, erule exE, rule_tac x="-1" in exI, simp) + +lemma on_ocircline_of_circline [simp]: + shows "on_circline (of_ocircline H) z \ on_ocircline H z" + by (transfer, transfer, simp) + +lemma circline_set_of_ocircline [simp]: + shows "circline_set (of_ocircline H) = ocircline_set H" + unfolding ocircline_set_def circline_set_def + by (safe) (transfer, simp)+ + +lemma inj_of_ocircline: + assumes "of_ocircline H = of_ocircline H'" + shows "H = H' \ H = opposite_ocircline H'" + using assms + by (transfer, transfer) (simp, metis linorder_neqE_linordered_idom minus_of_real_eq_of_real_iff mult_minus1 mult_sm_distribution neg_0_equal_iff_equal neg_less_0_iff_less) + +lemma inj_ocircline_set: + assumes "ocircline_set H = ocircline_set H'" and "ocircline_set H \ {}" + shows "H = H' \ H = opposite_ocircline H'" +proof- + from assms + have "circline_set (of_ocircline H) = circline_set (of_ocircline H')" + "circline_set (of_ocircline H') \ {}" + by auto + hence "of_ocircline H = of_ocircline H'" + by (simp add: inj_circline_set) + thus ?thesis + by (rule inj_of_ocircline) +qed + +text \Positive orientation.\ + +text \Given a representative Hermitean matrix of a circline, it represents exactly one of the two +possible oriented circlines. The choice of what should be called a positive orientation is +arbitrary. We follow Schwerdtfeger \cite{schwerdtfeger}, use the leading coefficient $A$ as the +first criterion, and say that circline matrices with $A > 0$ are called positively oriented, and +with $A < 0$ negatively oriented. However, Schwerdtfeger did not discuss the possible case of $A = +0$ (the case of lines), so we had to extend his definition to achieve a total characterization.\ + +definition pos_oriented_cmat :: "complex_mat \ bool" where + [simp]: "pos_oriented_cmat H \ + (let (A, B, C, D) = H + in (Re A > 0 \ (Re A = 0 \ ((B \ 0 \ arg B > 0) \ (B = 0 \ Re D > 0)))))" +lift_definition pos_oriented_clmat :: "circline_mat \ bool" is pos_oriented_cmat + done + +lift_definition pos_oriented :: "ocircline \ bool" is pos_oriented_clmat + by transfer + (case_tac circline_mat1, case_tac circline_mat2, simp, erule exE, simp, + metis mult_pos_pos zero_less_mult_pos) + +lemma pos_oriented: + shows "pos_oriented H \ pos_oriented (opposite_ocircline H)" +proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases H) auto + moreover + hence "Re A = 0 \ Re D = 0 \ B \ 0" + using hh hermitean_elems[of A B C D] + by (cases A, cases D) (auto simp add: Complex_eq) + moreover + have "B \ 0 \ \ 0 < arg B \ 0 < arg (- B)" + using canon_ang_plus_pi2[of "arg B"] arg_bounded[of B] + by (auto simp add: arg_uminus) + ultimately + show "pos_oriented_cmat H \ pos_oriented_cmat (opposite_ocircline_cmat H)" + by auto +qed + +lemma pos_oriented_opposite_ocircline_cmat [simp]: + assumes "hermitean H \ H \ mat_zero" + shows "pos_oriented_cmat (opposite_ocircline_cmat H) \ \ pos_oriented_cmat H" +proof- + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases H) auto + moreover + hence "Re A = 0 \ Re D = 0 \ B \ 0" + using assms hermitean_elems[of A B C D] + by (cases A, cases D) (auto simp add: Complex_eq) + moreover + have "B \ 0 \ \ 0 < arg B \ 0 < arg (- B)" + using canon_ang_plus_pi2[of "arg B"] arg_bounded[of B] + by (auto simp add: arg_uminus) + moreover + have "B \ 0 \ 0 < arg B \ \ 0 < arg (- B)" + using canon_ang_plus_pi1[of "arg B"] arg_bounded[of B] + by (auto simp add: arg_uminus) + ultimately + show "pos_oriented_cmat (opposite_ocircline_cmat H) = (\ pos_oriented_cmat H)" + by simp (metis not_less_iff_gr_or_eq) +qed + +lemma pos_oriented_opposite_ocircline [simp]: + shows "pos_oriented (opposite_ocircline H) \ \ pos_oriented H" + using pos_oriented_opposite_ocircline_cmat + by (transfer, transfer, simp) + +lemma pos_oriented_circle_inf: + assumes "\\<^sub>h \ ocircline_set H" + shows "pos_oriented H \ \\<^sub>h \ disc H" + using assms + unfolding ocircline_set_def disc_def + apply simp +proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases H) auto + hence "is_real A" + using hh hermitean_elems + by auto + assume "\ on_circline_cmat_cvec H \\<^sub>v" + thus "pos_oriented_cmat H = (\ in_ocircline_cmat_cvec H \\<^sub>v)" + using HH \is_real A\ + by (cases A) (auto simp add: vec_cnj_def Complex_eq) +qed + +lemma pos_oriented_euclidean_circle: + assumes "is_circle (of_ocircline H)" + "(a, r) = euclidean_circle (of_ocircline H)" + "circline_type (of_ocircline H) < 0" + shows "pos_oriented H \ of_complex a \ disc H" + using assms + unfolding disc_def + apply simp +proof (transfer, transfer) + fix H a r + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases H) auto + hence "is_real A" "is_real D" "C = cnj B" + using hh hermitean_elems + by auto + + assume *: "\ circline_A0_cmat (id H)" "(a, r) = euclidean_circle_cmat (id H)" "circline_type_cmat (id H) < 0" + hence "A \ 0" "Re A \ 0" + using HH \is_real A\ + by (case_tac[!] A) (auto simp add: Complex_eq) + + have "Re (A*D - B*C) < 0" + using \circline_type_cmat (id H) < 0\ HH + by simp + + have **: "(A * (D * cnj A) - B * (C * cnj A)) / (A * cnj A) = (A*D - B*C) / A" + using \A \ 0\ + by (simp add: field_simps) + hence ***: "0 < Re A \ Re ((A * (D * cnj A) - B * (C * cnj A)) / (A * cnj A)) < 0" + using \is_real A\ \A \ 0\ \Re (A*D - B*C) < 0\ + by (simp add: Re_divide_real divide_less_0_iff) + + have "Re D - Re (cnj B * B / cnj A) < Re ((C - cnj B * A / cnj A) * B / A)" if "Re A > 0" + using HH * \is_real A\ that + by simp (smt "**" "***" cnj.simps(1) cnj.simps(2) complex_eq diff_divide_distrib left_diff_distrib' + minus_complex.simps(1) mult.commute nonzero_mult_div_cancel_right)? + moreover have "Re A > 0" if "Re D - Re (cnj B * B / cnj A) < Re ((C - cnj B * A / cnj A) * B / A)" + using HH * \is_real A\ that + by simp (smt "**" "***" cnj.simps(1) cnj.simps(2) complex_eq diff_divide_distrib left_diff_distrib' + minus_complex.simps(1) mult.commute nonzero_mult_div_cancel_right)? + ultimately show "pos_oriented_cmat H = in_ocircline_cmat_cvec H (of_complex_cvec a)" + using HH \Re A \ 0\ * \is_real A\ by (auto simp add: vec_cnj_def) +qed + +text \Introduce positive orientation\ + +definition of_circline_cmat :: "complex_mat \ complex_mat" where + [simp]: "of_circline_cmat H = (if pos_oriented_cmat H then H else opposite_ocircline_cmat H)" + +lift_definition of_circline_clmat :: "circline_mat \ circline_mat" is of_circline_cmat + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def) + +lemma of_circline_clmat_def': + shows "of_circline_clmat H = (if pos_oriented_clmat H then H else opposite_ocircline_clmat H)" + by transfer simp + +lemma pos_oriented_cmat_mult_positive': + assumes + "hermitean H1 \ H1 \ mat_zero" and + "hermitean H2 \ H2 \ mat_zero" and + "\k. k > 0 \ H2 = cor k *\<^sub>s\<^sub>m H1" and + "pos_oriented_cmat H1" + shows "pos_oriented_cmat H2" +proof- + obtain A1 B1 C1 D1 A2 B2 C2 D2 + where HH: "H1 = (A1, B1, C1, D1)" "H2 = (A2, B2, C2, D2)" + by (cases H1, cases H2) + thus ?thesis + using assms + by fastforce +qed + +lemma pos_oriented_cmat_mult_positive: + assumes + "hermitean H1 \ H1 \ mat_zero" and + "hermitean H2 \ H2 \ mat_zero" and + "\k. k > 0 \ H2 = cor k *\<^sub>s\<^sub>m H1" + shows + "pos_oriented_cmat H1 \ pos_oriented_cmat H2" +proof- + from assms(3) obtain k where "k > 0 \ H2 = cor k *\<^sub>s\<^sub>m H1" + by auto + hence "\k. k > 0 \ H1 = cor k *\<^sub>s\<^sub>m H2" + by (rule_tac x="1/k" in exI, auto) + thus ?thesis + using assms pos_oriented_cmat_mult_positive' + by blast +qed + + +lemma pos_oriented_cmat_mult_negative: + assumes + "hermitean H1 \ H1 \ mat_zero" and + "hermitean H2 \ H2 \ mat_zero" and + "\k. k < 0 \ H2 = cor k *\<^sub>s\<^sub>m H1" + shows + "pos_oriented_cmat H1 \ \ pos_oriented_cmat H2" + using assms +proof- + obtain A B C D A1 B1 C1 D1 + where *: "H1 = (A, B, C, D)" "H2 = (A1, B1, C1, D1)" + by (cases H1, cases H2) auto + hence **: "is_real A" "is_real D" "is_real A1" "is_real D1" "B = 0 \ C = 0" "B1 = 0 \ C1 = 0" + using assms hermitean_elems[of A B C D] hermitean_elems[of A1 B1 C1 D1] + by auto + show ?thesis + proof (rule iffI) + assume H1: "pos_oriented_cmat H1" + show "\ pos_oriented_cmat H2" + proof (cases "Re A > 0") + case True + thus ?thesis + using assms * ** mult_neg_pos + by fastforce + next + case False + show ?thesis + proof (cases "B = 0") + case True + thus ?thesis + using assms * ** H1 `\ Re A > 0` mult_neg_pos + by fastforce + next + case False + thus ?thesis + using arg_uminus_opposite_sign[of B] arg_mult_real_negative + using assms * ** H1 `\ Re A > 0` mult_neg_pos + by fastforce + qed + qed + next + assume H2: "\ pos_oriented_cmat H2" + show "pos_oriented_cmat H1" + proof (cases "Re A > 0") + case True + thus ?thesis + using * ** mult_neg_pos + by fastforce + next + case False + show ?thesis + proof (cases "B = 0") + case True + thus ?thesis + using assms * ** H2 `\ Re A > 0` + by simp (smt arg_0_iff arg_complex_of_real_negative arg_complex_of_real_positive arg_mult_eq complex_of_real_Re mult.right_neutral mult_eq_0_iff of_real_0 of_real_1 zero_complex.simps(1)) + next + case False + thus ?thesis + using assms `\ Re A > 0` H2 * ** + using arg_uminus_opposite_sign[of B] + by (cases "Re A = 0", auto simp add: mult_neg_neg) + qed + qed + qed +qed + +lift_definition of_circline :: "circline \ ocircline" is of_circline_clmat +proof transfer + fix H1 H2 + assume hh: + "hermitean H1 \ H1 \ mat_zero" + "hermitean H2 \ H2 \ mat_zero" + assume "circline_eq_cmat H1 H2" + then obtain k where *: "k \ 0 \ H2 = cor k *\<^sub>s\<^sub>m H1" + by auto + show "ocircline_eq_cmat (of_circline_cmat H1) (of_circline_cmat H2)" + proof (cases "k > 0") + case True + hence "pos_oriented_cmat H1 = pos_oriented_cmat H2" + using * pos_oriented_cmat_mult_positive[OF hh] + by blast + thus ?thesis + using hh * \k > 0\ + apply (simp del: pos_oriented_cmat_def) + apply (rule conjI) + apply (rule impI) + apply (simp, rule_tac x=k in exI, simp) + apply (rule impI) + apply (simp, rule_tac x=k in exI, simp) + done + next + case False + hence "k < 0" + using * + by simp + hence "pos_oriented_cmat H1 \ \ (pos_oriented_cmat H2)" + using * pos_oriented_cmat_mult_negative[OF hh] + by blast + thus ?thesis + using hh * \k < 0\ + apply (simp del: pos_oriented_cmat_def) + apply (rule conjI) + apply (rule impI) + apply (simp, rule_tac x="-k" in exI, simp) + apply (rule impI) + apply (simp, rule_tac x="-k" in exI, simp) + done + qed +qed + +lemma pos_oriented_of_circline [simp]: + shows "pos_oriented (of_circline H)" + using pos_oriented_opposite_ocircline_cmat + by (transfer, transfer, simp) + +lemma of_ocircline_of_circline [simp]: + shows "of_ocircline (of_circline H) = H" + apply (transfer, auto simp add: of_circline_clmat_def') + apply (transfer, simp, rule_tac x="-1" in exI, simp) + done + +lemma of_circline_of_ocircline_pos_oriented [simp]: + assumes "pos_oriented H" + shows "of_circline (of_ocircline H) = H" + using assms + by (transfer, transfer, simp, rule_tac x=1 in exI, simp) + +lemma inj_of_circline: + assumes "of_circline H = of_circline H'" + shows "H = H'" + using assms +proof (transfer, transfer) + fix H H' + assume "ocircline_eq_cmat (of_circline_cmat H) (of_circline_cmat H')" + then obtain k where "k > 0" "of_circline_cmat H' = cor k *\<^sub>s\<^sub>m of_circline_cmat H" + by auto + thus "circline_eq_cmat H H'" + using mult_sm_inv_l[of "-1" "H'" "cor k *\<^sub>s\<^sub>m H"] + using mult_sm_inv_l[of "-1" "H'" "(- (cor k)) *\<^sub>s\<^sub>m H"] + apply (simp split: if_split_asm) + apply (rule_tac x="k" in exI, simp) + apply (rule_tac x="-k" in exI, simp) + apply (rule_tac x="-k" in exI, simp) + apply (rule_tac x="k" in exI, simp) + done +qed + +lemma of_circline_of_ocircline: + shows "of_circline (of_ocircline H') = H' \ + of_circline (of_ocircline H') = opposite_ocircline H'" +proof (cases "pos_oriented H'") + case True + thus ?thesis + by auto +next + case False + hence "pos_oriented (opposite_ocircline H')" + using pos_oriented + by auto + thus ?thesis + using of_ocircline_opposite_ocircline[of H'] + using of_circline_of_ocircline_pos_oriented [of "opposite_ocircline H'"] + by auto +qed + +(* -------------------------------------------------------------------------- *) +subsubsection \Set of points on oriented and unoriented circlines\ +(* -------------------------------------------------------------------------- *) + +lemma ocircline_set_of_circline [simp]: + shows "ocircline_set (of_circline H) = circline_set H" + unfolding ocircline_set_def circline_set_def +proof (safe) + fix z + assume "on_ocircline (of_circline H) z" + thus "on_circline H z" + by (transfer, transfer, simp del: on_circline_cmat_cvec_def opposite_ocircline_cmat_def split: if_split_asm) +next + fix z + assume "on_circline H z" + thus "on_ocircline (of_circline H) z" + by (transfer, transfer, simp del: on_circline_cmat_cvec_def opposite_ocircline_cmat_def split: if_split_asm) +qed + +(* ----------------------------------------------------------------- *) +subsection \Some special oriented circlines and discs\ +(* ----------------------------------------------------------------- *) + +lift_definition mk_ocircline :: "complex \ complex \ complex \ complex \ ocircline" is mk_circline_clmat + done + +text \oriented unit circle and unit disc\ + +lift_definition ounit_circle :: "ocircline" is unit_circle_clmat + done + +lemma pos_oriented_ounit_circle [simp]: + shows "pos_oriented ounit_circle" + by (transfer, transfer, simp) + +lemma of_ocircline_ounit_circle [simp]: + shows "of_ocircline ounit_circle = unit_circle" + by (transfer, transfer, simp) + +lemma of_circline_unit_circle [simp]: + shows "of_circline (unit_circle) = ounit_circle" + by (transfer, transfer, simp) + +lemma ocircline_set_ounit_circle [simp]: + shows "ocircline_set ounit_circle = circline_set unit_circle" + apply (subst of_circline_unit_circle[symmetric]) + apply (subst ocircline_set_of_circline) + apply simp + done + +definition unit_disc :: "complex_homo set" where + "unit_disc = disc ounit_circle" + +definition unit_disc_compl :: "complex_homo set" where + "unit_disc_compl = disc_compl ounit_circle" + +definition unit_circle_set :: "complex_homo set" where + "unit_circle_set = circline_set unit_circle" + +lemma zero_in_unit_disc [simp]: + shows "0\<^sub>h \ unit_disc" + unfolding unit_disc_def disc_def + by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def) + +lemma one_notin_unit_dic [simp]: + shows "1\<^sub>h \ unit_disc" + unfolding unit_disc_def disc_def + by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def) + +lemma inf_notin_unit_disc [simp]: + shows "\\<^sub>h \ unit_disc" + unfolding unit_disc_def disc_def + by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def) + +lemma unit_disc_iff_cmod_lt_1 [simp]: + shows "of_complex c \ unit_disc \ cmod c < 1" + unfolding unit_disc_def disc_def + by (simp, transfer, transfer, simp add: vec_cnj_def cmod_def power2_eq_square) + +lemma unit_disc_cmod_square_lt_1 [simp]: + assumes "z \ unit_disc" + shows "(cmod (to_complex z))\<^sup>2 < 1" + using assms inf_or_of_complex[of z] + by (auto simp add: abs_square_less_1) + +lemma unit_disc_to_complex_inj: + assumes "u \ unit_disc" and "v \ unit_disc" + assumes "to_complex u = to_complex v" + shows "u = v" + using assms + using inf_or_of_complex[of u] inf_or_of_complex[of v] + by auto + +lemma inversion_unit_disc [simp]: + shows "inversion ` unit_disc = unit_disc_compl" + unfolding unit_disc_def unit_disc_compl_def disc_def disc_compl_def +proof safe + fix x + assume "in_ocircline ounit_circle x" + thus "out_ocircline ounit_circle (inversion x)" + unfolding inversion_def + by (transfer, transfer, auto simp add: vec_cnj_def) +next + fix x + assume *: "out_ocircline ounit_circle x" + show "x \ inversion ` Collect (in_ocircline ounit_circle)" + proof (rule image_eqI) + show "x = inversion (inversion x)" + by auto + next + show "inversion x \ Collect (in_ocircline ounit_circle)" + using * + unfolding inversion_def + by (simp, transfer, transfer, auto simp add: vec_cnj_def) + qed +qed + +lemma inversion_unit_disc_compl [simp]: + shows "inversion ` unit_disc_compl = unit_disc" +proof- + have "inversion ` (inversion ` unit_disc) = unit_disc" + by (auto simp del: inversion_unit_disc simp add: image_iff) + thus ?thesis + by simp +qed + +lemma inversion_noteq_unit_disc: + assumes "u \ unit_disc" and "v \ unit_disc" + shows "inversion u \ v" +proof- + from assms + have "inversion u \ unit_disc_compl" + by (metis image_eqI inversion_unit_disc) + thus ?thesis + using assms + unfolding unit_disc_def unit_disc_compl_def + using disc_inter_disc_compl + by fastforce +qed + +lemma in_ocircline_ounit_circle_conjugate [simp]: + assumes "in_ocircline ounit_circle z" + shows "in_ocircline ounit_circle (conjugate z)" + using assms + by (transfer, transfer, auto simp add: vec_cnj_def) + +lemma conjugate_unit_disc [simp]: + shows "conjugate ` unit_disc = unit_disc" + unfolding unit_disc_def disc_def + apply (auto simp add: image_iff) + apply (rule_tac x="conjugate x" in exI, simp) + done + +lemma conjugate_in_unit_disc [simp]: + assumes "z \ unit_disc" + shows "conjugate z \ unit_disc" + using conjugate_unit_disc + using assms + by blast + +lemma out_ocircline_ounit_circle_conjugate [simp]: + assumes "out_ocircline ounit_circle z" + shows "out_ocircline ounit_circle (conjugate z)" + using assms + by (transfer, transfer, auto simp add: vec_cnj_def) + +lemma conjugate_unit_disc_compl [simp]: + shows "conjugate ` unit_disc_compl = unit_disc_compl" + unfolding unit_disc_compl_def disc_compl_def + apply (auto simp add: image_iff) + apply (rule_tac x="conjugate x" in exI, simp) + done + +lemma conjugate_in_unit_disc_compl [simp]: + assumes "z \ unit_disc_compl" + shows "conjugate z \ unit_disc_compl" + using conjugate_unit_disc_compl + using assms + by blast + +(* -------------------------------------------------------------------------- *) +subsubsection \Oriented x axis and lower half plane\ +(* -------------------------------------------------------------------------- *) + +lift_definition o_x_axis :: "ocircline" is x_axis_clmat +done + +lemma o_x_axis_pos_oriented [simp]: + shows "pos_oriented o_x_axis" + by (transfer, transfer, simp) + +lemma of_ocircline_o_x_axis [simp]: + shows "of_ocircline o_x_axis = x_axis" + by (transfer, transfer, simp) + +lemma of_circline_x_axis [simp]: + shows "of_circline x_axis = o_x_axis" + using of_circline_of_ocircline_pos_oriented[of o_x_axis] + using o_x_axis_pos_oriented + by simp + +lemma ocircline_set_circline_set_x_axis [simp]: + shows "ocircline_set o_x_axis = circline_set x_axis" + by (subst of_circline_x_axis[symmetric], subst ocircline_set_of_circline, simp) + +lemma ii_in_disc_o_x_axis [simp]: + shows "ii\<^sub>h \ disc o_x_axis" + unfolding disc_def + by simp (transfer, transfer, simp add: Let_def vec_cnj_def) + +lemma ii_notin_disc_o_x_axis [simp]: + shows "ii\<^sub>h \ disc_compl o_x_axis" + unfolding disc_compl_def + by simp (transfer, transfer, simp add: Let_def vec_cnj_def) + +lemma of_complex_in_o_x_axis_disc [simp]: + shows "of_complex z \ disc o_x_axis \ Im z < 0" + unfolding disc_def + by auto (transfer, transfer, simp add: vec_cnj_def)+ + +lemma inf_notin_disc_o_x_axis [simp]: + shows "\\<^sub>h \ disc o_x_axis" + unfolding disc_def + by simp (transfer, transfer, simp add: vec_cnj_def) + +lemma disc_o_x_axis: + shows "disc o_x_axis = of_complex ` {z. Im z < 0}" +proof- + { + fix z + assume "z \ disc o_x_axis" + hence "\ x. Im x < 0 \ z = of_complex x" + using inf_or_of_complex[of z] + by auto + } + thus ?thesis + by (auto simp add: image_iff) +qed + +(* -------------------------------------------------------------------------- *) +subsubsection \Oriented single point circline\ +(* -------------------------------------------------------------------------- *) + +lift_definition o_circline_point_0 :: "ocircline" is circline_point_0_clmat +done + +lemma of_ocircline_o_circline_point_0 [simp]: + shows "of_ocircline o_circline_point_0 = circline_point_0" + by (transfer, transfer, simp) + +(* ----------------------------------------------------------------- *) +subsection \Möbius action on oriented circlines and discs\ +(* ----------------------------------------------------------------- *) + +text \Möbius action on an oriented circline is the same as on to an unoriented circline.\ + +lift_definition moebius_ocircline :: "moebius \ ocircline \ ocircline" is moebius_circline_mmat_clmat + apply (transfer, transfer) + apply simp + apply ((erule exE)+, (erule conjE)+) + apply (simp add: mat_inv_mult_sm) + apply (rule_tac x="ka / Re (k * cnj k)" in exI, auto simp add: complex_mult_cnj_cmod power2_eq_square) + done + +text \Möbius action on (unoriented) circlines could have been defined using the action on oriented +circlines, but not the other way around.\ + +lemma moebius_circline_ocircline: + shows "moebius_circline M H = of_ocircline (moebius_ocircline M (of_circline H))" + apply (transfer, simp add: of_circline_clmat_def', safe) + apply (transfer, simp, rule_tac x="-1" in exI, simp) + done + +lemma moebius_ocircline_circline: + shows "moebius_ocircline M H = of_circline (moebius_circline M (of_ocircline H)) \ + moebius_ocircline M H = opposite_ocircline (of_circline (moebius_circline M (of_ocircline H)))" + apply (transfer, simp add: of_circline_clmat_def', safe) + apply (transfer, simp, rule_tac x="1" in exI, simp) + apply (transfer, simp, erule_tac x="1" in allE, simp) + done + +text \Möbius action on oriented circlines have many nice properties as it was the case with +Möbius action on (unoriented) circlines. These transformations are injective and form group under +composition.\ + +lemma inj_moebius_ocircline [simp]: + shows "inj (moebius_ocircline M)" + unfolding inj_on_def +proof (safe) + fix H H' + assume "moebius_ocircline M H = moebius_ocircline M H'" + thus "H = H'" + proof (transfer, transfer) + fix M H H' :: complex_mat + assume "mat_det M \ 0" + let ?iM = "mat_inv M" + assume "ocircline_eq_cmat (moebius_circline_cmat_cmat M H) (moebius_circline_cmat_cmat M H')" + then obtain k where "congruence ?iM H' = congruence ?iM (cor k *\<^sub>s\<^sub>m H)" "k > 0" + by (auto simp del: congruence_def) + thus "ocircline_eq_cmat H H'" + using \mat_det M \ 0\ inj_congruence[of ?iM H' "cor k *\<^sub>s\<^sub>m H"] mat_det_inv[of M] + by auto + qed +qed + +lemma moebius_ocircline_id_moebius [simp]: + shows "moebius_ocircline id_moebius H = H" + by (transfer, transfer) (force simp add: mat_adj_def mat_cnj_def) + +lemma moebius_ocircline_comp [simp]: + shows "moebius_ocircline (moebius_comp M1 M2) H = moebius_ocircline M1 (moebius_ocircline M2 H)" + by (transfer, transfer, simp, rule_tac x=1 in exI, simp add: mat_inv_mult_mm mult_mm_assoc) + +lemma moebius_ocircline_comp_inv_left [simp]: + shows "moebius_ocircline (moebius_inv M) (moebius_ocircline M H) = H" + by (subst moebius_ocircline_comp[symmetric]) simp + +lemma moebius_ocircline_comp_inv_right [simp]: + shows "moebius_ocircline M (moebius_ocircline (moebius_inv M) H) = H" + by (subst moebius_ocircline_comp[symmetric]) simp + +lemma moebius_ocircline_opposite_ocircline [simp]: + shows "moebius_ocircline M (opposite_ocircline H) = opposite_ocircline (moebius_ocircline M H)" + by (transfer, transfer, simp, rule_tac x=1 in exI, simp) + +text \Möbius action on oriented circlines preserve the set of points of the circline.\ + +lemma ocircline_set_moebius_ocircline [simp]: + shows "ocircline_set (moebius_ocircline M H) = moebius_pt M ` ocircline_set H" (is "?lhs = ?rhs") +proof- + have "?rhs = circline_set (moebius_circline M (of_ocircline H))" + by simp + thus ?thesis + using moebius_ocircline_circline[of M H] + by auto +qed + +lemma ocircline_set_fix_iff_ocircline_fix: + assumes "ocircline_set H' \ {}" + shows "ocircline_set (moebius_ocircline M H) = ocircline_set H' \ + moebius_ocircline M H = H' \ moebius_ocircline M H = opposite_ocircline H'" + using assms + using inj_ocircline_set[of "moebius_ocircline M H" H'] + by (auto simp del: ocircline_set_moebius_ocircline) + +lemma disc_moebius_ocircline [simp]: + shows "disc (moebius_ocircline M H) = moebius_pt M ` (disc H)" +proof (safe) + fix z + assume "z \ disc H" + thus "moebius_pt M z \ disc (moebius_ocircline M H)" + unfolding disc_def + proof (safe) + assume "in_ocircline H z" + thus "in_ocircline (moebius_ocircline M H) (moebius_pt M z)" + proof (transfer, transfer) + fix H M :: complex_mat and z :: complex_vec + assume "mat_det M \ 0" + assume "in_ocircline_cmat_cvec H z" + thus "in_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)" + using \mat_det M \ 0\ quad_form_congruence[of M z] + by simp + qed + qed +next + fix z + assume "z \ disc (moebius_ocircline M H)" + thus "z \ moebius_pt M ` disc H" + unfolding disc_def + proof(safe) + assume "in_ocircline (moebius_ocircline M H) z" + show "z \ moebius_pt M ` Collect (in_ocircline H)" + proof + show "z = moebius_pt M (moebius_pt (moebius_inv M) z)" + by simp + next + show "moebius_pt (moebius_inv M) z \ Collect (in_ocircline H)" + using \in_ocircline (moebius_ocircline M H) z\ + proof (safe, transfer, transfer) + fix M H :: complex_mat and z :: complex_vec + assume "mat_det M \ 0" + hence "congruence (mat_inv (mat_inv M)) (congruence (mat_inv M) H) = H" + by (simp del: congruence_def) + hence "quad_form z (congruence (mat_inv M) H) = quad_form (mat_inv M *\<^sub>m\<^sub>v z) H" + using quad_form_congruence[of "mat_inv M" "z" "congruence (mat_inv M) H"] + using \mat_det M \ 0\ mat_det_inv[of "M"] + by simp + moreover + assume "in_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) z" + ultimately + show "in_ocircline_cmat_cvec H (moebius_pt_cmat_cvec (moebius_inv_cmat M) z)" + by simp + qed + qed + qed +qed + +lemma disc_compl_moebius_ocircline [simp]: + shows "disc_compl (moebius_ocircline M H) = moebius_pt M ` (disc_compl H)" +proof (safe) + fix z + assume "z \ disc_compl H" + thus "moebius_pt M z \ disc_compl (moebius_ocircline M H)" + unfolding disc_compl_def + proof (safe) + assume "out_ocircline H z" + thus "out_ocircline (moebius_ocircline M H) (moebius_pt M z)" + proof (transfer, transfer) + fix H M :: complex_mat and z :: complex_vec + assume "mat_det M \ 0" + assume "out_ocircline_cmat_cvec H z" + thus "out_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)" + using \mat_det M \ 0\ quad_form_congruence[of M z] + by simp + qed + qed +next + fix z + assume "z \ disc_compl (moebius_ocircline M H)" + thus "z \ moebius_pt M ` disc_compl H" + unfolding disc_compl_def + proof(safe) + assume "out_ocircline (moebius_ocircline M H) z" + show "z \ moebius_pt M ` Collect (out_ocircline H)" + proof + show "z = moebius_pt M (moebius_pt (moebius_inv M) z)" + by simp + next + show "moebius_pt (moebius_inv M) z \ Collect (out_ocircline H)" + using \out_ocircline (moebius_ocircline M H) z\ + proof (safe, transfer, transfer) + fix M H :: complex_mat and z :: complex_vec + assume "mat_det M \ 0" + hence "congruence (mat_inv (mat_inv M)) (congruence (mat_inv M) H) = H" + by (simp del: congruence_def) + hence "quad_form z (congruence (mat_inv M) H) = quad_form (mat_inv M *\<^sub>m\<^sub>v z) H" + using quad_form_congruence[of "mat_inv M" "z" "congruence (mat_inv M) H"] + using \mat_det M \ 0\ mat_det_inv[of "M"] + by simp + moreover + assume "out_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) z" + ultimately + show "out_ocircline_cmat_cvec H (moebius_pt_cmat_cvec (moebius_inv_cmat M) z)" + by simp + qed + qed + qed +qed + +(* ----------------------------------------------------------------- *) +subsection \Orientation after Möbius transformations\ +(* ----------------------------------------------------------------- *) + +text \All Euclidean similarities preserve circline orientation.\ + +lemma moebius_similarity_oriented_lines_to_oriented_lines: + assumes "a \ 0" + shows "\\<^sub>h \ ocircline_set H \ \\<^sub>h \ ocircline_set (moebius_ocircline (moebius_similarity a b) H)" + using moebius_similarity_lines_to_lines[OF \a \ 0\, of b "of_ocircline H"] + by simp + +lemma moebius_similarity_preserve_orientation': + assumes "a \ 0" and "\\<^sub>h \ ocircline_set H" and "pos_oriented H" + shows "pos_oriented (moebius_ocircline (moebius_similarity a b) H)" +proof- + let ?M = "moebius_similarity a b" + let ?H = "moebius_ocircline ?M H" + have "\\<^sub>h \ ocircline_set ?H" + using \\\<^sub>h \ ocircline_set H\ moebius_similarity_oriented_lines_to_oriented_lines[OF \a \ 0\] + by simp + + have "\\<^sub>h \ disc_compl H" + using \\\<^sub>h \ ocircline_set H\ \pos_oriented H\ pos_oriented_circle_inf[of H] in_on_out + unfolding disc_def disc_compl_def ocircline_set_def + by auto + hence "\\<^sub>h \ disc_compl ?H" + using moebius_similarity_inf[OF \a \ 0\, of b] + by force + thus "pos_oriented ?H" + using pos_oriented_circle_inf[of ?H] disc_inter_disc_compl[of ?H] \\\<^sub>h \ ocircline_set ?H\ + by auto +qed + +lemma moebius_similarity_preserve_orientation: + assumes "a \ 0" and "\\<^sub>h \ ocircline_set H" + shows "pos_oriented H \ pos_oriented(moebius_ocircline (moebius_similarity a b) H)" +proof- + let ?M = "moebius_similarity a b" + let ?H = "moebius_ocircline ?M H" + have "\\<^sub>h \ ocircline_set ?H" + using \\\<^sub>h \ ocircline_set H\ moebius_similarity_oriented_lines_to_oriented_lines[OF \a \ 0\] + by simp + + have *: "H = moebius_ocircline (- moebius_similarity a b) ?H" + by simp + show ?thesis + using \a \ 0\ + using moebius_similarity_preserve_orientation' [OF \a \ 0\ \\\<^sub>h \ ocircline_set H\] + using moebius_similarity_preserve_orientation'[OF _ \\\<^sub>h \ ocircline_set ?H\, of "1/a" "-b/a"] + using moebius_similarity_inv[of a b, OF \a \ 0\] * + by auto +qed + +lemma reciprocal_preserve_orientation: + assumes "0\<^sub>h \ disc_compl H" + shows "pos_oriented (moebius_ocircline moebius_reciprocal H)" +proof- + have "\\<^sub>h \ disc_compl (moebius_ocircline moebius_reciprocal H)" + using assms + by force + thus "pos_oriented (moebius_ocircline moebius_reciprocal H)" + using pos_oriented_circle_inf[of "moebius_ocircline moebius_reciprocal H"] + using disc_inter_disc_compl[of "moebius_ocircline moebius_reciprocal H"] + using disc_compl_inter_ocircline_set[of "moebius_ocircline moebius_reciprocal H"] + by auto +qed + + +lemma reciprocal_not_preserve_orientation: + assumes "0\<^sub>h \ disc H" + shows "\ pos_oriented (moebius_ocircline moebius_reciprocal H)" +proof- + let ?H = "moebius_ocircline moebius_reciprocal H" + have "\\<^sub>h \ disc ?H" + using assms + by force + thus "\ pos_oriented ?H" + using pos_oriented_circle_inf[of ?H] disc_inter_ocircline_set[of ?H] + by auto +qed + +text \Orientation of the image of a given oriented circline $H$ under a given Möbius transformation +$M$ depends on whether the pole of $M$ (the point that $M$ maps to $\infty_{hc}$) lies in the disc +or in the disc complement of $H$ (if it is on the set of $H$, then it maps onto a line and we do not +discuss the orientation).\ + +lemma pole_in_disc: + assumes "M = mk_moebius a b c d" and "c \ 0" and "a*d - b*c \ 0" + assumes "is_pole M z" "z \ disc H" + shows "\ pos_oriented (moebius_ocircline M H)" +proof- + let ?t1 = "moebius_translation (a / c)" + let ?rd = "moebius_rotation_dilatation ((b * c - a * d) / (c * c))" + let ?r = "moebius_reciprocal" + let ?t2 = "moebius_translation (d / c)" + + have "0\<^sub>h = moebius_pt (moebius_translation (d/c)) z" + using pole_mk_moebius[of a b c d z] assms + by simp + + have "z \ ocircline_set H" + using \z \ disc H\ disc_inter_ocircline_set[of H] + by blast + + hence "0\<^sub>h \ ocircline_set (moebius_ocircline ?t2 H)" + using \0\<^sub>h = moebius_pt ?t2 z\ + using moebius_pt_neq_I[of z _ ?t2] + by force + + hence *: "\\<^sub>h \ ocircline_set (moebius_ocircline (?r + ?t2) H)" + using \0\<^sub>h = moebius_pt (moebius_translation (d / c)) z\ + by (metis circline_set_moebius_circline circline_set_moebius_circline_iff circline_set_of_ocircline moebius_pt_comp moebius_reciprocal ocircline_set_moebius_ocircline plus_moebius_def reciprocal_zero) + + + hence **: "\\<^sub>h \ ocircline_set (moebius_ocircline (?rd + ?r + ?t2) H)" + using \a*d - b*c \ 0\ \c \ 0\ + unfolding moebius_rotation_dilatation_def + using moebius_similarity_oriented_lines_to_oriented_lines[of _ "moebius_ocircline (?r + ?t2) H"] + by (metis divide_eq_0_iff divisors_zero moebius_ocircline_comp plus_moebius_def right_minus_eq) + + have "\ pos_oriented (moebius_ocircline (?r + ?t2) H)" + using pole_mk_moebius[of a b c d z] assms + using reciprocal_not_preserve_orientation + by force + hence "\ pos_oriented (moebius_ocircline (?rd + ?r + ?t2) H)" + using * + using \a*d - b*c \ 0\ \c \ 0\ + using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?r + ?t2) H"] + unfolding moebius_rotation_dilatation_def + by simp + hence "\ pos_oriented (moebius_ocircline (?t1 + ?rd + ?r + ?t2) H)" + using ** + using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?rd + ?r + ?t2) H"] + unfolding moebius_translation_def + by simp + + thus ?thesis + using assms + by simp (subst moebius_decomposition, simp_all) +qed + +lemma pole_in_disc_compl: + assumes "M = mk_moebius a b c d" and "c \ 0" and "a*d - b*c \ 0" + assumes "is_pole M z" and "z \ disc_compl H" + shows "pos_oriented (moebius_ocircline M H)" +proof- + let ?t1 = "moebius_translation (a / c)" + let ?rd = "moebius_rotation_dilatation ((b * c - a * d) / (c * c))" + let ?r = "moebius_reciprocal" + let ?t2 = "moebius_translation (d / c)" + + have "0\<^sub>h = moebius_pt (moebius_translation (d/c)) z" + using pole_mk_moebius[of a b c d z] assms + by simp + + have "z \ ocircline_set H" + using \z \ disc_compl H\ disc_compl_inter_ocircline_set[of H] + by blast + hence "0\<^sub>h \ ocircline_set (moebius_ocircline ?t2 H)" + using \0\<^sub>h = moebius_pt ?t2 z\ + using moebius_pt_neq_I[of z _ ?t2] + by force + hence *: "\\<^sub>h \ ocircline_set (moebius_ocircline (?r + ?t2) H)" + using \0\<^sub>h = moebius_pt (moebius_translation (d / c)) z\ + by (metis circline_set_moebius_circline circline_set_moebius_circline_iff circline_set_of_ocircline moebius_pt_comp moebius_reciprocal ocircline_set_moebius_ocircline plus_moebius_def reciprocal_zero) + + hence **: "\\<^sub>h \ ocircline_set (moebius_ocircline (?rd + ?r + ?t2) H)" + using \a*d - b*c \ 0\ \c \ 0\ + unfolding moebius_rotation_dilatation_def + using moebius_similarity_oriented_lines_to_oriented_lines[of _ "moebius_ocircline (?r + ?t2) H"] + by (metis divide_eq_0_iff divisors_zero moebius_ocircline_comp plus_moebius_def right_minus_eq) + + have "pos_oriented (moebius_ocircline (?r + ?t2) H)" + using pole_mk_moebius[of a b c d z] assms + using reciprocal_preserve_orientation + by force + hence "pos_oriented (moebius_ocircline (?rd + ?r + ?t2) H)" + using * + using \a*d - b*c \ 0\ \c \ 0\ + using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?r + ?t2) H"] + unfolding moebius_rotation_dilatation_def + by simp + hence "pos_oriented (moebius_ocircline (?t1 + ?rd + ?r + ?t2) H)" + using ** + using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?rd + ?r + ?t2) H"] + unfolding moebius_translation_def + by simp + + thus ?thesis + using assms + by simp (subst moebius_decomposition, simp_all) +qed + +(* ----------------------------------------------------------------- *) +subsection \Oriented circlines uniqueness\ +(* ----------------------------------------------------------------- *) + +lemma ocircline_01inf: + assumes "0\<^sub>h \ ocircline_set H \ 1\<^sub>h \ ocircline_set H \ \\<^sub>h \ ocircline_set H" + shows "H = o_x_axis \ H = opposite_ocircline o_x_axis" +proof- + have "0\<^sub>h \ circline_set (of_ocircline H) \ 1\<^sub>h \ circline_set (of_ocircline H) \ \\<^sub>h \ circline_set (of_ocircline H)" + using assms + by simp + hence "of_ocircline H = x_axis" + using unique_circline_01inf' + by auto + thus "H = o_x_axis \ H = opposite_ocircline o_x_axis" + by (metis inj_of_ocircline of_ocircline_o_x_axis) +qed + +lemma unique_ocircline_01inf: + shows "\! H. 0\<^sub>h \ ocircline_set H \ 1\<^sub>h \ ocircline_set H \ \\<^sub>h \ ocircline_set H \ ii\<^sub>h \ disc H" +proof + show "0\<^sub>h \ ocircline_set o_x_axis \ 1\<^sub>h \ ocircline_set o_x_axis \ \\<^sub>h \ ocircline_set o_x_axis \ ii\<^sub>h \ disc o_x_axis" + by simp +next + fix H + assume "0\<^sub>h \ ocircline_set H \ 1\<^sub>h \ ocircline_set H \ \\<^sub>h \ ocircline_set H \ ii\<^sub>h \ disc H" + hence "0\<^sub>h \ ocircline_set H \ 1\<^sub>h \ ocircline_set H \ \\<^sub>h \ ocircline_set H" "ii\<^sub>h \ disc H" + by auto + hence "H = o_x_axis \ H = opposite_ocircline o_x_axis" + using ocircline_01inf + by simp + thus "H = o_x_axis" + using \ii\<^sub>h \ disc H\ + by auto +qed + +lemma unique_ocircline_set: + assumes "A \ B" and "A \ C" and "B \ C" + shows "\! H. pos_oriented H \ (A \ ocircline_set H \ B \ ocircline_set H \ C \ ocircline_set H)" +proof- + obtain M where *: "moebius_pt M A = 0\<^sub>h" "moebius_pt M B = 1\<^sub>h" "moebius_pt M C = \\<^sub>h" + using ex_moebius_01inf[OF assms] + by auto + let ?iM = "moebius_pt (moebius_inv M)" + have **: "?iM 0\<^sub>h = A" "?iM 1\<^sub>h = B" "?iM \\<^sub>h = C" + using * + by (auto simp add: moebius_pt_invert) + let ?H = "moebius_ocircline (moebius_inv M) o_x_axis" + have 1: "A \ ocircline_set ?H" "B \ ocircline_set ?H" "C \ ocircline_set ?H" + using ** + by auto + have 2: "\ H'. A \ ocircline_set H' \ B \ ocircline_set H' \ C \ ocircline_set H' \ H' = ?H \ H' = opposite_ocircline ?H" + proof- + fix H' + let ?H' = "ocircline_set H'" and ?H'' = "ocircline_set (moebius_ocircline M H')" + assume "A \ ocircline_set H' \ B \ ocircline_set H' \ C \ ocircline_set H'" + hence "moebius_pt M A \ ?H''" "moebius_pt M B \ ?H''" "moebius_pt M C \ ?H''" + by auto + hence "0\<^sub>h \ ?H''" "1\<^sub>h \ ?H''" "\\<^sub>h \ ?H''" + using * + by auto + hence "moebius_ocircline M H' = o_x_axis \ moebius_ocircline M H' = opposite_ocircline o_x_axis" + using ocircline_01inf + by auto + hence "o_x_axis = moebius_ocircline M H' \ o_x_axis = opposite_ocircline (moebius_ocircline M H')" + by auto + thus "H' = ?H \ H' = opposite_ocircline ?H" + proof + assume *: "o_x_axis = moebius_ocircline M H'" + show "H' = moebius_ocircline (moebius_inv M) o_x_axis \ H' = opposite_ocircline (moebius_ocircline (moebius_inv M) o_x_axis)" + by (rule disjI1) (subst *, simp) + next + assume *: "o_x_axis = opposite_ocircline (moebius_ocircline M H')" + show "H' = moebius_ocircline (moebius_inv M) o_x_axis \ H' = opposite_ocircline (moebius_ocircline (moebius_inv M) o_x_axis)" + by (rule disjI2) (subst *, simp) + qed + qed + + show ?thesis (is "\! x. ?P x") + proof (cases "pos_oriented ?H") + case True + show ?thesis + proof + show "?P ?H" + using 1 True + by auto + next + fix H + assume "?P H" + thus "H = ?H" + using 1 2[of H] True + by auto + qed + next + case False + let ?OH = "opposite_ocircline ?H" + show ?thesis + proof + show "?P ?OH" + using 1 False + by auto + next + fix H + assume "?P H" + thus "H = ?OH" + using False 2[of H] + by auto + qed + qed +qed + +lemma ocircline_set_0h: + assumes "ocircline_set H = {0\<^sub>h}" + shows "H = o_circline_point_0 \ H = opposite_ocircline (o_circline_point_0)" +proof- + have "of_ocircline H = circline_point_0" + using assms + using unique_circline_type_zero_0' card_eq1_circline_type_zero[of "of_ocircline H"] + by auto + thus ?thesis + by (metis inj_of_ocircline of_ocircline_o_circline_point_0) +qed + + +end diff --git a/thys/Complex_Geometry/Quadratic.thy b/thys/Complex_Geometry/Quadratic.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Quadratic.thy @@ -0,0 +1,477 @@ +(* ----------------------------------------------------------------- *) +subsection \Quadratic equations\ +(* ----------------------------------------------------------------- *) + +text \In this section some simple properties of quadratic equations and their roots are derived. +Quadratic equations over reals and over complex numbers, but also systems of quadratic equations and +systems of quadratic and linear equations are analysed.\ + +theory Quadratic + imports More_Complex "HOL-Library.Quadratic_Discriminant" +begin + +(* ----------------------------------------------------------------- *) +subsubsection \Real quadratic equations, Viette rules\ +(* ----------------------------------------------------------------- *) + +lemma viette2_monic: + fixes b c \1 \2 :: real + assumes "b\<^sup>2 - 4*c \ 0" and "\1\<^sup>2 + b*\1 + c = 0" and "\2\<^sup>2 + b*\2 + c = 0" and "\1 \ \2" + shows "\1*\2 = c" + using assms + by algebra + +lemma viette2: + fixes a b c \1 \2 :: real + assumes "a \ 0" and "b\<^sup>2 - 4*a*c \ 0" and "a*\1\<^sup>2 + b*\1 + c = 0" and "a*\2\<^sup>2 + b*\2 + c = 0" and "\1 \ \2" + shows "\1*\2 = c/a" +proof (rule viette2_monic[of "b/a" "c/a" \1 \2]) + have "(b / a)\<^sup>2 - 4 * (c / a) = (b\<^sup>2 - 4*a*c) / a\<^sup>2" + using \a \ 0\ + by (auto simp add: power2_eq_square field_simps) + thus "0 \ (b / a)\<^sup>2 - 4 * (c / a)" + using \b\<^sup>2 - 4*a*c \ 0\ + by simp +next + show "\1\<^sup>2 + b / a * \1 + c / a = 0" "\2\<^sup>2 + b / a * \2 + c / a = 0" + using assms + by (auto simp add: power2_eq_square field_simps) +next + show "\1 \ \2" + by fact +qed + +lemma viette2'_monic: + fixes b c \ :: real + assumes "b\<^sup>2 - 4*c = 0" and "\\<^sup>2 + b*\ + c = 0" + shows "\*\ = c" + using assms + by algebra + +lemma viette2': + fixes a b c \ :: real + assumes "a \ 0" and "b\<^sup>2 - 4*a*c = 0" and "a*\\<^sup>2 + b*\ + c = 0" + shows "\*\ = c/a" +proof (rule viette2'_monic) + have "(b / a)\<^sup>2 - 4 * (c / a) = (b\<^sup>2 - 4*a*c) / a\<^sup>2" + using \a \ 0\ + by (auto simp add: power2_eq_square field_simps) + thus "(b / a)\<^sup>2 - 4 * (c / a) = 0" + using \b\<^sup>2 - 4*a*c = 0\ + by simp +next + show "\\<^sup>2 + b / a * \ + c / a = 0" + using assms + by (auto simp add: power2_eq_square field_simps) +qed + +(* ----------------------------------------------------------------- *) +subsubsection \Complex quadratic equations\ +(* ----------------------------------------------------------------- *) + +lemma complex_quadratic_equation_monic_only_two_roots: + fixes \ :: complex + assumes "\\<^sup>2 + b * \ + c = 0" + shows "\ = (-b + ccsqrt(b\<^sup>2 - 4*c)) / 2 \ \ = (-b - ccsqrt(b\<^sup>2 - 4*c)) / 2" +using assms +proof- + from assms have "(2 * (\ + b/2))\<^sup>2 = b\<^sup>2 - 4*c" + by (simp add: power2_eq_square field_simps) + (metis (no_types, lifting) distrib_right_numeral mult.assoc mult_zero_left) + hence "2 * (\ + b/2) = ccsqrt (b\<^sup>2 - 4*c) \ 2 * (\ + b/2) = - ccsqrt (b\<^sup>2 - 4*c)" + using ccsqrt[of "(2 * (\ + b / 2))" "b\<^sup>2 - 4 * c"] + by (simp add: power2_eq_square) + thus ?thesis + using mult_cancel_right[of "b + \ * 2" 2 "ccsqrt (b\<^sup>2 - 4*c)"] + using mult_cancel_right[of "b + \ * 2" 2 "-ccsqrt (b\<^sup>2 - 4*c)"] + by (auto simp add: field_simps) (metis add_diff_cancel diff_minus_eq_add minus_diff_eq) +qed + +lemma complex_quadratic_equation_monic_roots: + fixes \ :: complex + assumes "\ = (-b + ccsqrt(b\<^sup>2 - 4*c)) / 2 \ + \ = (-b - ccsqrt(b\<^sup>2 - 4*c)) / 2" + shows "\\<^sup>2 + b * \ + c = 0" +using assms +proof + assume *: "\ = (- b + ccsqrt (b\<^sup>2 - 4 * c)) / 2" + show ?thesis + by ((subst *)+) (subst power_divide, subst power2_sum, simp add: field_simps, simp add: power2_eq_square) +next + assume *: "\ = (- b - ccsqrt (b\<^sup>2 - 4 * c)) / 2" + show ?thesis + by ((subst *)+, subst power_divide, subst power2_diff, simp add: field_simps, simp add: power2_eq_square) +qed + +lemma complex_quadratic_equation_monic_distinct_roots: + fixes b c :: complex + assumes "b\<^sup>2 - 4*c \ 0" + shows "\ k\<^sub>1 k\<^sub>2. k\<^sub>1 \ k\<^sub>2 \ k\<^sub>1\<^sup>2 + b*k\<^sub>1 + c = 0 \ k\<^sub>2\<^sup>2 + b*k\<^sub>2 + c = 0" +proof- + let ?\1 = "(-b + ccsqrt(b\<^sup>2 - 4*c)) / 2" + let ?\2 = "(-b - ccsqrt(b\<^sup>2 - 4*c)) / 2" + show ?thesis + apply (rule_tac x="?\1" in exI) + apply (rule_tac x="?\2" in exI) + using assms + using complex_quadratic_equation_monic_roots[of ?\1 b c] + using complex_quadratic_equation_monic_roots[of ?\2 b c] + by simp +qed + +lemma complex_quadratic_equation_two_roots: + fixes \ :: complex + assumes "a \ 0" and "a*\\<^sup>2 + b * \ + c = 0" + shows "\ = (-b + ccsqrt(b\<^sup>2 - 4*a*c)) / (2*a) \ + \ = (-b - ccsqrt(b\<^sup>2 - 4*a*c)) / (2*a)" +proof- + from assms have "\\<^sup>2 + (b/a) * \ + (c/a) = 0" + by (simp add: field_simps) + hence "\ = (-(b/a) + ccsqrt((b/a)\<^sup>2 - 4*(c/a))) / 2 \ \ = (-(b/a) - ccsqrt((b/a)\<^sup>2 - 4*(c/a))) / 2" + using complex_quadratic_equation_monic_only_two_roots[of \ "b/a" "c/a"] + by simp + hence "\ k. \ = (-(b/a) + (-1)^k * ccsqrt((b/a)\<^sup>2 - 4*(c/a))) / 2" + by safe (rule_tac x="2" in exI, simp, rule_tac x="1" in exI, simp) + then obtain k1 where "\ = (-(b/a) + (-1)^k1 * ccsqrt((b/a)\<^sup>2 - 4*(c/a))) / 2" + by auto + moreover + have "(b / a)\<^sup>2 - 4 * (c / a) = (b\<^sup>2 - 4 * a * c) * (1 / a\<^sup>2)" + using \a \ 0\ + by (simp add: field_simps power2_eq_square) + hence "ccsqrt ((b / a)\<^sup>2 - 4 * (c / a)) = ccsqrt (b\<^sup>2 - 4 * a * c) * ccsqrt (1/a\<^sup>2) \ + ccsqrt ((b / a)\<^sup>2 - 4 * (c / a)) = - ccsqrt (b\<^sup>2 - 4 * a * c) * ccsqrt (1/a\<^sup>2)" + using ccsqrt_mult[of "b\<^sup>2 - 4 * a * c" "1/a\<^sup>2"] + by auto + hence "\ k. ccsqrt ((b / a)\<^sup>2 - 4 * (c / a)) = (-1)^k * ccsqrt (b\<^sup>2 - 4 * a * c) * ccsqrt (1 / a\<^sup>2)" + by safe (rule_tac x="2" in exI, simp, rule_tac x="1" in exI, simp) + then obtain k2 where "ccsqrt ((b / a)\<^sup>2 - 4 * (c / a)) = (-1)^k2 * ccsqrt (b\<^sup>2 - 4 * a * c) * ccsqrt (1 / a\<^sup>2)" + by auto + moreover + have "ccsqrt (1 / a\<^sup>2) = 1/a \ ccsqrt (1 / a\<^sup>2) = -1/a" + using ccsqrt[of "1/a" "1 / a\<^sup>2"] + by (auto simp add: power2_eq_square) + hence "\ k. ccsqrt (1 / a\<^sup>2) = (-1)^k * 1/a" + by safe (rule_tac x="2" in exI, simp, rule_tac x="1" in exI, simp) + then obtain k3 where "ccsqrt (1 / a\<^sup>2) = (-1)^k3 * 1/a" + by auto + ultimately + have "\ = (- (b / a) + ((-1) ^ k1 * (-1) ^ k2 * (-1) ^ k3) * ccsqrt (b\<^sup>2 - 4 * a * c) * 1/a) / 2" + by simp + moreover + have "(-(1::complex)) ^ k1 * (-1) ^ k2 * (-1) ^ k3 = 1 \ (-(1::complex)) ^ k1 * (-1) ^ k2 * (-1) ^ k3 = -1" + using neg_one_even_power[of "k1 + k2 + k3"] + using neg_one_odd_power[of "k1 + k2 + k3"] + by (smt power_add) + ultimately + have "\ = (- (b / a) + ccsqrt (b\<^sup>2 - 4 * a * c) * 1 / a) / 2 \ \ = (- (b / a) - ccsqrt (b\<^sup>2 - 4 * a * c) * 1 / a) / 2" + by auto + thus ?thesis + using \a \ 0\ + by (simp add: field_simps) +qed + +lemma complex_quadratic_equation_only_two_roots: + fixes x :: complex + assumes "a \ 0" + assumes "qf = (\ x. a*x\<^sup>2 + b*x + c)" + "qf x1 = 0" and "qf x2 = 0" and "x1 \ x2" + "qf x = 0" + shows "x = x1 \ x = x2" + using assms + using complex_quadratic_equation_two_roots + by blast + + +(* ----------------------------------------------------------------- *) +subsubsection \Intersections of linear and quadratic forms\ +(* ----------------------------------------------------------------- *) +(* These lemmas are not used *) + +lemma quadratic_linear_at_most_2_intersections_help: + fixes x y :: complex + assumes "(a11, a12, a22) \ (0, 0, 0)" and "k2 \ 0" + "qf = (\ x y. a11*x\<^sup>2 + 2*a12*x*y + a22*y\<^sup>2 + b1*x + b2*y + c)" and "lf = (\ x y. k1*x + k2*y + n)" + "qf x y = 0" and "lf x y = 0" + "pf = (\ x. (a11 - 2*a12*k1/k2 + a22*k1\<^sup>2/k2\<^sup>2)*x\<^sup>2 + (-2*a12*n/k2 + b1 + a22*2*n*k1/k2\<^sup>2 - b2*k1/k2)*x + a22*n\<^sup>2/k2\<^sup>2 - b2*n/k2 + c)" + "yf = (\ x. (-n - k1*x) / k2)" + shows "pf x = 0" and "y = yf x" +proof - + show "y = yf x" + using assms + by (simp add:field_simps eq_neg_iff_add_eq_0) +next + have "2*a12*x*(-n - k1*x)/k2 = (-2*a12*n/k2)*x - (2*a12*k1/k2)*x\<^sup>2" + by algebra + have "a22*((-n - k1*x)/k2)\<^sup>2 = a22*n\<^sup>2/k2\<^sup>2 + (a22*2*n*k1/k2\<^sup>2)*x + (a22*k1\<^sup>2/k2\<^sup>2)*x\<^sup>2" + by (simp add: power_divide) algebra + have "2*a12*x*(-n - k1*x)/k2 = (-2*a12*n/k2)*x - (2*a12*k1/k2)*x\<^sup>2" + by algebra + have "b2*(-n - k1*x)/k2 = -b2*n/k2 - (b2*k1/k2)*x" + by algebra + + have *: "y = (-n - k1*x)/k2" + using assms(2, 4, 6) + by (simp add:field_simps eq_neg_iff_add_eq_0) + + have "0 = a11*x\<^sup>2 + 2*a12*x*y + a22*y\<^sup>2 + b1*x + b2*y + c" + using assms + by simp + hence "0 = a11*x\<^sup>2 + 2*a12*x*(-n - k1*x)/k2 + a22*((-n - k1*x)/k2)\<^sup>2 + b1*x + b2*(-n - k1*x)/k2 + c" + by (subst (asm) *, subst (asm) *, subst (asm) *) auto + also have "... = (a11 - 2*a12*k1/k2 + a22*k1\<^sup>2/k2\<^sup>2)*x\<^sup>2 + (-2*a12*n/k2 + b1 + a22*2*n*k1/k2\<^sup>2 - b2*k1/k2)*x + a22*n\<^sup>2/k2\<^sup>2 -b2*n/k2 + c" + using \2*a12*x*(-n - k1*x)/k2 = (-2*a12*n/k2)*x - (2*a12*k1/k2)*x\<^sup>2\ + using \a22*((-n - k1*x)/k2)\<^sup>2 = a22*n\<^sup>2/k2\<^sup>2 + (a22*2*n*k1/k2\<^sup>2)*x + (a22*k1\<^sup>2/k2\<^sup>2)*x\<^sup>2\ + using \b2*(-n - k1*x)/k2 = -b2*n/k2 - (b2*k1/k2)*x\ + by (simp add:field_simps) + finally show "pf x = 0" + using assms(7) + by auto +qed + +lemma quadratic_linear_at_most_2_intersections_help': + fixes x y :: complex + assumes "qf = (\ x y. a11*x\<^sup>2 + 2*a12*x*y + a22*y\<^sup>2 + b1*x + b2*y + c)" + "x = -n/k1" and "k1 \ 0" and "qf x y = 0" + "yf = (\ y. k1\<^sup>2*a22*y\<^sup>2 + (-2*a12*n*k1 + b2*k1\<^sup>2)*y + a11*n\<^sup>2 - b1*n*k1 + c*k1\<^sup>2)" + shows "yf y = 0" +proof- + have "0 = a11*n\<^sup>2/k1\<^sup>2 - 2*a12*n*y/k1 + a22*y\<^sup>2 - b1*n/k1 + b2*y + c" + using assms(1, 2, 4) + by (simp add: power_divide) + hence "0 = a11*n\<^sup>2 - 2*a12*n*k1*y + a22*y\<^sup>2*k1\<^sup>2 - b1*n*k1 + b2*y*k1\<^sup>2 + c*k1\<^sup>2" + using assms(3) + apply (simp add:field_simps power2_eq_square) + by algebra + thus ?thesis + using assms(1, 4, 5) + by (simp add:field_simps) +qed + +lemma quadratic_linear_at_most_2_intersections: + fixes x y x1 y1 x2 y2 :: complex + assumes "(a11, a12, a22) \ (0, 0, 0)" and "(k1, k2) \ (0, 0)" + assumes "a11*k2\<^sup>2 - 2*a12*k1*k2 + a22*k1\<^sup>2 \ 0" + assumes "qf = (\ x y. a11*x\<^sup>2 + 2*a12*x*y + a22*y\<^sup>2 + b1*x + b2*y + c)" and "lf = (\ x y. k1*x + k2*y + n)" + "qf x1 y1 = 0" and "lf x1 y1 = 0" + "qf x2 y2 = 0" and "lf x2 y2 = 0" + "(x1, y1) \ (x2, y2)" + "qf x y = 0" and "lf x y = 0" + shows "(x, y) = (x1, y1) \ (x, y) = (x2, y2)" +proof(cases "k2 = 0") + case True + hence "k1 \ 0" + using assms(2) + by simp + + have "a22*k1\<^sup>2 \ 0" + using assms(3) True + by auto + + have "x1 = -n/k1" + using \k1 \ 0\ assms(5, 7) True + by (metis add.right_neutral add_eq_0_iff2 mult_zero_left nonzero_mult_div_cancel_left) + have "x2 = -n/k1" + using \k1 \ 0\ assms(5, 9) True + by (metis add.right_neutral add_eq_0_iff2 mult_zero_left nonzero_mult_div_cancel_left) + have "x = -n/k1" + using \k1 \ 0\ assms(5, 12) True + by (metis add.right_neutral add_eq_0_iff2 mult_zero_left nonzero_mult_div_cancel_left) + + let ?yf = "(\ y. k1\<^sup>2*a22*y\<^sup>2 + (-2*a12*n*k1 + b2*k1\<^sup>2)*y + a11*n\<^sup>2 - b1*n*k1 + c*k1\<^sup>2)" + + have "?yf y = 0" + using quadratic_linear_at_most_2_intersections_help'[of qf a11 a12 a22 b1 b2 c x n k1 y ?yf] + using assms(4, 11) \k1 \ 0\ \x = -n/k1\ + by auto + have "?yf y1 = 0" + using quadratic_linear_at_most_2_intersections_help'[of qf a11 a12 a22 b1 b2 c x1 n k1 y1 ?yf] + using assms(4, 6) \k1 \ 0\ \x1 = -n/k1\ + by auto + have "?yf y2 = 0" + using quadratic_linear_at_most_2_intersections_help'[of qf a11 a12 a22 b1 b2 c x2 n k1 y2 ?yf] + using assms(4, 8) \k1 \ 0\ \x2 = -n/k1\ + by auto + + have "y1 \ y2" + using assms(10) \x1 = -n/k1\ \x2 = -n/k1\ + by blast + + have "y = y1 \ y = y2" + using complex_quadratic_equation_only_two_roots[of "a22*k1\<^sup>2" ?yf "-2*a12*n*k1 + b2*k1\<^sup>2" "a11*n\<^sup>2 - b1*n*k1 + c*k1\<^sup>2" + y1 y2 y] + using \a22*k1\<^sup>2 \ 0\ \?yf y1 = 0\ \y1 \ y2\ \?yf y2 = 0\ \?yf y = 0\ + by fastforce + + thus ?thesis + using \x1 = -n/k1\ \x2 = -n/k1\ \x = -n/k1\ + by auto +next + case False + + let ?py = "(\ x. (-n - k1*x)/k2)" + let ?pf = "(\ x. (a11 - 2*a12*k1/k2 + a22*k1\<^sup>2/k2\<^sup>2)*x\<^sup>2 + (-2*a12*n/k2 + b1 + a22*2*n*k1/k2\<^sup>2 - b2*k1/k2)*x + a22*n\<^sup>2/k2\<^sup>2 -b2*n/k2 + c)" + have "?pf x1 = 0" "y1 = ?py x1" + using quadratic_linear_at_most_2_intersections_help[of a11 a12 a22 k2 qf b1 b2 c lf k1 n x1 y1] + using assms(1, 4, 5, 6, 7) False + by auto + have "?pf x2 = 0" "y2 = ?py x2" + using quadratic_linear_at_most_2_intersections_help[of a11 a12 a22 k2 qf b1 b2 c lf k1 n x2 y2] + using assms(1, 4, 5, 8, 9) False + by auto + have "?pf x = 0" "y = ?py x" + using quadratic_linear_at_most_2_intersections_help[of a11 a12 a22 k2 qf b1 b2 c lf k1 n x y] + using assms(1, 4, 5, 11, 12) False + by auto + + have "x1 \ x2" + using assms(10) \y1 = ?py x1\ \y2 = ?py x2\ + by auto + + have "a11 - 2*a12*k1/k2 + a22*k1\<^sup>2/k2\<^sup>2 = (a11 * k2\<^sup>2 - 2 * a12 * k1 * k2 + a22 * k1\<^sup>2)/k2\<^sup>2" + by (simp add: False power2_eq_square add_divide_distrib diff_divide_distrib) + also have "... \ 0" + using False assms(3) + by simp + finally have "a11 - 2*a12*k1/k2 + a22*k1\<^sup>2/k2\<^sup>2 \ 0" + . + + have "x = x1 \ x = x2" + using complex_quadratic_equation_only_two_roots[of "a11 - 2*a12*k1/k2 + a22*k1\<^sup>2/k2\<^sup>2" ?pf + "(- 2 * a12 * n / k2 + b1 + a22 * 2 * n * k1 / k2\<^sup>2 - b2 * k1 / k2)" + "a22 * n\<^sup>2 / k2\<^sup>2 - b2 * n / k2 + c" x1 x2 x] + using \?pf x2 = 0\ \?pf x1 = 0\ \?pf x = 0\ + using \a11 - 2 * a12 * k1 / k2 + a22 * k1\<^sup>2 / k2\<^sup>2 \ 0\ + using \x1 \ x2\ + by fastforce + + thus ?thesis + using \y = ?py x\ \y1 = ?py x1\ \y2 = ?py x2\ + by (cases "x = x1", auto) +qed + +lemma quadratic_quadratic_at_most_2_intersections': + fixes x y x1 y1 x2 y2 :: complex + assumes "b2 \ B2 \ b1 \ B1" + "(b2 - B2)\<^sup>2 + (b1 - B1)\<^sup>2 \ 0" + assumes "qf1 = (\ x y. x\<^sup>2 + y\<^sup>2 + b1*x + b2*y + c)" + "qf2 = (\ x y. x\<^sup>2 + y\<^sup>2 + B1*x + B2*y + C)" + "qf1 x1 y1 = 0" "qf2 x1 y1 = 0" + "qf1 x2 y2 = 0" "qf2 x2 y2 = 0" + "(x1, y1) \ (x2, y2)" + "qf1 x y = 0" "qf2 x y = 0" + shows "(x, y) = (x1, y1) \ (x, y) = (x2, y2)" +proof- + have "x\<^sup>2 + y\<^sup>2 + b1*x + b2*y + c = 0" + using assms by auto + have "x\<^sup>2 + y\<^sup>2 + B1*x + B2*y + C = 0" + using assms by auto + hence "0 = x\<^sup>2 + y\<^sup>2 + b1*x + b2*y + c - (x\<^sup>2 + y\<^sup>2 + B1*x + B2*y + C)" + using \x\<^sup>2 + y\<^sup>2 + b1*x + b2*y + c = 0\ + by auto + hence "0 = (b1 - B1)*x + (b2 - B2)*y + c - C" + by (simp add:field_simps) + + have "x1\<^sup>2 + y1\<^sup>2 + b1*x1 + b2*y1 + c = 0" + using assms by auto + have "x1\<^sup>2 + y1\<^sup>2 + B1*x1 + B2*y1 + C = 0" + using assms by auto + hence "0 = x1\<^sup>2 + y1\<^sup>2 + b1*x1 + b2*y1 + c - (x1\<^sup>2 + y1\<^sup>2 + B1*x1 + B2*y1 + C)" + using \x1\<^sup>2 + y1\<^sup>2 + b1*x1 + b2*y1 + c = 0\ + by auto + hence "0 = (b1 - B1)*x1 + (b2 - B2)*y1 + c - C" + by (simp add:field_simps) + + have "x2\<^sup>2 + y2\<^sup>2 + b1*x2 + b2*y2 + c = 0" + using assms by auto + have "x2\<^sup>2 + y2\<^sup>2 + B1*x2 + B2*y2 + C = 0" + using assms by auto + hence "0 = x2\<^sup>2 + y2\<^sup>2 + b1*x2 + b2*y2 + c - (x2\<^sup>2 + y2\<^sup>2 + B1*x2 + B2*y2 + C)" + using \x2\<^sup>2 + y2\<^sup>2 + b1*x2 + b2*y2 + c = 0\ + by auto + hence "0 = (b1 - B1)*x2 + (b2 - B2)*y2 + c - C" + by (simp add:field_simps) + + have "(b1 - B1, b2 - B2) \ (0, 0)" + using assms(1) by auto + + let ?lf = "(\ x y. (b1 - B1)*x + (b2 - B2)*y + c - C)" + + have "?lf x y = 0" "?lf x1 y1 = 0" "?lf x2 y2 = 0" + using \0 = (b1 - B1)*x2 + (b2 - B2)*y2 + c - C\ + \0 = (b1 - B1)*x1 + (b2 - B2)*y1 + c - C\ + \0 = (b1 - B1)*x + (b2 - B2)*y + c - C\ + by auto + + thus ?thesis + using quadratic_linear_at_most_2_intersections[of 1 0 1 "b1 - B1" "b2 - B2" qf1 b1 b2 c ?lf "c - C" x1 y1 x2 y2 x y] + using \(b1 - B1, b2 - B2) \ (0, 0)\ + using assms \(b1 - B1, b2 - B2) \ (0, 0)\ + using \(b1 - B1) * x + (b2 - B2) * y + c - C = 0\ \(b1 - B1) * x1 + (b2 - B2) * y1 + c - C = 0\ + by (simp add: add_diff_eq) +qed + +lemma quadratic_change_coefficients: + fixes x y :: complex + assumes "A1 \ 0" + assumes "qf = (\ x y. A1*x\<^sup>2 + A1*y\<^sup>2 + b1*x + b2*y + c)" + "qf x y = 0" + "qf_1 = (\ x y. x\<^sup>2 + y\<^sup>2 + (b1/A1)*x + (b2/A1)*y + c/A1)" + shows "qf_1 x y = 0" +proof- + have "0 = A1*x\<^sup>2 + A1*y\<^sup>2 + b1*x + b2*y + c" + using assms by auto + hence "0/A1 = (A1*x\<^sup>2 + A1*y\<^sup>2 + b1*x + b2*y + c)/A1" + using assms(1) by auto + also have "... = A1*x\<^sup>2/A1 + A1*y\<^sup>2/A1 + b1*x/A1 + b2*y/A1 + c/A1" + by (simp add: add_divide_distrib) + also have "... = x\<^sup>2 + y\<^sup>2 + (b1/A1)*x + (b2/A1)*y + c/A1" + using assms(1) + by (simp add:field_simps) + finally have "0 = x\<^sup>2 + y\<^sup>2 + (b1/A1)*x + (b2/A1)*y + c/A1" + by simp + thus ?thesis + using assms + by simp +qed + +lemma quadratic_quadratic_at_most_2_intersections: + fixes x y x1 y1 x2 y2 :: complex + assumes "A1 \ 0" and "A2 \ 0" + assumes "qf1 = (\ x y. A1*x\<^sup>2 + A1*y\<^sup>2 + b1*x + b2*y + c)" and + "qf2 = (\ x y. A2*x\<^sup>2 + A2*y\<^sup>2 + B1*x + B2*y + C)" and + "qf1 x1 y1 = 0" and "qf2 x1 y1 = 0" and + "qf1 x2 y2 = 0" and "qf2 x2 y2 = 0" and + "(x1, y1) \ (x2, y2)" and + "qf1 x y = 0" and "qf2 x y = 0" + assumes "(b2*A2 - B2*A1)\<^sup>2 + (b1*A2 - B1*A1)\<^sup>2 \ 0" and + "b2*A2 \ B2*A1 \ b1*A2 \ B1*A1" + shows "(x, y) = (x1, y1) \ (x, y) = (x2, y2)" +proof- + have *: "b2 / A1 \ B2 / A2 \ b1 / A1 \ B1 / A2" + using assms(1, 2) assms(13) + by (simp add:field_simps) + have **: "(b2 / A1 - B2 / A2)\<^sup>2 + (b1 / A1 - B1 / A2)\<^sup>2 \ 0" + using assms(1, 2) assms(12) + by (simp add:field_simps) + + let ?qf_1 = "(\ x y. x\<^sup>2 + y\<^sup>2 + (b1/A1)*x + (b2/A1)*y + c/A1)" + let ?qf_2 = "(\ x y. x\<^sup>2 + y\<^sup>2 + (B1/A2)*x + (B2/A2)*y + C/A2)" + + have "?qf_1 x1 y1 = 0" "?qf_1 x2 y2 = 0" "?qf_1 x y = 0" + "?qf_2 x1 y1 = 0" "?qf_2 x2 y2 = 0" "?qf_2 x y = 0" + using assms quadratic_change_coefficients[of A1 qf1 b1 b2 c x2 y2 ?qf_1] + quadratic_change_coefficients[of A1 qf1 b1 b2 c x1 y1 ?qf_1] + quadratic_change_coefficients[of A2 qf2 B1 B2 C x1 y1 ?qf_2] + quadratic_change_coefficients[of A2 qf2 B1 B2 C x2 y2 ?qf_2] + quadratic_change_coefficients[of A1 qf1 b1 b2 c x y ?qf_1] + quadratic_change_coefficients[of A2 qf2 B1 B2 C x y ?qf_2] + by auto + + thus ?thesis + using quadratic_quadratic_at_most_2_intersections' + [of "b2 / A1" "B2 / A2" "b1 / A1" "B1 / A2" ?qf_1 "c / A1" ?qf_2 "C / A2" x1 y1 x2 y2 x y] + using * ** \(x1, y1) \ (x2, y2)\ + by fastforce +qed + +end diff --git a/thys/Complex_Geometry/ROOT b/thys/Complex_Geometry/ROOT new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/ROOT @@ -0,0 +1,31 @@ +chapter AFP + +session Complex_Geometry (AFP) = HOL + + options [timeout = 1200] + sessions + "HOL-Analysis" + "HOL-Library" + theories + More_Transcendental + Canonical_Angle + More_Complex + Angles + More_Set + Linear_Systems + Quadratic + Matrices + Unitary_Matrices + Unitary11_Matrices + Hermitean_Matrices + Elementary_Complex_Geometry + Homogeneous_Coordinates + Moebius + Circlines + Oriented_Circlines + Circlines_Angle + Unit_Circle_Preserving_Moebius + Riemann_Sphere + Chordal_Metric + document_files + "root.bib" + "root.tex" diff --git a/thys/Complex_Geometry/Riemann_Sphere.thy b/thys/Complex_Geometry/Riemann_Sphere.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Riemann_Sphere.thy @@ -0,0 +1,641 @@ +(* ---------------------------------------------------------------------------- *) +section \Riemann sphere\ +(* ---------------------------------------------------------------------------- *) + +text \The extended complex plane $\mathbb{C}P^1$ can be identified with a Riemann (unit) sphere +$\Sigma$ by means of stereographic projection. The sphere is projected from its north pole $N$ to +the $xOy$ plane (identified with $\mathbb{C}$). This projection establishes a bijective map $sp$ +between $\Sigma \setminus \{N\}$ and the finite complex plane $\mathbb{C}$. The infinite point is +defined as the image of $N$.\ + +theory Riemann_Sphere +imports Homogeneous_Coordinates Circlines "HOL-Analysis.Product_Vector" +begin + +text \Coordinates in $\mathbb{R}^3$\ +type_synonym R3 = "real \ real \ real" + +text \Type of points of $\Sigma$\ +abbreviation unit_sphere where + "unit_sphere \ {(x::real, y::real, z::real). x*x + y*y + z*z = 1}" + +typedef riemann_sphere = "unit_sphere" + by (rule_tac x="(1, 0, 0)" in exI) simp + +setup_lifting type_definition_riemann_sphere + +lemma sphere_bounds': + assumes "x*x + y*y + z*z = (1::real)" + shows "-1 \ x \ x \ 1" +proof- + from assms have "x*x \ 1" + by (smt real_minus_mult_self_le) + hence "x\<^sup>2 \ 1\<^sup>2" "(- x)\<^sup>2 \ 1\<^sup>2" + by (auto simp add: power2_eq_square) + show "-1 \ x \ x \ 1" + proof (cases "x \ 0") + case True + thus ?thesis + using \x\<^sup>2 \ 1\<^sup>2\ + by (smt power2_le_imp_le) + next + case False + thus ?thesis + using \(-x)\<^sup>2 \ 1\<^sup>2\ + by (smt power2_le_imp_le) + qed +qed + +lemma sphere_bounds: + assumes "x*x + y*y + z*z = (1::real)" + shows "-1 \ x \ x \ 1" "-1 \ y \ y \ 1" "-1 \ z \ z \ 1" + using assms + using sphere_bounds'[of x y z] sphere_bounds'[of y x z] sphere_bounds'[of z x y] + by (auto simp add: field_simps) + +(* ---------------------------------------------------------------------------- *) +subsection \Parametrization of the unit sphere in polar coordinates\ +(* ---------------------------------------------------------------------------- *) + +lemma sphere_params_on_sphere: + fixes \ \ :: real + assumes "x = cos \ * cos \" and "y = cos \ * sin \" "z = sin \" + shows "x*x + y*y + z*z = 1" +proof- + have "x*x + y*y = (cos \ * cos \) * (cos \ * cos \) + (cos \ * cos \) * (sin \ * sin \)" + using assms + by simp + hence "x*x + y*y = cos \ * cos \" + using sin_cos_squared_add3[of \] + by (subst (asm) distrib_left[symmetric]) (simp add: field_simps) + thus ?thesis + using assms + using sin_cos_squared_add3[of \] + by simp +qed + +lemma sphere_params: + fixes x y z :: real + assumes "x*x + y*y + z*z = 1" + shows "x = cos (arcsin z) * cos (atan2 y x) \ y = cos (arcsin z) * sin (atan2 y x) \ z = sin (arcsin z)" +proof (cases "z=1 \ z = -1") + case True + hence "x = 0 \ y = 0" + using assms + by auto + thus ?thesis + using \z = 1 \ z = -1\ + by (auto simp add: cos_arcsin) +next + case False + hence "x \ 0 \ y \ 0" + using assms + by (auto simp add: square_eq_1_iff) + thus ?thesis + using real_sqrt_unique[of y "1 - z*z"] + using real_sqrt_unique[of "-y" "1 - z*z"] + using sphere_bounds[OF assms] assms + by (auto simp add: cos_arcsin cos_arctan sin_arctan power2_eq_square field_simps real_sqrt_divide atan2_def) +qed + +lemma ex_sphere_params: + assumes "x*x + y*y + z*z = 1" + shows "\ \ \. x = cos \ * cos \ \ y = cos \ * sin \ \ z = sin \ \ -pi / 2 \ \ \ \ \ pi / 2 \ -pi \ \ \ \ < pi" +using assms arcsin_bounded[of z] sphere_bounds[of x y z] +by (rule_tac x="arcsin z" in exI, rule_tac x="atan2 y x" in exI) (simp add: sphere_params arcsin_bounded atan2_bounded) + +(* ----------------------------------------------------------------- *) +subsection \Stereographic and inverse stereographic projection\ +(* ----------------------------------------------------------------- *) + +text \Stereographic projection\ + +definition stereographic_r3_cvec :: "R3 \ complex_vec" where +[simp]: "stereographic_r3_cvec M = (let (x, y, z) = M in + (if (x, y, z) \ (0, 0, 1) then + (x + \ * y, cor (1 - z)) + else + (1, 0) + ))" + + +lift_definition stereographic_r3_hcoords :: "R3 \ complex_homo_coords" is stereographic_r3_cvec + by (auto split: if_split_asm simp add: cor_eq_0) + +lift_definition stereographic :: "riemann_sphere \ complex_homo" is stereographic_r3_hcoords + done + +text \Inverse stereographic projection\ + +definition inv_stereographic_cvec_r3 :: "complex_vec \ R3" where [simp]: + "inv_stereographic_cvec_r3 z = ( + let (z1, z2) = z + in if z2 = 0 then + (0, 0, 1) + else + let z = z1/z2; + X = Re (2*z / (1 + z*cnj z)); + Y = Im (2*z / (1 + z*cnj z)); + Z = ((cmod z)\<^sup>2 - 1) / (1 + (cmod z)\<^sup>2) + in (X, Y, Z))" + +lemma Re_stereographic: + shows "Re (2 * z / (1 + z * cnj z)) = 2 * Re z / (1 + (cmod z)\<^sup>2)" + using one_plus_square_neq_zero + by (subst complex_mult_cnj_cmod, subst Re_divide_real) (auto simp add: power2_eq_square) + +lemma Im_stereographic: + shows "Im (2 * z / (1 + z * cnj z)) = 2 * Im z / (1 + (cmod z)\<^sup>2)" + using one_plus_square_neq_zero + by (subst complex_mult_cnj_cmod, subst Im_divide_real) (auto simp add: power2_eq_square) + +lemma inv_stereographic_on_sphere: + assumes "X = Re (2*z / (1 + z*cnj z))" and "Y = Im (2*z / (1 + z*cnj z))" and "Z = ((cmod z)\<^sup>2 - 1) / (1 + (cmod z)\<^sup>2)" + shows "X*X + Y*Y + Z*Z = 1" +proof- + have "1 + (cmod z)\<^sup>2 \ 0" + by (smt power2_less_0) + thus ?thesis + using assms + by (simp add: Re_stereographic Im_stereographic) + (cases z, simp add: power2_eq_square real_sqrt_mult[symmetric] add_divide_distrib[symmetric], simp add: complex_norm power2_eq_square field_simps) +qed + +lift_definition inv_stereographic_hcoords_r3 :: "complex_homo_coords \ R3" is inv_stereographic_cvec_r3 + done + +lift_definition inv_stereographic :: "complex_homo \ riemann_sphere" is inv_stereographic_hcoords_r3 +proof transfer + fix v v' + assume 1: "v \ vec_zero" "v' \ vec_zero" "v \\<^sub>v v'" + obtain v1 v2 v'1 v'2 where *: "v = (v1, v2)" "v' = (v'1, v'2)" + by (cases v, cases v', auto) + obtain x y z where + **: "inv_stereographic_cvec_r3 v = (x, y, z)" + by (cases "inv_stereographic_cvec_r3 v", blast) + have "inv_stereographic_cvec_r3 v \ unit_sphere" + proof (cases "v2 = 0") + case True + thus ?thesis + using * + by simp + next + case False + thus ?thesis + using * ** inv_stereographic_on_sphere[of x "v1 / v2" y z] + by simp + qed + moreover + have "inv_stereographic_cvec_r3 v = inv_stereographic_cvec_r3 v'" + using 1 * ** + by (auto split: if_split if_split_asm) + ultimately + show "inv_stereographic_cvec_r3 v \ unit_sphere \ + inv_stereographic_cvec_r3 v = inv_stereographic_cvec_r3 v'" + by simp +qed + +text \North pole\ +definition North_R3 :: R3 where + [simp]: "North_R3 = (0, 0, 1)" +lift_definition North :: "riemann_sphere" is North_R3 + by simp + +lemma stereographic_North: + shows "stereographic x = \\<^sub>h \ x = North" + by (transfer, transfer, auto split: if_split_asm) + +text \Stereographic and inverse stereographic projection are mutually inverse.\ + +lemma stereographic_inv_stereographic': + assumes + z: "z = z1/z2" and "z2 \ 0" and + X: "X = Re (2*z / (1 + z*cnj z))" and Y: "Y = Im (2*z / (1 + z*cnj z))" and Z: "Z = ((cmod z)\<^sup>2 - 1) / (1 + (cmod z)\<^sup>2)" + shows "\ k. k \ 0 \ (X + \*Y, complex_of_real (1 - Z)) = k *\<^sub>s\<^sub>v (z1, z2)" +proof- + have "1 + (cmod z)\<^sup>2 \ 0" + by (metis one_power2 sum_power2_eq_zero_iff zero_neq_one) + hence "(1 - Z) = 2 / (1 + (cmod z)\<^sup>2)" + using Z + by (auto simp add: field_simps) + hence "cor (1 - Z) = 2 / cor (1 + (cmod z)\<^sup>2)" + by auto + moreover + have "X = 2 * Re(z) / (1 + (cmod z)\<^sup>2)" + using X + by (simp add: Re_stereographic) + have "Y = 2 * Im(z) / (1 + (cmod z)\<^sup>2)" + using Y + by (simp add: Im_stereographic) + have "X + \*Y = 2 * z / cor (1 + (cmod z)\<^sup>2)" + using \1 + (cmod z)\<^sup>2 \ 0\ + unfolding Complex_eq[of X Y, symmetric] + by (subst \X = 2*Re(z) / (1 + (cmod z)\<^sup>2)\, subst \Y = 2*Im(z) / (1 + (cmod z)\<^sup>2)\, simp add: Complex_scale4 Complex_scale1) + moreover + have "1 + (cor (cmod (z1 / z2)))\<^sup>2 \ 0" + by (rule one_plus_square_neq_zero) + ultimately + show ?thesis + using \z2 \ 0\ \1 + (cmod z)\<^sup>2 \ 0\ + by (simp, subst z)+ + (rule_tac x="(2 / (1 + (cor (cmod (z1 / z2)))\<^sup>2)) / z2" in exI, auto) +qed + +lemma stereographic_inv_stereographic [simp]: + shows "stereographic (inv_stereographic w) = w" +proof- + have "w = stereographic (inv_stereographic w)" + proof (transfer, transfer) + fix w + assume "w \ vec_zero" + obtain w1 w2 where *: "w = (w1, w2)" + by (cases w, auto) + obtain x y z where **: "inv_stereographic_cvec_r3 w = (x, y, z)" + by (cases "inv_stereographic_cvec_r3 w", blast) + show "w \\<^sub>v stereographic_r3_cvec (inv_stereographic_cvec_r3 w)" + using \w \ vec_zero\ stereographic_inv_stereographic'[of "w1/w2" w1 w2 x y z] * ** + by (auto simp add: split_def Let_def split: if_split_asm) + qed + thus ?thesis + by simp +qed + +text \Stereographic projection is bijective function\ + +lemma bij_stereographic: + shows "bij stereographic" + unfolding bij_def inj_on_def surj_def +proof (safe) + fix a b + assume "stereographic a = stereographic b" + thus "a = b" + proof (transfer, transfer) + fix a b :: R3 + obtain xa ya za xb yb zb where + *: "a = (xa, ya, za)" "b = (xb, yb, zb)" + by (cases a, cases b, auto) + assume **: "a \ unit_sphere" "b \ unit_sphere" "stereographic_r3_cvec a \\<^sub>v stereographic_r3_cvec b" + show "a = b" + proof (cases "a = (0, 0, 1) \ b = (0, 0, 1)") + case True + thus ?thesis + using * ** + by (simp split: if_split_asm) force+ + next + case False + then obtain k where ++: "k \ 0" "cor xb + \ * cor yb = k * (cor xa + \ * cor ya)" "1 - cor zb = k * (1 - cor za)" + using * ** + by (auto split: if_split_asm) + + { + assume "xb + xa*zb = xa + xb*za" + "yb + ya*zb = ya + yb*za" + "xa*xa + ya*ya + za*za = 1" "xb*xb + yb*yb + zb*zb = 1" + "za \ 1" "zb \ 1" + hence "xa = xb \ ya = yb \ za = zb" + by algebra + } note *** = this + + have "za \ 1" "zb \ 1" + using False * ** + by auto + have "k = (1 - cor zb) / (1 - cor za)" + using \1 - cor zb = k * (1 - cor za)\ \za \ 1\ + by simp + hence "(1 - cor za) * (cor xb + \ * cor yb) = (1 - cor zb) * (cor xa + \ * cor ya)" + using \za \ 1\ ++(2) + by simp + hence "xb + xa*zb = xa + xb*za" + "yb + ya*zb = ya + yb*za" + "xa*xa + ya*ya + za*za = 1" "xb*xb + yb*yb + zb*zb = 1" + using * ** \za \ 1\ + apply (simp_all add: field_simps) + unfolding complex_of_real_def imaginary_unit.ctr + by (simp_all add: legacy_Complex_simps) + thus ?thesis + using * ** *** \za \ 1\ \zb \ 1\ + by simp + qed + qed +next + fix y + show "\ x. y = stereographic x" + by (rule_tac x="inv_stereographic y" in exI, simp) +qed + + +lemma inv_stereographic_stereographic [simp]: + shows "inv_stereographic (stereographic x) = x" + using stereographic_inv_stereographic[of "stereographic x"] + using bij_stereographic + unfolding bij_def inj_on_def + by simp + +lemma inv_stereographic_is_inv: + shows "inv_stereographic = inv stereographic" + by (rule inv_equality[symmetric], simp_all) + +(* ----------------------------------------------------------------- *) +subsection \Circles on the sphere\ +(* ----------------------------------------------------------------- *) + +text \Circlines in the plane correspond to circles on the Riemann sphere, and we formally establish +this connection. Every circle in three--dimensional space can be obtained as the intersection of a +sphere and a plane. We establish a one-to-one correspondence between circles on the Riemann sphere +and planes in space. Note that the plane need not intersect the sphere, but we will still say that +it defines a single imaginary circle. However, for one special circline (the one with the identity +representative matrix), there does not exist a plane in $\mathbb{R}^3$ that would correspond to it +--- in order to have this, instead of considering planes in $\mathbb{R}^3$, we must consider three +dimensional projective space and consider the infinite (hyper)plane.\ + +text \Planes in $R^3$ are given by equations $ax+by+cz=d$. Two four-tuples of coefficients $(a, b, c, +d)$ give the same plane iff they are proportional.\ + +type_synonym R4 = "real \ real \ real \ real" + +fun mult_sv :: "real \ R4 \ R4" (infixl "*\<^sub>s\<^sub>v\<^sub>4" 100) where + "k *\<^sub>s\<^sub>v\<^sub>4 (a, b, c, d) = (k*a, k*b, k*c, k*d)" + +abbreviation plane_vectors where + "plane_vectors \ {(a::real, b::real, c::real, d::real). a \ 0 \ b \ 0 \ c \ 0 \ d \ 0}" + +typedef plane_vec = "plane_vectors" + by (rule_tac x="(1, 1, 1, 1)" in exI) simp + +setup_lifting type_definition_plane_vec + +definition plane_vec_eq_r4 :: "R4 \ R4 \ bool" where + [simp]: "plane_vec_eq_r4 v1 v2 \ (\ k. k \ 0 \ v2 = k *\<^sub>s\<^sub>v\<^sub>4 v1)" + +lift_definition plane_vec_eq :: "plane_vec \ plane_vec \ bool" is plane_vec_eq_r4 + done + +lemma mult_sv_one [simp]: + shows "1 *\<^sub>s\<^sub>v\<^sub>4 x = x" + by (cases x) simp + +lemma mult_sv_distb [simp]: + shows "x *\<^sub>s\<^sub>v\<^sub>4 (y *\<^sub>s\<^sub>v\<^sub>4 v) = (x*y) *\<^sub>s\<^sub>v\<^sub>4 v" + by (cases v) simp + +quotient_type plane = plane_vec / plane_vec_eq +proof (rule equivpI) + show "reflp plane_vec_eq" + unfolding reflp_def + by (auto simp add: plane_vec_eq_def) (rule_tac x="1" in exI, simp) +next + show "symp plane_vec_eq" + unfolding symp_def + by (auto simp add: plane_vec_eq_def) (rule_tac x="1/k" in exI, simp) +next + show "transp plane_vec_eq" + unfolding transp_def + by (auto simp add: plane_vec_eq_def) (rule_tac x="ka*k" in exI, simp) +qed + +text \Plane coefficients give a linear equation and the point on the Riemann sphere lies on the +circle determined by the plane iff its representation satisfies that linear equation.\ + +definition on_sphere_circle_r4_r3 :: "R4 \ R3 \ bool" where + [simp]: "on_sphere_circle_r4_r3 \ A \ + (let (X, Y, Z) = A; + (a, b, c, d) = \ + in a*X + b*Y + c*Z + d = 0)" + +lift_definition on_sphere_circle_vec :: "plane_vec \ R3 \ bool" is on_sphere_circle_r4_r3 + done + +lift_definition on_sphere_circle :: "plane \ riemann_sphere \ bool" is on_sphere_circle_vec +proof (transfer) + fix pv1 pv2 :: R4 and w :: R3 + obtain a1 b1 c1 d1 a2 b2 c2 d2 x y z where + *: "pv1 = (a1, b1, c1, d1)" "pv2 = (a2, b2, c2, d2)" "w = (x, y, z)" + by (cases pv1, cases pv2, cases w, auto) + assume "pv1 \ plane_vectors" "pv2 \ plane_vectors" "w \ unit_sphere" "plane_vec_eq_r4 pv1 pv2" + then obtain k where **: "a2 = k*a1" "b2 = k*b1" "c2 = k*c1" "d2 = k*d1" "k \ 0" + using * + by auto + have "k * a1 * x + k * b1 * y + k * c1 * z + k * d1 = k*(a1*x + b1*y + c1*z + d1)" + by (simp add: field_simps) + thus "on_sphere_circle_r4_r3 pv1 w = on_sphere_circle_r4_r3 pv2 w" + using * ** + by simp +qed + +definition sphere_circle_set where + "sphere_circle_set \ = {A. on_sphere_circle \ A}" + + +(* ----------------------------------------------------------------- *) +subsection \Connections of circlines in the plane and circles on the Riemann sphere\ +(* ----------------------------------------------------------------- *) + +text \We introduce stereographic and inverse stereographic projection between circles on the Riemann +sphere and circlines in the extended complex plane.\ + +definition inv_stereographic_circline_cmat_r4 :: "complex_mat \ R4" where + [simp]: "inv_stereographic_circline_cmat_r4 H = + (let (A, B, C, D) = H + in (Re (B+C), Re(\*(C-B)), Re(A-D), Re(D+A)))" + +lift_definition inv_stereographic_circline_clmat_pv :: "circline_mat \ plane_vec" is inv_stereographic_circline_cmat_r4 + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def real_imag_0 eq_cnj_iff_real) + +lift_definition inv_stereographic_circline :: "circline \ plane" is inv_stereographic_circline_clmat_pv + apply transfer + apply simp + apply (erule exE) + apply (rule_tac x="k" in exI) + apply (case_tac "circline_mat1", case_tac "circline_mat2") + apply (simp add: field_simps) + done + +definition stereographic_circline_r4_cmat :: "R4 \ complex_mat" where +[simp]: "stereographic_circline_r4_cmat \ = + (let (a, b, c, d) = \ + in (cor ((c+d)/2) , ((cor a + \ * cor b)/2), ((cor a - \ * cor b)/2), cor ((d-c)/2)))" + +lift_definition stereographic_circline_pv_clmat :: "plane_vec \ circline_mat" is stereographic_circline_r4_cmat + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def) + +lift_definition stereographic_circline :: "plane \ circline" is stereographic_circline_pv_clmat + apply transfer + apply transfer + apply (case_tac plane_vec1, case_tac plane_vec2, simp, erule exE, rule_tac x=k in exI, simp add: field_simps) + done + +text \Stereographic and inverse stereographic projection of circlines are mutually inverse.\ + +lemma stereographic_circline_inv_stereographic_circline: + shows "stereographic_circline \ inv_stereographic_circline = id" +proof (rule ext, simp) + fix H + show "stereographic_circline (inv_stereographic_circline H) = H" + proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases "H") auto + have "is_real A" "is_real D" "C = cnj B" + using HH hh hermitean_elems[of A B C D] + by auto + thus "circline_eq_cmat (stereographic_circline_r4_cmat (inv_stereographic_circline_cmat_r4 H)) H" + using HH + apply simp + apply (rule_tac x=1 in exI, cases B) + by (smt add_uminus_conv_diff complex_cnj_add complex_cnj_complex_of_real complex_cnj_i complex_cnj_mult complex_cnj_one complex_eq distrib_left_numeral mult.commute mult.left_commute mult.left_neutral mult_cancel_right2 mult_minus_left of_real_1 one_add_one) + qed +qed + +text \Stereographic and inverse stereographic projection of circlines are mutually inverse.\ +lemma inv_stereographic_circline_stereographic_circline: + "inv_stereographic_circline \ stereographic_circline = id" +proof (rule ext, simp) + fix \ + show "inv_stereographic_circline (stereographic_circline \) = \" + proof (transfer, transfer) + fix \ + assume aa: "\ \ plane_vectors" + obtain a b c d where AA: "\ = (a, b, c, d)" + by (cases "\") auto + thus "plane_vec_eq_r4 (inv_stereographic_circline_cmat_r4 (stereographic_circline_r4_cmat \)) \" + using AA + by simp (rule_tac x=1 in exI, auto simp add: field_simps complex_of_real_def) + qed +qed + +lemma stereographic_sphere_circle_set'': + shows "on_sphere_circle (inv_stereographic_circline H) z \ + on_circline H (stereographic z)" +proof (transfer, transfer) + fix M :: R3 and H :: complex_mat + assume hh: "hermitean H \ H \ mat_zero" "M \ unit_sphere" + obtain A B C D where HH: "H = (A, B, C, D)" + by (cases "H") auto + have *: "is_real A" "is_real D" "C = cnj B" + using hh HH hermitean_elems[of A B C D] + by auto + obtain x y z where MM: "M = (x, y, z)" + by (cases "M") auto + show "on_sphere_circle_r4_r3 (inv_stereographic_circline_cmat_r4 H) M \ + on_circline_cmat_cvec H (stereographic_r3_cvec M)" (is "?lhs = ?rhs") + proof + assume ?lhs + show ?rhs + proof (cases "z=1") + case True + hence "x = 0" "y = 0" + using MM hh + by auto + thus ?thesis + using * \?lhs\ HH MM \z=1\ + by (cases A, simp add: vec_cnj_def Complex_eq Let_def) + next + case False + hence "Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z) = 0" + using * \?lhs\ HH MM + by (simp add: Let_def field_simps) + hence "(Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z))*(1-z) = 0" + by simp + hence "Re A*(1+z)*(1-z) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0" + by (simp add: field_simps) + moreover + have "x*x+y*y = (1+z)*(1-z)" + using MM hh + by (simp add: field_simps) + ultimately + have "Re A*(x*x+y*y) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0" + by simp + hence "(x * Re A + (1 - z) * Re B) * x - (- (y * Re A) + - ((1 - z) * Im B)) * y + (x * Re B + y * Im B + (1 - z) * Re D) * (1 - z) = 0" + by (simp add: field_simps) + thus ?thesis + using \z \ 1\ HH MM * \Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z) = 0\ + apply (simp add: Let_def vec_cnj_def) + apply (subst complex_eq_iff) + apply (simp add: field_simps) + done + qed + next + assume ?rhs + show ?lhs + proof (cases "z=1") + case True + hence "x = 0" "y = 0" + using MM hh + by auto + thus ?thesis + using HH MM \?rhs\ \z = 1\ + by (simp add: Let_def vec_cnj_def) + next + case False + hence "(x * Re A + (1 - z) * Re B) * x - (- (y * Re A) + - ((1 - z) * Im B)) * y + (x * Re B + y * Im B + (1 - z) * Re D) * (1 - z) = 0" + using HH MM * \?rhs\ + by (simp add: Let_def vec_cnj_def complex_eq_iff) + hence "Re A*(x*x+y*y) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0" + by (simp add: field_simps) + moreover + have "x*x + y*y = (1+z)*(1-z)" + using MM hh + by (simp add: field_simps) + ultimately + have "Re A*(1+z)*(1-z) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0" + by simp + hence "(Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z))*(1-z) = 0" + by (simp add: field_simps) + hence "Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z) = 0" + using \z \ 1\ + by simp + thus ?thesis + using MM HH * + by (simp add: field_simps) + qed + qed +qed + +lemma stereographic_sphere_circle_set' [simp]: + shows "stereographic ` sphere_circle_set (inv_stereographic_circline H) = + circline_set H" +unfolding sphere_circle_set_def circline_set_def +apply safe +proof- + fix x + assume "on_sphere_circle (inv_stereographic_circline H) x" + thus "on_circline H (stereographic x)" + using stereographic_sphere_circle_set'' + by simp +next + fix x + assume "on_circline H x" + show "x \ stereographic ` {z. on_sphere_circle (inv_stereographic_circline H) z}" + proof + show "x = stereographic (inv_stereographic x)" + by simp + next + show "inv_stereographic x \ {z. on_sphere_circle (inv_stereographic_circline H) z}" + using stereographic_sphere_circle_set''[of H "inv_stereographic x"] \on_circline H x\ + by simp + qed +qed + +text \The projection of the set of points on a circle on the Riemann sphere is exactly the set of +points on the circline obtained by the just introduced circle stereographic projection.\ +lemma stereographic_sphere_circle_set: + shows "stereographic ` sphere_circle_set H = circline_set (stereographic_circline H)" +using stereographic_sphere_circle_set'[of "stereographic_circline H"] +using inv_stereographic_circline_stereographic_circline +unfolding comp_def +by (metis id_apply) + +text \Stereographic projection of circlines is bijective.\ +lemma bij_stereographic_circline: + shows "bij stereographic_circline" + using stereographic_circline_inv_stereographic_circline inv_stereographic_circline_stereographic_circline + using o_bij by blast + +text \Inverse stereographic projection is bijective.\ +lemma bij_inv_stereographic_circline: + shows "bij inv_stereographic_circline" + using stereographic_circline_inv_stereographic_circline inv_stereographic_circline_stereographic_circline + using o_bij by blast + +end diff --git a/thys/Complex_Geometry/Unit_Circle_Preserving_Moebius.thy b/thys/Complex_Geometry/Unit_Circle_Preserving_Moebius.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Unit_Circle_Preserving_Moebius.thy @@ -0,0 +1,1201 @@ +(* ---------------------------------------------------------------------------- *) +section \Unit circle preserving Möbius transformations\ +(* ---------------------------------------------------------------------------- *) + +text \In this section we shall examine Möbius transformations that map the unit circle onto itself. +We shall say that they fix or preserve the unit circle (although, they do not need to fix each of +its points).\ + +theory Unit_Circle_Preserving_Moebius +imports Unitary11_Matrices Moebius Oriented_Circlines +begin + +(* ---------------------------------------------------------------------------- *) +subsection \Möbius transformations that fix the unit circle\ +(* ---------------------------------------------------------------------------- *) + +text \We define Möbius transformations that preserve unit circle as transformations represented by +generalized unitary matrices with the $1-1$ signature (elements of the gruop $GU_{1,1}(2, +\mathbb{C})$, defined earlier in the theory Unitary11Matrices).\ + +lift_definition unit_circle_fix_mmat :: "moebius_mat \ bool" is unitary11_gen + done + +lift_definition unit_circle_fix :: "moebius \ bool" is unit_circle_fix_mmat + apply transfer + apply (auto simp del: mult_sm.simps) + apply (simp del: mult_sm.simps add: unitary11_gen_mult_sm) + apply (simp del: mult_sm.simps add: unitary11_gen_div_sm) + done + +text \Our algebraic characterisation (by matrices) is geometrically correct.\ + +lemma unit_circle_fix_iff: + shows "unit_circle_fix M \ + moebius_circline M unit_circle = unit_circle" (is "?rhs = ?lhs") +proof + assume ?lhs + thus ?rhs + proof (transfer, transfer) + fix M :: complex_mat + assume "mat_det M \ 0" + assume "circline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat" + then obtain k where "k \ 0" "(1, 0, 0, -1) = cor k *\<^sub>s\<^sub>m congruence (mat_inv M) (1, 0, 0, -1)" + by auto + hence "(1/cor k, 0, 0, -1/cor k) = congruence (mat_inv M) (1, 0, 0, -1)" + using mult_sm_inv_l[of "cor k" "congruence (mat_inv M) (1, 0, 0, -1)" ] + by simp + hence "congruence M (1/cor k, 0, 0, -1/cor k) = (1, 0, 0, -1)" + using \mat_det M \ 0\ mat_det_inv[of M] + using congruence_inv[of "mat_inv M" "(1, 0, 0, -1)" "(1/cor k, 0, 0, -1/cor k)"] + by simp + hence "congruence M (1, 0, 0, -1) = cor k *\<^sub>s\<^sub>m (1, 0, 0, -1)" + using congruence_scale_m[of "M" "1/cor k" "(1, 0, 0, -1)"] + using mult_sm_inv_l[of "1/ cor k" "congruence M (1, 0, 0, -1)" "(1, 0, 0, -1)"] \k \ 0\ + by simp + thus "unitary11_gen M" + using \k \ 0\ + unfolding unitary11_gen_def + by simp + qed +next + assume ?rhs + thus ?lhs + proof (transfer, transfer) + fix M :: complex_mat + assume "mat_det M \ 0" + assume "unitary11_gen M" + hence "unitary11_gen (mat_inv M)" + using \mat_det M \ 0\ + using unitary11_gen_mat_inv + by simp + thus " circline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat" + unfolding unitary11_gen_real + by auto (rule_tac x="1/k" in exI, simp) + qed +qed + +lemma circline_set_fix_iff_circline_fix: + assumes "circline_set H' \ {}" + shows "circline_set (moebius_circline M H) = circline_set H' \ + moebius_circline M H = H'" + using assms + by auto (rule inj_circline_set, auto) + +lemma unit_circle_fix_iff_unit_circle_set: + shows "unit_circle_fix M \ moebius_pt M ` unit_circle_set = unit_circle_set" +proof- + have "circline_set unit_circle \ {}" + using one_in_unit_circle_set + by auto + thus ?thesis + using unit_circle_fix_iff[of M] circline_set_fix_iff_circline_fix[of unit_circle M unit_circle] + by (simp add: unit_circle_set_def) +qed + + +text \Unit circle preserving Möbius transformations form a group. \ + +lemma unit_circle_fix_id_moebius [simp]: + shows "unit_circle_fix id_moebius" + by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def) + +lemma unit_circle_fix_moebius_add [simp]: + assumes "unit_circle_fix M1" and "unit_circle_fix M2" + shows "unit_circle_fix (M1 + M2)" + using assms + unfolding unit_circle_fix_iff + by auto + +lemma unit_circle_fix_moebius_comp [simp]: + assumes "unit_circle_fix M1" and "unit_circle_fix M2" + shows "unit_circle_fix (moebius_comp M1 M2)" + using unit_circle_fix_moebius_add[OF assms] + by simp + +lemma unit_circle_fix_moebius_uminus [simp]: + assumes "unit_circle_fix M" + shows "unit_circle_fix (-M)" + using assms + unfolding unit_circle_fix_iff + by (metis moebius_circline_comp_inv_left uminus_moebius_def) + +lemma unit_circle_fix_moebius_inv [simp]: + assumes "unit_circle_fix M" + shows "unit_circle_fix (moebius_inv M)" + using unit_circle_fix_moebius_uminus[OF assms] + by simp + +text \Unit circle fixing transforms preserve inverse points.\ + +lemma unit_circle_fix_moebius_pt_inversion [simp]: + assumes "unit_circle_fix M" + shows "moebius_pt M (inversion z) = inversion (moebius_pt M z)" + using assms + using symmetry_principle[of z "inversion z" unit_circle M] + using unit_circle_fix_iff[of M, symmetric] + using circline_symmetric_inv_homo_disc[of z] + using circline_symmetric_inv_homo_disc'[of "moebius_pt M z" "moebius_pt M (inversion z)"] + by metis + +(* -------------------------------------------------------------------------- *) +subsection \Möbius transformations that fix the imaginary unit circle\ +(* -------------------------------------------------------------------------- *) + +text \Only for completeness we show that Möbius transformations that preserve the imaginary unit +circle are exactly those characterised by generalized unitary matrices (with the (2, 0) signature).\ +lemma imag_unit_circle_fixed_iff_unitary_gen: + assumes "mat_det (A, B, C, D) \ 0" + shows "moebius_circline (mk_moebius A B C D) imag_unit_circle = imag_unit_circle \ + unitary_gen (A, B, C, D)" (is "?lhs = ?rhs") +proof + assume ?lhs + thus ?rhs + using assms + proof (transfer, transfer) + fix A B C D :: complex + let ?M = "(A, B, C, D)" and ?E = "(1, 0, 0, 1)" + assume "circline_eq_cmat (moebius_circline_cmat_cmat (mk_moebius_cmat A B C D) imag_unit_circle_cmat) imag_unit_circle_cmat" + "mat_det ?M \ 0" + then obtain k where "k \ 0" "?E = cor k *\<^sub>s\<^sub>m congruence (mat_inv ?M) ?E" + by auto + hence "unitary_gen (mat_inv ?M)" + using mult_sm_inv_l[of "cor k" "congruence (mat_inv ?M) ?E" "?E"] + unfolding unitary_gen_def + by (metis congruence_def divide_eq_0_iff eye_def mat_eye_r of_real_eq_0_iff one_neq_zero) + thus "unitary_gen ?M" + using unitary_gen_inv[of "mat_inv ?M"] \mat_det ?M \ 0\ + by (simp del: mat_inv.simps) + qed +next + assume ?rhs + thus ?lhs + using assms + proof (transfer, transfer) + fix A B C D :: complex + let ?M = "(A, B, C, D)" and ?E = "(1, 0, 0, 1)" + assume "unitary_gen ?M" "mat_det ?M \ 0" + hence "unitary_gen (mat_inv ?M)" + using unitary_gen_inv[of ?M] + by simp + then obtain k where "k \ 0" "mat_adj (mat_inv ?M) *\<^sub>m\<^sub>m (mat_inv ?M) = cor k *\<^sub>s\<^sub>m eye" + using unitary_gen_real[of "mat_inv ?M"] mat_det_inv[of ?M] + by auto + hence *: "?E = (1 / cor k) *\<^sub>s\<^sub>m (mat_adj (mat_inv ?M) *\<^sub>m\<^sub>m (mat_inv ?M))" + using mult_sm_inv_l[of "cor k" eye "mat_adj (mat_inv ?M) *\<^sub>m\<^sub>m (mat_inv ?M)"] + by simp + have "\k. k \ 0 \ + (1, 0, 0, 1) = cor k *\<^sub>s\<^sub>m (mat_adj (mat_inv (A, B, C, D)) *\<^sub>m\<^sub>m (1, 0, 0, 1) *\<^sub>m\<^sub>m mat_inv (A, B, C, D))" + using \mat_det ?M \ 0\ \k \ 0\ + by (metis "*" Im_complex_of_real Re_complex_of_real \mat_adj (mat_inv ?M) *\<^sub>m\<^sub>m mat_inv ?M = cor k *\<^sub>s\<^sub>m eye\ complex_of_real_Re eye_def mat_eye_l mult_mm_assoc mult_mm_sm mult_sm_eye_mm of_real_1 of_real_divide of_real_eq_1_iff zero_eq_1_divide_iff) + thus "circline_eq_cmat (moebius_circline_cmat_cmat (mk_moebius_cmat A B C D) imag_unit_circle_cmat) imag_unit_circle_cmat" + using \mat_det ?M \ 0\ \k \ 0\ + by (simp del: mat_inv.simps) + qed +qed + +(* -------------------------------------------------------------------------- *) +subsection \Möbius transformations that fix the oriented unit circle and the unit disc\ +(* -------------------------------------------------------------------------- *) + +text \Möbius transformations that fix the unit circle either map the unit disc onto itself or +exchange it with its exterior. The transformations that fix the unit disc can be recognized from +their matrices -- they have the form as before, but additionally it must hold that $|a|^2 > |b|^2$.\ + +definition unit_disc_fix_cmat :: "complex_mat \ bool" where + [simp]: "unit_disc_fix_cmat M \ + (let (A, B, C, D) = M + in unitary11_gen (A, B, C, D) \ (B = 0 \ Re ((A*D)/(B*C)) > 1))" + +lift_definition unit_disc_fix_mmat :: "moebius_mat \ bool" is unit_disc_fix_cmat + done + +lift_definition unit_disc_fix :: "moebius \ bool" is unit_disc_fix_mmat +proof transfer + fix M M' :: complex_mat + assume det: "mat_det M \ 0" "mat_det M' \ 0" + assume "moebius_cmat_eq M M'" + then obtain k where *: "k \ 0" "M' = k *\<^sub>s\<^sub>m M" + by auto + hence **: "unitary11_gen M \ unitary11_gen M'" + using unitary11_gen_mult_sm[of k M] unitary11_gen_div_sm[of k M] + by auto + obtain A B C D where MM: "(A, B, C, D) = M" + by (cases M) auto + obtain A' B' C' D' where MM': "(A', B', C', D') = M'" + by (cases M') auto + + show "unit_disc_fix_cmat M = unit_disc_fix_cmat M'" + using * ** MM MM' + by auto +qed + +text \Transformations that fix the unit disc also fix the unit circle.\ +lemma unit_disc_fix_unit_circle_fix [simp]: + assumes "unit_disc_fix M" + shows "unit_circle_fix M" + using assms + by (transfer, transfer, auto) + +text \Transformations that preserve the unit disc preserve the orientation of the unit circle.\ +lemma unit_disc_fix_iff_ounit_circle: + shows "unit_disc_fix M \ + moebius_ocircline M ounit_circle = ounit_circle" (is "?rhs \ ?lhs") +proof + assume *: ?lhs + have "moebius_circline M unit_circle = unit_circle" + apply (subst moebius_circline_ocircline[of M unit_circle]) + apply (subst of_circline_unit_circle) + apply (subst *) + by simp + + hence "unit_circle_fix M" + by (simp add: unit_circle_fix_iff) + thus ?rhs + using * + proof (transfer, transfer) + fix M :: complex_mat + assume "mat_det M \ 0" + let ?H = "(1, 0, 0, -1)" + obtain A B C D where MM: "(A, B, C, D) = M" + by (cases M) auto + assume "unitary11_gen M" "ocircline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat" + then obtain k where "0 < k" "?H = cor k *\<^sub>s\<^sub>m congruence (mat_inv M) ?H" + by auto + hence "congruence M ?H = cor k *\<^sub>s\<^sub>m ?H" + using congruence_inv[of "mat_inv M" "?H" "(1/cor k) *\<^sub>s\<^sub>m ?H"] \mat_det M \ 0\ + using mult_sm_inv_l[of "cor k" "congruence (mat_inv M) ?H" "?H"] + using mult_sm_inv_l[of "1/cor k" "congruence M ?H"] + using congruence_scale_m[of M "1/cor k" "?H"] + by (auto simp add: mat_det_inv) + then obtain a b k' where "k' \ 0" "M = k' *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" "sgn (Re (mat_det (a, b, cnj b, cnj a))) = 1" + using unitary11_sgn_det_orientation'[of M k] \k > 0\ + by auto + moreover + have "mat_det (a, b, cnj b, cnj a) \ 0" + using \sgn (Re (mat_det (a, b, cnj b, cnj a))) = 1\ + by (smt sgn_0 zero_complex.simps(1)) + ultimately + show "unit_disc_fix_cmat M" + using unitary11_sgn_det[of k' a b M A B C D] + using MM[symmetric] \k > 0\ \unitary11_gen M\ + by (simp add: sgn_1_pos split: if_split_asm) + qed +next + assume ?rhs + thus ?lhs + proof (transfer, transfer) + fix M :: complex_mat + assume "mat_det M \ 0" + + obtain A B C D where MM: "(A, B, C, D) = M" + by (cases M) auto + assume "unit_disc_fix_cmat M" + hence "unitary11_gen M" "B = 0 \ 1 < Re (A * D / (B * C))" + using MM[symmetric] + by auto + have "sgn (if B = 0 then 1 else sgn (Re (A * D / (B * C)) - 1)) = 1" + using \B = 0 \ 1 < Re (A * D / (B * C))\ + by auto + then obtain k' where "k' > 0" "congruence M (1, 0, 0, -1) = cor k' *\<^sub>s\<^sub>m (1, 0, 0, -1)" + using unitary11_orientation[OF \unitary11_gen M\ MM[symmetric]] + by (auto simp add: sgn_1_pos) + thus "ocircline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat" + using congruence_inv[of M "(1, 0, 0, -1)" "cor k' *\<^sub>s\<^sub>m (1, 0, 0, -1)"] \mat_det M \ 0\ + using congruence_scale_m[of "mat_inv M" "cor k'" "(1, 0, 0, -1)"] + by auto + qed +qed + + +text \Our algebraic characterisation (by matrices) is geometrically correct.\ + +lemma unit_disc_fix_iff [simp]: + assumes "unit_disc_fix M" + shows "moebius_pt M ` unit_disc = unit_disc" + using assms + using unit_disc_fix_iff_ounit_circle[of M] + unfolding unit_disc_def + by (subst disc_moebius_ocircline[symmetric], simp) + +lemma unit_disc_fix_discI [simp]: + assumes "unit_disc_fix M" and "u \ unit_disc" + shows "moebius_pt M u \ unit_disc" + using unit_disc_fix_iff assms + by blast + +text \Unit disc preserving transformations form a group.\ + +lemma unit_disc_fix_id_moebius [simp]: + shows "unit_disc_fix id_moebius" + by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def) + +lemma unit_disc_fix_moebius_add [simp]: + assumes "unit_disc_fix M1" and "unit_disc_fix M2" + shows "unit_disc_fix (M1 + M2)" + using assms + unfolding unit_disc_fix_iff_ounit_circle + by auto + +lemma unit_disc_fix_moebius_comp [simp]: + assumes "unit_disc_fix M1" and "unit_disc_fix M2" + shows "unit_disc_fix (moebius_comp M1 M2)" + using unit_disc_fix_moebius_add[OF assms] + by simp + +lemma unit_disc_fix_moebius_uminus [simp]: + assumes "unit_disc_fix M" + shows "unit_disc_fix (-M)" + using assms + unfolding unit_disc_fix_iff_ounit_circle + by (metis moebius_ocircline_comp_inv_left uminus_moebius_def) + +lemma unit_disc_fix_moebius_inv [simp]: + assumes "unit_disc_fix M" + shows "unit_disc_fix (moebius_inv M)" + using unit_disc_fix_moebius_uminus[OF assms] + by simp + +(* -------------------------------------------------------------------------- *) +subsection \Rotations are unit disc preserving transformations\ +(* -------------------------------------------------------------------------- *) + +lemma unit_disc_fix_rotation [simp]: + shows "unit_disc_fix (moebius_rotation \)" + unfolding moebius_rotation_def moebius_similarity_def + by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def cis_mult) + +lemma moebius_rotation_unit_circle_fix [simp]: + shows "moebius_pt (moebius_rotation \) u \ unit_circle_set \ u \ unit_circle_set" + using moebius_pt_moebius_inv_in_set unit_circle_fix_iff_unit_circle_set + by fastforce + +lemma ex_rotation_mapping_u_to_positive_x_axis: + assumes "u \ 0\<^sub>h" and "u \ \\<^sub>h" + shows "\ \. moebius_pt (moebius_rotation \) u \ positive_x_axis" +proof- + from assms obtain c where *: "u = of_complex c" + using inf_or_of_complex + by blast + have "is_real (cis (- arg c) * c)" "Re (cis (-arg c) * c) > 0" + using "*" assms is_real_rot_to_x_axis positive_rot_to_x_axis of_complex_zero_iff + by blast+ + thus ?thesis + using * + by (rule_tac x="-arg c" in exI) (simp add: positive_x_axis_def circline_set_x_axis) +qed + +lemma ex_rotation_mapping_u_to_positive_y_axis: + assumes "u \ 0\<^sub>h" and "u \ \\<^sub>h" + shows "\ \. moebius_pt (moebius_rotation \) u \ positive_y_axis" +proof- + from assms obtain c where *: "u = of_complex c" + using inf_or_of_complex + by blast + have "is_imag (cis (pi/2 - arg c) * c)" "Im (cis (pi/2 - arg c) * c) > 0" + using "*" assms is_real_rot_to_x_axis positive_rot_to_x_axis of_complex_zero_iff + by - (simp, simp, simp add: field_simps) + thus ?thesis + using * + by (rule_tac x="pi/2-arg c" in exI) (simp add: positive_y_axis_def circline_set_y_axis) +qed + +lemma wlog_rotation_to_positive_x_axis: + assumes in_disc: "u \ unit_disc" and not_zero: "u \ 0\<^sub>h" + assumes preserving: "\\ u. \u \ unit_disc; u \ 0\<^sub>h; P (moebius_pt (moebius_rotation \) u)\ \ P u" + assumes x_axis: "\x. \is_real x; 0 < Re x; Re x < 1\ \ P (of_complex x)" + shows "P u" +proof- + from in_disc obtain \ where *: + "moebius_pt (moebius_rotation \) u \ positive_x_axis" + using ex_rotation_mapping_u_to_positive_x_axis[of u] + using inf_notin_unit_disc not_zero + by blast + let ?Mu = "moebius_pt (moebius_rotation \) u" + have "P ?Mu" + proof- + let ?x = "to_complex ?Mu" + have "?Mu \ unit_disc" "?Mu \ 0\<^sub>h" "?Mu \ \\<^sub>h" + using \u \ unit_disc\ \u \ 0\<^sub>h\ + by auto + hence "is_real (to_complex ?Mu)" "0 < Re ?x" "Re ?x < 1" + using * + unfolding positive_x_axis_def circline_set_x_axis + by (auto simp add: cmod_eq_Re) + thus ?thesis + using x_axis[of ?x] \?Mu \ \\<^sub>h\ + by simp + qed + thus ?thesis + using preserving[OF in_disc] not_zero + by simp +qed + +lemma wlog_rotation_to_positive_x_axis': + assumes not_zero: "u \ 0\<^sub>h" and not_inf: "u \ \\<^sub>h" + assumes preserving: "\\ u. \u \ 0\<^sub>h; u \ \\<^sub>h; P (moebius_pt (moebius_rotation \) u)\ \ P u" + assumes x_axis: "\x. \is_real x; 0 < Re x\ \ P (of_complex x)" + shows "P u" +proof- + from not_zero and not_inf obtain \ where *: + "moebius_pt (moebius_rotation \) u \ positive_x_axis" + using ex_rotation_mapping_u_to_positive_x_axis[of u] + using inf_notin_unit_disc + by blast + let ?Mu = "moebius_pt (moebius_rotation \) u" + have "P ?Mu" + proof- + let ?x = "to_complex ?Mu" + have "?Mu \ 0\<^sub>h" "?Mu \ \\<^sub>h" + using \u \ \\<^sub>h\ \u \ 0\<^sub>h\ + by auto + hence "is_real (to_complex ?Mu)" "0 < Re ?x" + using * + unfolding positive_x_axis_def circline_set_x_axis + by (auto simp add: cmod_eq_Re) + thus ?thesis + using x_axis[of ?x] \?Mu \ \\<^sub>h\ + by simp + qed + thus ?thesis + using preserving[OF not_zero not_inf] + by simp +qed + +lemma wlog_rotation_to_positive_y_axis: + assumes in_disc: "u \ unit_disc" and not_zero: "u \ 0\<^sub>h" + assumes preserving: "\\ u. \u \ unit_disc; u \ 0\<^sub>h; P (moebius_pt (moebius_rotation \) u)\ \ P u" + assumes y_axis: "\x. \is_imag x; 0 < Im x; Im x < 1\ \ P (of_complex x)" + shows "P u" +proof- + from in_disc and not_zero obtain \ where *: + "moebius_pt (moebius_rotation \) u \ positive_y_axis" + using ex_rotation_mapping_u_to_positive_y_axis[of u] + using inf_notin_unit_disc + by blast + let ?Mu = "moebius_pt (moebius_rotation \) u" + have "P ?Mu" + proof- + let ?y = "to_complex ?Mu" + have "?Mu \ unit_disc" "?Mu \ 0\<^sub>h" "?Mu \ \\<^sub>h" + using \u \ unit_disc\ \u \ 0\<^sub>h\ + by auto + hence "is_imag (to_complex ?Mu)" "0 < Im ?y" "Im ?y < 1" + using * + unfolding positive_y_axis_def circline_set_y_axis + by (auto simp add: cmod_eq_Im) + thus ?thesis + using y_axis[of ?y] \?Mu \ \\<^sub>h\ + by simp + qed + thus ?thesis + using preserving[OF in_disc not_zero] + by simp +qed + +(* ---------------------------------------------------------------------------- *) +subsection \Blaschke factors are unit disc preserving transformations\ +(* ---------------------------------------------------------------------------- *) + +text \For a given point $a$, Blaschke factor transformations are of the form $k \cdot +\left(\begin{array}{cc}1 & -a\\ -\overline{a} & 1\end{array}\right)$. It is a disc preserving +Möbius transformation that maps the point $a$ to zero (by the symmetry principle, it must map the +inverse point of $a$ to infinity).\ + +definition blaschke_cmat :: "complex \ complex_mat" where + [simp]: "blaschke_cmat a = (if cmod a \ 1 then (1, -a, -cnj a, 1) else eye)" +lift_definition blaschke_mmat :: "complex \ moebius_mat" is blaschke_cmat + by simp +lift_definition blaschke :: "complex \ moebius" is blaschke_mmat + done + +lemma blaschke_0_id [simp]: "blaschke 0 = id_moebius" + by (transfer, transfer, simp) + +lemma blaschke_a_to_zero [simp]: + assumes "cmod a \ 1" + shows "moebius_pt (blaschke a) (of_complex a) = 0\<^sub>h" + using assms + by (transfer, transfer, simp) + +lemma blaschke_inv_a_inf [simp]: + assumes "cmod a \ 1" + shows "moebius_pt (blaschke a) (inversion (of_complex a)) = \\<^sub>h" + using assms + unfolding inversion_def + by (transfer, transfer) (simp add: vec_cnj_def, rule_tac x="1/(1 - a*cnj a)" in exI, simp) + +lemma blaschke_inf [simp]: + assumes "cmod a < 1" and "a \ 0" + shows "moebius_pt (blaschke a) \\<^sub>h = of_complex (- 1 / cnj a)" + using assms + by (transfer, transfer, simp add: complex_mod_sqrt_Re_mult_cnj) + +lemma blaschke_0_minus_a [simp]: + assumes "cmod a \ 1" + shows "moebius_pt (blaschke a) 0\<^sub>h = ~\<^sub>h (of_complex a)" + using assms + by (transfer, transfer, simp) + +lemma blaschke_unit_circle_fix [simp]: + assumes "cmod a \ 1" + shows "unit_circle_fix (blaschke a)" + using assms + by (transfer, transfer) (simp add: unitary11_gen_def mat_adj_def mat_cnj_def) + +lemma blaschke_unit_disc_fix [simp]: + assumes "cmod a < 1" + shows "unit_disc_fix (blaschke a)" + using assms +proof (transfer, transfer) + fix a + assume *: "cmod a < 1" + show "unit_disc_fix_cmat (blaschke_cmat a)" + proof (cases "a = 0") + case True + thus ?thesis + by (simp add: unitary11_gen_def mat_adj_def mat_cnj_def) + next + case False + hence "Re (a * cnj a) < 1" + using * + by (metis complex_mod_sqrt_Re_mult_cnj real_sqrt_lt_1_iff) + hence "1 / Re (a * cnj a) > 1" + using False + by (smt complex_div_gt_0 less_divide_eq_1_pos one_complex.simps(1) right_inverse_eq) + hence "Re (1 / (a * cnj a)) > 1" + by (simp add: complex_is_Real_iff) + thus ?thesis + by (simp add: unitary11_gen_def mat_adj_def mat_cnj_def) + qed +qed + +lemma blaschke_unit_circle_fix': + assumes "cmod a \ 1" + shows "moebius_circline (blaschke a) unit_circle = unit_circle" + using assms + using blaschke_unit_circle_fix unit_circle_fix_iff + by simp + +lemma blaschke_ounit_circle_fix': + assumes "cmod a < 1" + shows "moebius_ocircline (blaschke a) ounit_circle = ounit_circle" +proof- + have "Re (a * cnj a) < 1" + using assms + by (metis complex_mod_sqrt_Re_mult_cnj real_sqrt_lt_1_iff) + thus ?thesis + using assms + using blaschke_unit_disc_fix unit_disc_fix_iff_ounit_circle + by simp +qed + +lemma moebius_pt_blaschke [simp]: + assumes "cmod a \ 1" and "z \ 1 / cnj a" + shows "moebius_pt (blaschke a) (of_complex z) = of_complex ((z - a) / (1 - cnj a * z))" + using assms +proof (cases "a = 0") + case True + thus ?thesis + by auto +next + case False + thus ?thesis + using assms + apply (transfer, transfer) + apply (simp add: complex_mod_sqrt_Re_mult_cnj) + apply (rule_tac x="1 / (1 - cnj a * z)" in exI) + apply (simp add: field_simps) + done +qed + +(* -------------------------------------------------------------------------- *) +subsubsection \Blaschke factors for a real point $a$\ +(* -------------------------------------------------------------------------- *) + +text \If the point $a$ is real, the Blaschke factor preserve x-axis and the upper and the lower +halfplane.\ + +lemma blaschke_real_preserve_x_axis [simp]: + assumes "is_real a" and "cmod a < 1" + shows "moebius_pt (blaschke a) z \ circline_set x_axis \ z \ circline_set x_axis" +proof (cases "a = 0") + case True + thus ?thesis + by simp +next + case False + have "cmod a \ 1" + using assms + by linarith + let ?a = "of_complex a" + let ?i = "inversion ?a" + let ?M = "moebius_pt (blaschke a)" + have *: "?M ?a = 0\<^sub>h" "?M ?i = \\<^sub>h" "?M 0\<^sub>h = of_complex (-a)" + using \cmod a \ 1\ blaschke_a_to_zero[of a] blaschke_inv_a_inf[of a] blaschke_0_minus_a[of a] + by auto + let ?Mx = "moebius_circline (blaschke a) x_axis" + have "?a \ circline_set x_axis" "?i \ circline_set x_axis" "0\<^sub>h \ circline_set x_axis" + using \is_real a\ \a \ 0\ eq_cnj_iff_real[of a] + by auto + hence "0\<^sub>h \ circline_set ?Mx" "\\<^sub>h \ circline_set ?Mx" "of_complex (-a) \ circline_set ?Mx" + using * + apply - + apply (force simp add: image_iff)+ + apply (simp add: image_iff, rule_tac x="0\<^sub>h" in bexI, simp_all) + done + moreover + have "0\<^sub>h \ circline_set x_axis" "\\<^sub>h \ circline_set x_axis" "of_complex (-a) \ circline_set x_axis" + using \is_real a\ + by auto + moreover + have "of_complex (-a) \ 0\<^sub>h" + using \a \ 0\ + by simp + hence "0\<^sub>h \ of_complex (-a)" + by metis + hence "\!H. 0\<^sub>h \ circline_set H \ \\<^sub>h \ circline_set H \ of_complex (- a) \ circline_set H" + using unique_circline_set[of "0\<^sub>h" "\\<^sub>h" "of_complex (-a)"] \a \ 0\ + by simp + ultimately + have "moebius_circline (blaschke a) x_axis = x_axis" + by auto + thus ?thesis + by (metis circline_set_moebius_circline_iff) +qed + +lemma blaschke_real_preserve_sgn_Im [simp]: + assumes "is_real a" and "cmod a < 1" and "z \ \\<^sub>h" and "z \ inversion (of_complex a)" + shows "sgn (Im (to_complex (moebius_pt (blaschke a) z))) = sgn (Im (to_complex z))" +proof (cases "a = 0") + case True + thus ?thesis + by simp +next + case False + obtain z' where z': "z = of_complex z'" + using inf_or_of_complex[of z] \z \ \\<^sub>h\ + by auto + have "z' \ 1 / cnj a" + using assms z' \a \ 0\ + by (auto simp add: of_complex_inj) + moreover + have "a * cnj a \ 1" + using \cmod a < 1\ + by auto (simp add: complex_mod_sqrt_Re_mult_cnj) + moreover + have "sgn (Im ((z' - a) / (1 - a * z'))) = sgn (Im z')" + proof- + have "a * z' \ 1" + using \is_real a\ \z' \ 1 / cnj a\ \a \ 0\ eq_cnj_iff_real[of a] + by (simp add: field_simps) + moreover + have "Re (1 - a\<^sup>2) > 0" + using \is_real a\ \cmod a < 1\ + by (smt Re_power2 minus_complex.simps(1) norm_complex_def one_complex.simps(1) power2_less_0 real_sqrt_lt_1_iff) + moreover + have "Im ((z' - a) / (1 - a * z')) = Re (((1 - a\<^sup>2) * Im z') / (cmod (1 - a*z'))\<^sup>2)" + proof- + have "1 - a * cnj z' \ 0" + using \z' \ 1 / cnj a\ + by (metis Im_complex_div_eq_0 complex_cnj_zero_iff diff_eq_diff_eq diff_numeral_special(9) eq_divide_imp is_real_div mult_not_zero one_complex.simps(2) zero_neq_one) + hence "Im ((z' - a) / (1 - a * z')) = Im (((z' - a) * (1 - a * cnj z')) / ((1 - a * z') * cnj (1 - a * z')))" + using \is_real a\ eq_cnj_iff_real[of a] + by simp + also have "... = Im ((z' - a - a * z' * cnj z' + a\<^sup>2 * cnj z') / (cmod (1 - a*z'))\<^sup>2)" + unfolding complex_mult_cnj_cmod + by (simp add: power2_eq_square field_simps) + finally show ?thesis + using \is_real a\ + by (simp add: field_simps) + qed + moreover + have "0 < (1 - (Re a)\<^sup>2) * Im z' / (cmod (1 - a * z'))\<^sup>2 \ Im z' > 0" + using `is_real a` `0 < Re (1 - a\<^sup>2)` + by (smt Re_power_real divide_le_0_iff minus_complex.simps(1) not_sum_power2_lt_zero one_complex.simps(1) zero_less_mult_pos) + ultimately + show ?thesis + unfolding sgn_real_def + using \cmod a < 1\ \a * z' \ 1\ \is_real a\ + by (auto simp add: cmod_eq_Re) + qed + ultimately + show ?thesis + using assms z' moebius_pt_blaschke[of a z'] \is_real a\ eq_cnj_iff_real[of a] + by simp +qed + +lemma blaschke_real_preserve_sgn_arg [simp]: + assumes "is_real a" and "cmod a < 1" and "z \ circline_set x_axis" + shows "sgn (arg (to_complex (moebius_pt (blaschke a) z))) = sgn (arg (to_complex z))" +proof- + have "z \ \\<^sub>h" + using assms + using special_points_on_x_axis''(3) by blast + moreover + have "z \ inversion (of_complex a)" + using assms + by (metis calculation circline_equation_x_axis circline_set_x_axis_I conjugate_of_complex inversion_of_complex inversion_sym is_real_inversion o_apply of_complex_zero reciprocal_zero to_complex_of_complex) + ultimately + show ?thesis + using blaschke_real_preserve_sgn_Im[OF assms(1) assms(2), of z] + by (smt arg_Im_sgn assms(3) circline_set_x_axis_I norm_sgn of_complex_to_complex) +qed + +(* -------------------------------------------------------------------------- *) +subsubsection \Inverse Blaschke transform\ +(* -------------------------------------------------------------------------- *) + +definition inv_blaschke_cmat :: "complex \ complex_mat" where + [simp]: "inv_blaschke_cmat a = (if cmod a \ 1 then (1, a, cnj a, 1) else eye)" +lift_definition inv_blaschke_mmat :: "complex \ moebius_mat" is inv_blaschke_cmat + by simp +lift_definition inv_blaschke :: "complex \ moebius" is inv_blaschke_mmat + done + +lemma inv_blaschke_neg [simp]: "inv_blaschke a = blaschke (-a)" + by (transfer, transfer) simp + +lemma inv_blaschke: + assumes "cmod a \ 1" + shows "blaschke a + inv_blaschke a = 0" + apply simp + apply (transfer, transfer) + by auto (rule_tac x="1/(1 - a*cnj a)" in exI, simp) + +lemma ex_unit_disc_fix_mapping_u_to_zero: + assumes "u \ unit_disc" + shows "\ M. unit_disc_fix M \ moebius_pt M u = 0\<^sub>h" +proof- + from assms obtain c where *: "u = of_complex c" + by (metis inf_notin_unit_disc inf_or_of_complex) + hence "cmod c < 1" + using assms unit_disc_iff_cmod_lt_1 + by simp + thus ?thesis + using * + by (rule_tac x="blaschke c" in exI) + (smt blaschke_a_to_zero blaschke_ounit_circle_fix' unit_disc_fix_iff_ounit_circle) +qed + +lemma wlog_zero: + assumes in_disc: "u \ unit_disc" + assumes preserving: "\ a u. \u \ unit_disc; cmod a < 1; P (moebius_pt (blaschke a) u)\ \ P u" + assumes zero: "P 0\<^sub>h" + shows "P u" +proof- + have *: "moebius_pt (blaschke (to_complex u)) u = 0\<^sub>h" + by (smt blaschke_a_to_zero in_disc inf_notin_unit_disc of_complex_to_complex unit_disc_iff_cmod_lt_1) + thus ?thesis + using preserving[of u "to_complex u"] in_disc zero + using inf_or_of_complex[of u] + by auto +qed + +lemma wlog_real_zero: + assumes in_disc: "u \ unit_disc" and real: "is_real (to_complex u)" + assumes preserving: "\ a u. \u \ unit_disc; is_real a; cmod a < 1; P (moebius_pt (blaschke a) u)\ \ P u" + assumes zero: "P 0\<^sub>h" + shows "P u" +proof- + have *: "moebius_pt (blaschke (to_complex u)) u = 0\<^sub>h" + by (smt blaschke_a_to_zero in_disc inf_notin_unit_disc of_complex_to_complex unit_disc_iff_cmod_lt_1) + thus ?thesis + using preserving[of u "to_complex u"] in_disc zero real + using inf_or_of_complex[of u] + by auto +qed + +lemma unit_disc_fix_transitive: + assumes in_disc: "u \ unit_disc" and "u' \ unit_disc" + shows "\ M. unit_disc_fix M \ moebius_pt M u = u'" +proof- + have "\ u \ unit_disc. \ M. unit_disc_fix M \ moebius_pt M u = u'" (is "?P u'") + proof (rule wlog_zero) + show "u' \ unit_disc" by fact + next + show "?P 0\<^sub>h" + by (simp add: ex_unit_disc_fix_mapping_u_to_zero) + next + fix a u + assume "cmod a < 1" and *: "?P (moebius_pt (blaschke a) u)" + show "?P u" + proof + fix u' + assume "u' \ unit_disc" + then obtain M' where "unit_disc_fix M'" "moebius_pt M' u' = moebius_pt (blaschke a) u" + using * + by auto + thus "\M. unit_disc_fix M \ moebius_pt M u' = u" + using \cmod a < 1\ blaschke_unit_disc_fix[of a] + using unit_disc_fix_moebius_comp[of "- blaschke a" "M'"] + using unit_disc_fix_moebius_inv[of "blaschke a"] + by (rule_tac x="(- (blaschke a)) + M'" in exI, simp) + qed + qed + thus ?thesis + using assms + by auto +qed + +(* -------------------------------------------------------------------------- *) +subsection \Decomposition of unit disc preserving Möbius transforms\ +(* -------------------------------------------------------------------------- *) + +text \Each transformation preserving unit disc can be decomposed to a rotation around the origin and +a Blaschke factors that maps a point within the unit disc to zero.\ + +lemma unit_disc_fix_decompose_blaschke_rotation: + assumes "unit_disc_fix M" + shows "\ k \. cmod k < 1 \ M = moebius_rotation \ + blaschke k" + using assms + unfolding moebius_rotation_def moebius_similarity_def +proof (simp, transfer, transfer) + fix M + assume *: "mat_det M \ 0" "unit_disc_fix_cmat M" + then obtain k a b :: complex where + **: "k \ 0" "mat_det (a, b, cnj b, cnj a) \ 0" "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" + using unitary11_gen_iff[of M] + by auto + have "a \ 0" + using * ** + by auto + then obtain a' k' \ + where ***: "k' \ 0 \ a' * cnj a' \ 1 \ M = k' *\<^sub>s\<^sub>m (cis \, 0, 0, 1) *\<^sub>m\<^sub>m (1, - a', - cnj a', 1)" + using ** unitary11_gen_cis_blaschke[of k M a b] + by auto + have "a' = 0 \ 1 < 1 / (cmod a')\<^sup>2" + using * *** complex_mult_cnj_cmod[of a'] + by simp + hence "cmod a' < 1" + by (smt less_divide_eq_1_pos norm_zero one_less_power one_power2 pos2) + thus "\k. cmod k < 1 \ + (\\. moebius_cmat_eq M (moebius_comp_cmat (mk_moebius_cmat (cis \) 0 0 1) (blaschke_cmat k)))" + using *** + apply (rule_tac x=a' in exI) + apply simp + apply (rule_tac x=\ in exI) + apply simp + apply (rule_tac x="1/k'" in exI) + by auto +qed + +lemma wlog_unit_disc_fix: + assumes "unit_disc_fix M" + assumes b: "\ k. cmod k < 1 \ P (blaschke k)" + assumes r: "\ \. P (moebius_rotation \)" + assumes comp: "\M1 M2. \unit_disc_fix M1; P M1; unit_disc_fix M2; P M2\ \ P (M1 + M2)" + shows "P M" + using assms + using unit_disc_fix_decompose_blaschke_rotation[OF assms(1)] + using blaschke_unit_disc_fix + by auto + +lemma ex_unit_disc_fix_to_zero_positive_x_axis: + assumes "u \ unit_disc" and "v \ unit_disc" and "u \ v" + shows "\ M. unit_disc_fix M \ + moebius_pt M u = 0\<^sub>h \ moebius_pt M v \ positive_x_axis" +proof- + from assms obtain B where + *: "unit_disc_fix B" "moebius_pt B u = 0\<^sub>h" + using ex_unit_disc_fix_mapping_u_to_zero + by blast + + let ?v = "moebius_pt B v" + have "?v \ unit_disc" + using \v \ unit_disc\ * + by auto + hence "?v \ \\<^sub>h" + using inf_notin_unit_disc by auto + have "?v \ 0\<^sub>h" + using \u \ v\ * + by (metis moebius_pt_invert) + + obtain R where + "unit_disc_fix R" + "moebius_pt R 0\<^sub>h = 0\<^sub>h" "moebius_pt R ?v \ positive_x_axis" + using ex_rotation_mapping_u_to_positive_x_axis[of ?v] \?v \ 0\<^sub>h\ \?v \ \\<^sub>h\ + using moebius_pt_rotation_inf_iff moebius_pt_moebius_rotation_zero unit_disc_fix_rotation + by blast + thus ?thesis + using * moebius_comp[of R B, symmetric] + using unit_disc_fix_moebius_comp + by (rule_tac x="R + B" in exI) (simp add: comp_def) +qed + +lemma wlog_x_axis: + assumes in_disc: "u \ unit_disc" "v \ unit_disc" + assumes preserved: "\ M u v. \unit_disc_fix M; u \ unit_disc; v \ unit_disc; P (moebius_pt M u) (moebius_pt M v)\ \ P u v" + assumes axis: "\ x. \is_real x; 0 \ Re x; Re x < 1\ \ P 0\<^sub>h (of_complex x)" + shows "P u v" +proof (cases "u = v") + case True + have "P u u" (is "?Q u") + proof (rule wlog_zero[where P="?Q"]) + show "u \ unit_disc" + by fact + next + show "?Q 0\<^sub>h" + using axis[of 0] + by simp + next + fix a u + assume "u \ unit_disc" "cmod a < 1" "?Q (moebius_pt (blaschke a) u)" + thus "?Q u" + using preserved[of "blaschke a" u u] + using blaschke_unit_disc_fix[of a] + by simp + qed + thus ?thesis + using True + by simp +next + case False + from in_disc obtain M where + *: "unit_disc_fix M" "moebius_pt M u = 0\<^sub>h" "moebius_pt M v \ positive_x_axis" + using ex_unit_disc_fix_to_zero_positive_x_axis False + by auto + then obtain x where **: "moebius_pt M v = of_complex x" "is_real x" + unfolding positive_x_axis_def circline_set_x_axis + by auto + moreover + have "of_complex x \ unit_disc" + using \unit_disc_fix M\ \v \ unit_disc\ ** + using unit_disc_fix_discI + by fastforce + hence "0 < Re x" "Re x < 1" + using \moebius_pt M v \ positive_x_axis\ ** + by (auto simp add: positive_x_axis_def cmod_eq_Re) + ultimately + have "P 0\<^sub>h (of_complex x)" + using \is_real x\ axis + by auto + thus ?thesis + using preserved[OF *(1) assms(1-2)] *(2) **(1) + by simp +qed + +lemma wlog_positive_x_axis: + assumes in_disc: "u \ unit_disc" "v \ unit_disc" "u \ v" + assumes preserved: "\ M u v. \unit_disc_fix M; u \ unit_disc; v \ unit_disc; u \ v; P (moebius_pt M u) (moebius_pt M v)\ \ P u v" + assumes axis: "\ x. \is_real x; 0 < Re x; Re x < 1\ \ P 0\<^sub>h (of_complex x)" + shows "P u v" +proof- + have "u \ v \ P u v" (is "?Q u v") + proof (rule wlog_x_axis) + show "u \ unit_disc" "v \ unit_disc" + by fact+ + next + fix M u v + assume "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" + "?Q (moebius_pt M u) (moebius_pt M v)" + thus "?Q u v" + using preserved[of M u v] + using moebius_pt_invert + by blast + next + fix x + assume "is_real x" "0 \ Re x" "Re x < 1" + thus "?Q 0\<^sub>h (of_complex x)" + using axis[of x] of_complex_zero_iff[of x] complex.expand[of x 0] + by fastforce + qed + thus ?thesis + using \u \ v\ + by simp +qed + +(* -------------------------------------------------------------------------- *) +subsection \All functions that fix the unit disc\ +(* -------------------------------------------------------------------------- *) + +text \It can be proved that continuous functions that fix the unit disc are either actions of +Möbius transformations that fix the unit disc (homographies), or are compositions of actions of +Möbius transformations that fix the unit disc and the conjugation (antihomographies). We postulate +this as a definition, but it this characterisation could also be formally shown (we do not need this +for our further applications).\ + +definition unit_disc_fix_f where + "unit_disc_fix_f f \ + (\ M. unit_disc_fix M \ (f = moebius_pt M \ f = moebius_pt M \ conjugate))" + +text \Unit disc fixing functions really fix unit disc.\ +lemma unit_disc_fix_f_unit_disc: + assumes "unit_disc_fix_f M" + shows "M ` unit_disc = unit_disc" + using assms + unfolding unit_disc_fix_f_def + using image_comp + by force + +text \Actions of unit disc fixing Möbius transformations (unit disc fixing homographies) are unit +disc fixing functions.\ +lemma unit_disc_fix_f_moebius_pt [simp]: + assumes "unit_disc_fix M" + shows "unit_disc_fix_f (moebius_pt M)" + using assms + unfolding unit_disc_fix_f_def + by auto + +text \Compositions of unit disc fixing Möbius transformations and conjugation (unit disc fixing +antihomographies) are unit disc fixing functions.\ +lemma unit_disc_fix_conjugate_moebius [simp]: + assumes "unit_disc_fix M" + shows "unit_disc_fix (conjugate_moebius M)" +proof- + have "\a aa ab b. \1 < Re (a * b / (aa * ab)); \ 1 < Re (cnj a * cnj b / (cnj aa * cnj ab))\ \ aa = 0" + by (metis cnj.simps(1) complex_cnj_divide complex_cnj_mult) + thus ?thesis + using assms + by (transfer, transfer) + (auto simp add: mat_cnj_def unitary11_gen_def mat_adj_def field_simps) +qed + +lemma unit_disc_fix_conjugate_comp_moebius [simp]: + assumes "unit_disc_fix M" + shows "unit_disc_fix_f (conjugate \ moebius_pt M)" + using assms + apply (subst conjugate_moebius) + apply (simp add: unit_disc_fix_f_def) + apply (rule_tac x="conjugate_moebius M" in exI, simp) + done + + +text \Uniti disc fixing functions form a group under function composition.\ + +lemma unit_disc_fix_f_comp [simp]: + assumes "unit_disc_fix_f f1" and "unit_disc_fix_f f2" + shows "unit_disc_fix_f (f1 \ f2)" + using assms + apply (subst (asm) unit_disc_fix_f_def) + apply (subst (asm) unit_disc_fix_f_def) +proof safe + fix M M' + assume "unit_disc_fix M" "unit_disc_fix M'" + thus "unit_disc_fix_f (moebius_pt M \ moebius_pt M')" + unfolding unit_disc_fix_f_def + by (rule_tac x="M + M'" in exI) auto +next + fix M M' + assume "unit_disc_fix M" "unit_disc_fix M'" + thus "unit_disc_fix_f (moebius_pt M \ (moebius_pt M' \ conjugate))" + unfolding unit_disc_fix_f_def + by (subst comp_assoc[symmetric])+ + (rule_tac x="M + M'" in exI, auto) +next + fix M M' + assume "unit_disc_fix M" "unit_disc_fix M'" + thus "unit_disc_fix_f ((moebius_pt M \ conjugate) \ moebius_pt M')" + unfolding unit_disc_fix_f_def + by (subst comp_assoc, subst conjugate_moebius, subst comp_assoc[symmetric])+ + (rule_tac x="M + conjugate_moebius M'" in exI, auto) +next + fix M M' + assume "unit_disc_fix M" "unit_disc_fix M'" + thus "unit_disc_fix_f ((moebius_pt M \ conjugate) \ (moebius_pt M' \ conjugate))" + apply (subst comp_assoc[symmetric], subst comp_assoc) + apply (subst conjugate_moebius, subst comp_assoc, subst comp_assoc) + apply (simp add: unit_disc_fix_f_def) + apply (rule_tac x="M + conjugate_moebius M'" in exI, auto) + done +qed + +lemma unit_disc_fix_f_inv: + assumes "unit_disc_fix_f M" + shows "unit_disc_fix_f (inv M)" + using assms + apply (subst (asm) unit_disc_fix_f_def) +proof safe + fix M + assume "unit_disc_fix M" + have "inv (moebius_pt M) = moebius_pt (-M)" + by (rule ext) (simp add: moebius_inv) + thus "unit_disc_fix_f (inv (moebius_pt M))" + using \unit_disc_fix M\ + unfolding unit_disc_fix_f_def + by (rule_tac x="-M" in exI, simp) +next + fix M + assume "unit_disc_fix M" + have "inv (moebius_pt M \ conjugate) = conjugate \ inv (moebius_pt M)" + by (subst o_inv_distrib, simp_all) + also have "... = conjugate \ (moebius_pt (-M))" + using moebius_inv + by auto + also have "... = moebius_pt (conjugate_moebius (-M)) \ conjugate" + by (simp add: conjugate_moebius) + finally + show "unit_disc_fix_f (inv (moebius_pt M \ conjugate))" + using \unit_disc_fix M\ + unfolding unit_disc_fix_f_def + by (rule_tac x="conjugate_moebius (-M)" in exI, simp) +qed + +(* -------------------------------------------------------------------------- *) +subsubsection \Action of unit disc fixing functions on circlines\ +(* -------------------------------------------------------------------------- *) + +definition unit_disc_fix_f_circline where + "unit_disc_fix_f_circline f H = + (if \ M. unit_disc_fix M \ f = moebius_pt M then + moebius_circline (THE M. unit_disc_fix M \ f = moebius_pt M) H + else if \ M. unit_disc_fix M \ f = moebius_pt M \ conjugate then + (moebius_circline (THE M. unit_disc_fix M \ f = moebius_pt M \ conjugate) \ conjugate_circline) H + else + H)" + + +lemma unique_moebius_pt_conjugate: + assumes "moebius_pt M1 \ conjugate = moebius_pt M2 \ conjugate" + shows "M1 = M2" +proof- + from assms have "moebius_pt M1 = moebius_pt M2" + using conjugate_conjugate_comp rewriteL_comp_comp2 by fastforce + thus ?thesis + using unique_moebius_pt + by auto +qed + +lemma unit_disc_fix_f_circline_direct: + assumes "unit_disc_fix M" and "f = moebius_pt M" + shows "unit_disc_fix_f_circline f H = moebius_circline M H" +proof- + have "M = (THE M. unit_disc_fix M \ f = moebius_pt M)" + using assms + using theI_unique[of "\ M. unit_disc_fix M \ f = moebius_pt M" M] + using unique_moebius_pt[of M] + by auto + thus ?thesis + using assms + unfolding unit_disc_fix_f_circline_def + by auto +qed + +lemma unit_disc_fix_f_circline_indirect: + assumes "unit_disc_fix M" and "f = moebius_pt M \ conjugate" + shows "unit_disc_fix_f_circline f H = ((moebius_circline M) \ conjugate_circline) H" +proof- + have "\ (\ M. unit_disc_fix M \ f = moebius_pt M)" + using assms homography_antihomography_exclusive[of f] + unfolding is_homography_def is_antihomography_def is_moebius_def + by auto + moreover + have "M = (THE M. unit_disc_fix M \ f = moebius_pt M \ conjugate)" + using assms + using theI_unique[of "\ M. unit_disc_fix M \ f = moebius_pt M \ conjugate" M] + using unique_moebius_pt_conjugate[of M] + by auto + ultimately + show ?thesis + using assms + unfolding unit_disc_fix_f_circline_def + by metis +qed + +text \Disc automorphisms - it would be nice to show that there are no disc automorphisms other than +unit disc fixing homographies and antihomographies, but this part of the theory is not yet +developed.\ + +definition is_disc_aut where "is_disc_aut f \ bij_betw f unit_disc unit_disc" + +end \ No newline at end of file diff --git a/thys/Complex_Geometry/Unitary11_Matrices.thy b/thys/Complex_Geometry/Unitary11_Matrices.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Unitary11_Matrices.thy @@ -0,0 +1,607 @@ +(* ----------------------------------------------------------------- *) +subsection \Generalized unitary matrices with signature $(1, 1)$\ +(* ----------------------------------------------------------------- *) + +theory Unitary11_Matrices +imports Matrices More_Complex +begin + +text \ When acting as Möbius transformations in the extended +complex plane, generalized complex $2\times 2$ unitary matrices fix +the imaginary unit circle (a Hermitean form with (2, 0) signature). We +now describe matrices that fix the ordinary unit circle (a Hermitean +form with (1, 1) signature, i.e., one positive and one negative +element on the diagonal). These are extremely important for further +formalization, since they will represent disc automorphisims and +isometries of the Poincar\'e disc. The development of this theory +follows the development of the theory of generalized unitary matrices. +\ + +text \Unitary11 matrices\ +definition unitary11 where + "unitary11 M \ congruence M (1, 0, 0, -1) = (1, 0, 0, -1)" + +text \Generalized unitary11 matrices\ +definition unitary11_gen where + "unitary11_gen M \ (\ k. k \ 0 \ congruence M (1, 0, 0, -1) = k *\<^sub>s\<^sub>m (1, 0, 0, -1))" + +text \Scalar can always be a non-zero real number\ +lemma unitary11_gen_real: + shows "unitary11_gen M \ (\ k. k \ 0 \ congruence M (1, 0, 0, -1) = cor k *\<^sub>s\<^sub>m (1, 0, 0, -1))" + unfolding unitary11_gen_def +proof (auto simp del: congruence_def) + fix k + assume "k \ 0" "congruence M (1, 0, 0, -1) = (k, 0, 0, - k)" + hence "mat_det (congruence M (1, 0, 0, -1)) = -k*k" + by simp + moreover + have "is_real (mat_det (congruence M (1, 0, 0, -1)))" "Re (mat_det (congruence M (1, 0, 0, -1))) \ 0" + by (auto simp add: mat_det_adj) + ultimately + have "is_real (k*k)" "Re (-k*k) \ 0" + by auto + hence "is_real (k*k) \ Re (k * k) > 0" + using \k \ 0\ + by (smt complex_eq_if_Re_eq mult_eq_0_iff mult_minus_left uminus_complex.simps(1) zero_complex.simps(1) zero_complex.simps(2)) + hence "is_real k" + by auto + thus "\ka. ka \ 0 \ k = cor ka" + using \k \ 0\ + by (rule_tac x="Re k" in exI) (cases k, auto simp add: Complex_eq) +qed + +text \Unitary11 matrices are special cases of generalized unitary 11 matrices\ +lemma unitary11_unitary11_gen [simp]: + assumes "unitary11 M" + shows "unitary11_gen M" + using assms + unfolding unitary11_gen_def unitary11_def + by (rule_tac x="1" in exI, auto) + +text \All generalized unitary11 matrices are regular\ +lemma unitary11_gen_regular: + assumes "unitary11_gen M" + shows "mat_det M \ 0" +proof- + from assms obtain k where + "k \ 0" "mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m M = cor k *\<^sub>s\<^sub>m (1, 0, 0, -1)" + unfolding unitary11_gen_real + by auto + hence "mat_det (mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m M) \ 0" + by simp + thus ?thesis + by (simp add: mat_det_adj) +qed + +lemmas unitary11_regular = unitary11_gen_regular[OF unitary11_unitary11_gen] + +(* ----------------------------------------------------------------- *) +subsubsection \The characterization in terms of matrix elements\ +(* ----------------------------------------------------------------- *) + +text \Special matrices are those having the determinant equal to 1. We first give their characterization.\ +lemma unitary11_special: + assumes "unitary11 M" and "mat_det M = 1" + shows "\ a b. M = (a, b, cnj b, cnj a)" +proof- + have "mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) = (1, 0, 0, -1) *\<^sub>m\<^sub>m mat_inv M" + using assms mult_mm_inv_r + by (simp add: unitary11_def) + thus ?thesis + using assms(2) + by (cases M) (simp add: mat_adj_def mat_cnj_def) +qed + +lemma unitary11_gen_special: + assumes "unitary11_gen M" and "mat_det M = 1" + shows "\ a b. M = (a, b, cnj b, cnj a) \ M = (a, b, -cnj b, -cnj a)" +proof- + from assms + obtain k where *: "k \ 0" "mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m M = cor k *\<^sub>s\<^sub>m (1, 0, 0, -1)" + unfolding unitary11_gen_real + by auto + hence "mat_det (mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m M) = - cor k* cor k" + by simp + hence "mat_det (mat_adj M *\<^sub>m\<^sub>m M) = cor k* cor k" + by simp + hence "cor k* cor k = 1" + using assms(2) + by (simp add: mat_det_adj) + hence "cor k = 1 \ cor k = -1" + using square_eq_1_iff[of "cor k"] + by simp + moreover + have "mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) = (cor k *\<^sub>s\<^sub>m (1, 0, 0, -1)) *\<^sub>m\<^sub>m mat_inv M " + using * + using assms mult_mm_inv_r mat_eye_r mat_eye_l + by auto + moreover + obtain a b c d where "M = (a, b, c, d)" + by (cases M) auto + ultimately + have "M = (a, b, cnj b, cnj a) \ M = (a, b, -cnj b, -cnj a)" + using assms(2) + by (auto simp add: mat_adj_def mat_cnj_def) + thus ?thesis + by auto +qed + +text \A characterization of all generalized unitary11 matrices\ +lemma unitary11_gen_iff': + shows "unitary11_gen M \ + (\ a b k. k \ 0 \ mat_det (a, b, cnj b, cnj a) \ 0 \ + (M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \ + M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)))" (is "?lhs = ?rhs") +proof + assume ?lhs + obtain d where *: "d*d = mat_det M" + using ex_complex_sqrt + by auto + hence "d \ 0" + using unitary11_gen_regular[OF \unitary11_gen M\] + by auto + from \unitary11_gen M\ + obtain k where "k \ 0" "mat_adj M *\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m M = cor k *\<^sub>s\<^sub>m (1, 0, 0, -1)" + unfolding unitary11_gen_real + by auto + hence "mat_adj ((1/d)*\<^sub>s\<^sub>mM)*\<^sub>m\<^sub>m (1, 0, 0, -1) *\<^sub>m\<^sub>m ((1/d)*\<^sub>s\<^sub>mM) = (cor k / (d*cnj d)) *\<^sub>s\<^sub>m (1, 0, 0, -1)" + by simp + moreover + have "is_real (cor k / (d * cnj d))" + by (metis complex_In_mult_cnj_zero div_reals Im_complex_of_real) + hence "cor (Re (cor k / (d * cnj d))) = cor k / (d * cnj d)" + by simp + ultimately + have "unitary11_gen ((1/d)*\<^sub>s\<^sub>mM)" + unfolding unitary11_gen_real + using \d \ 0\ \k \ 0\ + using \cor (Re (cor k / (d * cnj d))) = cor k / (d * cnj d)\ + by (rule_tac x="Re (cor k / (d * cnj d))" in exI, auto, simp add: *) + moreover + have "mat_det ((1 / d) *\<^sub>s\<^sub>m M) = 1" + using * unitary11_gen_regular[of M] \unitary11_gen M\ + by auto + ultimately + obtain a b where "(a, b, cnj b, cnj a) = (1 / d) *\<^sub>s\<^sub>m M \ (a, b, -cnj b, -cnj a) = (1 / d) *\<^sub>s\<^sub>m M" + using unitary11_gen_special[of "(1 / d) *\<^sub>s\<^sub>m M"] + by force + thus ?rhs + proof + assume "(a, b, cnj b, cnj a) = (1 / d) *\<^sub>s\<^sub>m M" + moreover + hence "mat_det (a, b, cnj b, cnj a) \ 0" + using unitary11_gen_regular[OF \unitary11_gen M\] \d \ 0\ + by auto + ultimately + show ?rhs + using \d \ 0\ + by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="d" in exI, simp) + next + assume *: "(a, b, -cnj b, -cnj a) = (1 / d) *\<^sub>s\<^sub>m M" + hence " (1 / d) *\<^sub>s\<^sub>m M = (a, b, -cnj b, -cnj a)" + by simp + hence "M = (a * d, b * d, - (d * cnj b), - (d * cnj a))" + using \d \ 0\ + using mult_sm_inv_l[of "1/d" M "(a, b, -cnj b, -cnj a)", symmetric] + by (simp add: field_simps) + moreover + have "mat_det (a, b, -cnj b, -cnj a) \ 0" + using * unitary11_gen_regular[OF \unitary11_gen M\] \d \ 0\ + by auto + ultimately + show ?thesis + using \d \ 0\ + by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="-d" in exI) (simp add: field_simps) + qed +next + assume ?rhs + then obtain a b k where "k \ 0" "mat_det (a, b, cnj b, cnj a) \ 0" + "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \ M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)" + by auto + moreover + let ?x = "cnj k * cnj a * (k * a) + - (cnj k * b * (k * cnj b))" + have "?x = (k*cnj k)*(a*cnj a - b*cnj b)" + by (auto simp add: field_simps) + hence "is_real ?x" + by simp + hence "cor (Re ?x) = ?x" + by (rule complex_of_real_Re) + moreover + have "?x \ 0" + using mult_eq_0_iff[of "cnj k * k" "(cnj a * a + - cnj b * b)"] + using \mat_det (a, b, cnj b, cnj a) \ 0\ \k \ 0\ + by (auto simp add: field_simps) + hence "Re ?x \ 0" + using \is_real ?x\ + by (metis calculation(4) of_real_0) + ultimately + show ?lhs + unfolding unitary11_gen_real + by (rule_tac x="Re ?x" in exI) (auto simp add: mat_adj_def mat_cnj_def) +qed + +text \Another characterization of all generalized unitary11 matrices. They are products of +rotation and Blaschke factor matrices.\ +lemma unitary11_gen_cis_blaschke: + assumes "k \ 0" and "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" and + "a \ 0" and "mat_det (a, b, cnj b, cnj a) \ 0" + shows "\ k' \ a'. k' \ 0 \ a' * cnj a' \ 1 \ + M = k' *\<^sub>s\<^sub>m (cis \, 0, 0, 1) *\<^sub>m\<^sub>m (1, -a', -cnj a', 1)" +proof- + have "a = cnj a * cis (2 * arg a)" + using rcis_cmod_arg[of a] rcis_cnj[of a] + using cis_rcis_eq rcis_mult + by simp + thus ?thesis + using assms + by (rule_tac x="k*cnj a" in exI, rule_tac x="2*arg a" in exI, rule_tac x="- b / a" in exI) (auto simp add: field_simps) +qed + +lemma unitary11_gen_cis_blaschke': + assumes "k \ 0" and "M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)" and + "a \ 0" and "mat_det (a, b, cnj b, cnj a) \ 0" + shows "\ k' \ a'. k' \ 0 \ a' * cnj a' \ 1 \ + M = k' *\<^sub>s\<^sub>m (cis \, 0, 0, 1) *\<^sub>m\<^sub>m (1, -a', -cnj a', 1)" +proof- + obtain k' \ a' where *: "k' \ 0" "k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) = k' *\<^sub>s\<^sub>m (cis \, 0, 0, 1) *\<^sub>m\<^sub>m (1, -a', -cnj a', 1)" "a' * cnj a' \ 1" + using unitary11_gen_cis_blaschke[OF \k \ 0\ _ \a \ 0\] \mat_det (a, b, cnj b, cnj a) \ 0\ + by blast + have "(cis \, 0, 0, 1) *\<^sub>m\<^sub>m (-1, 0, 0, 1) = (cis (\ + pi), 0, 0, 1)" + by (simp add: cis_def complex.corec Complex_eq) + thus ?thesis + using * \M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)\ + by (rule_tac x="k'" in exI, rule_tac x="\ + pi" in exI, rule_tac x="a'" in exI, simp) +qed + +lemma unitary11_gen_cis_blaschke_rev: + assumes "k' \ 0" and "M = k' *\<^sub>s\<^sub>m (cis \, 0, 0, 1) *\<^sub>m\<^sub>m (1, -a', -cnj a', 1)" and + "a' * cnj a' \ 1" + shows "\ k a b. k \ 0 \ mat_det (a, b, cnj b, cnj a) \ 0 \ + M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" + using assms + apply (rule_tac x="k'*cis(\/2)" in exI, rule_tac x="cis(\/2)" in exI, rule_tac x="-a'*cis(\/2)" in exI) + apply (simp add: cis_mult mult.commute mult.left_commute) + done + +lemma unitary11_gen_cis_inversion: + assumes "k \ 0" and "M = k *\<^sub>s\<^sub>m (0, b, cnj b, 0)" and "b \ 0" + shows "\ k' \. k' \ 0 \ + M = k' *\<^sub>s\<^sub>m (cis \, 0, 0, 1) *\<^sub>m\<^sub>m (0, 1, 1, 0)" +using assms +using rcis_cmod_arg[of b, symmetric] rcis_cnj[of b] cis_rcis_eq +by simp (rule_tac x="2*arg b" in exI, simp add: rcis_mult) + +lemma unitary11_gen_cis_inversion': + assumes "k \ 0" and "M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (0, b, cnj b, 0)" and "b \ 0" + shows "\ k' \. k' \ 0 \ + M = k' *\<^sub>s\<^sub>m (cis \, 0, 0, 1) *\<^sub>m\<^sub>m (0, 1, 1, 0)" +proof- + obtain k' \ where *: "k' \ 0" "k *\<^sub>s\<^sub>m (0, b, cnj b, 0) = k' *\<^sub>s\<^sub>m (cis \, 0, 0, 1) *\<^sub>m\<^sub>m (0, 1, 1, 0)" + using unitary11_gen_cis_inversion[OF \k \ 0\ _ \b \ 0\] + by metis + have "(cis \, 0, 0, 1) *\<^sub>m\<^sub>m (-1, 0, 0, 1) = (cis (\ + pi), 0, 0, 1)" + by (simp add: cis_def complex.corec Complex_eq) + thus ?thesis + using * \M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (0, b, cnj b, 0)\ + by (rule_tac x="k'" in exI, rule_tac x="\ + pi" in exI, simp) +qed + +lemma unitary11_gen_cis_inversion_rev: + assumes "k' \ 0" and "M = k' *\<^sub>s\<^sub>m (cis \, 0, 0, 1) *\<^sub>m\<^sub>m (0, 1, 1, 0)" + shows "\ k a b. k \ 0 \ mat_det (a, b, cnj b, cnj a) \ 0 \ + M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" + using assms + by (rule_tac x="k'*cis(\/2)" in exI, rule_tac x=0 in exI, rule_tac x="cis(\/2)" in exI) (simp add: cis_mult) + +text \Another characterization of generalized unitary11 matrices\ +lemma unitary11_gen_iff: + shows "unitary11_gen M \ + (\ k a b. k \ 0 \ mat_det (a, b, cnj b, cnj a) \ 0 \ + M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a))" (is "?lhs = ?rhs") +proof + assume ?lhs + then obtain a b k where *: "k \ 0" "mat_det (a, b, cnj b, cnj a) \ 0" "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \ M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)" + using unitary11_gen_iff' + by auto + show ?rhs + proof (cases "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)") + case True + thus ?thesis + using * + by auto + next + case False + hence **: "M = k *\<^sub>s\<^sub>m (-1, 0, 0, 1) *\<^sub>m\<^sub>m (a, b, cnj b, cnj a)" + using * + by simp + show ?thesis + proof (cases "a = 0") + case True + hence "b \ 0" + using * + by auto + show ?thesis + using unitary11_gen_cis_inversion_rev[of _ M] + using ** \a = 0\ + using unitary11_gen_cis_inversion'[OF \k \ 0\ _ \b \ 0\, of M] + by auto + next + case False + show ?thesis + using unitary11_gen_cis_blaschke_rev[of _ M] + using ** + using unitary11_gen_cis_blaschke'[OF \k \ 0\ _ \a \ 0\, of M b] \mat_det (a, b, cnj b, cnj a) \ 0\ + by blast + qed + qed +next + assume ?rhs + thus ?lhs + using unitary11_gen_iff' + by auto +qed + +lemma unitary11_iff: + shows "unitary11 M \ + (\ a b k. (cmod a)\<^sup>2 > (cmod b)\<^sup>2 \ + (cmod k)\<^sup>2 = 1 / ((cmod a)\<^sup>2 - (cmod b)\<^sup>2) \ + M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a))" (is "?lhs = ?rhs") +proof + assume ?lhs + obtain k a b where *: + "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)""mat_det (a, b, cnj b, cnj a) \ 0" "k \ 0" + using unitary11_gen_iff unitary11_unitary11_gen[OF \unitary11 M\] + by auto + + have md: "mat_det (a, b, cnj b, cnj a) = cor ((cmod a)\<^sup>2 - (cmod b)\<^sup>2)" + by (auto simp add: complex_mult_cnj_cmod) + hence **: "(cmod a)\<^sup>2 \ (cmod b)\<^sup>2" + using \mat_det (a, b, cnj b, cnj a) \ 0\ + by auto + + have "k * cnj k * mat_det (a, b, cnj b, cnj a) = 1" + using \M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)\ + using \unitary11 M\ + unfolding unitary11_def + by (auto simp add: mat_adj_def mat_cnj_def) (simp add: field_simps) + hence ***: "(cmod k)\<^sup>2 * ((cmod a)\<^sup>2 - (cmod b)\<^sup>2) = 1" + by (subst (asm) complex_mult_cnj_cmod, subst (asm) md, subst (asm) cor_mult[symmetric]) (metis of_real_1 of_real_eq_iff) + hence "((cmod a)\<^sup>2 - (cmod b)\<^sup>2) = 1 / (cmod k)\<^sup>2" + by (cases "k=0") (auto simp add: field_simps) + hence "cmod a ^ 2 = cmod b ^ 2 + 1 / cmod k ^ 2" + by simp + thus ?rhs + using \M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)\ ** mat_eye_l + by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="k" in exI) + (auto simp add: complex_mult_cnj_cmod intro!: ) +next + assume ?rhs + then obtain a b k where "(cmod b)\<^sup>2 < (cmod a)\<^sup>2 \ (cmod k)\<^sup>2 = 1 / ((cmod a)\<^sup>2 - (cmod b)\<^sup>2) \ M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" + by auto + moreover + have "cnj k * cnj a * (k * a) + - (cnj k * b * (k * cnj b)) = (cor ((cmod k)\<^sup>2 * ((cmod a)\<^sup>2 - (cmod b)\<^sup>2)))" + proof- + have "cnj k * cnj a * (k * a) = cor ((cmod k)\<^sup>2 * (cmod a)\<^sup>2)" + using complex_mult_cnj_cmod[of a] complex_mult_cnj_cmod[of k] + by (auto simp add: field_simps) + moreover + have "cnj k * b * (k * cnj b) = cor ((cmod k)\<^sup>2 * (cmod b)\<^sup>2)" + using complex_mult_cnj_cmod[of b, symmetric] complex_mult_cnj_cmod[of k] + by (auto simp add: field_simps) + ultimately + show ?thesis + by (auto simp add: field_simps) + qed + ultimately + show ?lhs + unfolding unitary11_def + by (auto simp add: mat_adj_def mat_cnj_def field_simps) +qed + +(* ----------------------------------------------------------------- *) +subsubsection \Group properties\ +(* ----------------------------------------------------------------- *) + +text \Generalized unitary11 matrices form a group under +multiplication (it is sometimes denoted by $GU_{1, 1}(2, +\mathbb{C})$). The group is also closed under non-zero complex scalar +multiplication. Since these matrices are always regular, they form a +subgroup of general linear group (usually denoted by $GL(2, +\mathbb{C})$) of all regular matrices.\ + +lemma unitary11_gen_mult_sm: + assumes "k \ 0" and "unitary11_gen M" + shows "unitary11_gen (k *\<^sub>s\<^sub>m M)" +proof- + have "k * cnj k = cor (Re (k * cnj k))" + by (subst complex_of_real_Re) auto + thus ?thesis + using assms + unfolding unitary11_gen_real + by auto (rule_tac x="Re (k*cnj k) * ka" in exI, auto) +qed + +lemma unitary11_gen_div_sm: + assumes "k \ 0" and "unitary11_gen (k *\<^sub>s\<^sub>m M)" + shows "unitary11_gen M" + using assms unitary11_gen_mult_sm[of "1/k" "k *\<^sub>s\<^sub>m M"] + by simp + + +lemma unitary11_inv: + assumes "k \ 0" and "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" and "mat_det (a, b, cnj b, cnj a) \ 0" + shows "\ k' a' b'. k' \ 0 \ mat_inv M = k' *\<^sub>s\<^sub>m (a', b', cnj b', cnj a') \ mat_det (a', b', cnj b', cnj a') \ 0" + using assms + by (subst assms, subst mat_inv_mult_sm[OF assms(1)]) + (rule_tac x="1/(k * mat_det (a, b, cnj b, cnj a))" in exI, rule_tac x="cnj a" in exI, rule_tac x="-b" in exI, simp add: field_simps) + +lemma unitary11_comp: + assumes "k1 \ 0" and "M1 = k1 *\<^sub>s\<^sub>m (a1, b1, cnj b1, cnj a1)" and "mat_det (a1, b1, cnj b1, cnj a1) \ 0" + "k2 \ 0" "M2 = k2 *\<^sub>s\<^sub>m (a2, b2, cnj b2, cnj a2)" "mat_det (a2, b2, cnj b2, cnj a2) \ 0" + shows "\ k a b. k \ 0 \ M1 *\<^sub>m\<^sub>m M2 = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \ mat_det (a, b, cnj b, cnj a) \ 0" + using assms + apply (rule_tac x="k1*k2" in exI) + apply (rule_tac x="a1*a2 + b1*cnj b2" in exI) + apply (rule_tac x="a1*b2 + b1*cnj a2" in exI) +proof (auto simp add: algebra_simps) + assume *: "a1 * (a2 * (cnj a1 * cnj a2)) + b1 * (b2 * (cnj b1 * cnj b2)) = + a1 * (b2 * (cnj a1 * cnj b2)) + a2 * (b1 * (cnj a2 * cnj b1))" and + **: "a1*cnj a1 \ b1 * cnj b1" "a2*cnj a2 \ b2*cnj b2" + hence "(a1*cnj a1)*(a2*cnj a2 - b2*cnj b2) = (b1*cnj b1)*(a2*cnj a2 - b2*cnj b2)" + by (simp add: field_simps) + hence "a1*cnj a1 = b1*cnj b1" + using **(2) + by simp + thus False + using **(1) + by simp +qed + +lemma unitary11_gen_mat_inv: + assumes "unitary11_gen M" and "mat_det M \ 0" + shows "unitary11_gen (mat_inv M)" +proof- + obtain k a b where "k \ 0 \ mat_det (a, b, cnj b, cnj a) \ 0 \ M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" + using assms unitary11_gen_iff[of M] + by auto + then obtain k' a' b' where "k' \ 0 \ mat_inv M = k' *\<^sub>s\<^sub>m (a', b', cnj b', cnj a') \ mat_det (a', b', cnj b', cnj a') \ 0" + using unitary11_inv [of k M a b] + by auto + thus ?thesis + using unitary11_gen_iff[of "mat_inv M"] + by auto +qed + +lemma unitary11_gen_comp: + assumes "unitary11_gen M1" and "mat_det M1 \ 0" and "unitary11_gen M2" and "mat_det M2 \ 0" + shows "unitary11_gen (M1 *\<^sub>m\<^sub>m M2)" +proof- + from assms obtain k1 k2 a1 a2 b1 b2 where + "k1 \ 0 \ mat_det (a1, b1, cnj b1, cnj a1) \ 0 \ M1 = k1 *\<^sub>s\<^sub>m (a1, b1, cnj b1, cnj a1)" + "k2 \ 0 \ mat_det (a2, b2, cnj b2, cnj a2) \ 0 \ M2 = k2 *\<^sub>s\<^sub>m (a2, b2, cnj b2, cnj a2)" + using unitary11_gen_iff[of M1] unitary11_gen_iff[of M2] + by blast + then obtain k a b where "k \ 0 \ M1 *\<^sub>m\<^sub>m M2 = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \ mat_det (a, b, cnj b, cnj a) \ 0" + using unitary11_comp[of k1 M1 a1 b1 k2 M2 a2 b2] + by blast + thus ?thesis + using unitary11_gen_iff[of "M1 *\<^sub>m\<^sub>m M2"] + by blast +qed + +text \Classification into orientation-preserving and orientation-reversing matrices\ +lemma unitary11_sgn_det_orientation: + assumes "k \ 0" and "mat_det (a, b, cnj b, cnj a) \ 0" and "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" + shows "\ k'. sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a))) \ congruence M (1, 0, 0, -1) = cor k' *\<^sub>s\<^sub>m (1, 0, 0, -1)" +proof- + let ?x = "cnj k * cnj a * (k * a) - (cnj k * b * (k * cnj b))" + have *: "?x = k * cnj k * (a * cnj a - b * cnj b)" + by (auto simp add: field_simps) + hence "is_real ?x" + by auto + hence "cor (Re ?x) = ?x" + by (rule complex_of_real_Re) + moreover + have "sgn (Re ?x) = sgn (Re (a * cnj a - b * cnj b))" + proof- + have *: "Re ?x = (cmod k)\<^sup>2 * Re (a * cnj a - b * cnj b)" + by (subst *, subst complex_mult_cnj_cmod, subst Re_mult_real) (metis Im_complex_of_real, metis Re_complex_of_real) + show ?thesis + using \k \ 0\ + by (subst *) (simp add: sgn_mult) + qed + ultimately + show ?thesis + using assms(3) + by (rule_tac x="Re ?x" in exI) (auto simp add: mat_adj_def mat_cnj_def) +qed + +lemma unitary11_sgn_det: + assumes "k \ 0" and "mat_det (a, b, cnj b, cnj a) \ 0" and "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" and "M = (A, B, C, D)" + shows "sgn (Re (mat_det (a, b, cnj b, cnj a))) = (if b = 0 then 1 else sgn (Re ((A*D)/(B*C)) - 1))" +proof (cases "b = 0") + case True + thus ?thesis + using assms + by (simp only: mat_det.simps, subst complex_mult_cnj_cmod, subst minus_complex.sel, subst Re_complex_of_real, simp) +next + case False + from assms have *: "A = k * a" "B = k * b" "C = k * cnj b" "D = k * cnj a" + by auto + hence *: "(A*D)/(B*C) = (a*cnj a)/(b*cnj b)" + using \k \ 0\ + by simp + show ?thesis + using \b \ 0\ + apply (subst *, subst Re_divide_real, simp, simp) + apply (simp only: mat_det.simps) + apply (subst complex_mult_cnj_cmod)+ + apply ((subst Re_complex_of_real)+, subst minus_complex.sel, (subst Re_complex_of_real)+, simp add: field_simps sgn_if) + done +qed + +lemma unitary11_orientation: + assumes "unitary11_gen M" and "M = (A, B, C, D)" + shows "\ k'. sgn k' = sgn (if B = 0 then 1 else sgn (Re ((A*D)/(B*C)) - 1)) \ congruence M (1, 0, 0, -1) = cor k' *\<^sub>s\<^sub>m (1, 0, 0, -1)" +proof- + from \unitary11_gen M\ + obtain k a b where *: "k \ 0" "mat_det (a, b, cnj b, cnj a) \ 0" "M = k*\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" + using unitary11_gen_iff[of M] + by auto + moreover + have "b = 0 \ B = 0" + using \M = (A, B, C, D)\ * + by auto + ultimately + show ?thesis + using unitary11_sgn_det_orientation[OF *] unitary11_sgn_det[OF * \M = (A, B, C, D)\] + by auto +qed + +lemma unitary11_sgn_det_orientation': + assumes "congruence M (1, 0, 0, -1) = cor k' *\<^sub>s\<^sub>m (1, 0, 0, -1)" and "k' \ 0" + shows "\ a b k. k \ 0 \ M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a) \ sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a)))" +proof- + obtain a b k where + "k \ 0" "mat_det (a, b, cnj b, cnj a) \ 0" "M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)" + using assms + using unitary11_gen_iff[of M] + unfolding unitary11_gen_def + by auto + moreover + have "sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a)))" + proof- + let ?x = "cnj k * cnj a * (k * a) - (cnj k * b * (k * cnj b))" + have *: "?x = k * cnj k * (a * cnj a - b * cnj b)" + by (auto simp add: field_simps) + hence "is_real ?x" + by auto + hence "cor (Re ?x) = ?x" + by (rule complex_of_real_Re) + + have **: "sgn (Re ?x) = sgn (Re (a * cnj a - b * cnj b))" + proof- + have *: "Re ?x = (cmod k)\<^sup>2 * Re (a * cnj a - b * cnj b)" + by (subst *, subst complex_mult_cnj_cmod, subst Re_mult_real) (metis Im_complex_of_real, metis Re_complex_of_real) + show ?thesis + using \k \ 0\ + by (subst *) (simp add: sgn_mult) + qed + moreover + have "?x = cor k'" + using \M = k *\<^sub>s\<^sub>m (a, b, cnj b, cnj a)\ assms + by (simp add: mat_adj_def mat_cnj_def) + hence "sgn (Re ?x) = sgn k'" + using \cor (Re ?x) = ?x\ + unfolding complex_of_real_def + by simp + ultimately + show ?thesis + by simp + qed + ultimately + show ?thesis + by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="k" in exI) simp +qed + +end diff --git a/thys/Complex_Geometry/Unitary_Matrices.thy b/thys/Complex_Geometry/Unitary_Matrices.thy new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/Unitary_Matrices.thy @@ -0,0 +1,330 @@ +(* -------------------------------------------------------------------------- *) +subsection \Generalized Unitary Matrices\ +(* -------------------------------------------------------------------------- *) + +theory Unitary_Matrices +imports Matrices More_Complex +begin + +text \In this section (generalized) $2\times 2$ unitary matrices are introduced.\ + +text \Unitary matrices\ +definition unitary where + "unitary M \ mat_adj M *\<^sub>m\<^sub>m M = eye" + +text \Generalized unitary matrices\ +definition unitary_gen where + "unitary_gen M \ + (\ k::complex. k \ 0 \ mat_adj M *\<^sub>m\<^sub>m M = k *\<^sub>s\<^sub>m eye)" + +text \Scalar can be always be a positive real\ +lemma unitary_gen_real: + assumes "unitary_gen M" + shows "(\ k::real. k > 0 \ mat_adj M *\<^sub>m\<^sub>m M = cor k *\<^sub>s\<^sub>m eye)" +proof- + obtain k where *: "mat_adj M *\<^sub>m\<^sub>m M = k *\<^sub>s\<^sub>m eye" "k \ 0" + using assms + by (auto simp add: unitary_gen_def) + obtain a b c d where "M = (a, b, c, d)" + by (cases M) auto + hence "k = cor ((cmod a)\<^sup>2) + cor ((cmod c)\<^sup>2)" + using * + by (subst complex_mult_cnj_cmod[symmetric])+ (auto simp add: mat_adj_def mat_cnj_def) + hence "is_real k \ Re k > 0" + using \k \ 0\ + by (smt add_cancel_left_left arg_0_iff arg_complex_of_real_positive not_sum_power2_lt_zero of_real_0 plus_complex.simps(1) plus_complex.simps(2)) + thus ?thesis + using * + by (rule_tac x="Re k" in exI) simp +qed + +text \Generalized unitary matrices can be factored into a product of a unitary matrix and a real +positive scalar multiple of the identity matrix\ +lemma unitary_gen_unitary: + shows "unitary_gen M \ + (\ k M'. k > 0 \ unitary M' \ M = (cor k *\<^sub>s\<^sub>m eye) *\<^sub>m\<^sub>m M')" (is "?lhs = ?rhs") +proof + assume ?lhs + then obtain k where *: "k>0" "mat_adj M *\<^sub>m\<^sub>m M = cor k *\<^sub>s\<^sub>m eye" + using unitary_gen_real[of M] + by auto + + let ?k' = "cor (sqrt k)" + have "?k' * cnj ?k' = cor k" + using \k > 0\ + by simp + moreover + have "Re ?k' > 0" "is_real ?k'" "?k' \ 0" + using \k > 0\ + by auto + ultimately + show ?rhs + using * mat_eye_l + unfolding unitary_gen_def unitary_def + by (rule_tac x="Re ?k'" in exI) (rule_tac x="(1/?k')*\<^sub>s\<^sub>mM" in exI, simp add: mult_sm_mm[symmetric]) +next + assume ?rhs + then obtain k M' where "k > 0" "unitary M'" "M = (cor k *\<^sub>s\<^sub>m eye) *\<^sub>m\<^sub>m M'" + by blast + hence "M = cor k *\<^sub>s\<^sub>m M'" + using mult_sm_mm[of "cor k" eye M'] mat_eye_l + by simp + thus ?lhs + using \unitary M'\ \k > 0\ + by (simp add: unitary_gen_def unitary_def) +qed + +text \When they represent Möbius transformations, eneralized unitary matrices fix the imaginary unit circle. Therefore, they +fix a Hermitean form with (2, 0) signature (two positive and no negative diagonal elements).\ +lemma unitary_gen_iff': + shows "unitary_gen M \ + (\ k::complex. k \ 0 \ congruence M (1, 0, 0, 1) = k *\<^sub>s\<^sub>m (1, 0, 0, 1))" + unfolding unitary_gen_def + using mat_eye_r + by (auto simp add: mult.assoc) + +text \Unitary matrices are special cases of general unitary matrices\ +lemma unitary_unitary_gen [simp]: + assumes "unitary M" + shows "unitary_gen M" + using assms + unfolding unitary_gen_def unitary_def + by auto + +text \Generalized unitary matrices are regular\ +lemma unitary_gen_regular: + assumes "unitary_gen M" + shows "mat_det M \ 0" +proof- + from assms obtain k where + "k \ 0" "mat_adj M *\<^sub>m\<^sub>m M = k *\<^sub>s\<^sub>m eye" + unfolding unitary_gen_def + by auto + hence "mat_det (mat_adj M *\<^sub>m\<^sub>m M) \ 0" + by simp + thus ?thesis + by (simp add: mat_det_adj) +qed + +lemmas unitary_regular = unitary_gen_regular[OF unitary_unitary_gen] + +(* -------------------------------------------------------------------------- *) +subsubsection \Group properties\ +(* -------------------------------------------------------------------------- *) + +text \Generalized $2\times 2$ unitary matrices form a group under +multiplication (usually denoted by $GU(2, \mathbb{C})$). The group is closed +under non-zero complex scalar multiplication. Since these matrices are +always regular, they form a subgroup of general linear group (usually +denoted by $GL(2, \mathbb{C})$) of all regular matrices.\ + +lemma unitary_gen_scale [simp]: + assumes "unitary_gen M" and "k \ 0" + shows "unitary_gen (k *\<^sub>s\<^sub>m M)" + using assms + unfolding unitary_gen_def + by auto + +lemma unitary_comp: + assumes "unitary M1" and "unitary M2" + shows "unitary (M1 *\<^sub>m\<^sub>m M2)" + using assms + unfolding unitary_def + by (metis mat_adj_mult_mm mat_eye_l mult_mm_assoc) + +lemma unitary_gen_comp: + assumes "unitary_gen M1" and "unitary_gen M2" + shows "unitary_gen (M1 *\<^sub>m\<^sub>m M2)" +proof- + obtain k1 k2 where *: "k1 * k2 \ 0" "mat_adj M1 *\<^sub>m\<^sub>m M1 = k1 *\<^sub>s\<^sub>m eye" "mat_adj M2 *\<^sub>m\<^sub>m M2 = k2 *\<^sub>s\<^sub>m eye" + using assms + unfolding unitary_gen_def + by auto + have "mat_adj M2 *\<^sub>m\<^sub>m mat_adj M1 *\<^sub>m\<^sub>m (M1 *\<^sub>m\<^sub>m M2) = mat_adj M2 *\<^sub>m\<^sub>m (mat_adj M1 *\<^sub>m\<^sub>m M1) *\<^sub>m\<^sub>m M2" + by (auto simp add: mult_mm_assoc) + also have "... = mat_adj M2 *\<^sub>m\<^sub>m ((k1 *\<^sub>s\<^sub>m eye) *\<^sub>m\<^sub>m M2)" + using * + by (auto simp add: mult_mm_assoc) + also have "... = mat_adj M2 *\<^sub>m\<^sub>m (k1 *\<^sub>s\<^sub>m M2)" + using mult_sm_eye_mm[of k1 M2] + by (simp del: eye_def) + also have "... = k1 *\<^sub>s\<^sub>m (k2 *\<^sub>s\<^sub>m eye)" + using * + by auto + finally + show ?thesis + using * + unfolding unitary_gen_def + by (rule_tac x="k1*k2" in exI, simp del: eye_def) +qed + +lemma unitary_adj_eq_inv: + shows "unitary M \ mat_det M \ 0 \ mat_adj M = mat_inv M" + using unitary_regular[of M] mult_mm_inv_r[of M "mat_adj M" eye] mat_eye_l[of "mat_inv M"] mat_inv_l[of M] + unfolding unitary_def + by - (rule, simp_all) + +lemma unitary_inv: + assumes "unitary M" + shows "unitary (mat_inv M)" + using assms + unfolding unitary_adj_eq_inv + using mat_adj_inv[of M] mat_det_inv[of M] + by simp + +lemma unitary_gen_inv: + assumes "unitary_gen M" + shows "unitary_gen (mat_inv M)" +proof- + obtain k M' where "0 < k" "unitary M'" "M = cor k *\<^sub>s\<^sub>m eye *\<^sub>m\<^sub>m M'" + using unitary_gen_unitary[of M] assms + by blast + hence "mat_inv M = cor (1/k) *\<^sub>s\<^sub>m mat_inv M'" + by (metis mat_inv_mult_sm mult_sm_eye_mm norm_not_less_zero of_real_1 of_real_divide of_real_eq_0_iff sgn_1_neg sgn_greater sgn_if sgn_pos sgn_sgn) + thus ?thesis + using \k > 0\ \unitary M'\ + by (subst unitary_gen_unitary[of "mat_inv M"]) (rule_tac x="1/k" in exI, rule_tac x="mat_inv M'" in exI, metis divide_pos_pos mult_sm_eye_mm unitary_inv zero_less_one) + qed + +(* -------------------------------------------------------------------------- *) +subsubsection \The characterization in terms of matrix elements\ +(* -------------------------------------------------------------------------- *) + +text \Special matrices are those having the determinant equal to 1. We first give their characterization.\ +lemma unitary_special: + assumes "unitary M" and "mat_det M = 1" + shows "\ a b. M = (a, b, -cnj b, cnj a)" +proof- + have "mat_adj M = mat_inv M" + using assms mult_mm_inv_r[of M "mat_adj M" "eye"] mat_eye_r mat_eye_l + by (simp add: unitary_def) + thus ?thesis + using \mat_det M = 1\ + by (cases M) (auto simp add: mat_adj_def mat_cnj_def) +qed + +lemma unitary_gen_special: + assumes "unitary_gen M" and "mat_det M = 1" + shows "\ a b. M = (a, b, -cnj b, cnj a)" +proof- + from assms + obtain k where *: "k \ 0" "mat_adj M *\<^sub>m\<^sub>m M = k *\<^sub>s\<^sub>m eye" + unfolding unitary_gen_def + by auto + hence "mat_det (mat_adj M *\<^sub>m\<^sub>m M) = k*k" + by simp + hence "k*k = 1" + using assms(2) + by (simp add: mat_det_adj) + hence "k = 1 \ k = -1" + using square_eq_1_iff[of k] + by simp + moreover + have "mat_adj M = k *\<^sub>s\<^sub>m mat_inv M" + using * + using assms mult_mm_inv_r[of M "mat_adj M" "k *\<^sub>s\<^sub>m eye"] mat_eye_r mat_eye_l + by simp (metis mult_sm_eye_mm *(2)) + moreover + obtain a b c d where "M = (a, b, c, d)" + by (cases M) auto + ultimately + have "M = (a, b, -cnj b, cnj a) \ M = (a, b, cnj b, -cnj a)" + using assms(2) + by (auto simp add: mat_adj_def mat_cnj_def) + moreover + have "Re (- (cor (cmod a))\<^sup>2 - (cor (cmod b))\<^sup>2) < 1" + by (smt cmod_square complex_norm_square minus_complex.simps(1) of_real_power realpow_square_minus_le uminus_complex.simps(1)) + hence "- (cor (cmod a))\<^sup>2 - (cor (cmod b))\<^sup>2 \ 1" + by force + hence "M \ (a, b, cnj b, -cnj a)" + using \mat_det M = 1\ complex_mult_cnj_cmod[of a] complex_mult_cnj_cmod[of b] + by auto + ultimately + show ?thesis + by auto +qed + +text \A characterization of all generalized unitary matrices\ +lemma unitary_gen_iff: + shows "unitary_gen M \ + (\ a b k. k \ 0 \ mat_det (a, b, -cnj b, cnj a) \ 0 \ + M = k *\<^sub>s\<^sub>m (a, b, -cnj b, cnj a))" (is "?lhs = ?rhs") +proof + assume ?lhs + obtain d where *: "d*d = mat_det M" + using ex_complex_sqrt + by auto + hence "d \ 0" + using unitary_gen_regular[OF \unitary_gen M\] + by auto + from \unitary_gen M\ + obtain k where "k \ 0" "mat_adj M *\<^sub>m\<^sub>m M = k *\<^sub>s\<^sub>m eye" + unfolding unitary_gen_def + by auto + hence "mat_adj ((1/d)*\<^sub>s\<^sub>mM) *\<^sub>m\<^sub>m ((1/d)*\<^sub>s\<^sub>mM) = (k / (d*cnj d)) *\<^sub>s\<^sub>m eye" + by simp + obtain a b where "(a, b, - cnj b, cnj a) = (1 / d) *\<^sub>s\<^sub>m M" + using unitary_gen_special[of "(1 / d) *\<^sub>s\<^sub>m M"] \unitary_gen M\ * unitary_gen_regular[of M] \d \ 0\ + by force + moreover + hence "mat_det (a, b, - cnj b, cnj a) \ 0" + using unitary_gen_regular[OF \unitary_gen M\] \d \ 0\ + by auto + ultimately + show ?rhs + apply (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="d" in exI) + using mult_sm_inv_l[of "1/d" M] + by (auto simp add: field_simps) +next + assume ?rhs + then obtain a b k where "k \ 0 \ mat_det (a, b, - cnj b, cnj a) \ 0 \ M = k *\<^sub>s\<^sub>m (a, b, - cnj b, cnj a)" + by auto + thus ?lhs + unfolding unitary_gen_def + apply (auto simp add: mat_adj_def mat_cnj_def) + using mult_eq_0_iff[of "cnj k * k" "cnj a * a + cnj b * b"] + by (auto simp add: field_simps) +qed + +text \A characterization of unitary matrices\ + +lemma unitary_iff: + shows "unitary M \ + (\ a b k. (cmod a)\<^sup>2 + (cmod b)\<^sup>2 \ 0 \ + (cmod k)\<^sup>2 = 1 / ((cmod a)\<^sup>2 + (cmod b)\<^sup>2) \ + M = k *\<^sub>s\<^sub>m (a, b, -cnj b, cnj a))" (is "?lhs = ?rhs") +proof + assume ?lhs + obtain k a b where *: "M = k *\<^sub>s\<^sub>m (a, b, -cnj b, cnj a)" "k \ 0" "mat_det (a, b, -cnj b, cnj a) \ 0" + using unitary_gen_iff unitary_unitary_gen[OF \unitary M\] + by auto + + have md: "mat_det (a, b, -cnj b, cnj a) = cor ((cmod a)\<^sup>2 + (cmod b)\<^sup>2)" + by (auto simp add: complex_mult_cnj_cmod) + + have "k * cnj k * mat_det (a, b, -cnj b, cnj a) = 1" + using \unitary M\ * + unfolding unitary_def + by (auto simp add: mat_adj_def mat_cnj_def field_simps) + hence "(cmod k)\<^sup>2 * ((cmod a)\<^sup>2 + (cmod b)\<^sup>2) = 1" + by (subst (asm) complex_mult_cnj_cmod, subst (asm) md, subst (asm) cor_mult[symmetric]) (metis of_real_1 of_real_eq_iff) + thus ?rhs + using * mat_eye_l + apply (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="k" in exI) + apply (auto simp add: complex_mult_cnj_cmod) + by (metis \(cmod k)\<^sup>2 * ((cmod a)\<^sup>2 + (cmod b)\<^sup>2) = 1\ mult_eq_0_iff nonzero_eq_divide_eq zero_neq_one) +next + assume ?rhs + then obtain a b k where *: "(cmod a)\<^sup>2 + (cmod b)\<^sup>2 \ 0" "(cmod k)\<^sup>2 = 1 / ((cmod a)\<^sup>2 + (cmod b)\<^sup>2)" "M = k *\<^sub>s\<^sub>m (a, b, -cnj b, cnj a)" + by auto + have "(k * cnj k) * (a * cnj a) + (k * cnj k) * (b * cnj b) = 1" + apply (subst complex_mult_cnj_cmod)+ + using *(1-2) + by (metis (no_types, lifting) distrib_left nonzero_eq_divide_eq of_real_1 of_real_add of_real_divide of_real_eq_0_iff) + thus ?lhs + using * + unfolding unitary_def + by (simp add: mat_adj_def mat_cnj_def field_simps) +qed + +end diff --git a/thys/Complex_Geometry/document/root.bib b/thys/Complex_Geometry/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Complex_Geometry/document/root.bib @@ -0,0 +1,128 @@ +@incollection{harrison05, + title={A {HOL} theory of {Euclidean} space}, + author={Harrison, John}, + booktitle={Theorem proving in higher order logics}, + pages={114--129}, + year={2005}, + publisher={Springer} +} + +@incollection{wlog, + title={Without loss of generality}, + author={Harrison, John}, + booktitle={Theorem Proving in Higher Order Logics}, + pages={43--59}, + year={2009}, + publisher={Springer} +} + +@book{schwerdtfeger, + title={Geometry of complex numbers: circle geometry, {Moebius} transformation, non-euclidean geometry}, + author={Schwerdtfeger, Hans}, + year={1979}, + publisher={Courier Corporation} +} + +@book{needham, + title={Visual complex analysis}, + author={Needham, Tristan}, + year={1998}, + publisher={Oxford University Press} +} + +@book{hilbert, + title={Grundlagen der geometrie}, + author={Hilbert, David}, + year={2013}, + publisher={Springer-Verlag} +} + +@incollection{hilbert-coq, + title={Higher-order intuitionistic formalization and proofs in {Hilbert’s} elementary geometry}, + author={Dehlinger, Christophe and Dufourd, Jean-Fran{\c{c}}ois and Schreck, Pascal}, + booktitle={Automated Deduction in Geometry}, + pages={306--323}, + year={2001}, + publisher={Springer} +} + +@incollection{hilbert-isabelle, + title={Formalizing {Hilbert’s} {Grundlagen} in {Isabelle/Isar}}, + author={Meikle, Laura I and Fleuriot, Jacques D}, + booktitle={Theorem proving in higher order logics}, + pages={319--334}, + year={2003}, + publisher={Springer} +} + +@article{hilbert-scott, + title={Mechanising {Hilbert’s} foundations of geometry in {Isabelle}}, + author={Scott, Phil}, + journal={Master's thesis, University of Edinburgh}, + year={2008}, + publisher={Citeseer} +} + +@book{tarski, + author = {Wolfram Schwabhäuser and Wanda Szmielew and Alfred Tarski}, + title = {{Metamathematische Methoden in der Geometrie}}, + publisher = {Springer-Verlag}, + year = {1983}, + address = {Berlin} +} + +@incollection{narboux-tarski, + title={Mechanical theorem proving in {Tarski’s} geometry}, + author={Narboux, Julien}, + booktitle={Automated Deduction in Geometry}, + pages={139--156}, + year={2007}, + publisher={Springer} +} + +@article{von-plato-formalization, + title={Constructive geometry according to {Jan} von {Plato}}, + author={Kahn, Gilles}, + journal={Coq contribution. Coq}, + volume={5}, + pages={10}, + year={1995} +} + +@article{vonPlato, + title={The axioms of constructive geometry}, + author={von Plato, Jan}, + journal={Annals of pure and applied logic}, + volume={76}, + number={2}, + pages={169--200}, + year={1995}, + publisher={Elsevier} +} + +@article{guilhot, + title={Formalisation en {Coq} et visualisation d'un cours de g{\'e}om{\'e}trie pour le lyc{\'e}e.}, + author={Guilhot, Fr{\'e}d{\'e}rique}, + journal={Technique et Science informatiques}, + volume={24}, + number={9}, + pages={1113--1138}, + year={2005} +} + +@article{duprat2008, + title={Une axiomatique de la g{\'e}om{\'e}trie plane en {Coq}}, + author={Duprat, Jean}, + journal={Actes des JFLA}, + pages={123--136}, + year={2008} +} + +@inproceedings{petrovic2012formalizing, + title={Formalizing analytic geometries}, + author={Petrovic, Danijela and Maric, Filip}, + booktitle={This volume contains the papers presented at ADG 2012: The 9th International Workshop on Automated Deduction in Geometry, held on September 17--19, 2012 at the University of Edinburgh. The submissions were each reviewed by at least 3 program committee mem-bers, and the committee decided to accept 15 papers for the workshop. The}, + pages={107}, + year={2012} +} + diff --git a/thys/Complex_Geometry/document/root.tex b/thys/Complex_Geometry/document/root.tex new file mode 100755 --- /dev/null +++ b/thys/Complex_Geometry/document/root.tex @@ -0,0 +1,73 @@ +\documentclass[8pt,a4paper]{article} +\usepackage[margin=2cm]{geometry} +\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} + +\usepackage{amsmath} + +\begin{document} + +\title{Complex Geometry} +\author{Filip Mari\'c \and + Danijela Simi\'c + } +\maketitle + +\begin{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\"obius +transformations). Most objects are defined algebraically, but +correspondence with classical geometric definitions is shown. +\end{abstract} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +% optional bibliography +\clearpage +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: diff --git a/thys/Poincare_Disc/Hyperbolic_Functions.thy b/thys/Poincare_Disc/Hyperbolic_Functions.thy new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/Hyperbolic_Functions.thy @@ -0,0 +1,187 @@ +section \Introduction\ + +text\Poincar\'e disc is a model of hyperbolic geometry. That fact has been +a mathematical folklore for more than 100 years. However, up to the +best of our knowledge, fully precise, formal proofs of this fact are +lacking. In this paper we present a formalization of the Poincar\'e disc model +in Isabelle/HOL, introduce its basic notions (h-points, h-lines, +h-congruence, h-isometries, h-betweenness) and prove that it models +Tarski's axioms except for Euclid's axiom. We shown that is satisfies +the negation of Euclid's axiom, and, moreover, the existence of +limiting parallels axiom. The model is defined within the extended +complex plane, which has been described quite precisely by +Schwerdfeger~\cite{schwerdtfeger} and formalized in the previous work +of the first two authors~\cite{amai-complexplane}.\ + +paragraph \Related work.\ + +text\In 1840 Lobachevsky~\cite{lobachevsky1840geometrische} published developments +about non-Euclidean geometry. Hyperbolic +geometry is studied through many of its models. The concept of a +projective disc model was introduced by Klein while Poincar\'e +investigated the half-plane model proposed by Liouville and Beltrami +and primarily studied the isometries of the hyperbolic plane that +preserve orientation. In this paper, we focus on the formalization of +the latter. + +Regarding non-Euclidean geometry, Makarios showed the +independence of Euclid's axiom~\cite{makarios}. He did so by +formalizing that the Klein--Beltrami model is a model of Tarski's +axioms at the exception of Euclid's axiom. Latter Coghetto formalized +the Klein-Beltrami model within Mizar~\cite{coghetto2018klein1,coghetto2018klein2}. +\ + +section \Background theories\ + +subsection\Hyperbolic Functions\ + +text \In this section hyperbolic cosine and hyperbolic sine functions are introduced and some of their +properties needed for further development are proved.\ + +theory Hyperbolic_Functions + imports Complex_Main Complex_Geometry.More_Complex +begin + +lemma cosh_arcosh [simp]: + fixes x :: real + assumes "x \ 1" + shows "cosh (arcosh x) = x" +proof- + from assms + have **: "x + sqrt(x\<^sup>2 - 1) \ 1" + by (smt one_le_power real_sqrt_ge_zero) + hence *: "x + sqrt(x\<^sup>2 - 1) \ 0" + by simp + moreover + have "sqrt (x\<^sup>2 - 1) + 1 / (x + sqrt (x\<^sup>2 - 1)) = x" (is "?lhs = x") + proof- + have "?lhs = (x*sqrt(x\<^sup>2 - 1) + x\<^sup>2) / (x + sqrt(x\<^sup>2 - 1))" + using * \x \ 1\ + by (subst add_divide_eq_iff, simp, simp add: field_simps) + also have "... = x * (sqrt(x\<^sup>2 - 1) + x) / (x + sqrt(x\<^sup>2 - 1))" + by (simp add: field_simps power2_eq_square) + finally + show ?thesis + using nonzero_mult_div_cancel_right[OF *, of x] + by (simp add: field_simps) + qed + thus ?thesis + using arcosh_real_def[OF assms(1)] + unfolding cosh_def + using ln_div[of 1, symmetric] ** + by auto +qed + + +lemma arcosh_ge_0 [simp]: + fixes x::real + assumes "x \ 1" + shows "arcosh x \ 0" + by (smt arcosh_def assms ln_ge_zero powr_ge_pzero) + +lemma arcosh_eq_0_iff: + fixes x::real + assumes "x \ 1" + shows "arcosh x = 0 \ x = 1" + using assms + using cosh_arcosh by fastforce + +lemma arcosh_eq_iff: + fixes x y::real + assumes "x \ 1" "y \ 1" + shows "arcosh x = arcosh y \ x = y" + using assms + using cosh_arcosh by fastforce + + +lemma cosh_gt_1 [simp]: + fixes x ::real + assumes "x > 0" + shows "cosh x > 1" + using assms cosh_real_strict_mono by force + + +lemma cosh_eq_iff: + fixes x y::real + assumes "x \ 0" "y \ 0" + shows "cosh x = cosh y \ x = y" + by (simp add: assms(1) assms(2)) + + +lemma arcosh_mono: + fixes x y::real + assumes "x \ 1" "y \ 1" + shows "arcosh x \ arcosh y \ x \ y" + using assms + by (smt arcosh_ge_0 cosh_arcosh cosh_real_nonneg_less_iff) + + +lemma arcosh_add: + fixes x y::real + assumes "x \ 1" "y \ 1" + shows "arcosh x + arcosh y = arcosh (x*y + sqrt((x\<^sup>2 - 1)*(y\<^sup>2 - 1)))" +proof- + have "sqrt ((x\<^sup>2 - 1) * (y\<^sup>2 - 1)) \ 0" + using assms + by simp + moreover + have "x * y \ 1" + using assms + by (smt mult_le_cancel_left1) + ultimately + have **: "x * y + sqrt ((x\<^sup>2 - 1) * (y\<^sup>2 - 1)) \ 1" + by linarith + hence 1: "0 \ (x * y + sqrt ((x\<^sup>2 - 1) * (y\<^sup>2 - 1)))\<^sup>2 - 1" + by simp + + have 2: "x * sqrt (y\<^sup>2 - 1) + y * sqrt (x\<^sup>2 - 1) \ 0" + using assms + by simp + + have "(x*sqrt(y\<^sup>2 - 1)+y*sqrt(x\<^sup>2 -1))\<^sup>2 = (sqrt((x*y+sqrt((x\<^sup>2-1)*(y\<^sup>2-1)))\<^sup>2 - 1))\<^sup>2" + using assms + proof (subst real_sqrt_pow2) + show "0 \ (x * y + sqrt ((x\<^sup>2 - 1) * (y\<^sup>2 - 1)))\<^sup>2 - 1" + by fact + next + have "(x * sqrt (y\<^sup>2 - 1))\<^sup>2 = x\<^sup>2 * (y\<^sup>2 - 1)" + using assms + apply (subst power_mult_distrib) + apply (subst real_sqrt_pow2, simp_all) + done + moreover + have "(y * sqrt (x\<^sup>2 - 1))\<^sup>2 = y\<^sup>2 * (x\<^sup>2 - 1)" + using assms + apply (subst power_mult_distrib) + apply (subst real_sqrt_pow2, simp_all) + done + ultimately show "(x * sqrt (y\<^sup>2 - 1) + y * sqrt (x\<^sup>2 - 1))\<^sup>2 = (x * y + sqrt ((x\<^sup>2 - 1) * (y\<^sup>2 - 1)))\<^sup>2 - 1" + using assms + unfolding power2_sum + apply (simp add: real_sqrt_mult power_mult_distrib) + apply (simp add: field_simps) + done + qed + hence "sqrt ((x * y + sqrt ((x\<^sup>2 - 1) * (y\<^sup>2 - 1)))\<^sup>2 - 1) = x * sqrt (y\<^sup>2 - 1) + y * sqrt (x\<^sup>2 - 1)" + using power2_eq_iff_nonneg[OF 2 real_sqrt_ge_zero[OF 1]] + by simp + thus ?thesis + using assms + apply (subst arcosh_real_def[OF assms(1)]) + apply (subst arcosh_real_def[OF assms(2)]) + apply (subst arcosh_real_def[OF **]) + apply (subst ln_mult[symmetric]) + apply (smt one_le_power real_sqrt_ge_zero) + apply (smt one_le_power real_sqrt_ge_zero) + apply (simp add: real_sqrt_mult) + apply (simp add: field_simps) + done +qed + +lemma arcosh_double: + fixes x :: real + assumes "x \ 1" + shows "2 * arcosh x = arcosh (2*x\<^sup>2 - 1)" + by (smt arcosh_add arcosh_mono assms one_power2 power2_eq_square real_sqrt_abs) + +end diff --git a/thys/Poincare_Disc/Poincare.thy b/thys/Poincare_Disc/Poincare.thy new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/Poincare.thy @@ -0,0 +1,210 @@ +section\Poincar\'e disc model types\ + +text \In this section we introduce datatypes that represent objects in the Poincar\'e disc model. +The types are defined as subtypes (e.g., the h-points are defined as elements of $\mathbb{C}P^1$ +that lie within the unit disc). The functions on those types are defined by lifting the functions +defined on the carrier type (e.g., h-distance is defined by lifting the distance function defined +for elements of $\mathbb{C}P^1$).\ + +theory Poincare +imports Poincare_Lines Poincare_Between Poincare_Distance Poincare_Circles +begin + +(* ------------------------------------------------------------------ *) +subsection \H-points\ +(* ------------------------------------------------------------------ *) + +typedef p_point = "{z. z \ unit_disc}" + using zero_in_unit_disc + by (rule_tac x="0\<^sub>h" in exI, simp) + +setup_lifting type_definition_p_point + +text \Point zero\ +lift_definition p_zero :: "p_point" is "0\<^sub>h" + by (rule zero_in_unit_disc) + +text \Constructing h-points from complex numbers\ +lift_definition p_of_complex :: "complex \ p_point" is "\ z. if cmod z < 1 then of_complex z else 0\<^sub>h" + by auto + +(* ------------------------------------------------------------------ *) +subsection \H-lines\ +(* ------------------------------------------------------------------ *) + +typedef p_line = "{H. is_poincare_line H}" + by (rule_tac x="x_axis" in exI, simp) + +setup_lifting type_definition_p_line + +lift_definition p_incident :: "p_line \ p_point \ bool" is on_circline + done + +text \Set of h-points on an h-line\ +definition p_points :: "p_line \ p_point set" where + "p_points l = {p. p_incident l p}" + +text \x-axis is an example of an h-line\ +lift_definition p_x_axis :: "p_line" is x_axis + by simp + +text \Constructing the unique h-line from two h-points\ +lift_definition p_line :: "p_point \ p_point \ p_line" is poincare_line +proof- + fix u v + show "is_poincare_line (poincare_line u v)" + proof (cases "u \ v") + case True + thus ?thesis + by simp + next + text\This branch must work only for formal reasons.\ + case False + thus ?thesis + by (transfer, transfer, auto simp add: hermitean_def mat_adj_def mat_cnj_def split: if_split_asm) + qed +qed + +text \Next we show how to lift some lemmas. This could be done for all the lemmas that we have +proved earlier, but we do not do that.\ + +text \If points are different then the constructed line contains the starting points\ +lemma p_on_line: + assumes "z \ w" + shows "p_incident (p_line z w) z" + "p_incident (p_line z w) w" + using assms + by (transfer, simp)+ + +text \There is a unique h-line passing trough the two different given h-points\ +lemma + assumes "u \ v" + shows "\! l. {u, v} \ p_points l" + using assms + apply (rule_tac a="p_line u v" in ex1I, auto simp add: p_points_def p_on_line) + apply (transfer, simp add: unique_poincare_line) + done + +text \The unique h-line trough zero and a non-zero h-point on the x-axis is the x-axis\ +lemma + assumes "p_zero \ p_points l" "u \ p_points l" "u \ p_zero" "u \ p_points p_x_axis" + shows "l = p_x_axis" + using assms + unfolding p_points_def + apply simp + apply transfer + using is_poincare_line_0_real_is_x_axis inf_notin_unit_disc + unfolding circline_set_def + by blast + +(* ------------------------------------------------------------------ *) +subsection \H-collinearity\ +(* ------------------------------------------------------------------ *) + +lift_definition p_collinear :: "p_point set \ bool" is poincare_collinear + done + +(* ------------------------------------------------------------------ *) +subsection \H-isometries\ +(* ------------------------------------------------------------------ *) + +text \H-isometries are functions that map the unit disc onto itself\ +typedef p_isometry = "{f. unit_disc_fix_f f}" + by (rule_tac x="id" in exI, simp add: unit_disc_fix_f_def, rule_tac x="id_moebius" in exI, simp) + +setup_lifting type_definition_p_isometry + +text \Action of an h-isometry on an h-point\ +lift_definition p_isometry_pt :: "p_isometry \ p_point \ p_point" is "\ f p. f p" + using unit_disc_fix_f_unit_disc + by auto + +text \Action of an h-isometry on an h-line\ +lift_definition p_isometry_line :: "p_isometry \ p_line \ p_line" is "\ f l. unit_disc_fix_f_circline f l" +proof- + fix f H + assume "unit_disc_fix_f f" "is_poincare_line H" + then obtain M where "unit_disc_fix M" and *: "f = moebius_pt M \ f = moebius_pt M \ conjugate" + unfolding unit_disc_fix_f_def + by auto + show "is_poincare_line (unit_disc_fix_f_circline f H)" + using * + proof + assume "f = moebius_pt M" + thus ?thesis + using \unit_disc_fix M\ \is_poincare_line H\ + using unit_disc_fix_f_circline_direct[of M f H] + by auto + next + assume "f = moebius_pt M \ conjugate" + thus ?thesis + using \unit_disc_fix M\ \is_poincare_line H\ + using unit_disc_fix_f_circline_indirect[of M f H] + by auto + qed +qed + +text \An example lemma about h-isometries.\ + +text \H-isometries preserve h-collinearity\ +lemma p_collinear_p_isometry_pt [simp]: + shows "p_collinear (p_isometry_pt M ` A) \ p_collinear A" +proof- + have *: "\ M A. ((\x. moebius_pt M (conjugate x)) ` A = moebius_pt M ` (conjugate ` A))" + by auto + show ?thesis + by transfer (auto simp add: unit_disc_fix_f_def *) +qed + +(* ------------------------------------------------------------------ *) +subsection \H-distance and h-congruence\ +(* ------------------------------------------------------------------ *) + +lift_definition p_dist :: "p_point \ p_point \ real" is poincare_distance + done + +definition p_congruent :: "p_point \ p_point \ p_point \ p_point \ bool" where + [simp]: "p_congruent u v u' v' \ p_dist u v = p_dist u' v'" + +lemma + assumes "p_dist u v = p_dist u' v'" + assumes "p_dist v w = p_dist v' w'" + assumes "p_dist u w = p_dist u' w'" + shows "\ f. p_isometry_pt f u = u' \ p_isometry_pt f v = v' \ p_isometry_pt f w = w'" + using assms + apply transfer + using unit_disc_fix_f_congruent_triangles + by auto + +text\We prove that unit disc equipped with Poincar\'e distance is a metric space, i.e. an +instantiation of @{term metric_space} locale.\ + +instantiation p_point :: metric_space +begin +definition "dist_p_point = p_dist" +definition "(uniformity_p_point :: (p_point \ p_point) filter) = (INF e:{0<..}. principal {(x, y). dist_class.dist x y < e})" +definition "open_p_point (U :: p_point set) = (\ x \ U. eventually (\(x', y). x' = x \ y \ U) uniformity)" +instance +proof + fix x y :: p_point + show "(dist_class.dist x y = 0) = (x = y)" + unfolding dist_p_point_def + by (transfer, simp add: poincare_distance_eq_0_iff) +next + fix x y z :: p_point + show "dist_class.dist x y \ dist_class.dist x z + dist_class.dist y z" + unfolding dist_p_point_def + apply transfer + using poincare_distance_triangle_inequality poincare_distance_sym + by metis +qed (simp_all add: open_p_point_def uniformity_p_point_def) +end + +(* ------------------------------------------------------------------ *) +subsection \H-betweennes\ +(* ------------------------------------------------------------------ *) + +lift_definition p_between :: "p_point \ p_point \ p_point \ bool" is poincare_between + done + +end diff --git a/thys/Poincare_Disc/Poincare_Between.thy b/thys/Poincare_Disc/Poincare_Between.thy new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/Poincare_Between.thy @@ -0,0 +1,1263 @@ +theory Poincare_Between + imports Poincare_Distance +begin + +(* ------------------------------------------------------------------ *) +section\H-betweenness in the Poincar\'e model\ +(* ------------------------------------------------------------------ *) + +subsection \H-betwenness expressed by a cross-ratio\ + +text\The point $v$ is h-between $u$ and $w$ if the cross-ratio between the pairs $u$ and $w$ and $v$ +and inverse of $v$ is real and negative.\ +definition poincare_between :: "complex_homo \ complex_homo \ complex_homo \ bool" where + "poincare_between u v w \ + u = v \ v = w \ + (let cr = cross_ratio u v w (inversion v) + in is_real (to_complex cr) \ Re (to_complex cr) < 0)" + +subsubsection \H-betwenness is preserved by h-isometries\ + +text \Since they preserve cross-ratio and inversion, h-isometries (unit disc preserving Möbius +transformations and conjugation) preserve h-betweeness.\ + +lemma unit_disc_fix_moebius_preserve_poincare_between [simp]: + assumes "unit_disc_fix M" and "u \ unit_disc" and "v \ unit_disc" and "w \ unit_disc" + shows "poincare_between (moebius_pt M u) (moebius_pt M v) (moebius_pt M w) \ + poincare_between u v w" +proof (cases "u = v \ v = w") + case True + thus ?thesis + using assms + unfolding poincare_between_def + by auto +next + case False + moreover + hence "moebius_pt M u \ moebius_pt M v \ moebius_pt M v \ moebius_pt M w" + by auto + moreover + have "v \ inversion v" "w \ inversion v" + using inversion_noteq_unit_disc[of v w] + using inversion_noteq_unit_disc[of v v] + using \v \ unit_disc\ \w \ unit_disc\ + by auto + ultimately + show ?thesis + using assms + using unit_circle_fix_moebius_pt_inversion[of M v, symmetric] + unfolding poincare_between_def + by (simp del: unit_circle_fix_moebius_pt_inversion) +qed + +lemma conjugate_preserve_poincare_between [simp]: + assumes "u \ unit_disc" and "v \ unit_disc" and "w \ unit_disc" + shows "poincare_between (conjugate u) (conjugate v) (conjugate w) \ + poincare_between u v w" +proof (cases "u = v \ v = w") + case True + thus ?thesis + using assms + unfolding poincare_between_def + by auto +next + case False + moreover + hence "conjugate u \ conjugate v \ conjugate v \ conjugate w" + using conjugate_inj by blast + moreover + have "v \ inversion v" "w \ inversion v" + using inversion_noteq_unit_disc[of v w] + using inversion_noteq_unit_disc[of v v] + using \v \ unit_disc\ \w \ unit_disc\ + by auto + ultimately + show ?thesis + using assms + using conjugate_cross_ratio[of v w "inversion v" u] + unfolding poincare_between_def + by (metis conjugate_id_iff conjugate_involution inversion_def inversion_sym o_apply) +qed + + +subsubsection \Some elementary properties of h-betwenness\ + +lemma poincare_between_nonstrict [simp]: + shows "poincare_between u u v" and "poincare_between u v v" + by (simp_all add: poincare_between_def) + +lemma poincare_between_sandwich: + assumes "u \ unit_disc" and "v \ unit_disc" + assumes "poincare_between u v u" + shows "u = v" +proof (rule ccontr) + assume "\ ?thesis" + thus False + using assms + using inversion_noteq_unit_disc[of v u] + using cross_ratio_1[of v u "inversion v"] + unfolding poincare_between_def Let_def + by auto +qed + +lemma poincare_between_rev: + assumes "u \ unit_disc" and "v \ unit_disc" and "w \ unit_disc" + shows "poincare_between u v w \ poincare_between w v u" + using assms + using inversion_noteq_unit_disc[of v w] + using inversion_noteq_unit_disc[of v u] + using cross_ratio_commute_13[of u v w "inversion v"] + using cross_ratio_not_inf[of w "inversion v" v u] + using cross_ratio_not_zero[of w v u "inversion v"] + using inf_or_of_complex[of "cross_ratio w v u (inversion v)"] + unfolding poincare_between_def + by (auto simp add: Let_def Im_complex_div_eq_0 Re_divide divide_less_0_iff) + +subsubsection \H-betwenness and h-collinearity\ + +text\Three points can be in an h-between relation only when they are h-collinear.\ +lemma poincare_between_poincare_collinear [simp]: + assumes in_disc: "u \ unit_disc" "v \ unit_disc" "w \ unit_disc" + assumes betw: "poincare_between u v w" + shows "poincare_collinear {u, v, w}" +proof (cases "u = v \ v = w") + case True + thus ?thesis + using assms + by auto +next + case False + hence distinct: "distinct [u, v, w, inversion v]" + using in_disc inversion_noteq_unit_disc[of v v] inversion_noteq_unit_disc[of v u] inversion_noteq_unit_disc[of v w] + using betw poincare_between_sandwich[of w v] + by (auto simp add: poincare_between_def Let_def) + + then obtain H where *: "{u, v, w, inversion v} \ circline_set H" + using assms + unfolding poincare_between_def + using four_points_on_circline_iff_cross_ratio_real[of u v w "inversion v"] + by auto + hence "H = poincare_line u v" + using assms distinct + using unique_circline_set[of u v "inversion v"] + using poincare_line[of u v] poincare_line_inversion[of u v] + unfolding circline_set_def + by auto + thus ?thesis + using * assms False + unfolding poincare_collinear_def + by (rule_tac x="poincare_line u v" in exI) simp +qed + +lemma poincare_between_poincare_line_uvz: + assumes "u \ v" and "u \ unit_disc" and "v \ unit_disc" and + "z \ unit_disc" and "poincare_between u v z" + shows "z \ circline_set (poincare_line u v)" + using assms + using poincare_between_poincare_collinear[of u v z] + using unique_poincare_line[OF assms(1-3)] + unfolding poincare_collinear_def + by auto + +lemma poincare_between_poincare_line_uzv: + assumes "u \ v" and "u \ unit_disc" and "v \ unit_disc" and + "z \ unit_disc" "poincare_between u z v" + shows "z \ circline_set (poincare_line u v)" + using assms + using poincare_between_poincare_collinear[of u z v] + using unique_poincare_line[OF assms(1-3)] + unfolding poincare_collinear_def + by auto + +subsubsection \H-betweeness on Euclidean segments\ + +text\If the three points lie on an h-line that is a Euclidean line (e.g., if it contains zero), +h-betweenness can be characterized much simpler than in the definition.\ + +lemma poincare_between_x_axis_u0v: + assumes "is_real u'" and "u' \ 0" and "v' \ 0" + shows "poincare_between (of_complex u') 0\<^sub>h (of_complex v') \ is_real v' \ Re u' * Re v' < 0" +proof- + have "Re u' \ 0" + using \is_real u'\ \u' \ 0\ + using complex_eq_if_Re_eq + by auto + have nz: "of_complex u' \ 0\<^sub>h" "of_complex v' \ 0\<^sub>h" + by (simp_all add: \u' \ 0\ \v' \ 0\) + hence "0\<^sub>h \ of_complex v'" + by metis + + let ?cr = "cross_ratio (of_complex u') 0\<^sub>h (of_complex v') \\<^sub>h" + have "is_real (to_complex ?cr) \ Re (to_complex ?cr) < 0 \ is_real v' \ Re u' * Re v' < 0" + using cross_ratio_0inf[of v' u'] \v' \ 0\ \u' \ 0\ \is_real u'\ + by (metis Re_complex_div_lt_0 Re_mult_real complex_cnj_divide divide_cancel_left eq_cnj_iff_real to_complex_of_complex) + thus ?thesis + unfolding poincare_between_def inversion_zero + using \of_complex u' \ 0\<^sub>h\ \0\<^sub>h \ of_complex v'\ + by simp +qed + +lemma poincare_between_u0v: + assumes "u \ unit_disc" and "v \ unit_disc" and "u \ 0\<^sub>h" and "v \ 0\<^sub>h" + shows "poincare_between u 0\<^sub>h v \ (\ k < 0. to_complex u = cor k * to_complex v)" (is "?P u v") +proof (cases "u = v") + case True + thus ?thesis + using assms + using inf_or_of_complex[of v] + using poincare_between_sandwich[of u "0\<^sub>h"] + by auto +next + case False + have "\ u. u \ unit_disc \ u \ 0\<^sub>h \ ?P u v" (is "?P' v") + proof (rule wlog_rotation_to_positive_x_axis) + fix \ v + let ?M = "moebius_pt (moebius_rotation \)" + assume 1: "v \ unit_disc" "v \ 0\<^sub>h" + assume 2: "?P' (?M v)" + show "?P' v" + proof (rule allI, rule impI, (erule conjE)+) + fix u + assume 3: "u \ unit_disc" "u \ 0\<^sub>h" + have "poincare_between (?M u) 0\<^sub>h (?M v) \ poincare_between u 0\<^sub>h v" + using \u \ unit_disc\ \v \ unit_disc\ + using unit_disc_fix_moebius_preserve_poincare_between unit_disc_fix_rotation zero_in_unit_disc + by fastforce + thus "?P u v" + using 1 2[rule_format, of "?M u"] 3 + using inf_or_of_complex[of u] inf_or_of_complex[of v] + by auto + qed + next + fix x + assume 1: "is_real x" "0 < Re x" "Re x < 1" + hence "x \ 0" + by auto + show "?P' (of_complex x)" + proof (rule allI, rule impI, (erule conjE)+) + fix u + assume 2: "u \ unit_disc" "u \ 0\<^sub>h" + then obtain u' where "u = of_complex u'" + using inf_or_of_complex[of u] + by auto + show "?P u (of_complex x)" + using 1 2 \x \ 0\ \u = of_complex u'\ + using poincare_between_rev[of u "0\<^sub>h" "of_complex x"] + using poincare_between_x_axis_u0v[of x u'] \is_real x\ + apply (auto simp add: cmod_eq_Re) + apply (rule_tac x="Re u' / Re x" in exI, simp add: divide_neg_pos sign_simps) + using mult_neg_pos mult_pos_neg + by blast + qed + qed fact+ + thus ?thesis + using assms + by auto +qed + +lemma poincare_between_u0v_polar_form: + assumes "x \ unit_disc" and "y \ unit_disc" and "x \ 0\<^sub>h" and "y \ 0\<^sub>h" and + "to_complex x = cor rx * cis \" "to_complex y = cor ry * cis \" + shows "poincare_between x 0\<^sub>h y \ rx * ry < 0" (is "?P x y rx ry") +proof- + from assms have "rx \ 0" "ry \ 0" + using inf_or_of_complex[of x] inf_or_of_complex[of y] + by auto + + have "(\k<0. cor rx = cor k * cor ry ) = (rx * ry < 0)" + proof + assume "\k<0. cor rx = cor k * cor ry" + then obtain k where "k < 0" "cor rx = cor k * cor ry" + by auto + hence "rx = k * ry" + using of_real_eq_iff + by fastforce + thus "rx * ry < 0" + using \k < 0\ \rx \ 0\ \ry \ 0\ + by (smt divisors_zero mult_nonneg_nonpos mult_nonpos_nonpos zero_less_mult_pos2) + next + assume "rx * ry < 0" + hence "rx = (rx/ry)*ry" "rx / ry < 0" + using \rx \ 0\ \ry \ 0\ + by (auto simp add: divide_less_0_iff sign_simps) + thus "\k<0. cor rx = cor k * cor ry" + using \rx \ 0\ \ry \ 0\ + by (rule_tac x="rx / ry" in exI, simp) + qed + thus ?thesis + using assms + using poincare_between_u0v[OF assms(1-4)] + by auto +qed + +lemma poincare_between_x_axis_0uv: + fixes x y :: real + assumes "-1 < x" and "x < 1" and "x \ 0" + assumes "-1 < y" and "y < 1" and "y \ 0" + shows "poincare_between 0\<^sub>h (of_complex x) (of_complex y) \ + (x < 0 \ y < 0 \ y \ x) \ (x > 0 \ y > 0 \ x \ y)" (is "?lhs \ ?rhs") +proof (cases "x = y") + case True + thus ?thesis + using assms + unfolding poincare_between_def + by auto +next + case False + let ?x = "of_complex x" and ?y = "of_complex y" + + have "?x \ unit_disc" "?y \ unit_disc" + using assms + by auto + + have distinct: "distinct [0\<^sub>h, ?x, ?y, inversion ?x]" + using \x \ 0\ \y \ 0\ \x \ y\ \?x \ unit_disc\ \?y \ unit_disc\ + using inversion_noteq_unit_disc[of ?x ?y] + using inversion_noteq_unit_disc[of ?x ?x] + using inversion_noteq_unit_disc[of ?x "0\<^sub>h"] + using of_complex_inj[of x y] + by (metis distinct_length_2_or_more distinct_singleton of_complex_zero_iff of_real_eq_0_iff of_real_eq_iff zero_in_unit_disc) + + let ?cr = "cross_ratio 0\<^sub>h ?x ?y (inversion ?x)" + have "Re (to_complex ?cr) = x\<^sup>2 * (x*y - 1) / (x * (y - x))" + using \x \ 0\ \x \ y\ + unfolding inversion_def + by simp (transfer, transfer, auto simp add: vec_cnj_def power2_eq_square field_simps split: if_split_asm) + moreover + { + fix a b :: real + assume "b \ 0" + hence "a < 0 \ b\<^sup>2 * a < (0::real)" + by (metis mult.commute mult_eq_0_iff mult_neg_pos mult_pos_pos not_less_iff_gr_or_eq not_real_square_gt_zero power2_eq_square) + } + hence "x\<^sup>2 * (x*y - 1) < 0" + using assms + by (smt minus_mult_minus mult_le_cancel_left1) + moreover + have "x * (y - x) > 0 \ ?rhs" + using \x \ 0\ \y \ 0\ \x \ y\ + by (smt mult_le_0_iff) + ultimately + have *: "Re (to_complex ?cr) < 0 \ ?rhs" + by (simp add: divide_less_0_iff) + + show ?thesis + proof + assume ?lhs + have "is_real (to_complex ?cr)" "Re (to_complex ?cr) < 0" + using \?lhs\ distinct + unfolding poincare_between_def Let_def + by auto + thus ?rhs + using * + by simp + next + assume ?rhs + hence "Re (to_complex ?cr) < 0" + using * + by simp + moreover + have "{0\<^sub>h, of_complex (cor x), of_complex (cor y), inversion (of_complex (cor x))} \ circline_set x_axis" + using \x \ 0\ is_real_inversion[of "cor x"] + using inf_or_of_complex[of "inversion ?x"] + by (auto simp del: inversion_of_complex) + hence "is_real (to_complex ?cr)" + using four_points_on_circline_iff_cross_ratio_real[OF distinct] + by auto + ultimately + show ?lhs + using distinct + unfolding poincare_between_def Let_def + by auto + qed +qed + +lemma poincare_between_0uv: + assumes "u \ unit_disc" and "v \ unit_disc" and "u \ 0\<^sub>h" and "v \ 0\<^sub>h" + shows "poincare_between 0\<^sub>h u v \ + (let u' = to_complex u; v' = to_complex v in arg u' = arg v' \ cmod u' \ cmod v')" (is "?P u v") +proof (cases "u = v") + case True + thus ?thesis + by simp +next + case False + have "\ v. v \ unit_disc \ v \ 0\<^sub>h \ v \ u \ (poincare_between 0\<^sub>h u v \ (let u' = to_complex u; v' = to_complex v in arg u' = arg v' \ cmod u' \ cmod v'))" (is "?P' u") + proof (rule wlog_rotation_to_positive_x_axis) + show "u \ unit_disc" "u \ 0\<^sub>h" + by fact+ + next + fix x + assume *: "is_real x" "0 < Re x" "Re x < 1" + hence "of_complex x \ unit_disc" "of_complex x \ 0\<^sub>h" "of_complex x \ circline_set x_axis" + unfolding circline_set_x_axis + by (auto simp add: cmod_eq_Re) + show "?P' (of_complex x)" + proof safe + fix v + assume "v \ unit_disc" "v \ 0\<^sub>h" "v \ of_complex x" "poincare_between 0\<^sub>h (of_complex x) v" + hence "v \ circline_set x_axis" + using poincare_between_poincare_line_uvz[of "0\<^sub>h" "of_complex x" v] + using poincare_line_0_real_is_x_axis[of "of_complex x"] + using \of_complex x \ 0\<^sub>h\ \v \ 0\<^sub>h\ \v \ of_complex x\ \of_complex x \ unit_disc\ \of_complex x \ circline_set x_axis\ + by auto + obtain v' where "v = of_complex v'" + using \v \ unit_disc\ + using inf_or_of_complex[of v] + by auto + hence **: "v = of_complex v'" "-1 < Re v'" "Re v' < 1" "Re v' \ 0" "is_real v'" + using \v \ unit_disc\ \v \ 0\<^sub>h\ \v \ circline_set x_axis\ of_complex_inj[of v'] + unfolding circline_set_x_axis + by (auto simp add: cmod_eq_Re real_imag_0) + show "let u' = to_complex (of_complex x); v' = to_complex v in arg u' = arg v' \ cmod u' \ cmod v'" + using poincare_between_x_axis_0uv[of "Re x" "Re v'"] * ** + using \poincare_between 0\<^sub>h (of_complex x) v\ + using arg_complex_of_real_positive[of "Re x"] arg_complex_of_real_negative[of "Re x"] + using arg_complex_of_real_positive[of "Re v'"] arg_complex_of_real_negative[of "Re v'"] + by (auto simp add: cmod_eq_Re) + next + fix v + assume "v \ unit_disc" "v \ 0\<^sub>h" "v \ of_complex x" + then obtain v' where **: "v = of_complex v'" "v' \ 0" "v' \ x" + using inf_or_of_complex[of v] + by auto blast + assume "let u' = to_complex (of_complex x); v' = to_complex v in arg u' = arg v' \ cmod u' \ cmod v'" + hence ***: "Re x < 0 \ Re v' < 0 \ Re v' \ Re x \ 0 < Re x \ 0 < Re v' \ Re x \ Re v'" "is_real v'" + using arg_pi_iff[of x] arg_pi_iff[of v'] + using arg_0_iff[of x] arg_0_iff[of v'] + using * ** + by (smt cmod_Re_le_iff to_complex_of_complex)+ + have "-1 < Re v'" "Re v' < 1" "Re v' \ 0" "is_real v'" + using \v \ unit_disc\ ** \is_real v'\ + by (auto simp add: cmod_eq_Re complex_eq_if_Re_eq) + thus "poincare_between 0\<^sub>h (of_complex x) v" + using poincare_between_x_axis_0uv[of "Re x" "Re v'"] * ** *** + by simp + qed + next + fix \ u + assume "u \ unit_disc" "u \ 0\<^sub>h" + let ?M = "moebius_rotation \" + assume *: "?P' (moebius_pt ?M u)" + show "?P' u" + proof (rule allI, rule impI, (erule conjE)+) + fix v + assume "v \ unit_disc" "v \ 0\<^sub>h" "v \ u" + have "moebius_pt ?M v \ moebius_pt ?M u" + using \v \ u\ + by auto + obtain u' v' where "v = of_complex v'" "u = of_complex u'" "v' \ 0" "u' \ 0" + using inf_or_of_complex[of u] inf_or_of_complex[of v] + using \v \ unit_disc\ \u \ unit_disc\ \v \ 0\<^sub>h\ \u \ 0\<^sub>h\ + by auto + thus "?P u v" + using *[rule_format, of "moebius_pt ?M v"] + using \moebius_pt ?M v \ moebius_pt ?M u\ + using unit_disc_fix_moebius_preserve_poincare_between[of ?M "0\<^sub>h" u v] + using \v \ unit_disc\ \u \ unit_disc\ \v \ 0\<^sub>h\ \u \ 0\<^sub>h\ + using arg_mult_eq[of "cis \" u' v'] + by simp (auto simp add: arg_mult) + qed + qed + thus ?thesis + using assms False + by auto +qed + +lemma poincare_between_y_axis_0uv: + fixes x y :: real + assumes "-1 < x" and "x < 1" and "x \ 0" + assumes "-1 < y" and "y < 1" and "y \ 0" + shows "poincare_between 0\<^sub>h (of_complex (\ * x)) (of_complex (\ * y)) \ + (x < 0 \ y < 0 \ y \ x) \ (x > 0 \ y > 0 \ x \ y)" (is "?lhs \ ?rhs") + using assms + using poincare_between_0uv[of "of_complex (\ * x)" "of_complex (\ * y)"] + using arg_pi2_iff[of "\ * cor x"] arg_pi2_iff[of "\ * cor y"] + using arg_minus_pi2_iff[of "\ * cor x"] arg_minus_pi2_iff[of "\ * cor y"] + apply simp + apply (cases "x > 0") + apply (cases "y > 0", simp, simp) + apply (cases "y > 0") + apply simp + using pi_gt_zero apply linarith + apply simp + done + +lemma poincare_between_x_axis_uvw: + fixes x y z :: real + assumes "-1 < x" and "x < 1" + assumes "-1 < y" and "y < 1" and "y \ x" + assumes "-1 < z" and "z < 1" and "z \ x" + shows "poincare_between (of_complex x) (of_complex y) (of_complex z) \ + (y < x \ z < x \ z \ y) \ (y > x \ z > x \ y \ z)" (is "?lhs \ ?rhs") +proof (cases "x = 0 \ y = 0 \ z = 0") + case True + thus ?thesis + proof (cases "x = 0") + case True + thus ?thesis + using poincare_between_x_axis_0uv assms + by simp + next + case False + show ?thesis + proof (cases "z = 0") + case True + thus ?thesis + using poincare_between_x_axis_0uv assms poincare_between_rev + by (smt norm_of_real of_complex_zero of_real_0 poincare_between_nonstrict(2) unit_disc_iff_cmod_lt_1) + next + case False + have "y = 0" + using `x \ 0` `z \ 0` `x = 0 \ y = 0 \ z = 0` + by simp + + have "poincare_between (of_complex x) 0\<^sub>h (of_complex z) = (is_real z \ x * z < 0)" + using `x \ 0` `z \ 0` poincare_between_x_axis_u0v + by auto + moreover + have "x * z < 0 \ ?rhs" + using True \x \ 0\ \z \ 0\ + by (smt zero_le_mult_iff) + ultimately + show ?thesis + using `y = 0` + by auto + qed + qed +next + case False + thus ?thesis + proof (cases "z = y") + case True + thus ?thesis + using assms + unfolding poincare_between_def + by auto + next + case False + let ?x = "of_complex x" and ?y = "of_complex y" and ?z = "of_complex z" + + have "?x \ unit_disc" "?y \ unit_disc" "?z \ unit_disc" + using assms + by auto + + have distinct: "distinct [?x, ?y, ?z, inversion ?y]" + using \y \ x\ \z \ x\ False \?x \ unit_disc\ \?y \ unit_disc\ \?z \ unit_disc\ + using inversion_noteq_unit_disc[of ?y ?y] + using inversion_noteq_unit_disc[of ?y ?x] + using inversion_noteq_unit_disc[of ?y ?z] + using of_complex_inj[of x y] of_complex_inj[of y z] of_complex_inj[of x z] + by auto + + have "cor y * cor x \ 1" + using assms + by (smt minus_mult_minus mult_less_cancel_left2 mult_less_cancel_right2 of_real_1 of_real_eq_iff of_real_mult) + + let ?cr = "cross_ratio ?x ?y ?z (inversion ?y)" + have "Re (to_complex ?cr) = (x - y) * (z*y - 1)/ ((x*y - 1)*(z - y))" + proof- + have " \y x z. \y \ x; z \ x; z \ y; cor y * cor x \ 1; x \ 0; y \ 0; z \ 0\ \ + (y * y + y * (y * (x * z)) - (y * x + y * (y * (y * z)))) / + (y * y + y * (y * (x * z)) - (y * z + y * (y * (y * x)))) = + (y + y * (x * z) - (x + y * (y * z))) / (y + y * (x * z) - (z + y * (y * x)))" + by (metis (no_types, hide_lams) ab_group_add_class.ab_diff_conv_add_uminus distrib_left mult_divide_mult_cancel_left_if mult_minus_right) + thus ?thesis + using \y \ x\ \z \ x\ False \\ (x = 0 \ y = 0 \ z = 0)\ + using \cor y * cor x \ 1\ + unfolding inversion_def + by (transfer, transfer, auto simp add: vec_cnj_def power2_eq_square field_simps split: if_split_asm) + qed + + moreover + have "(x*y - 1) < 0" + using assms + by (smt minus_mult_minus mult_less_cancel_right2 zero_less_mult_iff) + moreover + have "(z*y - 1) < 0" + using assms + by (smt minus_mult_minus mult_less_cancel_right2 zero_less_mult_iff) + moreover + have "(x - y) / (z - y) < 0 \ ?rhs" + using \y \ x\ \z \ x\ False \\ (x = 0 \ y = 0 \ z = 0)\ + by (smt divide_less_cancel divide_nonneg_nonpos divide_nonneg_pos divide_nonpos_nonneg divide_nonpos_nonpos) + ultimately + have *: "Re (to_complex ?cr) < 0 \ ?rhs" + by (smt linordered_field_class.sign_simps(45) minus_divide_left zero_less_divide_iff zero_less_mult_iff) + + show ?thesis + proof + assume ?lhs + have "is_real (to_complex ?cr)" "Re (to_complex ?cr) < 0" + using \?lhs\ distinct + unfolding poincare_between_def Let_def + by auto + thus ?rhs + using * + by simp + next + assume ?rhs + hence "Re (to_complex ?cr) < 0" + using * + by simp + moreover + have "{of_complex (cor x), of_complex (cor y), of_complex (cor z), inversion (of_complex (cor y))} \ circline_set x_axis" + using \\ (x = 0 \ y = 0 \ z = 0)\ is_real_inversion[of "cor y"] + using inf_or_of_complex[of "inversion ?y"] + by (auto simp del: inversion_of_complex) + hence "is_real (to_complex ?cr)" + using four_points_on_circline_iff_cross_ratio_real[OF distinct] + by auto + ultimately + show ?lhs + using distinct + unfolding poincare_between_def Let_def + by auto + qed + qed +qed + +subsubsection \H-betweenness and h-collinearity\ + +text\For three h-collinear points at least one of the three possible h-betweeness relations must +hold.\ +lemma poincare_collinear3_between: + assumes "u \ unit_disc" and "v \ unit_disc" and "w \ unit_disc" + assumes "poincare_collinear {u, v, w}" + shows "poincare_between u v w \ poincare_between u w v \ poincare_between v u w" (is "?P' u v w") +proof (cases "u=v") + case True + thus ?thesis + using assms + by auto +next + case False + have "\ w. w \ unit_disc \ poincare_collinear {u, v, w} \ ?P' u v w" (is "?P u v") + proof (rule wlog_positive_x_axis[where P="?P"]) + fix x + assume x: "is_real x" "0 < Re x" "Re x < 1" + hence "x \ 0" + using complex.expand[of x 0] + by auto + hence *: "poincare_line 0\<^sub>h (of_complex x) = x_axis" + using x poincare_line_0_real_is_x_axis[of "of_complex x"] + unfolding circline_set_x_axis + by auto + have "of_complex x \ unit_disc" + using x + by (auto simp add: cmod_eq_Re) + have "of_complex x \ 0\<^sub>h" + using \x \ 0\ + by auto + show "?P 0\<^sub>h (of_complex x)" + proof safe + fix w + assume "w \ unit_disc" + assume "poincare_collinear {0\<^sub>h, of_complex x, w}" + hence "w \ circline_set x_axis" + using * unique_poincare_line[of "0\<^sub>h" "of_complex x"] \of_complex x \ unit_disc\ \x \ 0\ \of_complex x \ 0\<^sub>h\ + unfolding poincare_collinear_def + by auto + then obtain w' where w': "w = of_complex w'" "is_real w'" + using \w \ unit_disc\ + using inf_or_of_complex[of w] + unfolding circline_set_x_axis + by auto + hence "-1 < Re w'" "Re w' < 1" + using \w \ unit_disc\ + by (auto simp add: cmod_eq_Re) + assume 1: "\ poincare_between (of_complex x) 0\<^sub>h w" + hence "w \ 0\<^sub>h" "w' \ 0" + using w' + unfolding poincare_between_def + by auto + hence "Re w' \ 0" + using w' complex.expand[of w' 0] + by auto + + have "Re w' \ 0" + using 1 poincare_between_x_axis_u0v[of x w'] \Re x > 0\ \is_real x\ \x \ 0\ \w' \ 0\ w' + using mult_pos_neg + by force + + moreover + + assume "\ poincare_between 0\<^sub>h (of_complex x) w" + hence "Re w' < Re x" + using poincare_between_x_axis_0uv[of "Re x" "Re w'"] + using w' x \-1 < Re w'\ \Re w' < 1\ \Re w' \ 0\ + by auto + + ultimately + show "poincare_between 0\<^sub>h w (of_complex x)" + using poincare_between_x_axis_0uv[of "Re w'" "Re x"] + using w' x \-1 < Re w'\ \Re w' < 1\ \Re w' \ 0\ + by auto + qed + next + show "u \ unit_disc" "v \ unit_disc" "u \ v" + by fact+ + next + fix M u v + assume 1: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "u \ v" + let ?Mu = "moebius_pt M u" and ?Mv = "moebius_pt M v" + assume 2: "?P ?Mu ?Mv" + show "?P u v" + proof safe + fix w + assume "w \ unit_disc" "poincare_collinear {u, v, w}" "\ poincare_between u v w" "\ poincare_between v u w" + thus "poincare_between u w v" + using 1 2[rule_format, of "moebius_pt M w"] + by simp + qed + qed + thus ?thesis + using assms + by simp +qed + +lemma poincare_collinear3_iff: + assumes "u \ unit_disc" "v \ unit_disc" "w \ unit_disc" + shows "poincare_collinear {u, v, w} \ poincare_between u v w \ poincare_between v u w \ poincare_between v w u" + using assms + by (metis poincare_collinear3_between insert_commute poincare_between_poincare_collinear poincare_between_rev) + +subsection \Some properties of betweenness\ + +lemma poincare_between_transitivity: + assumes "a \ unit_disc" and "x \ unit_disc" and "b \ unit_disc" and "y \ unit_disc" and + "poincare_between a x b" and "poincare_between a b y" + shows "poincare_between x b y" +proof(cases "a = b") + case True + thus ?thesis + using assms + using poincare_between_sandwich by blast +next + case False + have "\ x. \ y. poincare_between a x b \ poincare_between a b y \ x \ unit_disc + \ y \ unit_disc \ poincare_between x b y" (is "?P a b") + proof (rule wlog_positive_x_axis[where P="?P"]) + show "a \ unit_disc" + using assms by simp + next + show "b \ unit_disc" + using assms by simp + next + show "a \ b" + using False by simp + next + fix M u v + assume *: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "u \ v" + "\x y. poincare_between (moebius_pt M u) x (moebius_pt M v) \ + poincare_between (moebius_pt M u) (moebius_pt M v) y \ + x \ unit_disc \ y \ unit_disc \ + poincare_between x (moebius_pt M v) y" + show "\x y. poincare_between u x v \ poincare_between u v y \ x \ unit_disc \ y \ unit_disc + \ poincare_between x v y" + proof safe + fix x y + assume "poincare_between u x v" "poincare_between u v y" " x \ unit_disc" "y \ unit_disc" + + have "poincare_between (moebius_pt M u) (moebius_pt M x) (moebius_pt M v)" + using \poincare_between u x v\ \unit_disc_fix M\ \x \ unit_disc\ \u \ unit_disc\ \v \ unit_disc\ + by simp + moreover + have "poincare_between (moebius_pt M u) (moebius_pt M v) (moebius_pt M y)" + using \poincare_between u v y\ \unit_disc_fix M\ \y \ unit_disc\ \u \ unit_disc\ \v \ unit_disc\ + by simp + moreover + have "(moebius_pt M x) \ unit_disc" + using \unit_disc_fix M\ \x \ unit_disc\ by simp + moreover + have "(moebius_pt M y) \ unit_disc" + using \unit_disc_fix M\ \y \ unit_disc\ by simp + ultimately + have "poincare_between (moebius_pt M x) (moebius_pt M v) (moebius_pt M y)" + using * by blast + thus "poincare_between x v y" + using \y \ unit_disc\ * \x \ unit_disc\ by simp + qed + next + fix x + assume xx: "is_real x" "0 < Re x" "Re x < 1" + hence "of_complex x \ unit_disc" + using cmod_eq_Re by auto + hence "of_complex x \ \\<^sub>h" + by simp + have " of_complex x \ 0\<^sub>h" + using xx by auto + have "of_complex x \ circline_set x_axis" + using xx by simp + show "\m n. poincare_between 0\<^sub>h m (of_complex x) \ poincare_between 0\<^sub>h (of_complex x) n \ + m \ unit_disc \ n \ unit_disc \ poincare_between m (of_complex x) n" + proof safe + fix m n + assume **: "poincare_between 0\<^sub>h m (of_complex x)" "poincare_between 0\<^sub>h (of_complex x) n" + "m \ unit_disc" " n \ unit_disc" + show "poincare_between m (of_complex x) n" + proof(cases "m = 0\<^sub>h") + case True + thus ?thesis + using ** by auto + next + case False + hence "m \ circline_set x_axis" + using poincare_between_poincare_line_uzv[of "0\<^sub>h" "of_complex x" m] + using poincare_line_0_real_is_x_axis[of "of_complex x"] + using \of_complex x \ unit_disc\ \of_complex x \ \\<^sub>h\ \of_complex x \ 0\<^sub>h\ + using \of_complex x \ circline_set x_axis\ \m \ unit_disc\ **(1) + by simp + then obtain m' where "m = of_complex m'" "is_real m'" + using inf_or_of_complex[of m] \m \ unit_disc\ + unfolding circline_set_x_axis + by auto + hence "Re m' \ Re x" + using \poincare_between 0\<^sub>h m (of_complex x)\ xx \of_complex x \ 0\<^sub>h\ + using False ** \of_complex x \ unit_disc\ + using cmod_Re_le_iff poincare_between_0uv by auto + + have "n \ 0\<^sub>h" + using **(2, 4) \of_complex x \ 0\<^sub>h\ \of_complex x \ unit_disc\ + using poincare_between_sandwich by fastforce + have "n \ circline_set x_axis" + using poincare_between_poincare_line_uvz[of "0\<^sub>h" "of_complex x" n] + using poincare_line_0_real_is_x_axis[of "of_complex x"] + using \of_complex x \ unit_disc\ \of_complex x \ \\<^sub>h\ \of_complex x \ 0\<^sub>h\ + using \of_complex x \ circline_set x_axis\ \n \ unit_disc\ **(2) + by simp + then obtain n' where "n = of_complex n'" "is_real n'" + using inf_or_of_complex[of n] \n \ unit_disc\ + unfolding circline_set_x_axis + by auto + hence "Re x \ Re n'" + using \poincare_between 0\<^sub>h (of_complex x) n\ xx \of_complex x \ 0\<^sub>h\ + using False ** \of_complex x \ unit_disc\ \n \ 0\<^sub>h\ + using cmod_Re_le_iff poincare_between_0uv + by (metis Re_complex_of_real arg_0_iff rcis_cmod_arg rcis_zero_arg to_complex_of_complex) + + have "poincare_between (of_complex m') (of_complex x) (of_complex n')" + using \Re x \ Re n'\ \Re m' \ Re x\ + using poincare_between_x_axis_uvw[of "Re m'" "Re x" "Re n'"] + using \is_real n'\ \is_real m'\ \n \ unit_disc\ \n = of_complex n'\ + using xx \m = of_complex m'\ \m \ unit_disc\ + by (smt complex_of_real_Re norm_of_real poincare_between_def unit_disc_iff_cmod_lt_1) + + thus ?thesis + using \n = of_complex n'\ \m = of_complex m'\ + by auto + qed + qed + qed + thus ?thesis + using assms + by blast +qed + +(* ------------------------------------------------------------------ *) +subsection\Poincare between - sum distances\ +(* ------------------------------------------------------------------ *) + +text\Another possible definition of the h-betweenness relation is given in terms of h-distances +between pairs of points. We prove it as a characterization equivalent to our cross-ratio based +definition.\ + +lemma poincare_between_sum_distances_x_axis_u0v: + assumes "of_complex u' \ unit_disc" "of_complex v' \ unit_disc" + assumes "is_real u'" "u' \ 0" "v' \ 0" + shows "poincare_distance (of_complex u') 0\<^sub>h + poincare_distance 0\<^sub>h (of_complex v') = poincare_distance (of_complex u') (of_complex v') \ + is_real v' \ Re u' * Re v' < 0" (is "?P u' v' \ ?Q u' v'") +proof- + have "Re u' \ 0" + using \is_real u'\ \u' \ 0\ + using complex_eq_if_Re_eq + by simp + + let ?u = "cmod u'" and ?v = "cmod v'" and ?uv = "cmod (u' - v')" + have disc: "?u\<^sup>2 < 1" "?v\<^sup>2 < 1" + using unit_disc_cmod_square_lt_1[OF assms(1)] + using unit_disc_cmod_square_lt_1[OF assms(2)] + by auto + have "poincare_distance (of_complex u') 0\<^sub>h + poincare_distance 0\<^sub>h (of_complex v') = + arcosh (((1 + ?u\<^sup>2) * (1 + ?v\<^sup>2) + 4 * ?u * ?v) / ((1 - ?u\<^sup>2) * (1 - ?v\<^sup>2)))" (is "_ = arcosh ?r1") + using poincare_distance_formula_zero_sum[OF assms(1-2)] + by (simp add: Let_def) + moreover + have "poincare_distance (of_complex u') (of_complex v') = + arcosh (((1 - ?u\<^sup>2) * (1 - ?v\<^sup>2) + 2 * ?uv\<^sup>2) / ((1 - ?u\<^sup>2) * (1 - ?v\<^sup>2)))" (is "_ = arcosh ?r2") + using disc + using poincare_distance_formula[OF assms(1-2)] + by (subst add_divide_distrib) simp + moreover + have "arcosh ?r1 = arcosh ?r2 \ ?Q u' v'" + proof + assume "arcosh ?r1 = arcosh ?r2" + hence "?r1 = ?r2" + proof (subst (asm) arcosh_eq_iff) + show "?r1 \ 1" + proof- + have "(1 - ?u\<^sup>2) * (1 - ?v\<^sup>2) \ (1 + ?u\<^sup>2) * (1 + ?v\<^sup>2) + 4 * ?u * ?v" + by (simp add: field_simps) + thus ?thesis + using disc + by simp + qed + next + show "?r2 \ 1" + using disc + by simp + qed + hence "(1 + ?u\<^sup>2) * (1 + ?v\<^sup>2) + 4 * ?u * ?v = (1 - ?u\<^sup>2) * (1 - ?v\<^sup>2) + 2 * ?uv\<^sup>2" + using disc + by auto + hence "(cmod (u' - v'))\<^sup>2 = (cmod u' + cmod v')\<^sup>2" + by (simp add: field_simps power2_eq_square) + hence *: "Re u' * Re v' + \Re u'\ * sqrt ((Im v')\<^sup>2 + (Re v')\<^sup>2) = 0" + using \is_real u'\ + unfolding cmod_power2 cmod_def + by (simp add: field_simps) (simp add: power2_eq_square field_simps) + hence "sqrt ((Im v')\<^sup>2 + (Re v')\<^sup>2) = \Re v'\" + using \Re u' \ 0\ \v' \ 0\ + by (smt complex_neq_0 mult.commute mult_cancel_right mult_minus_left real_sqrt_gt_0_iff) + hence "Im v' = 0" + by (smt Im_eq_0 norm_complex_def) + moreover + hence "Re u' * Re v' = - \Re u'\ * \Re v'\" + using * + by simp + hence "Re u' * Re v' < 0" + using \Re u' \ 0\ \v' \ 0\ + by (simp add: \is_real v'\ complex_eq_if_Re_eq) + ultimately + show "?Q u' v'" + by simp + next + assume "?Q u' v'" + hence "is_real v'" "Re u' * Re v' < 0" + by auto + have "?r1 = ?r2" + proof (cases "Re u' > 0") + case True + hence "Re v' < 0" + using \Re u' * Re v' < 0\ + by (smt zero_le_mult_iff) + show ?thesis + using disc \is_real u'\ \is_real v'\ + using \Re u' > 0\ \Re v' < 0\ + unfolding cmod_power2 cmod_def + by simp (simp add: power2_eq_square field_simps) + next + case False + hence "Re u' < 0" + using \Re u' \ 0\ + by simp + hence "Re v' > 0" + using \Re u' * Re v' < 0\ + by (smt zero_le_mult_iff) + show ?thesis + using disc \is_real u'\ \is_real v'\ + using \Re u' < 0\ \Re v' > 0\ + unfolding cmod_power2 cmod_def + by simp (simp add: power2_eq_square field_simps) + qed + thus "arcosh ?r1 = arcosh ?r2" + by metis + qed + ultimately + show ?thesis + by simp +qed + +text\ + Different proof of the previous theorem relying on the cross-ratio definition, and not the distance formula. + We suppose that this could be also used to prove the triangle inequality. +\ +lemma poincare_between_sum_distances_x_axis_u0v_different_proof: + assumes "of_complex u' \ unit_disc" "of_complex v' \ unit_disc" + assumes "is_real u'" "u' \ 0" "v' \ 0" (* additional condition *) "is_real v'" + shows "poincare_distance (of_complex u') 0\<^sub>h + poincare_distance 0\<^sub>h (of_complex v') = poincare_distance (of_complex u') (of_complex v') \ + Re u' * Re v' < 0" (is "?P u' v' \ ?Q u' v'") +proof- + have "-1 < Re u'" "Re u' < 1" "Re u' \ 0" + using assms + by (auto simp add: cmod_eq_Re complex_eq_if_Re_eq) + have "-1 < Re v'" "Re v' < 1" "Re v' \ 0" + using assms + by (auto simp add: cmod_eq_Re complex_eq_if_Re_eq) + + have "\ln (Re ((1 - u') / (1 + u')))\ + \ln (Re ((1 - v') / (1 + v')))\ = + \ln (Re ((1 + u') * (1 - v') / ((1 - u') * (1 + v'))))\ \ Re u' * Re v' < 0" (is "\ln ?a1\ + \ln ?a2\ = \ln ?a3\ \ _") + proof- + have 1: "0 < ?a1" "ln ?a1 > 0 \ Re u' < 0" + using \Re u' < 1\ \Re u' > -1\ \is_real u'\ + using complex_is_Real_iff + by auto + have 2: "0 < ?a2" "ln ?a2 > 0 \ Re v' < 0" + using \Re v' < 1\ \Re v' > -1\ \is_real v'\ + using complex_is_Real_iff + by auto + have 3: "0 < ?a3" "ln ?a3 > 0 \ Re v' < Re u'" + using \Re u' < 1\ \Re u' > -1\ \is_real u'\ + using \Re v' < 1\ \Re v' > -1\ \is_real v'\ + using complex_is_Real_iff + by auto (simp add: field_simps)+ + show ?thesis + proof + assume *: "Re u' * Re v' < 0" + show "\ln ?a1\ + \ln ?a2\ = \ln ?a3\" + proof (cases "Re u' > 0") + case True + hence "Re v' < 0" + using * + by (smt mult_nonneg_nonneg) + show ?thesis + using 1 2 3 \Re u' > 0\ \Re v' < 0\ + using \Re u' < 1\ \Re u' > -1\ \is_real u'\ + using \Re v' < 1\ \Re v' > -1\ \is_real v'\ + using complex_is_Real_iff + using ln_div ln_mult + by simp + next + case False + hence "Re v' > 0" "Re u' < 0" + using * + by (smt zero_le_mult_iff)+ + show ?thesis + using 1 2 3 \Re u' < 0\ \Re v' > 0\ + using \Re u' < 1\ \Re u' > -1\ \is_real u'\ + using \Re v' < 1\ \Re v' > -1\ \is_real v'\ + using complex_is_Real_iff + using ln_div ln_mult + by simp + qed + next + assume *: "\ln ?a1\ + \ln ?a2\ = \ln ?a3\" + { + assume "Re u' > 0" "Re v' > 0" + hence False + using * 1 2 3 + using \Re u' < 1\ \Re u' > -1\ \is_real u'\ + using \Re v' < 1\ \Re v' > -1\ \is_real v'\ + using complex_is_Real_iff + using ln_mult ln_div + by (cases "Re v' < Re u'") auto + } + moreover + { + assume "Re u' < 0" "Re v' < 0" + hence False + using * 1 2 3 + using \Re u' < 1\ \Re u' > -1\ \is_real u'\ + using \Re v' < 1\ \Re v' > -1\ \is_real v'\ + using complex_is_Real_iff + using ln_mult ln_div + by (cases "Re v' < Re u'") auto + } + ultimately + show "Re u' * Re v' < 0" + using \Re u' \ 0\ \Re v' \ 0\ + by (smt divisors_zero mult_le_0_iff) + qed + qed + thus ?thesis + using assms + apply (subst poincare_distance_sym, simp, simp) + apply (subst poincare_distance_zero_x_axis, simp, simp add: circline_set_x_axis) + apply (subst poincare_distance_zero_x_axis, simp, simp add: circline_set_x_axis) + apply (subst poincare_distance_x_axis_x_axis, simp, simp, simp add: circline_set_x_axis, simp add: circline_set_x_axis) + apply simp + done +qed + +lemma poincare_between_sum_distances: + assumes "u \ unit_disc" and "v \ unit_disc" and "w \ unit_disc" + shows "poincare_between u v w \ + poincare_distance u v + poincare_distance v w = poincare_distance u w" (is "?P' u v w") +proof (cases "u = v") + case True + thus ?thesis + using assms + by simp +next + case False + have "\ w. w \ unit_disc \ (poincare_between u v w \ poincare_distance u v + poincare_distance v w = poincare_distance u w)" (is "?P u v") + proof (rule wlog_positive_x_axis) + fix x + assume "is_real x" "0 < Re x" "Re x < 1" + have "of_complex x \ circline_set x_axis" + using \is_real x\ + by (auto simp add: circline_set_x_axis) + + have "of_complex x \ unit_disc" + using \is_real x\ \0 < Re x\ \Re x < 1\ + by (simp add: cmod_eq_Re) + + have "x \ 0" + using \is_real x\ \Re x > 0\ + by auto + + show "?P (of_complex x) 0\<^sub>h" + proof (rule allI, rule impI) + fix w + assume "w \ unit_disc" + then obtain w' where "w = of_complex w'" + using inf_or_of_complex[of w] + by auto + + show "?P' (of_complex x) 0\<^sub>h w" + proof (cases "w = 0\<^sub>h") + case True + thus ?thesis + by simp + next + case False + hence "w' \ 0" + using \w = of_complex w'\ + by auto + + show ?thesis + using \is_real x\ \x \ 0\ \w = of_complex w'\ \w' \ 0\ + using \of_complex x \ unit_disc\ \w \ unit_disc\ + apply simp + apply (subst poincare_between_x_axis_u0v, simp_all) + apply (subst poincare_between_sum_distances_x_axis_u0v, simp_all) + done + qed + qed + next + show "v \ unit_disc" "u \ unit_disc" + using assms + by auto + next + show "v \ u" + using \u \ v\ + by simp + next + fix M u v + assume *: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "u \ v" and + **: "?P (moebius_pt M v) (moebius_pt M u)" + show "?P v u" + proof (rule allI, rule impI) + fix w + assume "w \ unit_disc" + hence "moebius_pt M w \ unit_disc" + using \unit_disc_fix M\ + by auto + thus "?P' v u w" + using \u \ unit_disc\ \v \ unit_disc\ \w \ unit_disc\ \unit_disc_fix M\ + using **[rule_format, of "moebius_pt M w"] + by auto + qed + qed + thus ?thesis + using assms + by simp +qed + +subsection \Some more properties of h-betweenness.\ + +text \Some lemmas proved earlier are proved almost directly using the sum of distances characterization.\ + +lemma unit_disc_fix_moebius_preserve_poincare_between': + assumes "unit_disc_fix M" and "u \ unit_disc" and "v \ unit_disc" and "w \ unit_disc" + shows "poincare_between (moebius_pt M u) (moebius_pt M v) (moebius_pt M w) \ + poincare_between u v w" + using assms + using poincare_between_sum_distances + by simp + +lemma conjugate_preserve_poincare_between': + assumes "u \ unit_disc" "v \ unit_disc" "w \ unit_disc" + shows "poincare_between (conjugate u) (conjugate v) (conjugate w) \ poincare_between u v w" + using assms + using poincare_between_sum_distances + by simp + +text \There is a unique point on a ray on the given distance from the given starting point\ +lemma unique_poincare_distance_on_ray: + assumes "d \ 0" "u \ v" "u \ unit_disc" "v \ unit_disc" + assumes "y \ unit_disc" "poincare_distance u y = d" "poincare_between u v y" + assumes "z \ unit_disc" "poincare_distance u z = d" "poincare_between u v z" + shows "y = z" +proof- + have "\ d y z. d \ 0 \ + y \ unit_disc \ poincare_distance u y = d \ poincare_between u v y \ + z \ unit_disc \ poincare_distance u z = d \ poincare_between u v z \ y = z" (is "?P u v") + proof (rule wlog_positive_x_axis[where P="?P"]) + fix x + assume x: "is_real x" "0 < Re x" "Re x < 1" + hence "x \ 0" + using complex.expand[of x 0] + by auto + hence *: "poincare_line 0\<^sub>h (of_complex x) = x_axis" + using x poincare_line_0_real_is_x_axis[of "of_complex x"] + unfolding circline_set_x_axis + by auto + have "of_complex x \ unit_disc" + using x + by (auto simp add: cmod_eq_Re) + have "arg x = 0" + using x + using arg_0_iff by blast + show "?P 0\<^sub>h (of_complex x)" + proof safe + fix y z + assume "y \ unit_disc" "z \ unit_disc" + then obtain y' z' where yz: "y = of_complex y'" "z = of_complex z'" + using inf_or_of_complex[of y] inf_or_of_complex[of z] + by auto + assume betw: "poincare_between 0\<^sub>h (of_complex x) y" "poincare_between 0\<^sub>h (of_complex x) z" + hence "y \ 0\<^sub>h" "z \ 0\<^sub>h" + using \x \ 0\ \of_complex x \ unit_disc\ \y \ unit_disc\ + using poincare_between_sandwich[of "0\<^sub>h" "of_complex x"] + using of_complex_zero_iff[of x] + by force+ + + hence "arg y' = 0" "cmod y' \ cmod x" "arg z' = 0" "cmod z' \ cmod x" + using poincare_between_0uv[of "of_complex x" y] poincare_between_0uv[of "of_complex x" z] + using \of_complex x \ unit_disc\ \x \ 0\ \arg x = 0\ \y \ unit_disc\ \z \ unit_disc\ betw yz + by (simp_all add: Let_def) + hence *: "is_real y'" "is_real z'" "Re y' > 0" "Re z' > 0" + using arg_0_iff[of y'] arg_0_iff[of z'] x \y \ 0\<^sub>h\ \z \ 0\<^sub>h\ yz + by auto + assume "poincare_distance 0\<^sub>h z = poincare_distance 0\<^sub>h y" "0 \ poincare_distance 0\<^sub>h y" + thus "y = z" + using * yz \y \ unit_disc\ \z \ unit_disc\ + using unique_x_axis_poincare_distance_positive[of "poincare_distance 0\<^sub>h y"] + by (auto simp add: cmod_eq_Re unit_disc_to_complex_inj) + qed + next + show "u \ unit_disc" "v \ unit_disc" "u \ v" + by fact+ + next + fix M u v + assume *: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "u \ v" + assume **: "?P (moebius_pt M u) (moebius_pt M v)" + show "?P u v" + proof safe + fix d y z + assume ***: "0 \ poincare_distance u y" + "y \ unit_disc" "poincare_between u v y" + "z \ unit_disc" "poincare_between u v z" + "poincare_distance u z = poincare_distance u y" + let ?Mu = "moebius_pt M u" and ?Mv = "moebius_pt M v" and ?My = "moebius_pt M y" and ?Mz = "moebius_pt M z" + have "?Mu \ unit_disc" "?Mv \ unit_disc" "?My \ unit_disc" "?Mz \ unit_disc" + using \u \ unit_disc\ \v \ unit_disc\ \y \ unit_disc\ \z \ unit_disc\ + using \unit_disc_fix M\ + by auto + hence "?My = ?Mz" + using * *** + using **[rule_format, of "poincare_distance ?Mu ?My" ?My ?Mz] + by simp + thus "y = z" + using bij_moebius_pt[of M] + unfolding bij_def inj_on_def + by blast + qed + qed + thus ?thesis + using assms + by auto +qed + +end \ No newline at end of file diff --git a/thys/Poincare_Disc/Poincare_Circles.thy b/thys/Poincare_Disc/Poincare_Circles.thy new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/Poincare_Circles.thy @@ -0,0 +1,618 @@ +theory Poincare_Circles + imports Poincare_Distance +begin +(* -------------------------------------------------------------------------- *) +section\H-circles in the Poincar\'e model\ +(* -------------------------------------------------------------------------- *) + +text\Circles consist of points that are at the same distance from the center.\ +definition poincare_circle :: "complex_homo \ real \ complex_homo set" where + "poincare_circle z r = {z'. z' \ unit_disc \ poincare_distance z z' = r}" + +text\Each h-circle in the Poincar\'e model is represented by an Euclidean circle in the model --- +the center and radius of that euclidean circle are determined by the following formulas.\ +definition poincare_circle_euclidean :: "complex_homo \ real \ euclidean_circle" where + "poincare_circle_euclidean z r = + (let R = (cosh r - 1) / 2; + z' = to_complex z; + cz = 1 - (cmod z')\<^sup>2; + k = cz * R + 1 + in (z' / k, cz * sqrt(R * (R + 1)) / k))" + +text\That Euclidean circle has a positive radius and is always fully within the disc.\ +lemma poincare_circle_in_disc: + assumes "r > 0" and "z \ unit_disc" and "(ze, re) = poincare_circle_euclidean z r" + shows "cmod ze < 1" "re > 0" "\ x \ circle ze re. cmod x < 1" +proof- + let ?R = "(cosh r - 1) / 2" + let ?z' = "to_complex z" + let ?cz = "1 - (cmod ?z')\<^sup>2" + let ?k = "?cz * ?R + 1" + let ?ze = "?z' / ?k" + let ?re = "?cz * sqrt(?R * (?R + 1)) / ?k" + + from \z \ unit_disc\ + obtain z' where z': "z = of_complex z'" + using inf_or_of_complex[of z] + by auto + + hence "z' = ?z'" + by simp + + obtain cz where cz: "cz = (1 - (cmod z')\<^sup>2)" + by auto + + have "cz > 0" "cz \ 1" + using \z \ unit_disc\ z' cz + using unit_disc_cmod_square_lt_1 + by fastforce+ + + obtain R where R: "R = ?R" + by blast + + have "R > 0" + using cosh_gt_1[of r] \r > 0\ + by (subst R) simp + + obtain k where k: "k = cz * R + 1" + by auto + + have "k > 1" + using k \R > 0\ \cz > 0\ + by simp + + hence "cmod k = k" + by simp + + let ?RR = "cz * sqrt(R * (R + 1)) / k" + + have "cmod z' + cz * sqrt(R * (R + 1)) < k" + proof- + have "((R+1)-R)\<^sup>2 > 0" + by simp + hence "(R+1)\<^sup>2 - 2*R*(R+1) + R\<^sup>2 > 0" + unfolding power2_diff + by (simp add: field_simps) + hence "(R+1)\<^sup>2 + 2*R*(R+1) + R\<^sup>2 - 4*R*(R+1) > 0" + by simp + hence "(2*R+1)\<^sup>2 / 4 > R*(R+1)" + using power2_sum[of "R+1" R] + by (simp add: field_simps) + hence "sqrt(R*(R+1)) < (2*R+1) / 2" + using \R > 0\ + by (smt arith_geo_mean_sqrt linordered_field_class.sign_simps(45) power_divide real_sqrt_four real_sqrt_pow2) + hence "sqrt(R*(R+1)) - R < 1/2" + by (simp add: field_simps) + hence "(1 + (cmod z')) * (sqrt(R*(R+1)) - R) < (1 + (cmod z')) * (1 / 2)" + by (subst mult_strict_left_mono, simp, smt norm_not_less_zero, simp) + also have "... < 1" + using \z \ unit_disc\ z' + by auto + finally have "(1 - cmod z') * ((1 + cmod z') * (sqrt(R*(R+1)) - R)) < (1 - cmod z') * 1" + using \z \ unit_disc\ z' + by (subst mult_strict_left_mono, simp_all) + hence "cz * (sqrt (R*(R+1)) - R) < 1 - cmod z'" + using square_diff_square_factored[of 1 "cmod z'"] + by (subst cz, subst (asm) mult.assoc[symmetric], simp add: power2_eq_square field_simps) + hence "cmod z' + cz * sqrt(R*(R+1)) < 1 + R * cz" + by (simp add: field_simps) + thus ?thesis + using k + by (simp add: field_simps) + qed + hence "cmod z' / k + cz * sqrt(R * (R + 1)) / k < 1" + using \k > 1\ + unfolding add_divide_distrib[symmetric] + by simp + hence "cmod (z' / k) + cz * sqrt(R * (R + 1)) / k < 1" + using \k > 1\ + by simp + hence "cmod ?ze + ?re < 1" + using k cz \R = ?R\ z' + by simp + + moreover + + have "cz * sqrt(R * (R + 1)) / k > 0" + using \cz > 0\ \R > 0\ \k > 1\ + by auto + hence "?re > 0" + using k cz \R = ?R\ z' + by simp + + moreover + + have "cmod ?ze < 1" + using \cmod ?ze + ?re < 1\ \?re > 0\ + by simp + + moreover + + have "ze = ?ze" "re = ?re" + using \(ze, re) = poincare_circle_euclidean z r\ + unfolding poincare_circle_euclidean_def Let_def + by simp_all + + moreover + + have "\ x \ circle ze re. cmod x \ cmod ze + re" + using norm_triangle_ineq2[of _ ze] + unfolding circle_def + by (smt mem_Collect_eq) + + ultimately + + show "cmod ze < 1" "re > 0" "\ x \ circle ze re. cmod x < 1" + by auto +qed + +text\The connection between the points on the h-circle and its corresponding Euclidean circle.\ +lemma poincare_circle_is_euclidean_circle: + assumes "z \ unit_disc" and "r > 0" + shows "let (Ze, Re) = poincare_circle_euclidean z r + in of_complex ` (circle Ze Re) = poincare_circle z r" +proof- + { + fix x + let ?z = "to_complex z" + + from assms obtain z' where z': "z = of_complex z'" "cmod z' < 1" + using inf_or_of_complex[of z] + by auto + + have *: "\ x. cmod x < 1 \ 1 - (cmod x)\<^sup>2 > 0" + by (metis less_iff_diff_less_0 minus_diff_eq mult.left_neutral neg_less_0_iff_less norm_mult_less norm_power power2_eq_square) + + let ?R = "(cosh r - 1) / 2" + obtain R where R: "R = ?R" + by blast + + let ?cx = "1 - (cmod x)\<^sup>2" and ?cz = "1 - (cmod z')\<^sup>2" and ?czx = "(cmod (z' - x))\<^sup>2" + + let ?k = "1 + R * ?cz" + obtain k where k: "k = ?k" + by blast + have "R > 0" + using R cosh_gt_1[OF \r > 0\] + by simp + + hence "k > 1" + using assms z' k *[of z'] + by auto + hence **: "cor k \ 0" + by (smt of_real_eq_0_iff) + + + have "of_complex x \ poincare_circle z r \ cmod x < 1 \ poincare_distance z (of_complex x) = r" + unfolding poincare_circle_def + by auto + also have "... \ cmod x < 1 \ poincare_distance_formula' ?z x = cosh r" + using poincare_distance_formula[of z "of_complex x"] cosh_dist[of z "of_complex x"] + unfolding poincare_distance_formula_def + using assms + using arcosh_cosh_real + by auto + also have "... \ cmod x < 1 \ ?czx / (?cz * ?cx) = ?R" + using z' + by (simp add: field_simps) + also have "... \ cmod x < 1 \ ?czx = ?R * ?cx * ?cz" + using assms z' *[of z'] *[of x] + using nonzero_divide_eq_eq[of "(1 - (cmod x)\<^sup>2) * (1 - (cmod z')\<^sup>2)" "(cmod (z' - x))\<^sup>2" ?R] + by (auto, simp add: field_simps) + also have "... \ cmod x < 1 \ (z' - x) * (cnj z' - cnj x) = R * ?cz * (1 - x * cnj x)" (is "_ \ _ \ ?l = ?r") + proof- + let ?l = "(z' - x) * (cnj z' - cnj x)" and ?r = "R * (1 - Re (z' * cnj z')) * (1 - x * cnj x)" + have "is_real ?l" + using eq_cnj_iff_real[of "?l"] + by simp + moreover + have "is_real ?r" + using eq_cnj_iff_real[of "1 - x * cnj x"] + using Im_complex_of_real[of "R * (1 - Re (z' * cnj z'))"] + by simp + ultimately + show ?thesis + apply (subst R[symmetric]) + apply (subst cmod_square)+ + apply (subst complex_eq_if_Re_eq, simp_all add: field_simps) + done + qed + also have "... \ cmod x < 1 \ z' * cnj z' - x * cnj z' - cnj x * z' + x * cnj x = R * ?cz - R * ?cz * x * cnj x" + unfolding right_diff_distrib left_diff_distrib + by (simp add: field_simps) + also have "... \ cmod x < 1 \ k * (x * cnj x) - x * cnj z' - cnj x * z' + z' * cnj z' = R * ?cz" (is "_ \ _ \ ?lhs = ?rhs") + by (subst k) (auto simp add: field_simps) + also have "... \ cmod x < 1 \ (k * x * cnj x - x * cnj z' - cnj x * z' + z' * cnj z') / k = (R * ?cz) / k" + using ** + by (auto simp add: Groups.mult_ac(1)) + also have "... \ cmod x < 1 \ x * cnj x - x * cnj z' / k - cnj x * z' / k + z' * cnj z' / k = (R * ?cz) / k" + using ** + unfolding add_divide_distrib diff_divide_distrib + by auto + also have "... \ cmod x < 1 \ (x - z'/k) * cnj(x - z'/k) = (R * ?cz) / k + (z' / k) * cnj(z' / k) - z' * cnj z' / k" + by (auto simp add: field_simps diff_divide_distrib) + also have "... \ cmod x < 1 \ (cmod (x - z'/k))\<^sup>2 = (R * ?cz) / k + (cmod z')\<^sup>2 / k\<^sup>2 - (cmod z')\<^sup>2 / k" + apply (subst complex_mult_cnj_cmod)+ + apply (subst complex_eq_if_Re_eq) + apply (simp_all add: power_divide) + done + also have "... \ cmod x < 1 \ (cmod (x - z'/k))\<^sup>2 = (R * ?cz * k + (cmod z')\<^sup>2 - (cmod z')\<^sup>2 * k) / k\<^sup>2" + using ** + unfolding add_divide_distrib diff_divide_distrib + by (simp add: power2_eq_square) + also have "... \ cmod x < 1 \ (cmod (x - z'/k))\<^sup>2 = ?cz\<^sup>2 * R * (R + 1) / k\<^sup>2" (is "_ \ _ \ ?a\<^sup>2 = ?b") + proof- + have *: "R * (1 - (cmod z')\<^sup>2) * k + (cmod z')\<^sup>2 - (cmod z')\<^sup>2 * k = (1 - (cmod z')\<^sup>2)\<^sup>2 * R * (R + 1)" + by (subst k)+ (simp add: field_simps power2_diff) + thus ?thesis + by (subst *, simp) + qed + also have "... \ cmod x < 1 \ cmod (x - z'/k) = ?cz * sqrt (R * (R + 1)) / k" + using \R > 0\ *[of z'] ** \k > 1\ \z \ unit_disc\ z' + using real_sqrt_unique[of ?a ?b, symmetric] + by (auto simp add: real_sqrt_divide real_sqrt_mult power_divide power_mult_distrib) + finally + have "of_complex x \ poincare_circle z r \ cmod x < 1 \ x \ circle (z'/k) (?cz * sqrt(R * (R+1)) / k)" + unfolding circle_def z' k R + by simp + hence "of_complex x \ poincare_circle z r \ (let (Ze, Re) = poincare_circle_euclidean z r in cmod x < 1 \ x \ circle Ze Re)" + unfolding poincare_circle_euclidean_def Let_def circle_def + using z' R k + by (simp add: field_simps) + hence "of_complex x \ poincare_circle z r \ (let (Ze, Re) = poincare_circle_euclidean z r in x \ circle Ze Re)" + using poincare_circle_in_disc[OF \r > 0\ \z \ unit_disc\] + by auto + } note * = this + show ?thesis + unfolding Let_def + proof safe + fix Ze Re x + assume "poincare_circle_euclidean z r = (Ze, Re)" "x \ circle Ze Re" + thus "of_complex x \ poincare_circle z r" + using *[of x] + by simp + next + fix Ze Re x + assume **: "poincare_circle_euclidean z r = (Ze, Re)" "x \ poincare_circle z r" + then obtain x' where x': "x = of_complex x'" + unfolding poincare_circle_def + using inf_or_of_complex[of x] + by auto + hence "x' \ circle Ze Re" + using *[of x'] ** + by simp + thus "x \ of_complex ` circle Ze Re" + using x' + by auto + qed +qed + +subsection \Intersection of circles in special positions\ + +text \Two h-circles centered at the x-axis intersect at mutually conjugate points\ +lemma intersect_poincare_circles_x_axis: + assumes z: "is_real z1" and "is_real z2" and "r1 > 0" and "r2 > 0" and + "-1 < Re z1" and "Re z1 < 1" and "-1 < Re z2" and "Re z2 < 1" and + "z1 \ z2" + assumes x1: "x1 \ poincare_circle (of_complex z1) r1 \ poincare_circle (of_complex z2) r2" and + x2: "x2 \ poincare_circle (of_complex z1) r1 \ poincare_circle (of_complex z2) r2" and + "x1 \ x2" + shows "x1 = conjugate x2" +proof- + have in_disc: "of_complex z1 \ unit_disc" "of_complex z2 \ unit_disc" + using assms + by (auto simp add: cmod_eq_Re) + + obtain x1' x2' where x': "x1 = of_complex x1'" "x2 = of_complex x2'" + using x1 x2 + using inf_or_of_complex[of x1] inf_or_of_complex[of x2] + unfolding poincare_circle_def + by auto + + obtain Ze1 Re1 where 1: "(Ze1, Re1) = poincare_circle_euclidean (of_complex z1) r1" + by (metis poincare_circle_euclidean_def) + obtain Ze2 Re2 where 2: "(Ze2, Re2) = poincare_circle_euclidean (of_complex z2) r2" + by (metis poincare_circle_euclidean_def) + have circle: "x1' \ circle Ze1 Re1 \ circle Ze2 Re2" "x2' \ circle Ze1 Re1 \ circle Ze2 Re2" + using poincare_circle_is_euclidean_circle[of "of_complex z1" r1] + using poincare_circle_is_euclidean_circle[of "of_complex z2" r2] + using assms 1 2 \of_complex z1 \ unit_disc\ \of_complex z2 \ unit_disc\ x' + by auto (metis image_iff of_complex_inj)+ + + have "is_real Ze1" "is_real Ze2" + using 1 2 \is_real z1\ \is_real z2\ + by (simp_all add: poincare_circle_euclidean_def Let_def) + + have "Re1 > 0" "Re2 > 0" + using 1 2 in_disc \r1 > 0\ \r2 > 0\ + using poincare_circle_in_disc(2)[of r1 "of_complex z1" Ze1 Re1] + using poincare_circle_in_disc(2)[of r2 "of_complex z2" Ze2 Re2] + by auto + + have "Ze1 \ Ze2" + proof (rule ccontr) + assume "\ ?thesis" + hence eq: "Ze1 = Ze2" "Re1 = Re2" + using circle(1) + unfolding circle_def + by auto + + let ?A = "Ze1 - Re1" and ?B = "Ze1 + Re1" + have "?A \ circle Ze1 Re1" "?B \ circle Ze1 Re1" + using \Re1 > 0\ + unfolding circle_def + by simp_all + hence "of_complex ?A \ poincare_circle (of_complex z1) r1" "of_complex ?B \ poincare_circle (of_complex z1) r1" + "of_complex ?A \ poincare_circle (of_complex z2) r2" "of_complex ?B \ poincare_circle (of_complex z2) r2" + using eq + using poincare_circle_is_euclidean_circle[OF \of_complex z1 \ unit_disc\ \r1 > 0\] + using poincare_circle_is_euclidean_circle[OF \of_complex z2 \ unit_disc\ \r2 > 0\] + using 1 2 + by auto blast+ + hence "poincare_distance (of_complex z1) (of_complex ?A) = poincare_distance (of_complex z1) (of_complex ?B)" + "poincare_distance (of_complex z2) (of_complex ?A) = poincare_distance (of_complex z2) (of_complex ?B)" + "-1 < Re (Ze1 - Re1)" "Re (Ze1 - Re1) < 1" "-1 < Re (Ze1 + Re1)" "Re (Ze1 + Re1) < 1" + using \is_real Ze1\ \is_real Ze2\ + unfolding poincare_circle_def + by (auto simp add: cmod_eq_Re) + hence "z1 = z2" + using unique_midpoint_x_axis[of "Ze1 - Re1" "Ze1 + Re1"] + using \is_real Ze1\ \is_real z1\ \is_real z2\ \Re1 > 0\ \-1 < Re z1\ \Re z1 < 1\ \-1 < Re z2\ \Re z2 < 1\ + by auto + thus False + using \z1 \ z2\ + by simp + qed + + hence *: "(Re x1')\<^sup>2 + (Im x1')\<^sup>2 - 2 * Re x1' * Ze1 + Ze1 * Ze1 - cor (Re1 * Re1) = 0" + "(Re x1')\<^sup>2 + (Im x1')\<^sup>2 - 2 * Re x1' * Ze2 + Ze2 * Ze2 - cor (Re2 * Re2) = 0" + "(Re x2')\<^sup>2 + (Im x2')\<^sup>2 - 2 * Re x2' * Ze1 + Ze1 * Ze1 - cor (Re1 * Re1) = 0" + "(Re x2')\<^sup>2 + (Im x2')\<^sup>2 - 2 * Re x2' * Ze2 + Ze2 * Ze2 - cor (Re2 * Re2) = 0" + using circle_equation[of Re1 Ze1] circle_equation[of Re2 Ze2] circle + using eq_cnj_iff_real[of Ze1] \is_real Ze1\ \Re1 > 0\ + using eq_cnj_iff_real[of Ze2] \is_real Ze2\ \Re2 > 0\ + using complex_add_cnj[of x1'] complex_add_cnj[of x2'] + using distrib_left[of Ze1 x1' "cnj x1'"] distrib_left[of Ze2 x1' "cnj x1'"] + using distrib_left[of Ze1 x2' "cnj x2'"] distrib_left[of Ze2 x2' "cnj x2'"] + by (auto simp add: complex_mult_cnj power2_eq_square field_simps) + + hence "- 2 * Re x1' * Ze1 + Ze1 * Ze1 - cor (Re1 * Re1) = - 2 * Re x1' * Ze2 + Ze2 * Ze2 - cor (Re2 * Re2)" + "- 2 * Re x2' * Ze1 + Ze1 * Ze1 - cor (Re1 * Re1) = - 2 * Re x2' * Ze2 + Ze2 * Ze2 - cor (Re2 * Re2)" + by (smt add_diff_cancel_right' add_diff_eq eq_iff_diff_eq_0 minus_diff_eq mult_minus_left of_real_minus)+ + hence "2 * Re x1' * (Ze2 - Ze1) = (Ze2 * Ze2 - cor (Re2 * Re2)) - (Ze1 * Ze1 - cor (Re1 * Re1))" + "2 * Re x2' * (Ze2 - Ze1) = (Ze2 * Ze2 - cor (Re2 * Re2)) - (Ze1 * Ze1 - cor (Re1 * Re1))" + by simp_all (simp add: field_simps)+ + hence "2 * Re x1' * (Ze2 - Ze1) = 2 * Re x2' * (Ze2 - Ze1)" + by simp + hence "Re x1' = Re x2'" + using \Ze1 \ Ze2\ + by simp + moreover + hence "(Im x1')\<^sup>2 = (Im x2')\<^sup>2" + using *(1) *(3) + by (simp add: \is_real Ze1\ complex_eq_if_Re_eq) + hence "Im x1' = Im x2' \ Im x1' = -Im x2'" + using power2_eq_iff + by blast + ultimately + show ?thesis + using x' `x1 \ x2` + using complex.expand + by (metis cnj.code complex_surj conjugate_of_complex) +qed + + +text \Two h-circles of the same radius centered at mutually conjugate points intersect at the x-axis\ +lemma intersect_poincare_circles_conjugate_centers: + assumes in_disc: "z1 \ unit_disc" "z2 \ unit_disc" and + "z1 \ z2" and "z1 = conjugate z2" and "r > 0" and + u: "u \ poincare_circle z1 r \ poincare_circle z2 r" + shows "is_real (to_complex u)" +proof- + obtain z1e r1e z2e r2e where + euclidean: "(z1e, r1e) = poincare_circle_euclidean z1 r" + "(z2e, r2e) = poincare_circle_euclidean z2 r" + by (metis poincare_circle_euclidean_def) + obtain z1' z2' where z': "z1 = of_complex z1'" "z2 = of_complex z2'" + using inf_or_of_complex[of z1] inf_or_of_complex[of z2] in_disc + by auto + obtain u' where u': "u = of_complex u'" + using u inf_or_of_complex[of u] + by (auto simp add: poincare_circle_def) + have "z1' = cnj z2'" + using \z1 = conjugate z2\ z' + by (auto simp add: of_complex_inj) + moreover + let ?cz = "1 - (cmod z2')\<^sup>2" + let ?den = "?cz * (cosh r - 1) / 2 + 1" + have "?cz > 0" + using in_disc z' + by (simp add: cmod_def) + hence "?den \ 1" + using cosh_gt_1[OF \r > 0\] + by auto + hence "?den \ 0" + by simp + hence "cor ?den \ 0" + using of_real_eq_0_iff + by blast + ultimately + have "r1e = r2e" "z1e = cnj z2e" "z1e \ z2e" + using z' euclidean \z1 \ z2\ + unfolding poincare_circle_euclidean_def Let_def + by simp_all metis + + hence "u' \ circle (cnj z2e) r2e \ circle z2e r2e" "z2e \ cnj z2e" + using euclidean u u' + using poincare_circle_is_euclidean_circle[of z1 r] + using poincare_circle_is_euclidean_circle[of z2 r] + using in_disc \r > 0\ + by auto (metis image_iff of_complex_inj)+ + hence "(cmod (u' - z2e))\<^sup>2 = (cmod(u' - cnj z2e))\<^sup>2" + by (simp add: circle_def) + hence "(u' - z2e) * (cnj u' - cnj z2e) = (u' - cnj z2e) * (cnj u' - z2e)" + by (metis complex_cnj_cnj complex_cnj_diff complex_norm_square) + hence "(z2e - cnj z2e) * (u' - cnj u') = 0" + by (simp add: field_simps) + thus ?thesis + using u' \z2e \ cnj z2e\ eq_cnj_iff_real[of u'] + by simp +qed + +subsection \Congruent triangles\ + +text\For every pair of triangles such that its three pairs of sides are pairwise equal there is an +h-isometry (a unit disc preserving Möbius transform, eventually composed with a conjugation) that +maps one triangle onto the other.\ +lemma unit_disc_fix_f_congruent_triangles: + assumes + in_disc: "u \ unit_disc" "v \ unit_disc" "w \ unit_disc" and + in_disc': "u' \ unit_disc" "v' \ unit_disc" "w' \ unit_disc" and + d: "poincare_distance u v = poincare_distance u' v'" + "poincare_distance v w = poincare_distance v' w'" + "poincare_distance u w = poincare_distance u' w'" + shows + "\ M. unit_disc_fix_f M \ M u = u' \ M v = v' \ M w = w'" +proof (cases "u = v \ u = w \ v = w") + case True + thus ?thesis + using assms + using poincare_distance_eq_0_iff[of u' v'] + using poincare_distance_eq_0_iff[of v' w'] + using poincare_distance_eq_0_iff[of u' w'] + using poincare_distance_eq_ex_moebius[of v w v' w'] + using poincare_distance_eq_ex_moebius[of u w u' w'] + using poincare_distance_eq_ex_moebius[of u v u' v'] + by (metis unit_disc_fix_f_def) +next + case False + + have "\ w u' v' w'. w \ unit_disc \ u' \ unit_disc \ v' \ unit_disc \ w' \ unit_disc \ w \ u \ w \ v \ + poincare_distance u v = poincare_distance u' v' \ + poincare_distance v w = poincare_distance v' w' \ + poincare_distance u w = poincare_distance u' w' \ + (\ M. unit_disc_fix_f M \ M u = u' \ M v = v' \ M w = w')" (is "?P u v") + proof (rule wlog_positive_x_axis[where P="?P"]) + show "v \ unit_disc" "u \ unit_disc" + by fact+ + next + show "u \ v" + using False + by simp + next + fix x + assume x: "is_real x" "0 < Re x" "Re x < 1" + + hence "of_complex x \ 0\<^sub>h" + using of_complex_zero_iff[of x] + by (auto simp add: complex.expand) + + show "?P 0\<^sub>h (of_complex x)" + proof safe + fix w u' v' w' + assume in_disc: "w \ unit_disc" "u' \ unit_disc" "v' \ unit_disc" "w' \ unit_disc" + assume "poincare_distance 0\<^sub>h (of_complex x) = poincare_distance u' v'" + then obtain M' where M': "unit_disc_fix M'" "moebius_pt M' u' = 0\<^sub>h" "moebius_pt M' v' = (of_complex x)" + using poincare_distance_eq_ex_moebius[of u' v' "0\<^sub>h" "of_complex x"] in_disc x + by (auto simp add: cmod_eq_Re) + + let ?w = "moebius_pt M' w'" + have "?w \ unit_disc" + using \unit_disc_fix M'\ \w' \ unit_disc\ + by simp + + assume "w \ 0\<^sub>h" "w \ of_complex x" + hence dist_gt_0: "poincare_distance 0\<^sub>h w > 0" "poincare_distance (of_complex x) w > 0" + using poincare_distance_eq_0_iff[of "0\<^sub>h" w] in_disc poincare_distance_ge0[of "0\<^sub>h" w] + using poincare_distance_eq_0_iff[of "of_complex x" w] in_disc poincare_distance_ge0[of "of_complex x" w] + using x + by (simp_all add: cmod_eq_Re) + + assume "poincare_distance (of_complex x) w = poincare_distance v' w'" + "poincare_distance 0\<^sub>h w = poincare_distance u' w'" + hence "poincare_distance 0\<^sub>h ?w = poincare_distance 0\<^sub>h w" + "poincare_distance (of_complex x) ?w = poincare_distance (of_complex x) w" + using M'(1) M'(2)[symmetric] M'(3)[symmetric] in_disc + using unit_disc_fix_preserve_poincare_distance[of M' u' w'] + using unit_disc_fix_preserve_poincare_distance[of M' v' w'] + by simp_all + hence "?w \ poincare_circle 0\<^sub>h (poincare_distance 0\<^sub>h w) \ poincare_circle (of_complex x) (poincare_distance (of_complex x) w)" + "w \ poincare_circle 0\<^sub>h (poincare_distance 0\<^sub>h w) \ poincare_circle (of_complex x) (poincare_distance (of_complex x) w)" + using \?w \ unit_disc\ \w \ unit_disc\ + unfolding poincare_circle_def + by simp_all + hence "?w = w \ ?w = conjugate w" + using intersect_poincare_circles_x_axis[of 0 x "poincare_distance 0\<^sub>h w" "poincare_distance (of_complex x) w" ?w w] x + using \of_complex x \ 0\<^sub>h\ dist_gt_0 + using poincare_distance_eq_0_iff + by auto + thus "\M. unit_disc_fix_f M \ M 0\<^sub>h = u' \ M (of_complex x) = v' \ M w = w'" + proof + assume "moebius_pt M' w' = w" + thus ?thesis + using M' + using moebius_pt_invert[of M' u' "0\<^sub>h"] + using moebius_pt_invert[of M' v' "of_complex x"] + using moebius_pt_invert[of M' w' "w"] + apply (rule_tac x="moebius_pt (-M')" in exI) + apply (simp add: unit_disc_fix_f_def) + apply (rule_tac x="-M'" in exI, simp) + done + next + let ?M = "moebius_pt (-M') \ conjugate" + assume "moebius_pt M' w' = conjugate w" + hence "?M w = w'" + using moebius_pt_invert[of M' w' "conjugate w"] + by simp + moreover + have "?M 0\<^sub>h = u'" "?M (of_complex x) = v'" + using moebius_pt_invert[of M' u' "0\<^sub>h"] + using moebius_pt_invert[of M' v' "of_complex x"] + using M' \is_real x\ eq_cnj_iff_real[of x] + by simp_all + moreover + have "unit_disc_fix_f ?M" + using \unit_disc_fix M'\ + unfolding unit_disc_fix_f_def + by (rule_tac x="-M'" in exI, simp) + ultimately + show ?thesis + by blast + qed + qed + next + fix M u v + assume 1: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" + let ?Mu = "moebius_pt M u" and ?Mv = "moebius_pt M v" + assume 2: "?P ?Mu ?Mv" + show "?P u v" + proof safe + fix w u' v' w' + let ?Mw = "moebius_pt M w" and ?Mu' = "moebius_pt M u'" and ?Mv' = "moebius_pt M v'" and ?Mw' = "moebius_pt M w'" + assume "w \ unit_disc" "u' \ unit_disc" "v' \ unit_disc" "w' \ unit_disc" "w \ u" "w \ v" + "poincare_distance u v = poincare_distance u' v'" + "poincare_distance v w = poincare_distance v' w'" + "poincare_distance u w = poincare_distance u' w'" + then obtain M' where M': "unit_disc_fix_f M'" "M' ?Mu = ?Mu'" "M' ?Mv = ?Mv'" "M' ?Mw = ?Mw'" + using 1 2[rule_format, of ?Mw ?Mu' ?Mv' ?Mw'] + by auto + + let ?M = "moebius_pt (-M) \ M' \ moebius_pt M" + show "\M. unit_disc_fix_f M \ M u = u' \ M v = v' \ M w = w'" + proof (rule_tac x="?M" in exI, safe) + show "unit_disc_fix_f ?M" + using M'(1) \unit_disc_fix M\ + by (subst unit_disc_fix_f_comp, subst unit_disc_fix_f_comp, simp_all) + next + show "?M u = u'" "?M v = v'" "?M w = w'" + using M' + by auto + qed + qed + qed + thus ?thesis + using assms False + by auto +qed + +end \ No newline at end of file diff --git a/thys/Poincare_Disc/Poincare_Distance.thy b/thys/Poincare_Disc/Poincare_Distance.thy new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/Poincare_Distance.thy @@ -0,0 +1,1567 @@ +theory Poincare_Distance + imports Poincare_Lines_Ideal_Points Hyperbolic_Functions +begin + +(* ------------------------------------------------------------------ *) +section \H-distance in the Poincar\'e model\ +(* ------------------------------------------------------------------ *) + +text\Informally, the \emph{h-distance} between the two h-points is defined as the absolute value of +the logarithm of the cross ratio between those two points and the two ideal points.\ + +abbreviation Re_cross_ratio where "Re_cross_ratio z u v w \ Re (to_complex (cross_ratio z u v w))" + +definition calc_poincare_distance :: "complex_homo \ complex_homo \ complex_homo \ complex_homo \ real" where + [simp]: "calc_poincare_distance u i1 v i2 = abs (ln (Re_cross_ratio u i1 v i2))" + +definition poincare_distance_pred :: "complex_homo \ complex_homo \ real \ bool" where + [simp]: "poincare_distance_pred u v d \ + (u = v \ d = 0) \ (u \ v \ (\ i1 i2. ideal_points (poincare_line u v) = {i1, i2} \ d = calc_poincare_distance u i1 v i2))" + +definition poincare_distance :: "complex_homo \ complex_homo \ real" where + "poincare_distance u v = (THE d. poincare_distance_pred u v d)" + +text\We shown that the described cross-ratio is always finite, +positive real number.\ +lemma distance_cross_ratio_real_positive: + assumes "u \ unit_disc" and "v \ unit_disc" and "u \ v" + shows "\ i1 i2. ideal_points (poincare_line u v) = {i1, i2} \ + cross_ratio u i1 v i2 \ \\<^sub>h \ is_real (to_complex (cross_ratio u i1 v i2)) \ Re_cross_ratio u i1 v i2 > 0" (is "?P u v") +proof (rule wlog_positive_x_axis[OF assms]) + fix x + assume *: "is_real x" "0 < Re x" "Re x < 1" + hence "x \ -1" "x \ 1" + by auto + hence **: "of_complex x \ \\<^sub>h" "of_complex x \ 0\<^sub>h" "of_complex x \ of_complex (-1)" "of_complex 1 \ of_complex x" + "of_complex x \ circline_set x_axis" + using * + unfolding circline_set_x_axis + by (auto simp add: of_complex_inj) + + have ***: "0\<^sub>h \ of_complex (-1)" "0\<^sub>h \ of_complex 1" + by (metis of_complex_zero_iff zero_neq_neg_one, simp) + + have ****: "- x - 1 \ 0" "x - 1 \ 0" + using \x \ -1\ \x \ 1\ + by (metis add.inverse_inverse eq_iff_diff_eq_0, simp) + + have "poincare_line 0\<^sub>h (of_complex x) = x_axis" + using ** + by (simp add: poincare_line_0_real_is_x_axis) + thus "?P 0\<^sub>h (of_complex x)" + using * ** *** **** + using cross_ratio_not_inf[of "0\<^sub>h" "of_complex 1" "of_complex (-1)" "of_complex x"] + using cross_ratio_not_inf[of "0\<^sub>h" "of_complex (-1)" "of_complex 1" "of_complex x"] + using cross_ratio_real[of 0 "-1" x 1] cross_ratio_real[of 0 1 x "-1"] + apply (auto simp add: poincare_line_0_real_is_x_axis doubleton_eq_iff circline_set_x_axis) + apply (subst cross_ratio, simp_all, subst Re_complex_div_gt_0, simp, subst mult_neg_neg, simp_all)+ + done +next + fix M u v + let ?Mu = "moebius_pt M u" and ?Mv = "moebius_pt M v" + assume *: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "u \ v" + "?P ?Mu ?Mv" + show "?P u v" + proof safe + fix i1 i2 + let ?cr = "cross_ratio u i1 v i2" + assume **: "ideal_points (poincare_line u v) = {i1, i2}" + have "i1 \ u" "i1 \ v" "i2 \ u" "i2 \ v" "i1 \ i2" + using ideal_points_different[OF *(2-3), of i1 i2] ** \u \ v\ + by auto + hence "0 < Re (to_complex ?cr) \ is_real (to_complex ?cr) \ ?cr \ \\<^sub>h" + using * ** + apply (erule_tac x="moebius_pt M i1" in allE) + apply (erule_tac x="moebius_pt M i2" in allE) + apply (subst (asm) ideal_points_poincare_line_moebius[of M u v i1 i2], simp_all) + done + thus "0 < Re (to_complex ?cr)" "is_real (to_complex ?cr)" "?cr = \\<^sub>h \ False" + by simp_all + qed +qed + +text\Next we can show that for every different points from the unit disc there is exactly one number +that satisfies the h-distance predicate.\ +lemma distance_unique: + assumes "u \ unit_disc" and "v \ unit_disc" + shows "\! d. poincare_distance_pred u v d" +proof (cases "u = v") + case True + thus ?thesis + by auto +next + case False + obtain i1 i2 where *: "i1 \ i2" "ideal_points (poincare_line u v) = {i1, i2}" + using obtain_ideal_points[OF is_poincare_line_poincare_line] \u \ v\ + by blast + let ?d = "calc_poincare_distance u i1 v i2" + show ?thesis + proof (rule ex1I) + show "poincare_distance_pred u v ?d" + using * \u \ v\ + proof (simp del: calc_poincare_distance_def, safe) + fix i1' i2' + assume "{i1, i2} = {i1', i2'}" + hence **: "(i1' = i1 \ i2' = i2) \ (i1' = i2 \ i2' = i1)" + using doubleton_eq_iff[of i1 i2 i1' i2'] + by blast + have all_different: "u \ i1" "u \ i2" "v \ i1" "v \ i2" "u \ i1'" "u \ i2'" "v \ i1'" "v \ i2'" "i1 \ i2" + using ideal_points_different[OF assms, of i1 i2] * ** \u \ v\ + by auto + + show "calc_poincare_distance u i1 v i2 = calc_poincare_distance u i1' v i2'" + proof- + let ?cr = "cross_ratio u i1 v i2" + let ?cr' = "cross_ratio u i1' v i2'" + + have "Re (to_complex ?cr) > 0" "is_real (to_complex ?cr)" + "Re (to_complex ?cr') > 0" "is_real (to_complex ?cr')" + using False distance_cross_ratio_real_positive[OF assms(1-2)] * ** + by auto + + thus ?thesis + using ** + using cross_ratio_not_zero cross_ratio_not_inf all_different + by auto (subst cross_ratio_commute_24, subst reciprocal_real, simp_all add: ln_div) + qed + qed + next + fix d + assume "poincare_distance_pred u v d" + thus "d = ?d" + using * \u \ v\ + by auto + qed +qed + +lemma poincare_distance_satisfies_pred [simp]: + assumes "u \ unit_disc" and "v \ unit_disc" + shows "poincare_distance_pred u v (poincare_distance u v)" + using distance_unique[OF assms] theI'[of "poincare_distance_pred u v"] + unfolding poincare_distance_def + by blast + +lemma poincare_distance_I: + assumes "u \ unit_disc" and "v \ unit_disc" and "u \ v" and "ideal_points (poincare_line u v) = {i1, i2}" + shows "poincare_distance u v = calc_poincare_distance u i1 v i2" + using assms + using poincare_distance_satisfies_pred[OF assms(1-2)] + by simp + +lemma poincare_distance_refl [simp]: + assumes "u \ unit_disc" + shows "poincare_distance u u = 0" + using assms + using poincare_distance_satisfies_pred[OF assms assms] + by simp + +text\Unit disc preserving Möbius transformations preserve h-distance. \ +lemma unit_disc_fix_preserve_poincare_distance [simp]: + assumes "unit_disc_fix M" and "u \ unit_disc" and "v \ unit_disc" + shows "poincare_distance (moebius_pt M u) (moebius_pt M v) = poincare_distance u v" +proof (cases "u = v") + case True + have "moebius_pt M u \ unit_disc" "moebius_pt M v \ unit_disc" + using unit_disc_fix_iff[OF assms(1), symmetric] assms + by blast+ + thus ?thesis + using assms \u = v\ + by simp +next + case False + obtain i1 i2 where *: "ideal_points (poincare_line u v) = {i1, i2}" + using \u \ v\ + by (rule obtain_ideal_points[OF is_poincare_line_poincare_line[of u v]]) + let ?Mu = "moebius_pt M u" and ?Mv = "moebius_pt M v" and ?Mi1 = "moebius_pt M i1" and ?Mi2 = "moebius_pt M i2" + + have **: "?Mu \ unit_disc" "?Mv \ unit_disc" + using assms + using unit_disc_fix_iff + by blast+ + + have ***: "?Mu \ ?Mv" + using \u \ v\ + by simp + + have "poincare_distance u v = calc_poincare_distance u i1 v i2" + using poincare_distance_I[OF assms(2-3) \u \ v\ *] + by auto + moreover + have "unit_circle_fix M" + using assms + by simp + hence ++: "ideal_points (poincare_line ?Mu ?Mv) = {?Mi1, ?Mi2}" + using \u \ v\ assms * + by simp + have "poincare_distance ?Mu ?Mv = calc_poincare_distance ?Mu ?Mi1 ?Mv ?Mi2" + by (rule poincare_distance_I[OF ** *** ++]) + moreover + have "calc_poincare_distance ?Mu ?Mi1 ?Mv ?Mi2 = calc_poincare_distance u i1 v i2" + using ideal_points_different[OF assms(2-3) \u \ v\ *] + unfolding calc_poincare_distance_def + by (subst moebius_preserve_cross_ratio[symmetric], simp_all) + ultimately + show ?thesis + by simp +qed + + +text\Knowing ideal points for x-axis, we can easily explicitly calculate distances.\ +lemma poincare_distance_x_axis_x_axis: + assumes "x \ unit_disc" and "y \ unit_disc" and "x \ circline_set x_axis" and "y \ circline_set x_axis" + shows "poincare_distance x y = + (let x' = to_complex x; y' = to_complex y + in abs (ln (Re (((1 + x') * (1 - y')) / ((1 - x') * (1 + y'))))))" +proof- + obtain x' y' where *: "x = of_complex x'" "y = of_complex y'" + using inf_or_of_complex[of x] inf_or_of_complex[of y] \x \ unit_disc\ \y \ unit_disc\ + by auto + + have "cmod x' < 1" "cmod y' < 1" + using \x \ unit_disc\ \y \ unit_disc\ * + by (metis unit_disc_iff_cmod_lt_1)+ + hence **: "x' \ 1" "x' \ 1" "y' \ -1" "y' \ 1" + by auto + + have "1 + y' \ 0" + using ** + by (metis add.left_cancel add_neg_numeral_special(7)) + + show ?thesis + proof (cases "x = y") + case True + thus ?thesis + using assms(1-2) + using unit_disc_iff_cmod_lt_1[of "to_complex x"] * ** `1 + y' \ 0` + by auto + + next + case False + hence "poincare_line x y = x_axis" + using poincare_line_x_axis[OF assms] + by simp + hence "ideal_points (poincare_line x y) = {of_complex (-1), of_complex 1}" + by simp + hence "poincare_distance x y = calc_poincare_distance x (of_complex (-1)) y (of_complex 1)" + using poincare_distance_I assms \x \ y\ + by auto + also have "... = abs (ln (Re (((x' + 1) * (y' - 1)) / ((x' - 1) * (y' + 1)))))" + using * \cmod x' < 1\ \cmod y' < 1\ + by (simp, transfer, transfer, auto) + finally + show ?thesis + using * + by (metis (no_types, lifting) add.commute minus_diff_eq minus_divide_divide mult_minus_left mult_minus_right to_complex_of_complex) + qed +qed + +lemma poincare_distance_zero_x_axis: + assumes "x \ unit_disc" and "x \ circline_set x_axis" + shows "poincare_distance 0\<^sub>h x = (let x' = to_complex x in abs (ln (Re ((1 - x') / (1 + x')))))" + using assms + using poincare_distance_x_axis_x_axis[of "0\<^sub>h" x] + by (simp add: Let_def) + +lemma poincare_distance_zero: + assumes "x \ unit_disc" + shows "poincare_distance 0\<^sub>h x = (let x' = to_complex x in abs (ln (Re ((1 - cmod x') / (1 + cmod x')))))" (is "?P x") +proof (cases "x = 0\<^sub>h") + case True + thus ?thesis + by auto +next + case False + show ?thesis + proof (rule wlog_rotation_to_positive_x_axis) + show "x \ unit_disc" "x \ 0\<^sub>h" by fact+ + next + fix \ u + assume "u \ unit_disc" "u \ 0\<^sub>h" "?P (moebius_pt (moebius_rotation \) u)" + thus "?P u" + using unit_disc_fix_preserve_poincare_distance[of "moebius_rotation \" "0\<^sub>h" u] + by (cases "u = \\<^sub>h") (simp_all add: Let_def) + next + fix x + assume "is_real x" "0 < Re x" "Re x < 1" + thus "?P (of_complex x)" + using poincare_distance_zero_x_axis[of "of_complex x"] + by simp (auto simp add: circline_set_x_axis cmod_eq_Re complex_is_Real_iff) + qed +qed + +lemma poincare_distance_zero_opposite [simp]: + assumes "of_complex z \ unit_disc" + shows "poincare_distance 0\<^sub>h (of_complex (- z)) = poincare_distance 0\<^sub>h (of_complex z)" +proof- + have *: "of_complex (-z) \ unit_disc" + using assms + by auto + show ?thesis + using poincare_distance_zero[OF assms] + using poincare_distance_zero[OF *] + by simp +qed + +(* ------------------------------------------------------------------ *) +subsection\Distance explicit formula\ +(* ------------------------------------------------------------------ *) + +text\Instead of the h-distance itself, very frequently its hyperbolic cosine is analyzed.\ + +abbreviation "cosh_dist u v \ cosh (poincare_distance u v)" + +lemma cosh_poincare_distance_cross_ratio_average: + assumes "u \ unit_disc" "v \ unit_disc" "u \ v" "ideal_points (poincare_line u v) = {i1, i2}" + shows "cosh_dist u v = + ((Re_cross_ratio u i1 v i2) + (Re_cross_ratio v i1 u i2)) / 2" +proof- + let ?cr = "cross_ratio u i1 v i2" + let ?crRe = "Re (to_complex ?cr)" + have "?cr \ \\<^sub>h" "is_real (to_complex ?cr)" "?crRe > 0" + using distance_cross_ratio_real_positive[OF assms(1-3)] assms(4) + by simp_all + then obtain cr where *: "cross_ratio u i1 v i2 = of_complex cr" "cr \ 0" "is_real cr" "Re cr > 0" + using inf_or_of_complex[of "cross_ratio u i1 v i2"] + by (smt to_complex_of_complex zero_complex.simps(1)) + thus ?thesis + using * + using assms cross_ratio_commute_13[of v i1 u i2] + unfolding poincare_distance_I[OF assms] calc_poincare_distance_def cosh_def + by (cases "Re cr \ 1") + (auto simp add: ln_div[of 0] exp_minus field_simps Re_divide power2_eq_square complex.expand) +qed + +definition poincare_distance_formula' :: "complex \ complex \ real" where +[simp]: "poincare_distance_formula' u v = 1 + 2 * ((cmod (u - v))\<^sup>2 / ((1 - (cmod u)\<^sup>2) * (1 - (cmod v)\<^sup>2)))" + +text\Next we show that the following formula expresses h-distance between any two h-points (note +that the ideal points do not figure anymore).\ + +definition poincare_distance_formula :: "complex \ complex \ real" where + [simp]: "poincare_distance_formula u v = arcosh (poincare_distance_formula' u v)" + +lemma blaschke_preserve_distance_formula [simp]: + assumes "of_complex k \ unit_disc" "u \ unit_disc" "v \ unit_disc" + shows "poincare_distance_formula (to_complex (moebius_pt (blaschke k) u)) (to_complex (moebius_pt (blaschke k) v)) = + poincare_distance_formula (to_complex u) (to_complex v)" +proof (cases "k = 0") + case True + thus ?thesis + by simp +next + case False + obtain u' v' where *: "u' = to_complex u" "v' = to_complex v" + by auto + + have "cmod u' < 1" "cmod v' < 1" "cmod k < 1" + using assms * + using inf_or_of_complex[of u] inf_or_of_complex[of v] + by auto + + obtain nu du nv dv d kk ddu ddv where + **: "nu = u' - k" "du = 1 - cnj k *u'" "nv = v' - k" "dv = 1 - cnj k * v'" + "d = u' - v'" "ddu = 1 - u'*cnj u'" "ddv = 1 - v'*cnj v'" "kk = 1 - k*cnj k" + by auto + + have d: "nu*dv - nv*du = d*kk" + by (subst **)+ (simp add: field_simps) + have ddu: "du*cnj du - nu*cnj nu = ddu*kk" + by (subst **)+ (simp add: field_simps) + have ddv: "dv*cnj dv - nv*cnj nv = ddv*kk" + by (subst **)+ (simp add: field_simps) + + have "du \ 0" + proof (rule ccontr) + assume "\ ?thesis" + hence "cmod (1 - cnj k * u') = 0" + using \du = 1 - cnj k * u'\ + by auto + hence "cmod (cnj k * u') = 1" + by auto + hence "cmod k * cmod u' = 1" + by auto + thus False + using \cmod k < 1\ \cmod u' < 1\ + using mult_strict_mono[of "cmod k" 1 "cmod u'" 1] + by simp + qed + + have "dv \ 0" + proof (rule ccontr) + assume "\ ?thesis" + hence "cmod (1 - cnj k * v') = 0" + using \dv = 1 - cnj k * v'\ + by auto + hence "cmod (cnj k * v') = 1" + by auto + hence "cmod k * cmod v' = 1" + by auto + thus False + using \cmod k < 1\ \cmod v' < 1\ + using mult_strict_mono[of "cmod k" 1 "cmod v'" 1] + by simp + qed + + have "kk \ 0" + proof (rule ccontr) + assume "\ ?thesis" + hence "cmod (1 - k * cnj k) = 0" + using \kk = 1 - k * cnj k\ + by auto + hence "cmod (k * cnj k) = 1" + by auto + hence "cmod k * cmod k = 1" + by auto + thus False + using \cmod k < 1\ + using mult_strict_mono[of "cmod k" 1 "cmod k" 1] + by simp + qed + + note nz = \du \ 0\ \dv \ 0\ \kk \ 0\ + + + have "nu / du - nv / dv = (nu*dv - nv*du) / (du * dv)" + using nz + by (simp add: field_simps) + hence "(cmod (nu/du - nv/dv))\<^sup>2 = cmod ((d*kk) / (du*dv) * (cnj ((d*kk) / (du*dv))))" (is "?lhs = _") + unfolding complex_mod_mult_cnj[symmetric] + by (subst (asm) d) simp + also have "... = cmod ((d*cnj d*kk*kk) / (du*cnj du*dv*cnj dv))" + by (simp add: field_simps) + finally have 1: "?lhs = cmod ((d*cnj d*kk*kk) / (du*cnj du*dv*cnj dv))" + . + + have "(1 - ((cmod nu) / (cmod du))\<^sup>2)*(1 - ((cmod nv) / (cmod dv))\<^sup>2) = + (1 - cmod((nu * cnj nu) / (du * cnj du)))*(1 - cmod((nv * cnj nv) / (dv * cnj dv)))" (is "?rhs = _") + by (metis cmod_divide complex_mod_mult_cnj power_divide) + also have "... = cmod(((du*cnj du - nu*cnj nu) / (du * cnj du)) * ((dv*cnj dv - nv*cnj nv) / (dv * cnj dv)))" + proof- + have "u' \ 1 / cnj k" "v' \ 1 / cnj k" + using \cmod u' < 1\ \cmod v' < 1\ \cmod k < 1\ + by (auto simp add: False) + moreover + have "cmod k \ 1" + using \cmod k < 1\ + by linarith + ultimately + have "cmod (nu/du) < 1" "cmod (nv/dv) < 1" + using **(1-4) + using unit_disc_fix_discI[OF blaschke_unit_disc_fix[OF \cmod k < 1\] \u \ unit_disc\] \u' = to_complex u\ + using unit_disc_fix_discI[OF blaschke_unit_disc_fix[OF \cmod k < 1\] \v \ unit_disc\] \v' = to_complex v\ + using inf_or_of_complex[of u] \u \ unit_disc\ inf_or_of_complex[of v] \v \ unit_disc\ + using moebius_pt_blaschke[of k u'] using moebius_pt_blaschke[of k v'] + by auto + hence "(cmod (nu/du))\<^sup>2 < 1" "(cmod (nv/dv))\<^sup>2 < 1" + by (simp_all add: cmod_def) + hence "cmod (nu * cnj nu / (du * cnj du)) < 1" "cmod (nv * cnj nv / (dv * cnj dv)) < 1" + by (metis complex_mod_mult_cnj norm_divide power_divide)+ + moreover + have "is_real (nu * cnj nu / (du * cnj du))" "is_real (nv * cnj nv / (dv * cnj dv))" + using eq_cnj_iff_real[of "nu * cnj nu / (du * cnj du)"] + using eq_cnj_iff_real[of "nv * cnj nv / (dv * cnj dv)"] + by (auto simp add: mult.commute) + moreover + have "Re (nu * cnj nu / (du * cnj du)) \ 0" "Re (nv * cnj nv / (dv * cnj dv)) \ 0" + using \du \ 0\ \dv \ 0\ + unfolding complex_mult_cnj_cmod + by simp_all + ultimately + have "1 - cmod (nu * cnj nu / (du * cnj du)) = cmod (1 - nu * cnj nu / (du * cnj du))" + "1 - cmod (nv * cnj nv / (dv * cnj dv)) = cmod (1 - nv * cnj nv / (dv * cnj dv))" + by (simp_all add: cmod_def) + thus ?thesis + using nz + apply simp + apply (subst diff_divide_eq_iff, simp, simp) + apply (subst diff_divide_eq_iff, simp, simp) + done + qed + also have "... = cmod(((ddu * kk) / (du * cnj du)) * ((ddv * kk) / (dv * cnj dv)))" + by (subst ddu, subst ddv, simp) + also have "... = cmod((ddu*ddv*kk*kk) / (du*cnj du*dv*cnj dv))" + by (simp add: field_simps) + finally have 2: "?rhs = cmod((ddu*ddv*kk*kk) / (du*cnj du*dv*cnj dv))" + . + + have "?lhs / ?rhs = + cmod ((d*cnj d*kk*kk) / (du*cnj du*dv*cnj dv)) / cmod((ddu*ddv*kk*kk) / (du*cnj du*dv*cnj dv))" + by (subst 1, subst 2, simp) + also have "... = cmod ((d*cnj d)/(ddu*ddv))" + using nz + by simp + also have "... = (cmod d)\<^sup>2 / ((1 - (cmod u')\<^sup>2)*(1 - (cmod v')\<^sup>2))" + proof- + have "(cmod u')\<^sup>2 < 1" "(cmod v')\<^sup>2 < 1" + using \cmod u' < 1\ \cmod v' < 1\ + by (simp_all add: cmod_def) + hence "cmod (1 - u' * cnj u') = 1 - (cmod u')\<^sup>2" "cmod (1 - v' * cnj v') = 1 - (cmod v')\<^sup>2" + by (auto simp add: cmod_eq_Re cmod_power2 power2_eq_square[symmetric]) + thus ?thesis + using nz + apply (subst **)+ + unfolding complex_mod_mult_cnj[symmetric] + by simp + qed + finally + have 3: "?lhs / ?rhs = (cmod d)\<^sup>2 / ((1 - (cmod u')\<^sup>2)*(1 - (cmod v')\<^sup>2))" + . + + have "cmod k \ 1" "u' \ 1 / cnj k" "v' \ 1 / cnj k" "u \ \\<^sub>h" "v \ \\<^sub>h" + using \cmod k < 1\ \u \ unit_disc\ \v \ unit_disc\ * \k \ 0\ ** \kk \ 0\ nz + by auto + thus ?thesis using assms + using * ** 3 + using moebius_pt_blaschke[of k u'] + using moebius_pt_blaschke[of k v'] + by simp +qed + +text \To prove the equivalence between the h-distance definition and the distance formula, we shall +employ the without loss of generality principle. Therefore, we must show that the distance formula +is preserved by h-isometries.\ + +text\Rotation preserve @{term poincare_distance_formula}.\ +lemma rotation_preserve_distance_formula [simp]: + assumes "u \ unit_disc" "v \ unit_disc" + shows "poincare_distance_formula (to_complex (moebius_pt (moebius_rotation \) u)) (to_complex (moebius_pt (moebius_rotation \) v)) = + poincare_distance_formula (to_complex u) (to_complex v)" + using assms + using inf_or_of_complex[of u] inf_or_of_complex[of v] + by auto + +text\Unit disc fixing Möbius preserve @{term poincare_distance_formula}.\ +lemma unit_disc_fix_preserve_distance_formula [simp]: + assumes "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" + shows "poincare_distance_formula (to_complex (moebius_pt M u)) (to_complex (moebius_pt M v)) = + poincare_distance_formula (to_complex u) (to_complex v)" (is "?P' u v M") +proof- + have "\ u \ unit_disc. \ v \ unit_disc. ?P' u v M" (is "?P M") + proof (rule wlog_unit_disc_fix[OF assms(1)]) + fix k + assume "cmod k < 1" + hence "of_complex k \ unit_disc" + by simp + thus "?P (blaschke k)" + using blaschke_preserve_distance_formula + by simp + next + fix \ + show "?P (moebius_rotation \)" + using rotation_preserve_distance_formula + by simp + next + fix M1 M2 + assume *: "?P M1" and **: "?P M2" and u11: "unit_disc_fix M1" "unit_disc_fix M2" + thus "?P (M1 + M2)" + by (auto simp del: poincare_distance_formula_def) + qed + thus ?thesis + using assms + by simp +qed + +text\The equivalence between the two h-distance representations.\ +lemma poincare_distance_formula: + assumes "u \ unit_disc" and "v \ unit_disc" + shows "poincare_distance u v = poincare_distance_formula (to_complex u) (to_complex v)" (is "?P u v") +proof (rule wlog_x_axis) + fix x + assume *: "is_real x" "0 \ Re x" "Re x < 1" + show "?P 0\<^sub>h (of_complex x)" (is "?lhs = ?rhs") + proof- + have "of_complex x \ unit_disc" "of_complex x \ circline_set x_axis" "cmod x < 1" + using * cmod_eq_Re + by (auto simp add: circline_set_x_axis) + hence "?lhs = \ln (Re ((1 - x) / (1 + x)))\" + using poincare_distance_zero_x_axis[of "of_complex x"] + by simp + moreover + have "?rhs = \ln (Re ((1 - x) / (1 + x)))\" + proof- + let ?x = "1 + 2 * (cmod x)\<^sup>2 / (1 - (cmod x)\<^sup>2)" + have "0 \ 2 * (cmod x)\<^sup>2 / (1 - (cmod x)\<^sup>2)" + by (smt \cmod x < 1\ divide_nonneg_nonneg norm_ge_zero power_le_one zero_le_power2) + hence arcosh_real_gt: "1 \ ?x" + by auto + have "?rhs = arcosh ?x" + by simp + also have "... = ln ((1 + (cmod x)\<^sup>2) / (1 - (cmod x)\<^sup>2) + 2 * (cmod x) / (1 - (cmod x)\<^sup>2))" + proof- + have "1 - (cmod x)\<^sup>2 > 0" + using \cmod x < 1\ + by (smt norm_not_less_zero one_power2 power2_eq_imp_eq power_mono) + hence 1: "?x = (1 + (cmod x)\<^sup>2) / (1 - (cmod x)\<^sup>2)" + by (simp add: field_simps) + have 2: "?x\<^sup>2 - 1 = (4 * (cmod x)\<^sup>2) / (1 - (cmod x)\<^sup>2)\<^sup>2" + using \1 - (cmod x)\<^sup>2 > 0\ + apply (subst 1) + unfolding power_divide + by (subst divide_diff_eq_iff, simp, simp add: power2_eq_square field_simps) + show ?thesis + using \1 - (cmod x)\<^sup>2 > 0\ + apply (subst arcosh_real_def[OF arcosh_real_gt]) + apply (subst 2) + apply (subst 1) + apply (subst real_sqrt_divide) + apply (subst real_sqrt_mult) + apply simp + done + qed + also have "... = ln (((1 + (cmod x))\<^sup>2) / (1 - (cmod x)\<^sup>2))" + apply (subst add_divide_distrib[symmetric]) + apply (simp add: field_simps power2_eq_square) + done + also have "... = ln ((1 + cmod x) / (1 - (cmod x)))" + using \cmod x < 1\ + using square_diff_square_factored[of 1 "cmod x"] + by (simp add: power2_eq_square) + also have "... = \ln (Re ((1 - x) / (1 + x)))\" + proof- + have *: "Re ((1 - x) / (1 + x)) \ 1" "Re ((1 - x) / (1 + x)) > 0" + using \is_real x\ \Re x \ 0\ \Re x < 1\ + using complex_is_Real_iff + by auto + hence "\ln (Re ((1 - x) / (1 + x)))\ = - ln (Re ((1 - x) / (1 + x)))" + by auto + hence "\ln (Re ((1 - x) / (1 + x)))\ = ln (Re ((1 + x) / (1 - x)))" + using ln_div[of 1 "Re ((1 - x)/(1 + x))"] * \is_real x\ + by (simp add: complex_is_Real_iff) + moreover + have "ln ((1 + cmod x) / (1 - cmod x)) = ln ((1 + Re x) / (1 - Re x))" + using \Re x \ 0\ \is_real x\ + using cmod_eq_Re by auto + moreover + have "(1 + Re x) / (1 - Re x) = Re ((1 + x) / (1 - x))" + using \is_real x\ \Re x < 1\ + by (smt Re_divide_real eq_iff_diff_eq_0 minus_complex.simps one_complex.simps plus_complex.simps) + ultimately + show ?thesis + by simp + qed + finally + show ?thesis + . + qed + ultimately + show ?thesis + by simp + qed +next + fix M u v + assume *: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" + assume "?P (moebius_pt M u) (moebius_pt M v)" + thus "?P u v" + using *(1-3) + by (simp del: poincare_distance_formula_def) +next + show "u \ unit_disc" "v \ unit_disc" + by fact+ +qed + +text\Some additional properties proved easily using the distance formula.\ + + +text \@{term poincare_distance} is symmetric.\ +lemma poincare_distance_sym: + assumes "u \ unit_disc" and "v \ unit_disc" + shows "poincare_distance u v = poincare_distance v u" + using assms + using poincare_distance_formula[OF assms(1) assms(2)] + using poincare_distance_formula[OF assms(2) assms(1)] + by (simp add: mult.commute norm_minus_commute) + +lemma poincare_distance_formula'_ge_1: + assumes "u \ unit_disc" and "v \ unit_disc" + shows "1 \ poincare_distance_formula' (to_complex u) (to_complex v)" + using unit_disc_cmod_square_lt_1[OF assms(1)] unit_disc_cmod_square_lt_1[OF assms(2)] + by auto + +text\@{term poincare_distance} is non-negative.\ +lemma poincare_distance_ge0: + assumes "u \ unit_disc" and "v \ unit_disc" + shows "poincare_distance u v \ 0" + using poincare_distance_formula'_ge_1 + unfolding poincare_distance_formula[OF assms(1) assms(2)] + unfolding poincare_distance_formula_def + unfolding poincare_distance_formula'_def + by (rule arcosh_ge_0, simp_all add: assms) + +lemma cosh_dist: + assumes "u \ unit_disc" and "v \ unit_disc" + shows "cosh_dist u v = poincare_distance_formula' (to_complex u) (to_complex v)" + using poincare_distance_formula[OF assms] poincare_distance_formula'_ge_1[OF assms] + by simp + +text\@{term poincare_distance} is zero only if the two points are equal.\ +lemma poincare_distance_eq_0_iff: + assumes "u \ unit_disc" and "v \ unit_disc" + shows "poincare_distance u v = 0 \ u = v" + using assms + apply auto + using poincare_distance_formula'_ge_1[OF assms] + using unit_disc_cmod_square_lt_1[OF assms(1)] unit_disc_cmod_square_lt_1[OF assms(2)] + unfolding poincare_distance_formula[OF assms(1) assms(2)] + unfolding poincare_distance_formula_def + unfolding poincare_distance_formula'_def + apply (subst (asm) arcosh_eq_0_iff) + apply assumption + apply (simp add: unit_disc_to_complex_inj) + done + +text\Conjugate preserve @{term poincare_distance_formula}.\ +lemma conjugate_preserve_poincare_distance [simp]: + assumes "u \ unit_disc" and "v \ unit_disc" + shows "poincare_distance (conjugate u) (conjugate v) = poincare_distance u v" +proof- + obtain u' v' where *: "u = of_complex u'" "v = of_complex v'" + using assms inf_or_of_complex[of u] inf_or_of_complex[of v] + by auto + + have **: "conjugate u \ unit_disc" "conjugate v \ unit_disc" + using * assms + by auto + + show ?thesis + using * + using poincare_distance_formula[OF assms] + using poincare_distance_formula[OF **] + by (metis complex_cnj_diff complex_mod_cnj conjugate_of_complex poincare_distance_def poincare_distance_formula'_def poincare_distance_formula_def to_complex_of_complex) +qed + +(* ------------------------------------------------------------------ *) +subsection\Existence and uniqueness of points with a given distance\ +(* ------------------------------------------------------------------ *) + +lemma ex_x_axis_poincare_distance_negative': + fixes d :: real + assumes "d \ 0" + shows "let z = (1 - exp d) / (1 + exp d) + in is_real z \ Re z \ 0 \ Re z > -1 \ + of_complex z \ unit_disc \ of_complex z \ circline_set x_axis \ + poincare_distance 0\<^sub>h (of_complex z) = d" +proof- + have "exp d \ 1" + using assms + using one_le_exp_iff[of d, symmetric] + by blast + + hence "1 + exp d \ 0" + by linarith + + let ?z = "(1 - exp d) / (1 + exp d)" + + have "?z \ 0" + using \exp d \ 1\ + by (simp add: divide_nonpos_nonneg) + + moreover + + have "?z > -1" + using exp_gt_zero[of d] + by (smt divide_less_eq_1_neg nonzero_minus_divide_right) + + moreover + + hence "abs ?z < 1" + using \?z \ 0\ + by simp + hence "cmod ?z < 1" + by (metis norm_of_real) + hence "of_complex ?z \ unit_disc" + by simp + + moreover + have "of_complex ?z \ circline_set x_axis" + unfolding circline_set_x_axis + by simp + + moreover + have "(1 - ?z) / (1 + ?z) = exp d" + proof- + have "1 + ?z = 2 / (1 + exp d)" + using \1 + exp d \ 0\ + by (subst add_divide_eq_iff, auto) + moreover + have "1 - ?z = 2 * exp d / (1 + exp d)" + using \1 + exp d \ 0\ + by (subst diff_divide_eq_iff, auto) + ultimately + show ?thesis + using \1 + exp d \ 0\ + by simp + qed + + ultimately + show ?thesis + using poincare_distance_zero_x_axis[of "of_complex ?z"] + using \d \ 0\ \exp d \ 1\ + by simp (simp add: cmod_eq_Re) +qed + +lemma ex_x_axis_poincare_distance_negative: + assumes "d \ 0" + shows "\ z. is_real z \ Re z \ 0 \ Re z > -1 \ + of_complex z \ unit_disc \ of_complex z \ circline_set x_axis \ + poincare_distance 0\<^sub>h (of_complex z) = d" (is "\ z. ?P z") + using ex_x_axis_poincare_distance_negative'[OF assms] + unfolding Let_def + by blast + +text\For each real number $d$ there is exactly one point on the positive x-axis such that h-distance +between 0 and that point is $d$.\ +lemma unique_x_axis_poincare_distance_negative: + assumes "d \ 0" + shows "\! z. is_real z \ Re z \ 0 \ Re z > -1 \ + poincare_distance 0\<^sub>h (of_complex z) = d" (is "\! z. ?P z") +proof- + let ?z = "(1 - exp d) / (1 + exp d)" + + have "?P ?z" + using ex_x_axis_poincare_distance_negative'[OF assms] + unfolding Let_def + by blast + + moreover + + have "\ z'. ?P z' \ z' = ?z" + proof- + let ?g = "\ x'. \ln (Re ((1 - x') / (1 + x')))\" + let ?A = "{x. is_real x \ Re x > -1 \ Re x \ 0}" + have "inj_on (poincare_distance 0\<^sub>h \ of_complex) ?A" + proof (rule comp_inj_on) + show "inj_on of_complex ?A" + using of_complex_inj + unfolding inj_on_def + by blast + next + show "inj_on (poincare_distance 0\<^sub>h) (of_complex ` ?A)" (is "inj_on ?f (of_complex ` ?A)") + proof (subst inj_on_cong) + have *: "of_complex ` ?A = + {z. z \ unit_disc \ z \ circline_set x_axis \ Re (to_complex z) \ 0}" (is "_ = ?B") + by (auto simp add: cmod_eq_Re circline_set_x_axis) + + fix x + assume "x \ of_complex ` ?A" + hence "x \ ?B" + using * + by simp + thus "poincare_distance 0\<^sub>h x = (?g \ to_complex) x" + using poincare_distance_zero_x_axis + by (simp add: Let_def) + next + have *: "to_complex ` of_complex ` ?A = ?A" + by (auto simp add: image_iff) + + show "inj_on (?g \ to_complex) (of_complex ` ?A)" + proof (rule comp_inj_on) + show "inj_on to_complex (of_complex ` ?A)" + unfolding inj_on_def + by auto + next + have "inj_on ?g ?A" + unfolding inj_on_def + proof(safe) + fix x y + assume hh: "is_real x" "is_real y" "- 1 < Re x" "Re x \ 0" + "- 1 < Re y" "Re y \ 0" "\ln (Re ((1 - x) / (1 + x)))\ = \ln (Re ((1 - y) / (1 + y)))\" + + have "is_real ((1 - x)/(1 + x))" + using \is_real x\ div_reals[of "1-x" "1+x"] + by auto + have "is_real ((1 - y)/(1 + y))" + using \is_real y\ div_reals[of "1-y" "1+y"] + by auto + + have "Re (1 + x) > 0" + using \- 1 < Re x\ by auto + hence "1 + x \ 0" + by force + have "Re (1 - x) \ 0" + using \Re x \ 0\ by auto + hence "Re ((1 - x)/(1 + x)) > 0" + using Re_divide_real \0 < Re (1 + x)\ complex_eq_if_Re_eq hh(1) hh(4) by auto + have "Re(1 - x) \ Re ( 1 + x)" + using hh by auto + hence "Re ((1 - x)/(1 + x)) \ 1" + using \Re (1 + x) > 0\ \is_real ((1 - x)/(1 + x))\ + by (smt Re_divide_real arg_0_iff hh(1) le_divide_eq_1_pos one_complex.simps(2) plus_complex.simps(2)) + + have "Re (1 + y) > 0" + using \- 1 < Re y\ by auto + hence "1 + y \ 0" + by force + have "Re (1 - y) \ 0" + using \Re y \ 0\ by auto + hence "Re ((1 - y)/(1 + y)) > 0" + using Re_divide_real \0 < Re (1 + y)\ complex_eq_if_Re_eq hh by auto + have "Re(1 - y) \ Re ( 1 + y)" + using hh by auto + hence "Re ((1 - y)/(1 + y)) \ 1" + using \Re (1 + y) > 0\ \is_real ((1 - y)/(1 + y))\ + by (smt Re_divide_real arg_0_iff hh le_divide_eq_1_pos one_complex.simps(2) plus_complex.simps(2)) + + have "ln (Re ((1 - x) / (1 + x))) = ln (Re ((1 - y) / (1 + y)))" + using \Re ((1 - y)/(1 + y)) \ 1\ \Re ((1 - x)/(1 + x)) \ 1\ hh + by auto + hence "Re ((1 - x) / (1 + x)) = Re ((1 - y) / (1 + y))" + using \Re ((1 - y)/(1 + y)) > 0\ \Re ((1 - x)/(1 + x)) > 0\ + by auto + hence "(1 - x) / (1 + x) = (1 - y) / (1 + y)" + using \is_real ((1 - y)/(1 + y))\ \is_real ((1 - x)/(1 + x))\ + using complex_eq_if_Re_eq by blast + hence "(1 - x) * (1 + y) = (1 - y) * (1 + x)" + using \1 + y \ 0\ \1 + x \ 0\ + by (simp add:field_simps) + thus "x = y" + by (simp add:field_simps) + qed + thus "inj_on ?g (to_complex ` of_complex ` ?A)" + using * + by simp + qed + qed + qed + thus ?thesis + using \?P ?z\ + unfolding inj_on_def + by auto + qed + ultimately + show ?thesis + by blast +qed + +lemma ex_x_axis_poincare_distance_positive: + assumes "d \ 0" + shows "\ z. is_real z \ Re z \ 0 \ Re z < 1 \ + of_complex z \ unit_disc \ of_complex z \ circline_set x_axis \ + poincare_distance 0\<^sub>h (of_complex z) = d" (is "\ z. is_real z \ Re z \ 0 \ Re z < 1 \ ?P z") +proof- + obtain z where *: "is_real z" "Re z \ 0" "Re z > -1" "?P z" + using ex_x_axis_poincare_distance_negative[OF assms] + by auto + hence **: "of_complex z \ unit_disc" "of_complex z \ circline_set x_axis" + by (auto simp add: cmod_eq_Re) + have "is_real (-z) \ Re (-z) \ 0 \ Re (-z) < 1 \ ?P (-z)" + using * ** + by (simp add: circline_set_x_axis) + thus ?thesis + by blast +qed + +lemma unique_x_axis_poincare_distance_positive: + assumes "d \ 0" + shows "\! z. is_real z \ Re z \ 0 \ Re z < 1 \ + poincare_distance 0\<^sub>h (of_complex z) = d" (is "\! z. is_real z \ Re z \ 0 \ Re z < 1 \ ?P z") +proof- + obtain z where *: "is_real z" "Re z \ 0" "Re z > -1" "?P z" + using unique_x_axis_poincare_distance_negative[OF assms] + by auto + hence **: "of_complex z \ unit_disc" "of_complex z \ circline_set x_axis" + by (auto simp add: cmod_eq_Re circline_set_x_axis) + show ?thesis + proof + show "is_real (-z) \ Re (-z) \ 0 \ Re (-z) < 1 \ ?P (-z)" + using * ** + by simp + next + fix z' + assume "is_real z' \ Re z' \ 0 \ Re z' < 1 \ ?P z'" + hence "is_real (-z') \ Re (-z') \ 0 \ Re (-z') > -1 \ ?P (-z')" + by (auto simp add: circline_set_x_axis cmod_eq_Re) + hence "-z' = z" + using unique_x_axis_poincare_distance_negative[OF assms] * + by blast + thus "z' = -z" + by auto + qed +qed + +text\Equal distance implies that segments are isometric - this means that congruence could be +defined either by two segments having the same distance or by requiring existence of an isometry +that maps one segment to the other.\ +lemma poincare_distance_eq_ex_moebius: + assumes in_disc: "u \ unit_disc" and "v \ unit_disc" and "u' \ unit_disc" and "v' \ unit_disc" + assumes "poincare_distance u v = poincare_distance u' v'" + shows "\ M. unit_disc_fix M \ moebius_pt M u = u' \ moebius_pt M v = v'" (is "?P' u v u' v'") +proof (cases "u = v") + case True + thus ?thesis + using assms poincare_distance_eq_0_iff[of u' v'] + by (simp add: unit_disc_fix_transitive) +next + case False + have "\ u' v'. u \ v \ u' \ unit_disc \ v' \ unit_disc \ poincare_distance u v = poincare_distance u' v' \ + ?P' u' v' u v" (is "?P u v") + proof (rule wlog_positive_x_axis[where P="?P"]) + fix x + assume "is_real x" "0 < Re x" "Re x < 1" + hence "of_complex x \ unit_disc" "of_complex x \ circline_set x_axis" + unfolding circline_set_x_axis + by (auto simp add: cmod_eq_Re) + + show "?P 0\<^sub>h (of_complex x)" + proof safe + fix u' v' + assume "0\<^sub>h \ of_complex x" and in_disc: "u' \ unit_disc" "v' \ unit_disc" and + "poincare_distance 0\<^sub>h (of_complex x) = poincare_distance u' v'" + hence "u' \ v'" "poincare_distance u' v' > 0" + using poincare_distance_eq_0_iff[of "0\<^sub>h" "of_complex x"] \of_complex x \ unit_disc\ + using poincare_distance_ge0[of "0\<^sub>h" "of_complex x"] + by auto + then obtain M where M: "unit_disc_fix M" "moebius_pt M u' = 0\<^sub>h" "moebius_pt M v' \ positive_x_axis" + using ex_unit_disc_fix_to_zero_positive_x_axis[of u' v'] in_disc + by auto + + then obtain Mv' where Mv': "moebius_pt M v' = of_complex Mv'" + using inf_or_of_complex[of "moebius_pt M v'"] in_disc unit_disc_fix_iff[of M] + by (metis image_eqI inf_notin_unit_disc) + + have "moebius_pt M v' \ unit_disc" + using M(1) \v' \ unit_disc\ + by auto + + have "Re Mv' > 0" "is_real Mv'" "Re Mv' < 1" + using M Mv' of_complex_inj \moebius_pt M v' \ unit_disc\ + unfolding positive_x_axis_def circline_set_x_axis + using cmod_eq_Re + by auto fastforce + + have "poincare_distance 0\<^sub>h (moebius_pt M v') = poincare_distance u' v'" + using M(1) + using in_disc + by (subst M(2)[symmetric], simp) + + have "Mv' = x" + using \poincare_distance 0\<^sub>h (moebius_pt M v') = poincare_distance u' v'\ Mv' + using \poincare_distance 0\<^sub>h (of_complex x) = poincare_distance u' v'\ + using unique_x_axis_poincare_distance_positive[of "poincare_distance u' v'"] + \poincare_distance u' v' > 0\ + using \Re Mv' > 0\ \Re Mv' < 1\ \is_real Mv'\ + using \is_real x\ \Re x > 0\ \Re x < 1\ + unfolding positive_x_axis_def + by auto + + thus "?P' u' v' 0\<^sub>h (of_complex x)" + using M Mv' + by auto + qed + next + show "u \ unit_disc" "v \ unit_disc" "u \ v" + by fact+ + next + fix M u v + let ?Mu = "moebius_pt M u" and ?Mv = "moebius_pt M v" + assume 1: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "u \ v" + hence 2: "?Mu \ ?Mv" "?Mu \ unit_disc" "?Mv \ unit_disc" + by auto + assume 3: "?P (moebius_pt M u) (moebius_pt M v)" + show "?P u v" + proof safe + fix u' v' + assume 4: "u' \ unit_disc" "v' \ unit_disc" "poincare_distance u v = poincare_distance u' v'" + hence "poincare_distance ?Mu ?Mv = poincare_distance u v" + using 1 + by simp + then obtain M' where 5: "unit_disc_fix M'" "moebius_pt M' u' = ?Mu" "moebius_pt M' v' = ?Mv" + using 2 3 4 + by auto + let ?M = "(-M) + M'" + have "unit_disc_fix ?M \ moebius_pt ?M u' = u \ moebius_pt ?M v' = v" + using 5 \unit_disc_fix M\ + using unit_disc_fix_moebius_comp[of "-M" "M'"] + using unit_disc_fix_moebius_inv[of M] + by simp + thus "\M. unit_disc_fix M \ moebius_pt M u' = u \ moebius_pt M v' = v" + by blast + qed + qed + then obtain M where "unit_disc_fix M \ moebius_pt M u' = u \ moebius_pt M v' = v" + using assms \u \ v\ + by blast + hence "unit_disc_fix (-M) \ moebius_pt (-M) u = u' \ moebius_pt (-M) v = v'" + using unit_disc_fix_moebius_inv[of M] + by auto + thus ?thesis + by blast +qed + +lemma unique_midpoint_x_axis: + assumes x: "is_real x" "-1 < Re x" "Re x < 1" and + y: "is_real y" "-1 < Re y" "Re y < 1" and + "x \ y" + shows "\! z. -1 < Re z \ Re z < 1 \ is_real z \ poincare_distance (of_complex z) (of_complex x) = poincare_distance (of_complex z) (of_complex y)" (is "\! z. ?R z (of_complex x) (of_complex y)") +proof- + let ?x = "of_complex x" and ?y = "of_complex y" + let ?P = "\ x y. \! z. ?R z x y" + have "\ x. -1 < Re x \ Re x < 1 \ is_real x \ of_complex x \ ?y \ ?P (of_complex x) ?y" (is "?Q (of_complex y)") + proof (rule wlog_real_zero) + show "?y \ unit_disc" + using y + by (simp add: cmod_eq_Re) + next + show "is_real (to_complex ?y)" + using y + by simp + next + show "?Q 0\<^sub>h" + proof (rule allI, rule impI, (erule conjE)+) + fix x + assume x: "-1 < Re x" "Re x < 1" "is_real x" + let ?x = "of_complex x" + assume "?x \ 0\<^sub>h" + hence "x \ 0" + by auto + hence "Re x \ 0" + using x + using complex_neq_0 + by auto + + have *: "\ a. -1 < a \ a < 1 \ + (poincare_distance (of_complex (cor a)) ?x = poincare_distance (of_complex (cor a)) 0\<^sub>h \ + (Re x) * a * a - 2 * a + Re x = 0)" + proof (rule allI, rule impI) + fix a :: real + assume "-1 < a \ a < 1" + hence "of_complex (cor a) \ unit_disc" + by auto + moreover + have "(a - Re x)\<^sup>2 / ((1 - a\<^sup>2) * (1 - (Re x)\<^sup>2)) = a\<^sup>2 / (1 - a\<^sup>2) \ + (Re x) * a * a - 2 * a + Re x = 0" (is "?lhs \ ?rhs") + proof- + have "1 - a\<^sup>2 \ 0" + using \-1 < a \ a < 1\ + by (metis cancel_comm_monoid_add_class.diff_cancel diff_eq_diff_less less_numeral_extra(4) power2_eq_1_iff right_minus_eq) + hence "?lhs \ (a - Re x)\<^sup>2 / (1 - (Re x)\<^sup>2) = a\<^sup>2" + by (smt divide_cancel_right divide_divide_eq_left mult.commute) + also have "... \ (a - Re x)\<^sup>2 = a\<^sup>2 * (1 - (Re x)\<^sup>2)" + proof- + have "1 - (Re x)\<^sup>2 \ 0" + using x + by (smt power2_eq_1_iff) + thus ?thesis + by (simp add: divide_eq_eq) + qed + also have "... \ a\<^sup>2 * (Re x)\<^sup>2 - 2*a*Re x + (Re x)\<^sup>2 = 0" + by (simp add: power2_diff field_simps) + also have "... \ Re x * (a\<^sup>2 * Re x - 2 * a + Re x) = 0" + by (simp add: power2_eq_square field_simps) + also have "... \ ?rhs" + using \Re x \ 0\ + by (simp add: mult.commute mult.left_commute power2_eq_square) + finally + show ?thesis + . + qed + moreover + have "arcosh (1 + 2 * ((a - Re x)\<^sup>2 / ((1 - a\<^sup>2) * (1 - (Re x)\<^sup>2)))) = arcosh (1 + 2 * a\<^sup>2 / (1 - a\<^sup>2)) \ ?lhs" + using \-1 < a \ a < 1\ x mult_left_cancel[of "2::real" "(a - Re x)\<^sup>2 / ((1 - a\<^sup>2) * (1 - (Re x)\<^sup>2))" "a\<^sup>2 / (1 - a\<^sup>2)"] + by (subst arcosh_eq_iff, simp_all add: square_le_1) + ultimately + show "poincare_distance (of_complex (cor a)) (of_complex x) = poincare_distance (of_complex (cor a)) 0\<^sub>h \ + (Re x) * a * a - 2 * a + Re x = 0" + using x + by (auto simp add: poincare_distance_formula cmod_eq_Re) + qed + + show "?P ?x 0\<^sub>h" + proof + let ?a = "(1 - sqrt(1 - (Re x)\<^sup>2)) / (Re x)" + let ?b = "(1 + sqrt(1 - (Re x)\<^sup>2)) / (Re x)" + + have "is_real ?a" + by simp + moreover + have "1 - (Re x)\<^sup>2 > 0" + using x + by (smt power2_eq_1_iff square_le_1) + have "\?a\ < 1" + proof (cases "Re x > 0") + case True + have "(1 - Re x)\<^sup>2 < 1 - (Re x)\<^sup>2" + using \Re x > 0\ x + by (simp add: power2_eq_square field_simps) + hence "1 - Re x < sqrt (1 - (Re x)\<^sup>2)" + using real_less_rsqrt by fastforce + thus ?thesis + using \1 - (Re x)\<^sup>2 > 0\ \Re x > 0\ + by simp + next + case False + hence "Re x < 0" + using \Re x \ 0\ + by simp + + have "1 + Re x > 0" + using \Re x > -1\ + by simp + hence "2*Re x + 2*Re x*Re x < 0" + using \Re x < 0\ + by (metis comm_semiring_class.distrib mult.commute mult_2_right mult_less_0_iff one_add_one zero_less_double_add_iff_zero_less_single_add) + hence "(1 + Re x)\<^sup>2 < 1 - (Re x)\<^sup>2" + by (simp add: power2_eq_square field_simps) + hence "1 + Re x < sqrt (1 - (Re x)\<^sup>2)" + using \1 - (Re x)\<^sup>2 > 0\ + using real_less_rsqrt by blast + thus ?thesis + using \Re x < 0\ + by (simp add: field_simps) + qed + hence "-1 < ?a" "?a < 1" + by linarith+ + moreover + have "(Re x) * ?a * ?a - 2 * ?a + Re x = 0" + using \Re x \ 0\ \1 - (Re x)\<^sup>2 > 0\ + by (simp add: field_simps power2_eq_square) + ultimately + show "-1 < Re (cor ?a) \ Re (cor ?a) < 1 \ is_real ?a \ poincare_distance (of_complex ?a) (of_complex x) = poincare_distance (of_complex ?a) 0\<^sub>h" + using * + by auto + + fix z + assume **: "- 1 < Re z \ Re z < 1 \ is_real z \ + poincare_distance (of_complex z) (of_complex x) = poincare_distance (of_complex z) 0\<^sub>h" + hence "Re x * Re z * Re z - 2 * Re z + Re x = 0" + using *[rule_format, of "Re z"] x + by auto + moreover + have "sqrt (4 - 4 * Re x * Re x) = 2 * sqrt(1 - Re x * Re x)" + proof- + have "sqrt (4 - 4 * Re x * Re x) = sqrt(4 * (1 - Re x * Re x))" + by simp + thus ?thesis + by (simp only: real_sqrt_mult, simp) + qed + moreover + have "(2 - 2 * sqrt (1 - Re x * Re x)) / (2 * Re x) = ?a" + proof- + have "(2 - 2 * sqrt (1 - Re x * Re x)) / (2 * Re x) = + (2 * (1 - sqrt (1 - Re x * Re x))) / (2 * Re x)" + by simp + thus ?thesis + by (subst (asm) mult_divide_mult_cancel_left) (auto simp add: power2_eq_square) + qed + moreover + have "(2 + 2 * sqrt (1 - Re x * Re x)) / (2 * Re x) = ?b" + proof- + have "(2 + 2 * sqrt (1 - Re x * Re x)) / (2 * Re x) = + (2 * (1 + sqrt (1 - Re x * Re x))) / (2 * Re x)" + by simp + thus ?thesis + by (subst (asm) mult_divide_mult_cancel_left) (auto simp add: power2_eq_square) + qed + ultimately + have "Re z = ?a \ Re z = ?b" + using discriminant_nonneg[of "Re x" "-2" "Re x" "Re z"] discrim_def[of "Re x" "-2" "Re x"] + using \Re x \ 0\ \-1 < Re x\ \Re x < 1\ \1 - (Re x)\<^sup>2 > 0\ + by (auto simp add:power2_eq_square) + have "\?b\ > 1" + proof (cases "Re x > 0") + case True + have "(Re x - 1)\<^sup>2 < 1 - (Re x)\<^sup>2" + using \Re x > 0\ x + by (simp add: power2_eq_square field_simps) + hence "Re x - 1 < sqrt (1 - (Re x)\<^sup>2)" + using real_less_rsqrt + by simp + thus ?thesis + using \1 - (Re x)\<^sup>2 > 0\ \Re x > 0\ + by simp + next + case False + hence "Re x < 0" + using \Re x \ 0\ + by simp + have "1 + Re x > 0" + using \Re x > -1\ + by simp + hence "2*Re x + 2*Re x*Re x < 0" + using \Re x < 0\ + by (metis comm_semiring_class.distrib mult.commute mult_2_right mult_less_0_iff one_add_one zero_less_double_add_iff_zero_less_single_add) + hence "1 - (Re x)\<^sup>2 > (- 1 - (Re x))\<^sup>2" + by (simp add: field_simps power2_eq_square) + hence "sqrt (1 - (Re x)\<^sup>2) > -1 - Re x" + using real_less_rsqrt + by simp + thus ?thesis + using \Re x < 0\ + by (simp add: field_simps) + qed + hence "?b < -1 \ ?b > 1" + by auto + + hence "Re z = ?a" + using \Re z = ?a \ Re z = ?b\ ** + by auto + thus "z = ?a" + using ** complex_of_real_Re + by fastforce + qed + qed + next + fix a u + let ?M = "moebius_pt (blaschke a)" + let ?Mu = "?M u" + assume "u \ unit_disc" "is_real a" "cmod a < 1" + assume *: "?Q ?Mu" + show "?Q u" + proof (rule allI, rule impI, (erule conjE)+) + fix x + assume x: "-1 < Re x" "Re x < 1" "is_real x" "of_complex x \ u" + let ?Mx = "?M (of_complex x)" + have "of_complex x \ unit_disc" + using x cmod_eq_Re + by auto + hence "?Mx \ unit_disc" + using \is_real a\ \cmod a < 1\ blaschke_unit_disc_fix[of a] + using unit_disc_fix_discI + by blast + hence "?Mx \ \\<^sub>h" + by auto + moreover + have "of_complex x \ circline_set x_axis" + using x + by auto + hence "?Mx \ circline_set x_axis" + using blaschke_real_preserve_x_axis[OF \is_real a\ \cmod a < 1\, of "of_complex x"] + by auto + hence "-1 < Re (to_complex ?Mx) \ Re (to_complex ?Mx) < 1 \ is_real (to_complex ?Mx)" + using \?Mx \ \\<^sub>h\ \?Mx \ unit_disc\ + unfolding circline_set_x_axis + by (auto simp add: cmod_eq_Re) + moreover + have "?Mx \ ?Mu" + using \of_complex x \ u\ + by simp + ultimately + have "?P ?Mx ?Mu" + using *[rule_format, of "to_complex ?Mx"] \?Mx \ \\<^sub>h\ + by simp + then obtain Mz where + "?R Mz ?Mx ?Mu" + by blast + have "of_complex Mz \ unit_disc" "of_complex Mz \ circline_set x_axis" + using \?R Mz ?Mx ?Mu\ + using cmod_eq_Re + by auto + + let ?Minv = "- (blaschke a)" + let ?z = "moebius_pt ?Minv (of_complex Mz)" + have "?z \ unit_disc" + using \of_complex Mz \ unit_disc\ \cmod a < 1\ + by auto + moreover + have "?z \ circline_set x_axis" + using \of_complex Mz \ circline_set x_axis\ + using blaschke_real_preserve_x_axis \is_real a\ \cmod a < 1\ + by fastforce + ultimately + have z1: "-1 < Re (to_complex ?z)" "Re (to_complex ?z) < 1" "is_real (to_complex ?z)" + using inf_or_of_complex[of "?z"] + unfolding circline_set_x_axis + by (auto simp add: cmod_eq_Re) + + have z2: "poincare_distance ?z (of_complex x) = poincare_distance ?z u" + using \?R Mz ?Mx ?Mu\ \cmod a < 1\ \?z \ unit_disc\ \of_complex x \ unit_disc\ \u \ unit_disc\ + by (metis blaschke_preserve_distance_formula blaschke_unit_disc_fix moebius_pt_comp_inv_right poincare_distance_formula uminus_moebius_def unit_disc_fix_discI unit_disc_iff_cmod_lt_1) + show "?P (of_complex x) u" + proof + show "?R (to_complex ?z) (of_complex x) u" + using z1 z2 \?z \ unit_disc\ inf_or_of_complex[of ?z] + by auto + next + fix z' + assume "?R z' (of_complex x) u" + hence "of_complex z' \ unit_disc" "of_complex z' \ circline_set x_axis" + by (auto simp add: cmod_eq_Re) + let ?Mz' = "?M (of_complex z')" + have "?Mz' \ unit_disc" "?Mz' \ circline_set x_axis" + using \of_complex z' \ unit_disc\ \of_complex z' \ circline_set x_axis\ \cmod a < 1\ \is_real a\ + using blaschke_unit_disc_fix unit_disc_fix_discI + using blaschke_real_preserve_x_axis circline_set_x_axis + by blast+ + hence "-1 < Re (to_complex ?Mz')" "Re (to_complex ?Mz') < 1" "is_real (to_complex ?Mz')" + unfolding circline_set_x_axis + by (auto simp add: cmod_eq_Re) + moreover + have "poincare_distance ?Mz' ?Mx = poincare_distance ?Mz' ?Mu" + using \?R z' (of_complex x) u\ + using \cmod a < 1\ \of_complex x \ unit_disc\ \of_complex z' \ unit_disc\ \u \ unit_disc\ + by auto + ultimately + have "?R (to_complex ?Mz') ?Mx ?Mu" + using \?Mz' \ unit_disc\ inf_or_of_complex[of ?Mz'] + by auto + hence "?Mz' = of_complex Mz" + using \?P ?Mx ?Mu\ \?R Mz ?Mx ?Mu\ + by (metis \moebius_pt (blaschke a) (of_complex z') \ unit_disc\ \of_complex Mz \ unit_disc\ to_complex_of_complex unit_disc_to_complex_inj) + thus "z' = to_complex ?z" + using moebius_pt_invert by auto + qed + qed + qed + thus ?thesis + using assms + by (metis to_complex_of_complex) +qed + +(* ------------------------------------------------------------------ *) +subsection\Triangle inequality\ +(* ------------------------------------------------------------------ *) + +lemma poincare_distance_formula_zero_sum: + assumes "u \ unit_disc" and "v \ unit_disc" + shows "poincare_distance u 0\<^sub>h + poincare_distance 0\<^sub>h v = + (let u' = cmod (to_complex u); v' = cmod (to_complex v) + in arcosh (((1 + u'\<^sup>2) * (1 + v'\<^sup>2) + 4 * u' * v') / ((1 - u'\<^sup>2) * (1 - v'\<^sup>2))))" +proof- + obtain u' v' where uv: "u' = to_complex u" "v' = to_complex v" + by auto + have uv': "u = of_complex u'" "v = of_complex v'" + using uv assms inf_or_of_complex[of u] inf_or_of_complex[of v] + by auto + + let ?u' = "cmod u'" and ?v' = "cmod v'" + + have disc: "?u'\<^sup>2 < 1" "?v'\<^sup>2 < 1" + using unit_disc_cmod_square_lt_1[OF \u \ unit_disc\] + using unit_disc_cmod_square_lt_1[OF \v \ unit_disc\] uv + by auto + thm arcosh_add + have "arcosh (1 + 2 * ?u'\<^sup>2 / (1 - ?u'\<^sup>2)) + arcosh (1 + 2 * ?v'\<^sup>2 / (1 - ?v'\<^sup>2)) = + arcosh (((1 + ?u'\<^sup>2) * (1 + ?v'\<^sup>2) + 4 * ?u' * ?v') / ((1 - ?u'\<^sup>2) * (1 - ?v'\<^sup>2)))" (is "arcosh ?ll + arcosh ?rr = arcosh ?r") + proof (subst arcosh_add) + show "?ll \ 1" "?rr \ 1" + using disc + by auto + next + show "arcosh ((1 + 2 * ?u'\<^sup>2 / (1 - ?u'\<^sup>2)) * (1 + 2 * ?v'\<^sup>2 / (1 - ?v'\<^sup>2)) + + sqrt (((1 + 2 * ?u'\<^sup>2 / (1 - ?u'\<^sup>2))\<^sup>2 - 1) * ((1 + 2 * ?v'\<^sup>2 / (1 - ?v'\<^sup>2))\<^sup>2 - 1))) = + arcosh ?r" (is "arcosh ?l = _") + proof- + have "1 + 2 * ?u'\<^sup>2 / (1 - ?u'\<^sup>2) = (1 + ?u'\<^sup>2) / (1 - ?u'\<^sup>2)" + using disc + by (subst add_divide_eq_iff, simp_all) + moreover + have "1 + 2 * ?v'\<^sup>2 / (1 - ?v'\<^sup>2) = (1 + ?v'\<^sup>2) / (1 - ?v'\<^sup>2)" + using disc + by (subst add_divide_eq_iff, simp_all) + moreover + have "sqrt (((1 + 2 * ?u'\<^sup>2 / (1 - ?u'\<^sup>2))\<^sup>2 - 1) * ((1 + 2 * ?v'\<^sup>2 / (1 - ?v'\<^sup>2))\<^sup>2 - 1)) = + (4 * ?u' * ?v') / ((1 - ?u'\<^sup>2) * (1 - ?v'\<^sup>2))" (is "sqrt ?s = ?t") + proof- + have "?s = ?t\<^sup>2" + using disc + apply (subst add_divide_eq_iff, simp)+ + apply (subst power_divide)+ + apply simp + apply (subst divide_diff_eq_iff, simp)+ + apply (simp add: power2_eq_square field_simps) + done + thus ?thesis + using disc + by simp + qed + ultimately + have "?l = ?r" + using disc + by simp (subst add_divide_distrib, simp) + thus ?thesis + by simp + qed + qed + thus ?thesis + using uv' assms + using poincare_distance_formula + by (simp add: Let_def) +qed + +lemma poincare_distance_triangle_inequality: + assumes "u \ unit_disc" and "v \ unit_disc" and "w \ unit_disc" + shows "poincare_distance u v + poincare_distance v w \ poincare_distance u w" (is "?P' u v w") +proof- + have "\ w. w \ unit_disc \ ?P' u v w" (is "?P v u") + proof (rule wlog_x_axis[where P="?P"]) + fix x + assume "is_real x" "0 \ Re x" "Re x < 1" + hence "of_complex x \ unit_disc" + by (simp add: cmod_eq_Re) + + show "?P 0\<^sub>h (of_complex x)" + proof safe + fix w + assume "w \ unit_disc" + then obtain w' where w: "w = of_complex w'" + using inf_or_of_complex[of w] + by auto + + let ?x = "cmod x" and ?w = "cmod w'" and ?xw = "cmod (x - w')" + + have disc: "?x\<^sup>2 < 1" "?w\<^sup>2 < 1" + using unit_disc_cmod_square_lt_1[OF \of_complex x \ unit_disc\] + using unit_disc_cmod_square_lt_1[OF \w \ unit_disc\] w + by auto + + have "poincare_distance (of_complex x) 0\<^sub>h + poincare_distance 0\<^sub>h w = + arcosh (((1 + ?x\<^sup>2) * (1 + ?w\<^sup>2) + 4 * ?x * ?w) / ((1 - ?x\<^sup>2) * (1 - ?w\<^sup>2)))" (is "_ = arcosh ?r1") + using poincare_distance_formula_zero_sum[OF \of_complex x \ unit_disc\ \w \ unit_disc\] w + by (simp add: Let_def) + moreover + have "poincare_distance (of_complex x) (of_complex w') = + arcosh (((1 - ?x\<^sup>2) * (1 - ?w\<^sup>2) + 2 * ?xw\<^sup>2) / ((1 - ?x\<^sup>2) * (1 - ?w\<^sup>2)))" (is "_ = arcosh ?r2") + using disc + using poincare_distance_formula[OF \of_complex x \ unit_disc\ \w \ unit_disc\] w + by (subst add_divide_distrib) simp + moreover + have *: "(1 - ?x\<^sup>2) * (1 - ?w\<^sup>2) + 2 * ?xw\<^sup>2 \ (1 + ?x\<^sup>2) * (1 + ?w\<^sup>2) + 4 * ?x * ?w" + proof- + have "(cmod (x - w'))\<^sup>2 \ (cmod x + cmod w')\<^sup>2" + using norm_triangle_ineq4[of x w'] + by (simp add: power_mono) + thus ?thesis + by (simp add: field_simps power2_sum) + qed + have "arcosh ?r1 \ arcosh ?r2" + proof (subst arcosh_mono) + show "?r1 \ 1" + using disc + by (smt "*" le_divide_eq_1_pos mult_pos_pos zero_le_power2) + next + show "?r2 \ 1" + using disc + by simp + next + show "?r1 \ ?r2" + using disc + using * + by (subst divide_right_mono, simp_all) + qed + ultimately + show "poincare_distance (of_complex x) w \ poincare_distance (of_complex x) 0\<^sub>h + poincare_distance 0\<^sub>h w" + using \of_complex x \ unit_disc\ \w \ unit_disc\ w + using poincare_distance_formula + by simp + qed + next + show "v \ unit_disc" "u \ unit_disc" + by fact+ + next + fix M u v + assume *: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" + assume **: "?P (moebius_pt M u) (moebius_pt M v)" + show "?P u v" + proof safe + fix w + assume "w \ unit_disc" + thus "?P' v u w" + using * **[rule_format, of "moebius_pt M w"] + by simp + qed + qed + thus ?thesis + using assms + by auto +qed + +end \ No newline at end of file diff --git a/thys/Poincare_Disc/Poincare_Lines.thy b/thys/Poincare_Disc/Poincare_Lines.thy new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/Poincare_Lines.thy @@ -0,0 +1,1878 @@ +(* ------------------------------------------------------------------ *) +section \H-lines in the Poincar\'e model\ +(* ------------------------------------------------------------------ *) + +theory Poincare_Lines + imports Complex_Geometry.Unit_Circle_Preserving_Moebius Complex_Geometry.Circlines_Angle +begin + + +(* ------------------------------------------------------------------ *) +subsection \Definition and basic properties of h-lines\ +(* ------------------------------------------------------------------ *) + +text \H-lines in the Poincar\'e model are either line segments passing trough the origin or +segments (within the unit disc) of circles that are perpendicular to the unit circle. Algebraically +these are circlines that are represented by Hermitean matrices of +the form +$$H = \left( + \begin{array}{cc} + A & B\\ + \overline{B} & A + \end{array} +\right),$$ +for $A \in \mathbb{R}$, and $B \in \mathbb{C}$, and $|B|^2 > A^2$, +where the circline equation is the usual one: $z^*Hz = 0$, for homogenous coordinates $z$.\ + +definition is_poincare_line_cmat :: "complex_mat \ bool" where + [simp]: "is_poincare_line_cmat H \ + (let (A, B, C, D) = H + in hermitean (A, B, C, D) \ A = D \ (cmod B)\<^sup>2 > (cmod A)\<^sup>2)" + +lift_definition is_poincare_line_clmat :: "circline_mat \ bool" is is_poincare_line_cmat + done + +text \We introduce the predicate that checks if a given complex matrix is a matrix of a h-line in +the Poincar\'e model, and then by means of the lifting package lift it to the type of non-zero +Hermitean matrices, and then to circlines (that are equivalence classes of such matrices).\ + +lift_definition is_poincare_line :: "circline \ bool" is is_poincare_line_clmat +proof (transfer, transfer) + fix H1 H2 :: complex_mat + assume hh: "hermitean H1 \ H1 \ mat_zero" "hermitean H2 \ H2 \ mat_zero" + assume "circline_eq_cmat H1 H2" + thus "is_poincare_line_cmat H1 \ is_poincare_line_cmat H2" + using hh + by (cases H1, cases H2) (auto simp add: power_mult_distrib) +qed + +lemma is_poincare_line_mk_circline: + assumes "(A, B, C, D) \ hermitean_nonzero" + shows "is_poincare_line (mk_circline A B C D) \ (cmod B)\<^sup>2 > (cmod A)\<^sup>2 \ A = D" + using assms + by (transfer, transfer, auto simp add: Let_def) + + +text\Abstract characterisation of @{term is_poincare_line} predicate: H-lines in the Poincar\'e +model are real circlines (circlines with the negative determinant) perpendicular to the unit +circle.\ + +lemma is_poincare_line_iff: + shows "is_poincare_line H \ circline_type H = -1 \ perpendicular H unit_circle" + unfolding perpendicular_def +proof (simp, transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where *: "H = (A, B, C, D)" + by (cases H, auto) + have **: "is_real A" "is_real D" "C = cnj B" + using hh * hermitean_elems + by auto + hence "(Re A = Re D \ cmod A * cmod A < cmod B * cmod B) = + (Re A * Re D < Re B * Re B + Im B * Im B \ (Re D = Re A \ Re A * Re D = Re B * Re B + Im B * Im B))" + using * + by (smt cmod_power2 power2_eq_square zero_power2)+ + thus "is_poincare_line_cmat H \ + circline_type_cmat H = - 1 \ cos_angle_cmat (of_circline_cmat H) unit_circle_cmat = 0" + using * ** + by (auto simp add: sgn_1_neg complex_eq_if_Re_eq cmod_square power2_eq_square simp del: pos_oriented_cmat_def) +qed + +text\The @{term x_axis} is an h-line.\ +lemma is_poincare_line_x_axis [simp]: + shows "is_poincare_line x_axis" + by (transfer, transfer) (auto simp add: hermitean_def mat_adj_def mat_cnj_def) + +text\The @{term unit_circle} is not an h-line.\ +lemma not_is_poincare_line_unit_circle [simp]: + shows "\ is_poincare_line unit_circle" + by (transfer, transfer, simp) + +(* ------------------------------------------------------------------ *) +subsubsection \Collinear points\ +(* ------------------------------------------------------------------ *) + +text\Points are collinear if they all belong to an h-line. \ +definition poincare_collinear :: "complex_homo set \ bool" where + "poincare_collinear S \ (\ p. is_poincare_line p \ S \ circline_set p)" + +(* ------------------------------------------------------------------ *) +subsubsection \H-lines and inversion\ +(* ------------------------------------------------------------------ *) + +text\Every h-line in the Poincar\'e model contains the inverse (wrt.~the unit circle) of each of its +points (note that at most one of them belongs to the unit disc).\ +lemma is_poincare_line_inverse_point: + assumes "is_poincare_line H" "u \ circline_set H" + shows "inversion u \ circline_set H" + using assms + unfolding is_poincare_line_iff circline_set_def perpendicular_def inversion_def + apply simp +proof (transfer, transfer) + fix u H + assume hh: "hermitean H \ H \ mat_zero" "u \ vec_zero" and + aa: "circline_type_cmat H = - 1 \ cos_angle_cmat (of_circline_cmat H) unit_circle_cmat = 0" "on_circline_cmat_cvec H u" + obtain A B C D u1 u2 where *: "H = (A, B, C, D)" "u = (u1, u2)" + by (cases H, cases u, auto) + have "is_real A" "is_real D" "C = cnj B" + using * hh hermitean_elems + by auto + moreover + have "A = D" + using aa(1) * \is_real A\ \is_real D\ + by (auto simp del: pos_oriented_cmat_def simp add: complex.expand split: if_split_asm) + thus "on_circline_cmat_cvec H (conjugate_cvec (reciprocal_cvec u))" + using aa(2) * + by (simp add: vec_cnj_def field_simps) +qed + +text\Every h-line in the Poincar\'e model and is invariant under unit circle inversion.\ + +lemma circline_inversion_poincare_line: + assumes "is_poincare_line H" + shows "circline_inversion H = H" +proof- + obtain u v w where *: "u \ v" "v \ w" "u \ w" "{u, v, w} \ circline_set H" + using assms is_poincare_line_iff[of H] + using circline_type_neg_card_gt3[of H] + by auto + hence "{inversion u, inversion v, inversion w} \ circline_set (circline_inversion H)" + "{inversion u, inversion v, inversion w} \ circline_set H" + using is_poincare_line_inverse_point[OF assms] + by auto + thus ?thesis + using * unique_circline_set[of "inversion u" "inversion v" "inversion w"] + by (metis insert_subset inversion_involution) +qed + +(* ------------------------------------------------------------------ *) +subsubsection \Classification of h-lines into Euclidean segments and circles\ +(* ------------------------------------------------------------------ *) + +text\If an h-line contains zero, than it also contains infinity (the inverse point of zero) and is by +definition an Euclidean line.\ +lemma is_poincare_line_trough_zero_trough_infty [simp]: + assumes "is_poincare_line l" and "0\<^sub>h \ circline_set l" + shows "\\<^sub>h \ circline_set l" + using is_poincare_line_inverse_point[OF assms] + by simp + +lemma is_poincare_line_trough_zero_is_line: + assumes "is_poincare_line l" and "0\<^sub>h \ circline_set l" + shows "is_line l" + using assms + using inf_in_circline_set is_poincare_line_trough_zero_trough_infty + by blast + +text\If an h-line does not contain zero, than it also does not contain infinity (the inverse point of +zero) and is by definition an Euclidean circle.\ +lemma is_poincare_line_not_trough_zero_not_trough_infty [simp]: + assumes "is_poincare_line l" + assumes "0\<^sub>h \ circline_set l" + shows "\\<^sub>h \ circline_set l" + using assms + using is_poincare_line_inverse_point[OF assms(1), of "\\<^sub>h"] + by auto + +lemma is_poincare_line_not_trough_zero_is_circle: + assumes "is_poincare_line l" "0\<^sub>h \ circline_set l" + shows "is_circle l" + using assms + using inf_in_circline_set is_poincare_line_not_trough_zero_not_trough_infty + by auto + +(* ------------------------------------------------------------------ *) +subsubsection\Points on h-line\ +(* ------------------------------------------------------------------ *) + +text\Each h-line in the Poincar\'e model contains at least two different points within the unit +disc.\ + +text\First we prove an auxiliary lemma.\ +lemma ex_is_poincare_line_points': + assumes i12: "i1 \ circline_set H \ unit_circle_set" + "i2 \ circline_set H \ unit_circle_set" + "i1 \ i2" + assumes a: "a \ circline_set H" "a \ unit_circle_set" + shows "\ b. b \ i1 \ b \ i2 \ b \ a \ b \ inversion a \ b \ circline_set H" +proof- + have "inversion a \ unit_circle_set" + using \a \ unit_circle_set\ + unfolding unit_circle_set_def circline_set_def + by (metis inversion_id_iff_on_unit_circle inversion_involution mem_Collect_eq) + + have "a \ inversion a" + using \a \ unit_circle_set\ inversion_id_iff_on_unit_circle[of a] + unfolding unit_circle_set_def circline_set_def + by auto + + have "a \ i1" "a \ i2" "inversion a \ i1" "inversion a \ i2" + using assms \inversion a \ unit_circle_set\ + by auto + + then obtain b where cr2: "cross_ratio b i1 a i2 = of_complex 2" + using \i1 \ i2\ + using ex_cross_ratio[of i1 a i2] + by blast + + have distinct_b: "b \ i1" "b \ i2" "b \ a" + using \i1 \ i2\ \a \ i1\ \a \ i2\ + using ex1_cross_ratio[of i1 a i2] + using cross_ratio_0[of i1 a i2] cross_ratio_1[of i1 a i2] cross_ratio_inf[of i1 i2 a] + using cr2 + by auto + + hence "b \ circline_set H" + using assms four_points_on_circline_iff_cross_ratio_real[of b i1 a i2] cr2 + using unique_circline_set[of i1 i2 a] + by auto + + moreover + + have "b \ inversion a" + proof (rule ccontr) + assume *: "\ ?thesis" + have "inversion i1 = i1" "inversion i2 = i2" + using i12 + unfolding unit_circle_set_def + by auto + hence "cross_ratio (inversion a) i1 a i2 = cross_ratio a i1 (inversion a) i2" + using * cross_ratio_inversion[of i1 a i2 b] \a \ i1\ \a \ i2\ \i1 \ i2\ \b \ i1\ + using four_points_on_circline_iff_cross_ratio_real[of b i1 a i2] + using i12 distinct_b conjugate_id_iff[of "cross_ratio b i1 a i2"] + using i12 a \b \ circline_set H\ + by auto + hence "cross_ratio (inversion a) i1 a i2 \ of_complex 2" + using cross_ratio_commute_13[of "inversion a" i1 a i2] + using reciprocal_id_iff + using of_complex_inj + by force + thus False + using * cr2 + by simp + qed + + ultimately + show ?thesis + using assms \b \ i1\ \b \ i2\ \b \ a\ + by auto +qed + +text\Now we can prove the statement.\ +lemma ex_is_poincare_line_points: + assumes "is_poincare_line H" + shows "\ u v. u \ unit_disc \ v \ unit_disc \ u \ v \ {u, v} \ circline_set H" +proof- + obtain u v w where *: "u \ v" "v \ w" "u \ w" "{u, v, w} \ circline_set H" + using assms is_poincare_line_iff[of H] + using circline_type_neg_card_gt3[of H] + by auto + + have "\ {u, v, w} \ unit_circle_set" + using unique_circline_set[of u v w] * + by (metis assms insert_subset not_is_poincare_line_unit_circle unit_circle_set_def) + + hence "H \ unit_circle" + unfolding unit_circle_set_def + using * + by auto + + show ?thesis + proof (cases "(u \ unit_disc \ v \ unit_disc) \ + (u \ unit_disc \ w \ unit_disc) \ + (v \ unit_disc \ w \ unit_disc)") + case True + thus ?thesis + using * + by auto + next + case False + + have "\ a b. a \ b \ a \ inversion b \ a \ circline_set H \ b \ circline_set H \ a \ unit_circle_set \ b \ unit_circle_set" + proof (cases "(u \ unit_circle_set \ v \ unit_circle_set) \ + (u \ unit_circle_set \ w \ unit_circle_set) \ + (v \ unit_circle_set \ w \ unit_circle_set)") + case True + then obtain i1 i2 a where *: + "i1 \ unit_circle_set \ circline_set H" "i2 \ unit_circle_set \ circline_set H" + "a \ circline_set H" "a \ unit_circle_set" + "i1 \ i2" "i1 \ a" "i2 \ a" + using * \\ {u, v, w} \ unit_circle_set\ + by auto + then obtain b where "b \ circline_set H" "b \ i1" "b \ i2" "b \ a" "b \ inversion a" + using ex_is_poincare_line_points'[of i1 H i2 a] + by blast + + hence "b \ unit_circle_set" + using * \H \ unit_circle\ unique_circline_set[of i1 i2 b] + unfolding unit_circle_set_def + by auto + + thus ?thesis + using * \b \ circline_set H\ \b \ a\ \b \ inversion a\ + by auto + next + case False + then obtain f g h where + *: "f \ g" "f \ circline_set H" "f \ unit_circle_set" + "g \ circline_set H" "g \ unit_circle_set" + "h \ circline_set H" "h \ f" "h \ g" + using * + by auto + show ?thesis + proof (cases "f = inversion g") + case False + thus ?thesis + using * + by auto + next + case True + show ?thesis + proof (cases "h \ unit_circle_set") + case False + thus ?thesis + using * \f = inversion g\ + by auto + next + case True + obtain m where cr2: "cross_ratio m h f g = of_complex 2" + using ex_cross_ratio[of h f g] * \f \ g\ \h \ f\ \h \ g\ + by auto + hence "m \ h" "m \ f" "m \ g" + using \h \ f\ \h \ g\ \f \ g\ + using ex1_cross_ratio[of h f g] + using cross_ratio_0[of h f g] cross_ratio_1[of h f g] cross_ratio_inf[of h g f] + using cr2 + by auto + hence "m \ circline_set H" + using four_points_on_circline_iff_cross_ratio_real[of m h f g] cr2 + using \h \ f\ \h \ g\ \f \ g\ * + using unique_circline_set[of h f g] + by auto + + show ?thesis + proof (cases "m \ unit_circle_set") + case False + thus ?thesis + using \m \ f\ \m \ g\ \f = inversion g\ * \m \ circline_set H\ + by auto + next + case True + then obtain n where "n \ h" "n \ m" "n \ f" "n \ inversion f" "n \ circline_set H" + using ex_is_poincare_line_points'[of h H m f] * \m \ circline_set H\ \h \ unit_circle_set\ \m \ h\ + by auto + hence "n \ unit_circle_set" + using * \H \ unit_circle\ unique_circline_set[of m n h] + using \m \ h\ \m \ unit_circle_set\ \h \ unit_circle_set\ \m \ circline_set H\ + unfolding unit_circle_set_def + by auto + + thus ?thesis + using * \n \ circline_set H\ \n \ f\ \n \ inversion f\ + by auto + qed + qed + qed + qed + then obtain a b where ab: "a \ b" "a \ inversion b" "a \ circline_set H" "b \ circline_set H" "a \ unit_circle_set" "b \ unit_circle_set" + by blast + have "\ x. x \ circline_set H \ x \ unit_circle_set \ (\ x'. x' \ circline_set H \ unit_disc \ (x' = x \ x' = inversion x))" + proof safe + fix x + assume x: "x \ circline_set H" "x \ unit_circle_set" + show "\ x'. x' \ circline_set H \ unit_disc \ (x' = x \ x' = inversion x)" + proof (cases "x \ unit_disc") + case True + thus ?thesis + using x + by auto + next + case False + hence "x \ unit_disc_compl" + using x in_on_out_univ[of "ounit_circle"] + unfolding unit_circle_set_def unit_disc_def unit_disc_compl_def + by auto + hence "inversion x \ unit_disc" + using inversion_unit_disc_compl + by blast + thus ?thesis + using is_poincare_line_inverse_point[OF assms, of x] x + by auto + qed + qed + then obtain a' b' where + *: "a' \ circline_set H" "a' \ unit_disc" "b' \ circline_set H" "b' \ unit_disc" and + **: "a' = a \ a' = inversion a" "b' = b \ b' = inversion b" + using ab + by blast + have "a' \ b'" + using \a \ b\ \a \ inversion b\ ** * + by (metis inversion_involution) + thus ?thesis + using * + by auto + qed +qed + +(* ------------------------------------------------------------------ *) +subsubsection \H-line uniqueness\ +(* ------------------------------------------------------------------ *) + +text\There is no more than one h-line that contains two different h-points (in the disc).\ +lemma unique_is_poincare_line: + assumes in_disc: "u \ unit_disc" "v \ unit_disc" "u \ v" + assumes pl: "is_poincare_line l1" "is_poincare_line l2" + assumes on_l: "{u, v} \ circline_set l1 \ circline_set l2" + shows "l1 = l2" +proof- + have "u \ inversion u" "v \ inversion u" + using in_disc + using inversion_noteq_unit_disc[of u v] + using inversion_noteq_unit_disc[of u u] + by auto + thus ?thesis + using on_l + using unique_circline_set[of u "inversion u" "v"] \u \ v\ + using is_poincare_line_inverse_point[of l1 u] + using is_poincare_line_inverse_point[of l2 u] + using pl + by auto +qed + +text\For the rest of our formalization it is often useful to consider points on h-lines that are not +within the unit disc. Many lemmas in the rest of this section will have such generalizations.\ + +text\There is no more than one h-line that contains two different and not mutually inverse points +(not necessary in the unit disc).\ +lemma unique_is_poincare_line_general: + assumes different: "u \ v" "u \ inversion v" + assumes pl: "is_poincare_line l1" "is_poincare_line l2" + assumes on_l: "{u, v} \ circline_set l1 \ circline_set l2" + shows "l1 = l2" +proof (cases "u \ inversion u") + case True + thus ?thesis + using unique_circline_set[of u "inversion u" "v"] + using assms + using is_poincare_line_inverse_point by force +next + case False + show ?thesis + proof (cases "v \ inversion v") + case True + thus ?thesis + using unique_circline_set[of u "inversion v" "v"] + using assms + using is_poincare_line_inverse_point by force + next + case False + + have "on_circline unit_circle u" "on_circline unit_circle v" + using `\ u \ inversion u` `\ v \ inversion v` + using inversion_id_iff_on_unit_circle + by fastforce+ + thus ?thesis + using pl on_l `u \ v` + unfolding circline_set_def + apply simp + proof (transfer, transfer, safe) + fix u1 u2 v1 v2 A1 B1 C1 D1 A2 B2 C2 D2 :: complex + let ?u = "(u1, u2)" and ?v = "(v1, v2)" and ?H1 = "(A1, B1, C1, D1)" and ?H2 = "(A2, B2, C2, D2)" + assume *: "?u \ vec_zero" "?v \ vec_zero" + "on_circline_cmat_cvec unit_circle_cmat ?u" "on_circline_cmat_cvec unit_circle_cmat ?v" + "is_poincare_line_cmat ?H1" "is_poincare_line_cmat ?H2" + "hermitean ?H1" "?H1 \ mat_zero" "hermitean ?H2" "?H2 \ mat_zero" + "on_circline_cmat_cvec ?H1 ?u" "on_circline_cmat_cvec ?H1 ?v" + "on_circline_cmat_cvec ?H2 ?u" "on_circline_cmat_cvec ?H2 ?v" + "\ (u1, u2) \\<^sub>v (v1, v2)" + have **: "A1 = D1" "A2 = D2" "C1 = cnj B1" "C2 = cnj B2" "is_real A1" "is_real A2" + using `is_poincare_line_cmat ?H1` `is_poincare_line_cmat ?H2` + using `hermitean ?H1` `?H1 \ mat_zero` `hermitean ?H2` `?H2 \ mat_zero` + using hermitean_elems + by auto + + have uv: "u1 \ 0" "u2 \ 0" "v1 \ 0" "v2 \ 0" + using *(1-4) + by (auto simp add: vec_cnj_def) + + have u: "cor ((Re (u1/u2))\<^sup>2) + cor ((Im (u1/u2))\<^sup>2) = 1" + using `on_circline_cmat_cvec unit_circle_cmat ?u` uv + apply (subst cor_add[symmetric]) + apply (subst complex_mult_cnj[symmetric]) + apply (simp add: vec_cnj_def mult.commute) + done + + have v: "cor ((Re (v1/v2))\<^sup>2) + cor ((Im (v1/v2))\<^sup>2) = 1" + using `on_circline_cmat_cvec unit_circle_cmat ?v` uv + apply (subst cor_add[symmetric]) + apply (subst complex_mult_cnj[symmetric]) + apply (simp add: vec_cnj_def mult.commute) + done + + have + "A1 * (cor ((Re (u1/u2))\<^sup>2) + cor ((Im (u1/u2))\<^sup>2) + 1) + cor (Re B1) * cor(2 * Re (u1/u2)) + cor (Im B1) * cor(2 * Im (u1/u2)) = 0" + "A2 * (cor ((Re (u1/u2))\<^sup>2) + cor ((Im (u1/u2))\<^sup>2) + 1) + cor (Re B2) * cor(2 * Re (u1/u2)) + cor (Im B2) * cor(2 * Im (u1/u2)) = 0" + "A1 * (cor ((Re (v1/v2))\<^sup>2) + cor ((Im (v1/v2))\<^sup>2) + 1) + cor (Re B1) * cor(2 * Re (v1/v2)) + cor (Im B1) * cor(2 * Im (v1/v2)) = 0" + "A2 * (cor ((Re (v1/v2))\<^sup>2) + cor ((Im (v1/v2))\<^sup>2) + 1) + cor (Re B2) * cor(2 * Re (v1/v2)) + cor (Im B2) * cor(2 * Im (v1/v2)) = 0" + using circline_equation_quadratic_equation[of A1 "u1/u2" B1 D1 "Re (u1/u2)" "Im (u1 / u2)" "Re B1" "Im B1"] + using circline_equation_quadratic_equation[of A2 "u1/u2" B2 D2 "Re (u1/u2)" "Im (u1 / u2)" "Re B2" "Im B2"] + using circline_equation_quadratic_equation[of A1 "v1/v2" B1 D1 "Re (v1/v2)" "Im (v1 / v2)" "Re B1" "Im B1"] + using circline_equation_quadratic_equation[of A2 "v1/v2" B2 D2 "Re (v1/v2)" "Im (v1 / v2)" "Re B2" "Im B2"] + using `on_circline_cmat_cvec ?H1 ?u` `on_circline_cmat_cvec ?H2 ?u` + using `on_circline_cmat_cvec ?H1 ?v` `on_circline_cmat_cvec ?H2 ?v` + using ** uv + by (simp_all add: vec_cnj_def field_simps) + + hence + "A1 + cor (Re B1) * cor(Re (u1/u2)) + cor (Im B1) * cor(Im (u1/u2)) = 0" + "A1 + cor (Re B1) * cor(Re (v1/v2)) + cor (Im B1) * cor(Im (v1/v2)) = 0" + "A2 + cor (Re B2) * cor(Re (u1/u2)) + cor (Im B2) * cor(Im (u1/u2)) = 0" + "A2 + cor (Re B2) * cor(Re (v1/v2)) + cor (Im B2) * cor(Im (v1/v2)) = 0" + using u v + by simp_all algebra+ + + hence + "cor (Re A1 + Re B1 * Re (u1/u2) + Im B1 * Im (u1/u2)) = 0" + "cor (Re A2 + Re B2 * Re (u1/u2) + Im B2 * Im (u1/u2)) = 0" + "cor (Re A1 + Re B1 * Re (v1/v2) + Im B1 * Im (v1/v2)) = 0" + "cor (Re A2 + Re B2 * Re (v1/v2) + Im B2 * Im (v1/v2)) = 0" + using `is_real A1` `is_real A2` + by simp_all + + hence + "Re A1 + Re B1 * Re (u1/u2) + Im B1 * Im (u1/u2) = 0" + "Re A1 + Re B1 * Re (v1/v2) + Im B1 * Im (v1/v2) = 0" + "Re A2 + Re B2 * Re (u1/u2) + Im B2 * Im (u1/u2) = 0" + "Re A2 + Re B2 * Re (v1/v2) + Im B2 * Im (v1/v2) = 0" + using of_real_eq_0_iff + by blast+ + + moreover + + have "Re(u1/u2) \ Re(v1/v2) \ Im(u1/u2) \ Im(v1/v2)" + proof (rule ccontr) + assume "\ ?thesis" + hence "u1/u2 = v1/v2" + using complex_eqI by blast + thus False + using uv `\ (u1, u2) \\<^sub>v (v1, v2)` + using "*"(1) "*"(2) complex_cvec_eq_mix[OF *(1) *(2)] + by (auto simp add: field_simps) + qed + + moreover + + have "Re A1 \ 0 \ Re B1 \ 0 \ Im B1 \ 0" + using `?H1 \ mat_zero` ** + by (metis complex_cnj_zero complex_of_real_Re mat_zero_def of_real_0) + + ultimately + + obtain k where + k: "Re A2 = k * Re A1" "Re B2 = k * Re B1" "Im B2 = k * Im B1" + using linear_system_homogenous_3_2[of "\x y z. 1 * x + Re (u1 / u2) * y + Im (u1 / u2) * z" 1 "Re (u1/u2)" "Im (u1/u2)" + "\x y z. 1 * x + Re (v1 / v2) * y + Im (v1 / v2) * z" 1 "Re (v1/v2)" "Im (v1/v2)" + "Re A2" "Re B2" "Im B2" "Re A1" "Re B1" "Im B1"] + by (auto simp add: field_simps) + + have "Re A2 \ 0 \ Re B2 \ 0 \ Im B2 \ 0" + using `?H2 \ mat_zero` ** + by (metis complex_cnj_zero complex_of_real_Re mat_zero_def of_real_0) + hence "k \ 0" + using k + by auto + + show "circline_eq_cmat ?H1 ?H2" + using ** k `k \ 0` + by (auto simp add: vec_cnj_def) (rule_tac x="k" in exI, auto simp add: complex.expand) + qed + qed +qed + +text \The only h-line that goes trough zero and a non-zero point on the x-axis is the x-axis.\ +lemma is_poincare_line_0_real_is_x_axis: + assumes "is_poincare_line l" "0\<^sub>h \ circline_set l" + "x \ circline_set l \ circline_set x_axis" "x \ 0\<^sub>h" "x \ \\<^sub>h" + shows "l = x_axis" + using assms + using is_poincare_line_trough_zero_trough_infty[OF assms(1-2)] + using unique_circline_set[of x "0\<^sub>h" "\\<^sub>h"] + by auto + +text \The only h-line that goes trough zero and a non-zero point on the y-axis is the y-axis.\ +lemma is_poincare_line_0_imag_is_y_axis: + assumes "is_poincare_line l" "0\<^sub>h \ circline_set l" + "y \ circline_set l \ circline_set y_axis" "y \ 0\<^sub>h" "y \ \\<^sub>h" + shows "l = y_axis" + using assms + using is_poincare_line_trough_zero_trough_infty[OF assms(1-2)] + using unique_circline_set[of y "0\<^sub>h" "\\<^sub>h"] + by auto + +(* ------------------------------------------------------------------ *) +subsubsection\H-isometries preserve h-lines\ +(* ------------------------------------------------------------------ *) + +text\\emph{H-isometries} are defined as homographies (actions of Möbius transformations) and +antihomographies (compositions of actions of Möbius transformations with conjugation) that fix the +unit disc (map it onto itself). They also map h-lines onto h-lines\ + +text\We prove a bit more general lemma that states that all Möbius transformations that fix the +unit circle (not necessary the unit disc) map h-lines onto h-lines\ +lemma unit_circle_fix_preserve_is_poincare_line [simp]: + assumes "unit_circle_fix M" "is_poincare_line H" + shows "is_poincare_line (moebius_circline M H)" + using assms + unfolding is_poincare_line_iff +proof (safe) + let ?H' = "moebius_ocircline M (of_circline H)" + let ?U' = "moebius_ocircline M ounit_circle" + assume ++: "unit_circle_fix M" "perpendicular H unit_circle" + have ounit: "ounit_circle = moebius_ocircline M ounit_circle \ + ounit_circle = moebius_ocircline M (opposite_ocircline ounit_circle)" + using ++(1) unit_circle_fix_iff[of M] + by (simp add: inj_of_ocircline moebius_circline_ocircline) + + show "perpendicular (moebius_circline M H) unit_circle" + proof (cases "pos_oriented ?H'") + case True + hence *: "of_circline (of_ocircline ?H') = ?H'" + using of_circline_of_ocircline_pos_oriented + by blast + from ounit show ?thesis + proof + assume **: "ounit_circle = moebius_ocircline M ounit_circle" + show ?thesis + using ++ + unfolding perpendicular_def + by (simp, subst moebius_circline_ocircline, subst *, subst **) simp + next + assume **: "ounit_circle = moebius_ocircline M (opposite_ocircline ounit_circle)" + show ?thesis + using ++ + unfolding perpendicular_def + by (simp, subst moebius_circline_ocircline, subst *, subst **) simp + qed + next + case False + hence *: "of_circline (of_ocircline ?H') = opposite_ocircline ?H'" + by (metis of_circline_of_ocircline pos_oriented_of_circline) + from ounit show ?thesis + proof + assume **: "ounit_circle = moebius_ocircline M ounit_circle" + show ?thesis + using ++ + unfolding perpendicular_def + by (simp, subst moebius_circline_ocircline, subst *, subst **) simp + next + assume **: "ounit_circle = moebius_ocircline M (opposite_ocircline ounit_circle)" + show ?thesis + using ++ + unfolding perpendicular_def + by (simp, subst moebius_circline_ocircline, subst *, subst **) simp + qed + qed +qed simp + +lemma unit_circle_fix_preserve_is_poincare_line_iff [simp]: + assumes "unit_circle_fix M" + shows "is_poincare_line (moebius_circline M H) \ is_poincare_line H" + using assms + using unit_circle_fix_preserve_is_poincare_line[of M H] + using unit_circle_fix_preserve_is_poincare_line[of "moebius_inv M" "moebius_circline M H"] + by (auto simp del: unit_circle_fix_preserve_is_poincare_line) + +text\Since h-lines are preserved by transformations that fix the unit circle, so is collinearity.\ +lemma unit_disc_fix_preserve_poincare_collinear [simp]: + assumes "unit_circle_fix M" "poincare_collinear A" + shows "poincare_collinear (moebius_pt M ` A)" + using assms + unfolding poincare_collinear_def + by (auto, rule_tac x="moebius_circline M p" in exI, auto) + +lemma unit_disc_fix_preserve_poincare_collinear_iff [simp]: + assumes "unit_circle_fix M" + shows "poincare_collinear (moebius_pt M ` A) \ poincare_collinear A" + using assms + using unit_disc_fix_preserve_poincare_collinear[of M A] + using unit_disc_fix_preserve_poincare_collinear[of "moebius_inv M" "moebius_pt M ` A"] + by (auto simp del: unit_disc_fix_preserve_poincare_collinear) + +lemma unit_disc_fix_preserve_poincare_collinear3 [simp]: + assumes "unit_disc_fix M" + shows "poincare_collinear {moebius_pt M u, moebius_pt M v, moebius_pt M w} \ + poincare_collinear {u, v, w}" + using assms unit_disc_fix_preserve_poincare_collinear_iff[of M "{u, v, w}"] + by simp + +text\Conjugation is also an h-isometry and it preserves h-lines.\ +lemma is_poincare_line_conjugate_circline [simp]: + assumes "is_poincare_line H" + shows "is_poincare_line (conjugate_circline H)" + using assms + by (transfer, transfer, auto simp add: mat_cnj_def hermitean_def mat_adj_def) + +lemma is_poincare_line_conjugate_circline_iff [simp]: + shows "is_poincare_line (conjugate_circline H) \ is_poincare_line H" + using is_poincare_line_conjugate_circline[of "conjugate_circline H"] + by auto + +text\Since h-lines are preserved by conjugation, so is collinearity.\ +lemma conjugate_preserve_poincare_collinear [simp]: + assumes "poincare_collinear A" + shows "poincare_collinear (conjugate ` A)" + using assms + unfolding poincare_collinear_def + by auto (rule_tac x="conjugate_circline p" in exI, auto) + +lemma conjugate_conjugate [simp]: "conjugate ` conjugate ` A = A" + by (auto simp add: image_iff) + +lemma conjugate_preserve_poincare_collinear_iff [simp]: + shows "poincare_collinear (conjugate ` A) \ poincare_collinear A" + using conjugate_preserve_poincare_collinear[of "A"] + using conjugate_preserve_poincare_collinear[of "conjugate ` A"] + by (auto simp del: conjugate_preserve_poincare_collinear) + +(* ------------------------------------------------------------------ *) +subsubsection\Mapping h-lines to x-axis\ +(* ------------------------------------------------------------------ *) + +text\Each h-line in the Poincar\'e model can be mapped onto the x-axis (by a unit-disc preserving +Möbius transformation).\ +lemma ex_unit_disc_fix_is_poincare_line_to_x_axis: + assumes "is_poincare_line l" + shows "\ M. unit_disc_fix M \ moebius_circline M l = x_axis" +proof- + from assms obtain u v where "u \ v" "u \ unit_disc" "v \ unit_disc" and "{u, v} \ circline_set l" + using ex_is_poincare_line_points + by blast + then obtain M where *: "unit_disc_fix M" "moebius_pt M u = 0\<^sub>h" "moebius_pt M v \ positive_x_axis" + using ex_unit_disc_fix_to_zero_positive_x_axis[of u v] + by auto + moreover + hence "{0\<^sub>h, moebius_pt M v} \ circline_set x_axis" + unfolding positive_x_axis_def + by auto + moreover + have "moebius_pt M v \ 0\<^sub>h" + using \u \ v\ * + by (metis moebius_pt_neq_I) + moreover + have "moebius_pt M v \ \\<^sub>h" + using \unit_disc_fix M\ \v \ unit_disc\ + using unit_disc_fix_discI + by fastforce + ultimately + show ?thesis + using \is_poincare_line l\ \{u, v} \ circline_set l\ \unit_disc_fix M\ + using is_poincare_line_0_real_is_x_axis[of "moebius_circline M l" "moebius_pt M v"] + by (rule_tac x="M" in exI, force) +qed + +text \When proving facts about h-lines, without loss of generality it can be assumed that h-line is +the x-axis (if the property being proved is invariant under Möbius transformations that fix the +unit disc).\ + +lemma wlog_line_x_axis: + assumes is_line: "is_poincare_line H" + assumes x_axis: "P x_axis" + assumes preserves: "\ M. \unit_disc_fix M; P (moebius_circline M H)\ \ P H" + shows "P H" + using assms + using ex_unit_disc_fix_is_poincare_line_to_x_axis[of H] + by auto + +(* ------------------------------------------------------------------ *) +subsection\Construction of the h-line between the two given points\ +(* ------------------------------------------------------------------ *) + +text\Next we show how to construct the (unique) h-line between the two given points in the Poincar\'e model\ + +text\ +Geometrically, h-line can be constructed by finding the inverse point of one of the two points and +by constructing the circle (or line) trough it and the two given points. + +Algebraically, for two given points $u$ and $v$ in $\mathbb{C}$, the h-line matrix coefficients can +be $A = i\cdot(u\overline{v}-v\overline{u})$ and $B = i\cdot(v(|u|^2+1) - u(|v|^2+1))$. + +We need to extend this to homogenous coordinates. There are several degenerate cases. + + - If $\{z, w\} = \{0_h, \infty_h\}$ then there is no unique h-line (any line trough zero is an h-line). + + - If z and w are mutually inverse, then the construction fails (both geometric and algebraic). + + - If z and w are different points on the unit circle, then the standard construction fails (only geometric). + + - None of this problematic cases occur when z and w are inside the unit disc. + +We express the construction algebraically, and construct the Hermitean circline matrix for the two +points given in homogenous coordinates. It works correctly in all cases except when the two points +are the same or are mutually inverse. +\ + + +definition mk_poincare_line_cmat :: "real \ complex \ complex_mat" where + [simp]: "mk_poincare_line_cmat A B = (cor A, B, cnj B, cor A)" + +lemma mk_poincare_line_cmat_zero_iff: + "mk_poincare_line_cmat A B = mat_zero \ A = 0 \ B = 0" + by auto + +lemma mk_poincare_line_cmat_hermitean + [simp]: "hermitean (mk_poincare_line_cmat A B)" + by simp + +lemma mk_poincare_line_cmat_scale: + "cor k *\<^sub>s\<^sub>m mk_poincare_line_cmat A B = mk_poincare_line_cmat (k * A) (k * B)" + by simp + +definition poincare_line_cvec_cmat :: "complex_vec \ complex_vec \ complex_mat" where + [simp]: "poincare_line_cvec_cmat z w = + (let (z1, z2) = z; + (w1, w2) = w; + nom = w1*cnj w2*(z1*cnj z1 + z2*cnj z2) - z1*cnj z2*(w1*cnj w1 + w2*cnj w2); + den = z1*cnj z2*cnj w1*w2 - w1*cnj w2*cnj z1*z2 + in if den \ 0 then + mk_poincare_line_cmat (Re(\*den)) (\*nom) + else if z1*cnj z2 \ 0 then + mk_poincare_line_cmat 0 (\*z1*cnj z2) + else if w1*cnj w2 \ 0 then + mk_poincare_line_cmat 0 (\*w1*cnj w2) + else + mk_poincare_line_cmat 0 \)" + +lemma poincare_line_cvec_cmat_AeqD: + assumes "poincare_line_cvec_cmat z w = (A, B, C, D)" + shows "A = D" + using assms + by (cases z, cases w) (auto split: if_split_asm) + +lemma poincare_line_cvec_cmat_hermitean [simp]: + shows "hermitean (poincare_line_cvec_cmat z w)" + by (cases z, cases w) (auto split: if_split_asm simp del: mk_poincare_line_cmat_def) + +lemma poincare_line_cvec_cmat_nonzero [simp]: + assumes "z \ vec_zero" "w \ vec_zero" + shows "poincare_line_cvec_cmat z w \ mat_zero" +proof- + + obtain z1 z2 w1 w2 where *: "z = (z1, z2)" "w = (w1, w2)" + by (cases z, cases w, auto) + + let ?den = "z1*cnj z2*cnj w1*w2 - w1*cnj w2*cnj z1*z2" + show ?thesis + proof (cases "?den \ 0") + case True + have "is_real (\ * ?den)" + using eq_cnj_iff_real[of "\ *?den"] + by (simp add: field_simps) + hence "Re (\ * ?den) \ 0" + using \?den \ 0\ + by (metis complex_i_not_zero complex_surj mult_eq_0_iff zero_complex.code) + thus ?thesis + using * \?den \ 0\ + by (simp del: mk_poincare_line_cmat_def mat_zero_def add: mk_poincare_line_cmat_zero_iff) + next + case False + thus ?thesis + using * + by (simp del: mk_poincare_line_cmat_def mat_zero_def add: mk_poincare_line_cmat_zero_iff) + qed +qed + +lift_definition poincare_line_hcoords_clmat :: "complex_homo_coords \ complex_homo_coords \ circline_mat" is poincare_line_cvec_cmat + using poincare_line_cvec_cmat_hermitean poincare_line_cvec_cmat_nonzero + by simp + +lift_definition poincare_line :: "complex_homo \ complex_homo \ circline" is poincare_line_hcoords_clmat +proof transfer + fix za zb wa wb + assume "za \ vec_zero" "zb \ vec_zero" "wa \ vec_zero" "wb \ vec_zero" + assume "za \\<^sub>v zb" "wa \\<^sub>v wb" + obtain za1 za2 zb1 zb2 wa1 wa2 wb1 wb2 where + *: "(za1, za2) = za" "(zb1, zb2) = zb" + "(wa1, wa2) = wa" "(wb1, wb2) = wb" + by (cases za, cases zb, cases wa, cases wb, auto) + obtain kz kw where + **: "kz \ 0" "kw \ 0" "zb1 = kz * za1" "zb2 = kz * za2" "wb1 = kw * wa1" "wb2 = kw * wa2" + using \za \\<^sub>v zb\ \wa \\<^sub>v wb\ *[symmetric] + by auto + + let ?nom = "\ z1 z2 w1 w2. w1*cnj w2*(z1*cnj z1 + z2*cnj z2) - z1*cnj z2*(w1*cnj w1 + w2*cnj w2)" + let ?den = "\ z1 z2 w1 w2. z1*cnj z2*cnj w1*w2 - w1*cnj w2*cnj z1*z2" + + show "circline_eq_cmat (poincare_line_cvec_cmat za wa) + (poincare_line_cvec_cmat zb wb)" + proof- + have "\k. k \ 0 \ + poincare_line_cvec_cmat (zb1, zb2) (wb1, wb2) = cor k *\<^sub>s\<^sub>m poincare_line_cvec_cmat (za1, za2) (wa1, wa2)" + proof (cases "?den za1 za2 wa1 wa2 \ 0") + case True + hence "?den zb1 zb2 wb1 wb2 \ 0" + using ** + by (simp add: field_simps) + + let ?k = "kz * cnj kz * kw * cnj kw" + + have "?k \ 0" + using ** + by simp + + have "is_real ?k" + using eq_cnj_iff_real[of ?k] + by auto + + have "cor (Re ?k) = ?k" + using \is_real ?k\ + using complex_of_real_Re + by blast + + have "Re ?k \ 0" + using \?k \ 0\ \cor (Re ?k) = ?k\ + by (metis of_real_0) + + have arg1: "Re (\ * ?den zb1 zb2 wb1 wb2) = Re ?k * Re (\ * ?den za1 za2 wa1 wa2)" + apply (subst **)+ + apply (subst Re_mult_real[symmetric, OF \is_real ?k\]) + apply (rule arg_cong[where f=Re]) + apply (simp add: field_simps) + done + have arg2: "\ * ?nom zb1 zb2 wb1 wb2 = ?k * \ * ?nom za1 za2 wa1 wa2" + using ** + by (simp add: field_simps) + have "mk_poincare_line_cmat (Re (\*?den zb1 zb2 wb1 wb2)) (\*?nom zb1 zb2 wb1 wb2) = + cor (Re ?k) *\<^sub>s\<^sub>m mk_poincare_line_cmat (Re (\*?den za1 za2 wa1 wa2)) (\*?nom za1 za2 wa1 wa2)" + using \cor (Re ?k) = ?k\ \is_real ?k\ + apply (subst mk_poincare_line_cmat_scale) + apply (subst arg1, subst arg2) + apply (subst \cor (Re ?k) = ?k\)+ + apply simp + done + thus ?thesis + using \?den za1 za2 wa1 wa2 \ 0\ \?den zb1 zb2 wb1 wb2 \ 0\ + using \Re ?k \ 0\ \cor (Re ?k) = ?k\ + by (rule_tac x="Re ?k" in exI, simp) + next + case False + hence "?den zb1 zb2 wb1 wb2 = 0" + using ** + by (simp add: field_simps) + show ?thesis + proof (cases "za1*cnj za2 \ 0") + case True + hence "zb1*cnj zb2 \ 0" + using ** + by (simp add: field_simps) + + let ?k = "kz * cnj kz" + + have "?k \ 0" "is_real ?k" + using ** + using eq_cnj_iff_real[of ?k] + by auto + thus ?thesis + using \za1 * cnj za2 \ 0\ \zb1 * cnj zb2 \ 0\ + using \\ (?den za1 za2 wa1 wa2 \ 0)\ \?den zb1 zb2 wb1 wb2 = 0\ ** + by (rule_tac x="Re (kz * cnj kz)" in exI, auto simp add: complex.expand) + next + case False + hence "zb1 * cnj zb2 = 0" + using ** + by (simp add: field_simps) + show ?thesis + proof (cases "wa1 * cnj wa2 \ 0") + case True + hence "wb1*cnj wb2 \ 0" + using ** + by (simp add: field_simps) + + let ?k = "kw * cnj kw" + + have "?k \ 0" "is_real ?k" + using ** + using eq_cnj_iff_real[of ?k] + by auto + + thus ?thesis + using \\ (za1 * cnj za2 \ 0)\ + using \wa1 * cnj wa2 \ 0\ \wb1 * cnj wb2 \ 0\ + using \\ (?den za1 za2 wa1 wa2 \ 0)\ \?den zb1 zb2 wb1 wb2 = 0\ ** + by (rule_tac x="Re (kw * cnj kw)" in exI) + (auto simp add: complex.expand) + next + case False + hence "wb1 * cnj wb2 = 0" + using ** + by (simp add: field_simps) + thus ?thesis + using \\ (za1 * cnj za2 \ 0)\ \zb1 * cnj zb2 = 0\ + using \\ (wa1 * cnj wa2 \ 0)\ \wb1 * cnj wb2 = 0\ + using \\ (?den za1 za2 wa1 wa2 \ 0)\ \?den zb1 zb2 wb1 wb2 = 0\ ** + by simp + qed + qed + qed + thus ?thesis + using *[symmetric] + by simp + qed +qed + +subsubsection \Correctness of the construction\ + +text\For finite points, our definition matches the classic algebraic definition for points in +$\mathbb{C}$ (given in ordinary, not homogenous coordinates).\ +lemma poincare_line_non_homogenous: + assumes "u \ \\<^sub>h" "v \ \\<^sub>h" "u \ v" "u \ inversion v" + shows "let u' = to_complex u; v' = to_complex v; + A = \ * (u' * cnj v' - v' * cnj u'); + B = \ * (v' * ((cmod u')\<^sup>2 + 1) - u' * ((cmod v')\<^sup>2 + 1)) + in poincare_line u v = mk_circline A B (cnj B) A" + using assms + unfolding unit_disc_def disc_def inversion_def + apply (simp add: Let_def) +proof (transfer, transfer, safe) + fix u1 u2 v1 v2 + assume uv: "(u1, u2) \ vec_zero" "(v1, v2) \ vec_zero" + "\ (u1, u2) \\<^sub>v \\<^sub>v" "\ (v1, v2) \\<^sub>v \\<^sub>v" + "\ (u1, u2) \\<^sub>v (v1, v2)" "\ (u1, u2) \\<^sub>v conjugate_cvec (reciprocal_cvec (v1, v2))" + let ?u = "to_complex_cvec (u1, u2)" and ?v = "to_complex_cvec (v1, v2)" + let ?A = "\ * (?u * cnj ?v - ?v * cnj ?u)" + let ?B = "\ * (?v * ((cor (cmod ?u))\<^sup>2 + 1) - ?u * ((cor (cmod ?v))\<^sup>2 + 1))" + let ?C = "- (\ * (cnj ?v * ((cor (cmod ?u))\<^sup>2 + 1) - cnj ?u * ((cor (cmod ?v))\<^sup>2 + 1)))" + let ?D = ?A + let ?H = "(?A, ?B, ?C, ?D)" + + + let ?den = "u1 * cnj u2 * cnj v1 * v2 - v1 * cnj v2 * cnj u1 * u2" + + have "u2 \ 0" "v2 \ 0" + using uv + using inf_cvec_z2_zero_iff + by blast+ + + have "\ (u1, u2) \\<^sub>v (cnj v2, cnj v1)" + using uv(6) + by (simp add: vec_cnj_def) + moreover + have "(cnj v2, cnj v1) \ vec_zero" + using uv(2) + by auto + ultimately + have *: "u1 * cnj v1 \ u2 * cnj v2" "u1 * v2 \ u2 * v1" + using uv(5) uv(1) uv(2) `u2 \ 0` `v2 \ 0` + using complex_cvec_eq_mix + by blast+ + + show "circline_eq_cmat (poincare_line_cvec_cmat (u1, u2) (v1, v2)) + (mk_circline_cmat ?A ?B ?C ?D)" + proof (cases "?den \ 0") + case True + + let ?nom = "v1 * cnj v2 * (u1 * cnj u1 + u2 * cnj u2) - u1 * cnj u2 * (v1 * cnj v1 + v2 * cnj v2)" + let ?H' = "mk_poincare_line_cmat (Re (\ * ?den)) (\ * ?nom)" + + have "circline_eq_cmat ?H ?H'" + proof- + let ?k = "(u2 * cnj v2) * (v2 * cnj u2)" + have "is_real ?k" + using eq_cnj_iff_real + by fastforce + hence "cor (Re ?k) = ?k" + using complex_of_real_Re + by blast + + have "Re (\ * ?den) = Re ?k * ?A" + proof- + have "?A = cnj ?A" + by (simp add: field_simps) + hence "is_real ?A" + using eq_cnj_iff_real + by fastforce + moreover + have "\ * ?den = cnj (\ * ?den)" + by (simp add: field_simps) + hence "is_real (\ * ?den)" + using eq_cnj_iff_real + by fastforce + hence "cor (Re (\ * ?den)) = \ * ?den" + using complex_of_real_Re + by blast + ultimately + show ?thesis + using `cor (Re ?k) = ?k` + by (simp add: field_simps) + qed + + moreover + have "\ * ?nom = Re ?k * ?B" + using `cor (Re ?k) = ?k` `u2 \ 0` `v2 \ 0` complex_mult_cnj_cmod[symmetric] + by (auto simp add: field_simps) + + moreover + have "?k \ 0" + using `u2 \ 0` `v2 \ 0` + by simp + hence "Re ?k \ 0" + using `is_real ?k` + by (metis \cor (Re ?k) = ?k\ of_real_0) + + ultimately + show ?thesis + by simp (rule_tac x="Re ?k" in exI, simp add: mult.commute) + qed + + moreover + + have "poincare_line_cvec_cmat (u1, u2) (v1, v2) = ?H'" + using `?den \ 0` + unfolding poincare_line_cvec_cmat_def + by (simp add: Let_def) + + moreover + + hence "hermitean ?H' \ ?H' \ mat_zero" + by (metis mk_poincare_line_cmat_hermitean poincare_line_cvec_cmat_nonzero uv(1) uv(2)) + + hence "hermitean ?H \ ?H \ mat_zero" + using `circline_eq_cmat ?H ?H'` + using circline_eq_cmat_hermitean_nonzero[of ?H' ?H] symp_circline_eq_cmat + unfolding symp_def + by metis + + hence "mk_circline_cmat ?A ?B ?C ?D = ?H" + by simp + + ultimately + + have "circline_eq_cmat (mk_circline_cmat ?A ?B ?C ?D) + (poincare_line_cvec_cmat (u1, u2) (v1, v2))" + by simp + thus ?thesis + using symp_circline_eq_cmat + unfolding symp_def + by blast + next + case False + + let ?d = "v1 * (u1 * cnj u1 / (u2 * cnj u2) + 1) / v2 - u1 * (v1 * cnj v1 / (v2 * cnj v2) + 1) / u2" + let ?cd = "cnj v1 * (u1 * cnj u1 / (u2 * cnj u2) + 1) / cnj v2 - cnj u1 * (v1 * cnj v1 / (v2 * cnj v2) + 1) / cnj u2" + + have "cnj ?d = ?cd" + by (simp add: mult.commute) + + let ?d1 = "(v1 / v2) * (cnj u1 / cnj u2) - 1" + let ?d2 = "u1 / u2 - v1 / v2" + + have **: "?d = ?d1 * ?d2" + using `\ ?den \ 0` `u2 \ 0` `v2 \ 0` + by(simp add: field_simps) + + hence "?d \ 0" + using `\ ?den \ 0` `u2 \ 0` `v2 \ 0` * + by auto (simp add: field_simps)+ + + have "is_real ?d1" + proof- + have "cnj ?d1 = ?d1" + using `\ ?den \ 0` `u2 \ 0` `v2 \ 0` * + by (simp add: field_simps) + thus ?thesis + using eq_cnj_iff_real + by blast + qed + + show ?thesis + proof (cases "u1 * cnj u2 \ 0") + case True + let ?nom = "u1 * cnj u2" + let ?H' = "mk_poincare_line_cmat 0 (\ * ?nom)" + + have "circline_eq_cmat ?H ?H'" + proof- + + let ?k = "(u1 * cnj u2) / ?d" + + have "is_real ?k" + proof- + have "is_real ((u1 * cnj u2) / ?d2)" + proof- + let ?rhs = "(u2 * cnj u2) / (1 - (v1*u2)/(u1*v2))" + + have 1: "(u1 * cnj u2) / ?d2 = ?rhs" + using `\ ?den \ 0` `u2 \ 0` `v2 \ 0` * `u1 * cnj u2 \ 0` + by (simp add: field_simps) + moreover + have "cnj ?rhs = ?rhs" + proof- + have "cnj (1 - v1 * u2 / (u1 * v2)) = 1 - v1 * u2 / (u1 * v2)" + using `\ ?den \ 0` `u2 \ 0` `v2 \ 0` * `u1 * cnj u2 \ 0` + by (simp add: field_simps) + moreover + have "cnj (u2 * cnj u2) = u2 * cnj u2" + by simp + ultimately + show ?thesis + by simp + qed + + ultimately + + show ?thesis + using eq_cnj_iff_real + by fastforce + qed + + thus ?thesis + using ** `is_real ?d1` + by (metis complex_cnj_divide divide_divide_eq_left' eq_cnj_iff_real) + qed + + have "?k \ 0" + using `?d \ 0` `u1 * cnj u2 \ 0` + by simp + + have "cnj ?k = ?k" + using `is_real ?k` + using eq_cnj_iff_real by blast + + have "Re ?k \ 0" + using `?k \ 0` `is_real ?k` + by (metis complex.expand zero_complex.simps(1) zero_complex.simps(2)) + + have "u1 * cnj u2 = ?k * ?d" + using `?d \ 0` + by simp + + moreover + + hence "cnj u1 * u2 = cnj ?k * cnj ?d" + by (metis complex_cnj_cnj complex_cnj_mult) + hence "cnj u1 * u2 = ?k * ?cd" + using `cnj ?k = ?k` `cnj ?d = ?cd` + by metis + + ultimately + + show ?thesis + using `~ ?den \ 0` `u1 * cnj u2 \ 0` `u2 \ 0` `v2 \ 0` `Re ?k \ 0` `is_real ?k` `?d \ 0` + using complex_mult_cnj_cmod[symmetric, of u1] + using complex_mult_cnj_cmod[symmetric, of v1] + using complex_mult_cnj_cmod[symmetric, of u2] + using complex_mult_cnj_cmod[symmetric, of v2] + apply (auto simp add: power_divide) + apply (rule_tac x="Re ?k" in exI) + apply simp + apply (simp add: field_simps) + done + qed + + moreover + + have "poincare_line_cvec_cmat (u1, u2) (v1, v2) = ?H'" + using `\ ?den \ 0` `u1 * cnj u2 \ 0` + unfolding poincare_line_cvec_cmat_def + by (simp add: Let_def) + + moreover + + hence "hermitean ?H' \ ?H' \ mat_zero" + by (metis mk_poincare_line_cmat_hermitean poincare_line_cvec_cmat_nonzero uv(1) uv(2)) + + hence "hermitean ?H \ ?H \ mat_zero" + using `circline_eq_cmat ?H ?H'` + using circline_eq_cmat_hermitean_nonzero[of ?H' ?H] symp_circline_eq_cmat + unfolding symp_def + by metis + + hence "mk_circline_cmat ?A ?B ?C ?D = ?H" + by simp + + ultimately + + have "circline_eq_cmat (mk_circline_cmat ?A ?B ?C ?D) + (poincare_line_cvec_cmat (u1, u2) (v1, v2))" + by simp + thus ?thesis + using symp_circline_eq_cmat + unfolding symp_def + by blast + next + case False + show ?thesis + proof (cases "v1 * cnj v2 \ 0") + case True + let ?nom = "v1 * cnj v2" + let ?H' = "mk_poincare_line_cmat 0 (\ * ?nom)" + + have "circline_eq_cmat ?H ?H'" + proof- + let ?k = "(v1 * cnj v2) / ?d" + + have "is_real ?k" + proof- + have "is_real ((v1 * cnj v2) / ?d2)" + proof- + let ?rhs = "(v2 * cnj v2) / ((u1*v2)/(u2*v1) - 1)" + + have 1: "(v1 * cnj v2) / ?d2 = ?rhs" + using `\ ?den \ 0` `u2 \ 0` `v2 \ 0` * `v1 * cnj v2 \ 0` + by (simp add: field_simps) + moreover + have "cnj ?rhs = ?rhs" + proof- + have "cnj (u1 * v2 / (u2 * v1) - 1) = u1 * v2 / (u2 * v1) - 1" + using `\ ?den \ 0` `u2 \ 0` `v2 \ 0` * `v1 * cnj v2 \ 0` + by (simp add: field_simps) + moreover + have "cnj (v2 * cnj v2) = v2 * cnj v2" + by simp + ultimately + show ?thesis + by simp + qed + + ultimately + + show ?thesis + using eq_cnj_iff_real + by fastforce + qed + + thus ?thesis + using ** `is_real ?d1` + by (metis complex_cnj_divide divide_divide_eq_left' eq_cnj_iff_real) + qed + + have "?k \ 0" + using `?d \ 0` `v1 * cnj v2 \ 0` + by simp + + have "cnj ?k = ?k" + using `is_real ?k` + using eq_cnj_iff_real by blast + + have "Re ?k \ 0" + using `?k \ 0` `is_real ?k` + by (metis complex.expand zero_complex.simps(1) zero_complex.simps(2)) + + have "v1 * cnj v2 = ?k * ?d" + using `?d \ 0` + by simp + + moreover + + hence "cnj v1 * v2 = cnj ?k * cnj ?d" + by (metis complex_cnj_cnj complex_cnj_mult) + hence "cnj v1 * v2 = ?k * ?cd" + using `cnj ?k = ?k` `cnj ?d = ?cd` + by metis + + ultimately + + show ?thesis + using `~ ?den \ 0` `v1 * cnj v2 \ 0` `u2 \ 0` `v2 \ 0` `Re ?k \ 0` `is_real ?k` `?d \ 0` + using complex_mult_cnj_cmod[symmetric, of u1] + using complex_mult_cnj_cmod[symmetric, of v1] + using complex_mult_cnj_cmod[symmetric, of u2] + using complex_mult_cnj_cmod[symmetric, of v2] + apply (auto simp add: power_divide) + apply (rule_tac x="Re ?k" in exI) + apply simp + apply (simp add: field_simps) + done + qed + + moreover + + have "poincare_line_cvec_cmat (u1, u2) (v1, v2) = ?H'" + using `\ ?den \ 0` `\ u1 * cnj u2 \ 0` `v1 * cnj v2 \ 0` + unfolding poincare_line_cvec_cmat_def + by (simp add: Let_def) + + moreover + + hence "hermitean ?H' \ ?H' \ mat_zero" + by (metis mk_poincare_line_cmat_hermitean poincare_line_cvec_cmat_nonzero uv(1) uv(2)) + + hence "hermitean ?H \ ?H \ mat_zero" + using `circline_eq_cmat ?H ?H'` + using circline_eq_cmat_hermitean_nonzero[of ?H' ?H] symp_circline_eq_cmat + unfolding symp_def + by metis + + hence "mk_circline_cmat ?A ?B ?C ?D = ?H" + by simp + + ultimately + + have "circline_eq_cmat (mk_circline_cmat ?A ?B ?C ?D) + (poincare_line_cvec_cmat (u1, u2) (v1, v2))" + by simp + thus ?thesis + using symp_circline_eq_cmat + unfolding symp_def + by blast + next + case False + hence False + using `\ ?den \ 0` `\ u1 * cnj u2 \ 0` uv + by (simp add: \u2 \ 0\ \v2 \ 0\) + thus ?thesis + by simp + qed + qed + qed +qed + +text\Our construction (in homogenous coordinates) always yields an h-line that contain two starting +points (this also holds for all degenerate cases except when points are the same).\ +lemma poincare_line [simp]: + assumes "z \ w" + shows "on_circline (poincare_line z w) z" + "on_circline (poincare_line z w) w" +proof- + have "on_circline (poincare_line z w) z \ on_circline (poincare_line z w) w" + using assms + proof (transfer, transfer) + fix z w + assume vz: "z \ vec_zero" "w \ vec_zero" + obtain z1 z2 w1 w2 where + zw: "(z1, z2) = z" "(w1, w2) = w" + by (cases z, cases w, auto) + + let ?den = "z1*cnj z2*cnj w1*w2 - w1*cnj w2*cnj z1*z2" + have *: "cor (Re (\ * ?den)) = \ * ?den" + proof- + have "cnj ?den = -?den" + by auto + hence "is_imag ?den" + using eq_minus_cnj_iff_imag[of ?den] + by simp + thus ?thesis + using complex_of_real_Re[of "\ * ?den"] + by simp + qed + show "on_circline_cmat_cvec (poincare_line_cvec_cmat z w) z \ + on_circline_cmat_cvec (poincare_line_cvec_cmat z w) w" + unfolding poincare_line_cvec_cmat_def mk_poincare_line_cmat_def + apply (subst zw[symmetric])+ + unfolding Let_def prod.case + apply (subst *)+ + by (auto simp add: vec_cnj_def field_simps) + qed + thus "on_circline (poincare_line z w) z" "on_circline (poincare_line z w) w" + by auto +qed + +lemma poincare_line_circline_set [simp]: + assumes "z \ w" + shows "z \ circline_set (poincare_line z w)" + "w \ circline_set (poincare_line z w)" + using assms + by (auto simp add: circline_set_def) + +text\When the points are different, the constructed line matrix always has a negative determinant\ +lemma poincare_line_type: + assumes "z \ w" + shows "circline_type (poincare_line z w) = -1" +proof- + have "\ a b. a \ b \ {a, b} \ circline_set (poincare_line z w)" + using poincare_line[of z w] assms + unfolding circline_set_def + by (rule_tac x=z in exI, rule_tac x=w in exI, simp) + thus ?thesis + using circline_type[of "poincare_line z w"] + using circline_type_pos_card_eq0[of "poincare_line z w"] + using circline_type_zero_card_eq1[of "poincare_line z w"] + by auto +qed + +text\The constructed line is an h-line in the Poincar\'e model (in all cases when the two points are +different)\ +lemma is_poincare_line_poincare_line [simp]: + assumes "z \ w" + shows "is_poincare_line (poincare_line z w)" + using poincare_line_type[of z w, OF assms] +proof (transfer, transfer) + fix z w + assume vz: "z \ vec_zero" "w \ vec_zero" + obtain A B C D where *: "poincare_line_cvec_cmat z w = (A, B, C, D)" + by (cases "poincare_line_cvec_cmat z w") auto + assume "circline_type_cmat (poincare_line_cvec_cmat z w) = - 1" + thus "is_poincare_line_cmat (poincare_line_cvec_cmat z w)" + using vz * + using poincare_line_cvec_cmat_hermitean[of z w] + using poincare_line_cvec_cmat_nonzero[of z w] + using poincare_line_cvec_cmat_AeqD[of z w A B C D] + using hermitean_elems[of A B C D] + using cmod_power2[of D] cmod_power2[of C] + unfolding is_poincare_line_cmat_def + by (simp del: poincare_line_cvec_cmat_def add: sgn_1_neg power2_eq_square) +qed + +text \When the points are different, the constructed h-line between two points also contains their inverses\ +lemma poincare_line_inversion: + assumes "z \ w" + shows "on_circline (poincare_line z w) (inversion z)" + "on_circline (poincare_line z w) (inversion w)" + using assms + using is_poincare_line_poincare_line[OF \z \ w\] + using is_poincare_line_inverse_point + unfolding circline_set_def + by auto + +text \When the points are different, the onstructed h-line between two points contains the inverse of its every point\ +lemma poincare_line_inversion_full: + assumes "u \ v" + assumes "on_circline (poincare_line u v) x" + shows "on_circline (poincare_line u v) (inversion x)" + using is_poincare_line_inverse_point[of "poincare_line u v" x] + using is_poincare_line_poincare_line[OF `u \ v`] assms + unfolding circline_set_def + by simp + +subsubsection \Existence of h-lines\ + +text\There is an h-line trough every point in the Poincar\'e model\ +lemma ex_poincare_line_one_point: + shows "\ l. is_poincare_line l \ z \ circline_set l" +proof (cases "z = 0\<^sub>h") + case True + thus ?thesis + by (rule_tac x="x_axis" in exI) simp +next + case False + thus ?thesis + by (rule_tac x="poincare_line 0\<^sub>h z" in exI) auto +qed + +lemma poincare_collinear_singleton [simp]: + assumes "u \ unit_disc" + shows "poincare_collinear {u}" + using assms + using ex_poincare_line_one_point[of u] + by (auto simp add: poincare_collinear_def) + +text\There is an h-line trough every two points in the Poincar\'e model\ +lemma ex_poincare_line_two_points: + assumes "z \ w" + shows "\ l. is_poincare_line l \ z \ circline_set l \ w \ circline_set l" + using assms + by (rule_tac x="poincare_line z w" in exI, simp) + +lemma poincare_collinear_doubleton [simp]: + assumes "u \ unit_disc" "v \ unit_disc" + shows "poincare_collinear {u, v}" + using assms + using ex_poincare_line_one_point[of u] + using ex_poincare_line_two_points[of u v] + by (cases "u = v") (simp_all add: poincare_collinear_def) + + +subsubsection \Uniqueness of h-lines\ + +text \The only h-line between two points is the one obtained by the line-construction.\ +text \First we show this only for two different points inside the disc.\ +lemma unique_poincare_line: + assumes in_disc: "u \ v" "u \ unit_disc" "v \ unit_disc" + assumes on_l: "u \ circline_set l" "v \ circline_set l" "is_poincare_line l" + shows "l = poincare_line u v" + using assms + using unique_is_poincare_line[of u v l "poincare_line u v"] + unfolding circline_set_def + by auto + +text\The assumption that the points are inside the disc can be relaxed.\ +lemma unique_poincare_line_general: + assumes in_disc: "u \ v" "u \ inversion v" + assumes on_l: "u \ circline_set l" "v \ circline_set l" "is_poincare_line l" + shows "l = poincare_line u v" + using assms + using unique_is_poincare_line_general[of u v l "poincare_line u v"] + unfolding circline_set_def + by auto + +text\The explicit line construction enables us to prove that there exists a unique h-line through any +given two h-points (uniqueness part was already shown earlier).\ +text \First we show this only for two different points inside the disc.\ +lemma ex1_poincare_line: + assumes "u \ v" "u \ unit_disc" "v \ unit_disc" + shows "\! l. is_poincare_line l \ u \ circline_set l \ v \ circline_set l" +proof (rule ex1I) + let ?l = "poincare_line u v" + show "is_poincare_line ?l \ u \ circline_set ?l \ v \ circline_set ?l" + using assms + unfolding circline_set_def + by auto +next + fix l + assume "is_poincare_line l \ u \ circline_set l \ v \ circline_set l" + thus "l = poincare_line u v" + using unique_poincare_line assms + by auto +qed + +text \The assumption that the points are in the disc can be relaxed.\ +lemma ex1_poincare_line_general: + assumes "u \ v" "u \ inversion v" + shows "\! l. is_poincare_line l \ u \ circline_set l \ v \ circline_set l" +proof (rule ex1I) + let ?l = "poincare_line u v" + show "is_poincare_line ?l \ u \ circline_set ?l \ v \ circline_set ?l" + using assms + unfolding circline_set_def + by auto +next + fix l + assume "is_poincare_line l \ u \ circline_set l \ v \ circline_set l" + thus "l = poincare_line u v" + using unique_poincare_line_general assms + by auto +qed + +subsubsection \Some consequences of line uniqueness\ + +text\H-line $uv$ is the same as the h-line $vu$.\ +lemma poincare_line_sym: + assumes "u \ unit_disc" "v \ unit_disc" "u \ v" + shows "poincare_line u v = poincare_line v u" + using assms + using unique_poincare_line[of u v "poincare_line v u"] + by simp + +lemma poincare_line_sym_general: + assumes "u \ v" "u \ inversion v" + shows "poincare_line u v = poincare_line v u" + using assms + using unique_poincare_line_general[of u v "poincare_line v u"] + by simp + +text\Each h-line is the h-line constructed out of its two arbitrary different points.\ +lemma ex_poincare_line_points: + assumes "is_poincare_line H" + shows "\ u v. u \ unit_disc \ v \ unit_disc \ u \ v \ H = poincare_line u v" + using assms + using ex_is_poincare_line_points + using unique_poincare_line[where l=H] + by fastforce + +text\If an h-line contains two different points on x-axis/y-axis then it is the x-axis/y-axis.\ +lemma poincare_line_0_real_is_x_axis: + assumes "x \ circline_set x_axis" "x \ 0\<^sub>h" "x \ \\<^sub>h" + shows "poincare_line 0\<^sub>h x = x_axis" + using assms + using is_poincare_line_0_real_is_x_axis[of "poincare_line 0\<^sub>h x" x] + by auto + +lemma poincare_line_0_imag_is_y_axis: + assumes "y \ circline_set y_axis" "y \ 0\<^sub>h" "y \ \\<^sub>h" + shows "poincare_line 0\<^sub>h y = y_axis" + using assms + using is_poincare_line_0_imag_is_y_axis[of "poincare_line 0\<^sub>h y" y] + by auto + +lemma poincare_line_x_axis: + assumes "x \ unit_disc" "y \ unit_disc" "x \ circline_set x_axis" "y \ circline_set x_axis" "x \ y" + shows "poincare_line x y = x_axis" + using assms + using unique_poincare_line + by auto + +lemma poincare_line_minus_one_one [simp]: + shows "poincare_line (of_complex (-1)) (of_complex 1) = x_axis" +proof- + have "0\<^sub>h \ circline_set (poincare_line (of_complex (-1)) (of_complex 1))" + unfolding circline_set_def + by simp (transfer, transfer, simp add: vec_cnj_def) + hence "poincare_line 0\<^sub>h (of_complex 1) = poincare_line (of_complex (-1)) (of_complex 1)" + by (metis is_poincare_line_poincare_line is_poincare_line_trough_zero_trough_infty not_zero_on_unit_circle of_complex_inj of_complex_one one_neq_neg_one one_on_unit_circle poincare_line_0_real_is_x_axis poincare_line_circline_set(2) reciprocal_involution reciprocal_one reciprocal_zero unique_circline_01inf') + thus ?thesis + using poincare_line_0_real_is_x_axis[of "of_complex 1"] + by auto +qed + +subsubsection \Transformations of constructed lines\ + +text\Unit dics preserving Möbius transformations preserve the h-line construction\ +lemma unit_disc_fix_preserve_poincare_line [simp]: + assumes "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "u \ v" + shows "poincare_line (moebius_pt M u) (moebius_pt M v) = moebius_circline M (poincare_line u v)" +proof (rule unique_poincare_line[symmetric]) + show "moebius_pt M u \ moebius_pt M v" + using \u \ v\ + by auto +next + show "moebius_pt M u \ circline_set (moebius_circline M (poincare_line u v))" + "moebius_pt M v \ circline_set (moebius_circline M (poincare_line u v))" + unfolding circline_set_def + using moebius_circline[of M "poincare_line u v"] \u \ v\ + by auto +next + from assms(1) have "unit_circle_fix M" + by simp + thus "is_poincare_line (moebius_circline M (poincare_line u v))" + using unit_circle_fix_preserve_is_poincare_line assms + by auto +next + show "moebius_pt M u \ unit_disc" "moebius_pt M v \ unit_disc" + using assms(2-3) unit_disc_fix_iff[OF assms(1)] + by auto +qed + +text\Conjugate preserve the h-line construction\ +lemma conjugate_preserve_poincare_line [simp]: + assumes "u \ unit_disc" "v \ unit_disc" "u \ v" + shows "poincare_line (conjugate u) (conjugate v) = conjugate_circline (poincare_line u v)" +proof- + have "conjugate u \ conjugate v" + using \u \ v\ + by (auto simp add: conjugate_inj) + moreover + have "conjugate u \ unit_disc" "conjugate v \ unit_disc" + using assms + by auto + moreover + have "conjugate u \ circline_set (conjugate_circline (poincare_line u v))" + "conjugate v \ circline_set (conjugate_circline (poincare_line u v))" + using \u \ v\ + by simp_all + moreover + have "is_poincare_line (conjugate_circline (poincare_line u v))" + using is_poincare_line_poincare_line[OF \u \ v\] + by simp + ultimately + show ?thesis + using unique_poincare_line[of "conjugate u" "conjugate v" "conjugate_circline (poincare_line u v)"] + by simp +qed + +subsubsection \Collinear points and h-lines\ + +lemma poincare_collinear3_poincare_line_general: + assumes "poincare_collinear {a, a1, a2}" "a1 \ a2" "a1 \ inversion a2" + shows "a \ circline_set (poincare_line a1 a2)" + using assms + using poincare_collinear_def unique_poincare_line_general + by auto + +lemma poincare_line_poincare_collinear3_general: + assumes "a \ circline_set (poincare_line a1 a2)" "a1 \ a2" + shows "poincare_collinear {a, a1, a2}" + using assms + unfolding poincare_collinear_def + by (rule_tac x="poincare_line a1 a2" in exI, simp) + + +lemma poincare_collinear3_poincare_lines_equal_general: + assumes "poincare_collinear {a, a1, a2}" "a \ a1" "a \ a2" "a \ inversion a1" "a \ inversion a2" + shows "poincare_line a a1 = poincare_line a a2" + using assms + using unique_poincare_line_general[of a a2 "poincare_line a a1"] + by (simp add: insert_commute poincare_collinear3_poincare_line_general) + +subsubsection \Points collinear with @{term "0\<^sub>h"}\ + +lemma poincare_collinear_zero_iff: + assumes "of_complex y' \ unit_disc" and "of_complex z' \ unit_disc" and + "y' \ z'" and "y' \ 0" and "z' \ 0" + shows "poincare_collinear {0\<^sub>h, of_complex y', of_complex z'} \ + y'*cnj z' = cnj y'*z'" (is "?lhs \ ?rhs") +proof- + have "of_complex y' \ of_complex z'" + using assms + using of_complex_inj + by blast + show ?thesis + proof + assume ?lhs + hence "0\<^sub>h \ circline_set (poincare_line (of_complex y') (of_complex z'))" + using unique_poincare_line[of "of_complex y'" "of_complex z'"] + using assms \of_complex y' \ of_complex z'\ + unfolding poincare_collinear_def + by auto + moreover + let ?mix = "y' * cnj z' - cnj y' * z'" + have "is_real (\ * ?mix)" + using eq_cnj_iff_real[of ?mix] + by auto + hence "y' * cnj z' = cnj y' * z' \ Re (\ * ?mix) = 0" + using complex.expand[of "\ * ?mix" 0] + by (metis complex_i_not_zero eq_iff_diff_eq_0 mult_eq_0_iff zero_complex.simps(1) zero_complex.simps(2)) + ultimately + show ?rhs + using \y' \ z'\ \y' \ 0\ \z' \ 0\ + unfolding circline_set_def + by simp (transfer, transfer, auto simp add: vec_cnj_def split: if_split_asm, metis Re_complex_of_real Re_mult_real Im_complex_of_real) + next + assume ?rhs + thus ?lhs + using assms \of_complex y' \ of_complex z'\ + unfolding poincare_collinear_def + unfolding circline_set_def + apply (rule_tac x="poincare_line (of_complex y') (of_complex z')" in exI) + apply auto + apply (transfer, transfer, simp add: vec_cnj_def) + done + qed +qed + +lemma poincare_collinear_zero_polar_form: + assumes "poincare_collinear {0\<^sub>h, of_complex x, of_complex y}" and + "x \ 0" and "y \ 0" and "of_complex x \ unit_disc" and "of_complex y \ unit_disc" + shows "\ \ rx ry. x = cor rx * cis \ \ y = cor ry * cis \ \ rx \ 0 \ ry \ 0" +proof- + from \x \ 0\ \y \ 0\ obtain \ \' rx ry where + polar: "x = cor rx * cis \" "y = cor ry * cis \'" and "\ = arg x" "\' = arg y" + by (metis cmod_cis) + hence "rx \ 0" "ry \ 0" + using \x \ 0\ \y \ 0\ + by auto + have "of_complex y \ circline_set (poincare_line 0\<^sub>h (of_complex x))" + using assms + using unique_poincare_line[of "0\<^sub>h" "of_complex x"] + unfolding poincare_collinear_def + unfolding circline_set_def + using of_complex_zero_iff + by fastforce + hence "cnj x * y = x * cnj y" + using \x \ 0\ \y \ 0\ + unfolding circline_set_def + by simp (transfer, transfer, simp add: vec_cnj_def field_simps) + hence "cis(\' - \) = cis(\ - \')" + using polar \rx \ 0\ \ry \ 0\ + by (simp add: cis_mult) + hence "sin (\' - \) = 0" + using cis_diff_cis_opposite[of "\' - \"] + by simp + then obtain k :: int where "\' - \ = k * pi" + using sin_zero_iff_int2[of "\' - \"] + by auto + hence *: "\' = \ + k * pi" + by simp + show ?thesis + proof (cases "even k") + case True + then obtain k' where "k = 2*k'" + using evenE by blast + hence "cis \ = cis \'" + using * cos_periodic_int sin_periodic_int + by (simp add: cis.ctr field_simps) + thus ?thesis + using polar \rx \ 0\ \ry \ 0\ + by (rule_tac x=\ in exI, rule_tac x=rx in exI, rule_tac x=ry in exI) simp + next + case False + then obtain k' where "k = 2*k' + 1" + using oddE by blast + hence "cis \ = - cis \'" + using * cos_periodic_int sin_periodic_int + by (simp add: cis.ctr complex_minus field_simps) + thus ?thesis + using polar \rx \ 0\ \ry \ 0\ + by (rule_tac x=\ in exI, rule_tac x=rx in exI, rule_tac x="-ry" in exI) simp + qed +qed + +end diff --git a/thys/Poincare_Disc/Poincare_Lines_Axis_Intersections.thy b/thys/Poincare_Disc/Poincare_Lines_Axis_Intersections.thy new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/Poincare_Lines_Axis_Intersections.thy @@ -0,0 +1,1235 @@ +theory Poincare_Lines_Axis_Intersections + imports Poincare_Between +begin + +(* ------------------------------------------------------------------ *) +section\Intersection of h-lines with the x-axis in the Poincar\'e model\ +(* ------------------------------------------------------------------ *) + +(* ---------------------------------------------------------------- *) +subsection\Betweeness of x-axis intersection\ +(* ---------------------------------------------------------------- *) + +text\The intersection point of the h-line determined by points $u$ and $v$ and the x-axis is between +$u$ and $v$, then $u$ and $v$ are in the opposite half-planes (one must be in the upper, and the +other one in the lower half-plane).\ + +lemma poincare_between_x_axis_intersection: + assumes "u \ unit_disc" and "v \ unit_disc" and "z \ unit_disc" and "u \ v" + assumes "u \ circline_set x_axis" and "v \ circline_set x_axis" + assumes "z \ circline_set (poincare_line u v) \ circline_set x_axis" + shows "poincare_between u z v \ arg (to_complex u) * arg (to_complex v) < 0" +proof- + have "\ u v. u \ unit_disc \ v \ unit_disc \ u \ v \ + u \ circline_set x_axis \ v \ circline_set x_axis \ + z \ circline_set (poincare_line u v) \ circline_set x_axis \ + (poincare_between u z v \ arg (to_complex u) * arg (to_complex v) < 0)" (is "?P z") + proof (rule wlog_real_zero) + show "?P 0\<^sub>h" + proof ((rule allI)+, rule impI, (erule conjE)+) + fix u v + assume *: "u \ unit_disc" "v \ unit_disc" "u \ v" + "u \ circline_set x_axis" "v \ circline_set x_axis" + "0\<^sub>h \ circline_set (poincare_line u v) \ circline_set x_axis" + obtain u' v' where uv: "u = of_complex u'" "v = of_complex v'" + using * inf_or_of_complex[of u] inf_or_of_complex[of v] + by auto + + + hence "u \ 0\<^sub>h" "v \ 0\<^sub>h" "u' \ 0" "v' \ 0" + using * + by auto + + hence "arg u' \ 0" "arg v' \ 0" + using * arg_0_iff[of u'] arg_0_iff[of v'] + unfolding circline_set_x_axis uv + by auto + + have "poincare_collinear {0\<^sub>h, u, v}" + using * + unfolding poincare_collinear_def + by (rule_tac x="poincare_line u v" in exI, simp) + have "(\k<0. u' = cor k * v') \ (arg u' * arg v' < 0)" (is "?lhs \ ?rhs") + proof + assume "?lhs" + then obtain k where "k < 0" "u' = cor k * v'" + by auto + thus ?rhs + using arg_mult_real_negative[of k v'] arg_uminus_opposite_sign[of v'] + using \u' \ 0\ \v' \ 0\ \arg u' \ 0\ \arg v' \ 0\ + by (auto simp add: mult_neg_pos mult_pos_neg) + next + assume ?rhs + obtain ru rv \ where polar: "u' = cor ru * cis \" "v' = cor rv * cis \" + using \poincare_collinear {0\<^sub>h, u, v}\ poincare_collinear_zero_polar_form[of u' v'] uv * \u' \ 0\ \v' \ 0\ + by auto + have "ru * rv < 0" + using polar \?rhs\ \u' \ 0\ \v' \ 0\ + using arg_mult_real_negative[of "ru" "cis \"] arg_mult_real_positive[of "ru" "cis \"] + using arg_mult_real_negative[of "rv" "cis \"] arg_mult_real_positive[of "rv" "cis \"] + apply (cases "ru > 0") + apply (cases "rv > 0", simp, simp add: mult_pos_neg) + apply (cases "rv > 0", simp add: mult_neg_pos, simp) + done + thus "?lhs" + using polar + by (rule_tac x="ru / rv" in exI, auto simp add: divide_less_0_iff mult_less_0_iff) + qed + thus "poincare_between u 0\<^sub>h v = (arg (to_complex u) * arg (to_complex v) < 0)" + using poincare_between_u0v[of u v] * \u \ 0\<^sub>h\ \v \ 0\<^sub>h\ uv + by simp + qed + next + fix a z + assume 1: "is_real a" "cmod a < 1" "z \ unit_disc" + assume 2: "?P (moebius_pt (blaschke a) z)" + show "?P z" + proof ((rule allI)+, rule impI, (erule conjE)+) + fix u v + let ?M = "moebius_pt (blaschke a)" + let ?Mu = "?M u" + let ?Mv = "?M v" + assume *: "u \ unit_disc" "v \ unit_disc" "u \ v" "u \ circline_set x_axis" "v \ circline_set x_axis" + hence "u \ \\<^sub>h" "v \ \\<^sub>h" + by auto + + have **: "\ x y :: real. x * y < 0 \ sgn (x * y) < 0" + by simp + + assume "z \ circline_set (poincare_line u v) \ circline_set x_axis" + thus "poincare_between u z v = (arg (to_complex u) * arg (to_complex v) < 0)" + using * 1 2[rule_format, of ?Mu ?Mv] \cmod a < 1\ \is_real a\ blaschke_unit_disc_fix[of a] + using inversion_noteq_unit_disc[of "of_complex a" u] \u \ \\<^sub>h\ + using inversion_noteq_unit_disc[of "of_complex a" v] \v \ \\<^sub>h\ + apply auto + apply (subst (asm) **, subst **, subst (asm) sgn_mult, subst sgn_mult, simp) + apply (subst (asm) **, subst (asm) **, subst (asm) sgn_mult, subst (asm) sgn_mult, simp) + done + qed + next + show "z \ unit_disc" by fact + next + show "is_real (to_complex z)" + using assms inf_or_of_complex[of z] + by (auto simp add: circline_set_x_axis) + qed + thus ?thesis + using assms + by simp +qed + +(* ------------------------------------------------------------------ *) +subsection\Check if an h-line intersects the x-axis\ +(* ------------------------------------------------------------------ *) + +lemma x_axis_intersection_equation: + assumes + "H = mk_circline A B C D" and + "(A, B, C, D) \ hermitean_nonzero" + shows "of_complex z \ circline_set x_axis \ circline_set H \ + A*z\<^sup>2 + 2*Re B*z + D = 0 \ is_real z" (is "?lhs \ ?rhs") +proof- + have "?lhs \ A*z\<^sup>2 + (B + cnj B)*z + D = 0 \ z = cnj z" + using assms + using circline_equation_x_axis[of z] + using circline_equation[of H A B C D z] + using hermitean_elems + by (auto simp add: power2_eq_square field_simps) + thus ?thesis + using eq_cnj_iff_real[of z] + using hermitean_elems[of A B C D] + by (simp add: complex_add_cnj complex_eq_if_Re_eq) +qed + +text \Check if an h-line intersects x-axis within the unit disc - this could be generalized to +checking if an arbitrary circline intersects the x-axis, but we do not need that.\ + +definition intersects_x_axis_cmat :: "complex_mat \ bool" where + [simp]: "intersects_x_axis_cmat H = (let (A, B, C, D) = H in A = 0 \ (Re B)\<^sup>2 > (Re A)\<^sup>2)" + +lift_definition intersects_x_axis_clmat :: "circline_mat \ bool" is intersects_x_axis_cmat + done + +lift_definition intersects_x_axis :: "circline \ bool" is intersects_x_axis_clmat +proof (transfer) + fix H1 H2 + assume hh: "hermitean H1 \ H1 \ mat_zero" and "hermitean H2 \ H2 \ mat_zero" + obtain A1 B1 C1 D1 A2 B2 C2 D2 where *: "H1 = (A1, B1, C1, D1)" "H2 = (A2, B2, C2, D2)" + by (cases H1, cases H2, auto) + assume "circline_eq_cmat H1 H2" + then obtain k where k: "k \ 0 \ H2 = cor k *\<^sub>s\<^sub>m H1" + by auto + show "intersects_x_axis_cmat H1 = intersects_x_axis_cmat H2" + proof- + have "k \ 0 \ (Re A1)\<^sup>2 < (Re B1)\<^sup>2 \ (k * Re A1)\<^sup>2 < (k * Re B1)\<^sup>2" + by (smt mult_strict_left_mono power2_eq_square semiring_normalization_rules(13) zero_less_power2) + thus ?thesis + using * k + by auto + qed +qed + +lemma intersects_x_axis_mk_circline: + assumes "is_real A" and "A \ 0 \ B \ 0" + shows "intersects_x_axis (mk_circline A B (cnj B) A) \ A = 0 \ (Re B)\<^sup>2 > (Re A)\<^sup>2" +proof- + let ?H = "(A, B, (cnj B), A)" + have "hermitean ?H" + using `is_real A` + unfolding hermitean_def mat_adj_def mat_cnj_def + using eq_cnj_iff_real + by auto + moreover + have "?H \ mat_zero" + using assms + by auto + ultimately + show ?thesis + by (transfer, transfer, auto simp add: Let_def) +qed + +lemma intersects_x_axis_iff: + assumes "is_poincare_line H" + shows "(\ x \ unit_disc. x \ circline_set H \ circline_set x_axis) \ intersects_x_axis H" +proof- + obtain Ac B C Dc where *: "H = mk_circline Ac B C Dc" "hermitean (Ac, B, C, Dc)" "(Ac, B, C, Dc) \ mat_zero" + using ex_mk_circline[of H] + by auto + hence "(cmod B)\<^sup>2 > (cmod Ac)\<^sup>2" "Ac = Dc" + using assms + using is_poincare_line_mk_circline + by auto + + hence "H = mk_circline (Re Ac) B (cnj B) (Re Ac)" "hermitean (cor (Re Ac), B, (cnj B), cor (Re Ac))" "(cor (Re Ac), B, (cnj B), cor (Re Ac)) \ mat_zero" + using hermitean_elems[of Ac B C Dc] * + by auto + then obtain A where + *: "H = mk_circline (cor A) B (cnj B) (cor A)" "(cor A, B, (cnj B), cor A) \ hermitean_nonzero" + by auto + + show ?thesis + proof (cases "A = 0") + case True + thus ?thesis + using * + using x_axis_intersection_equation[OF *(1-2), of 0] + using intersects_x_axis_mk_circline[of "cor A" B] + by auto + next + case False + show ?thesis + proof + assume "\ x \ unit_disc. x \ circline_set H \ circline_set x_axis" + then obtain x where **: "of_complex x \ unit_disc" "of_complex x \ circline_set H \ circline_set x_axis" + by (metis inf_or_of_complex inf_notin_unit_disc) + hence "is_real x" + unfolding circline_set_x_axis + using of_complex_inj + by auto + hence eq: "A * (Re x)\<^sup>2 + 2 * Re B * Re x + A = 0" + using ** + using x_axis_intersection_equation[OF *(1-2), of "Re x"] + by simp + hence "(2 * Re B)\<^sup>2 - 4 * A * A \ 0" + using discriminant_iff[of A _ "2 * Re B" A] + using discrim_def[of A "2 * Re B" A] False + by auto + hence "(Re B)\<^sup>2 \ (Re A)\<^sup>2" + by (simp add: power2_eq_square) + moreover + have "(Re B)\<^sup>2 \ (Re A)\<^sup>2" + proof (rule ccontr) + assume "\ ?thesis" + hence "Re B = Re A \ Re B = - Re A" + using power2_eq_iff by blast + hence "A * (Re x)\<^sup>2 + A * 2* Re x + A = 0 \ A * (Re x)\<^sup>2 - A * 2 * Re x + A = 0" + using eq + by auto + hence "A * ((Re x)\<^sup>2 + 2* Re x + 1) = 0 \ A * ((Re x)\<^sup>2 - 2 * Re x + 1) = 0" + by (simp add: field_simps) + hence "(Re x)\<^sup>2 + 2 * Re x + 1 = 0 \ (Re x)\<^sup>2 - 2 * Re x + 1 = 0" + using \A \ 0\ + by simp + hence "(Re x + 1)\<^sup>2 = 0 \ (Re x - 1)\<^sup>2 = 0" + by (simp add: power2_sum power2_diff field_simps) + hence "Re x = -1 \ Re x = 1" + by auto + thus False + using \is_real x\ \of_complex x \ unit_disc\ + by (auto simp add: cmod_eq_Re) + qed + ultimately + show "intersects_x_axis H" + using intersects_x_axis_mk_circline + using * + by auto + next + assume "intersects_x_axis H" + hence "(Re B)\<^sup>2 > (Re A)\<^sup>2" + using * False + using intersects_x_axis_mk_circline + by simp + hence discr: "(2 * Re B)\<^sup>2 - 4 * A * A > 0" + by (simp add: power2_eq_square) + then obtain x1 x2 where + eqs: "A * x1\<^sup>2 + 2 * Re B * x1 + A = 0" "A * x2\<^sup>2 + 2 * Re B * x2 + A = 0" "x1 \ x2" + using discriminant_pos_ex[OF \A \ 0\, of "2 * Re B" A] + using discrim_def[of A "2 * Re B" A] + by auto + hence "x1 * x2 = 1" + using viette2[OF \A \ 0\, of "2 * Re B" A x1 x2] discr \A \ 0\ + by auto + have "abs x1 \ 1" "abs x2 \ 1" + using eqs discr \x1 * x2 = 1\ + by (auto simp add: abs_if power2_eq_square) + hence "abs x1 < 1 \ abs x2 < 1" + using \x1 * x2 = 1\ + by (smt mult_le_cancel_left1 mult_minus_right) + thus "\x \ unit_disc. x \ circline_set H \ circline_set x_axis" + using x_axis_intersection_equation[OF *(1-2), of x1] + using x_axis_intersection_equation[OF *(1-2), of x2] + using eqs + by auto + qed + qed +qed + +(* ------------------------------------------------------------------ *) +subsection\Check if a Poincar\'e line intersects the y-axis\ +(* ------------------------------------------------------------------ *) + +definition intersects_y_axis_cmat :: "complex_mat \ bool" where + [simp]: "intersects_y_axis_cmat H = (let (A, B, C, D) = H in A = 0 \ (Im B)\<^sup>2 > (Re A)\<^sup>2)" + +lift_definition intersects_y_axis_clmat :: "circline_mat \ bool" is intersects_y_axis_cmat + done + +lift_definition intersects_y_axis :: "circline \ bool" is intersects_y_axis_clmat +proof (transfer) + fix H1 H2 + assume hh: "hermitean H1 \ H1 \ mat_zero" and "hermitean H2 \ H2 \ mat_zero" + obtain A1 B1 C1 D1 A2 B2 C2 D2 where *: "H1 = (A1, B1, C1, D1)" "H2 = (A2, B2, C2, D2)" + by (cases H1, cases H2, auto) + assume "circline_eq_cmat H1 H2" + then obtain k where k: "k \ 0 \ H2 = cor k *\<^sub>s\<^sub>m H1" + by auto + show "intersects_y_axis_cmat H1 = intersects_y_axis_cmat H2" + proof- + have "k \ 0 \ (Re A1)\<^sup>2 < (Im B1)\<^sup>2 \ (k * Re A1)\<^sup>2 < (k * Im B1)\<^sup>2" + by (smt mult_strict_left_mono power2_eq_square semiring_normalization_rules(13) zero_less_power2) + thus ?thesis + using * k + by auto + qed +qed + +lemma intersects_x_axis_intersects_y_axis [simp]: + shows "intersects_x_axis (moebius_circline (moebius_rotation (pi/2)) H) \ intersects_y_axis H" + unfolding moebius_rotation_def moebius_similarity_def + by simp (transfer, transfer, auto simp add: mat_adj_def mat_cnj_def) + +lemma intersects_y_axis_iff: + assumes "is_poincare_line H" + shows "(\ y \ unit_disc. y \ circline_set H \ circline_set y_axis) \ intersects_y_axis H" (is "?lhs \ ?rhs") +proof- + let ?R = "moebius_rotation (pi / 2)" + let ?H' = "moebius_circline ?R H" + have 1: "is_poincare_line ?H'" + using assms + using unit_circle_fix_preserve_is_poincare_line[OF _ assms, of ?R] + by simp + + show ?thesis + proof + assume "?lhs" + then obtain y where "y \ unit_disc" "y \ circline_set H \ circline_set y_axis" + by auto + hence "moebius_pt ?R y \ unit_disc \ moebius_pt ?R y \ circline_set ?H' \ circline_set x_axis" + using rotation_pi_2_y_axis + by (metis Int_iff circline_set_moebius_circline_E moebius_circline_comp_inv_left moebius_pt_comp_inv_left unit_disc_fix_discI unit_disc_fix_rotation) + thus ?rhs + using intersects_x_axis_iff[OF 1] + using intersects_x_axis_intersects_y_axis[of H] + by auto + next + assume "intersects_y_axis H" + hence "intersects_x_axis ?H'" + using intersects_x_axis_intersects_y_axis[of H] + by simp + then obtain x where *: "x \ unit_disc" "x \ circline_set ?H' \ circline_set x_axis" + using intersects_x_axis_iff[OF 1] + by auto + let ?y = "moebius_pt (-?R) x" + have "?y \ unit_disc \ ?y \ circline_set H \ circline_set y_axis" + using * rotation_pi_2_y_axis[symmetric] + by (metis Int_iff circline_set_moebius_circline_E moebius_pt_comp_inv_left moebius_rotation_uminus uminus_moebius_def unit_disc_fix_discI unit_disc_fix_rotation) + thus ?lhs + by auto + qed +qed + +(* ------------------------------------------------------------------ *) +subsection\Intersection point of a Poincar\'e line with the x-axis in the unit disc\ +(* ------------------------------------------------------------------ *) + +definition calc_x_axis_intersection_cvec :: "complex \ complex \ complex_vec" where + [simp]: "calc_x_axis_intersection_cvec A B = + (let discr = (Re B)\<^sup>2 - (Re A)\<^sup>2 in + (-Re(B) + sgn (Re B) * sqrt(discr), A))" + +(* intersection with the x-axis for poincare lines that are euclidean circles *) +definition calc_x_axis_intersection_cmat_cvec :: "complex_mat \ complex_vec" where [simp]: + "calc_x_axis_intersection_cmat_cvec H = + (let (A, B, C, D) = H in + if A \ 0 then + calc_x_axis_intersection_cvec A B + else + (0, 1) + )" + +lift_definition calc_x_axis_intersection_clmat_hcoords :: "circline_mat \ complex_homo_coords" is calc_x_axis_intersection_cmat_cvec + by (auto split: if_split_asm) + +lift_definition calc_x_axis_intersection :: "circline \ complex_homo" is calc_x_axis_intersection_clmat_hcoords +proof transfer + fix H1 H2 + assume *: "hermitean H1 \ H1 \ mat_zero" "hermitean H2 \ H2 \ mat_zero" + obtain A1 B1 C1 D1 A2 B2 C2 D2 where hh: "H1 = (A1, B1, C1, D1)" "H2 = (A2, B2, C2, D2)" + by (cases H1, cases H2, auto) + assume "circline_eq_cmat H1 H2" + then obtain k where k: "k \ 0" "H2 = cor k *\<^sub>s\<^sub>m H1" + by auto + + have "calc_x_axis_intersection_cvec A1 B1 \\<^sub>v calc_x_axis_intersection_cvec A2 B2" + using hh k + apply simp + apply (rule_tac x="cor k" in exI) + apply auto + apply (simp add: sgn_mult power_mult_distrib) + apply (subst right_diff_distrib[symmetric]) + apply (subst real_sqrt_mult) + apply (subst cor_mult) + by (simp add: real_sgn_eq right_diff_distrib) + + thus "calc_x_axis_intersection_cmat_cvec H1 \\<^sub>v + calc_x_axis_intersection_cmat_cvec H2" + using hh k + by (auto simp del: calc_x_axis_intersection_cvec_def) +qed + + +lemma calc_x_axis_intersection_in_unit_disc: + assumes "is_poincare_line H" "intersects_x_axis H" + shows "calc_x_axis_intersection H \ unit_disc" +proof (cases "is_line H") + case True + thus ?thesis + using assms + unfolding unit_disc_def disc_def + by simp (transfer, transfer, auto simp add: vec_cnj_def) +next + case False + thus ?thesis + using assms + unfolding unit_disc_def disc_def + proof (simp, transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + then obtain A B D where *: "H = (A, B, cnj B, D)" "is_real A" "is_real D" + using hermitean_elems + by (cases H) blast + assume "is_poincare_line_cmat H" + hence *: "H = (A, B, cnj B, A)" "is_real A" + using * + by auto + + assume "\ circline_A0_cmat H" + hence "A \ 0" + using * + by simp + + assume "intersects_x_axis_cmat H" + hence "(Re B)\<^sup>2 > (Re A)\<^sup>2" + using * \A \ 0\ + by (auto simp add: power2_eq_square complex.expand) + + hence "Re B \ 0" + by auto + + have "Re A \ 0" + using \is_real A\ \A \ 0\ + by (auto simp add: complex.expand) + + have "sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2) < sqrt((Re B)\<^sup>2)" + using \Re A \ 0\ + by (subst real_sqrt_less_iff) auto + also have "... = sgn (Re B) * (Re B)" + by (smt mult_minus_right nonzero_eq_divide_eq real_sgn_eq real_sqrt_abs) + finally + have 1: "sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2) < sgn (Re B) * (Re B)" + . + + have 2: "(Re B)\<^sup>2 - (Re A)\<^sup>2 < sgn (Re B) * (Re B) * sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)" + using \(Re B)\<^sup>2 > (Re A)\<^sup>2\ + using mult_strict_right_mono[OF 1, of "sqrt ((Re B)\<^sup>2 - (Re A)\<^sup>2)"] + by simp + + have 3: "(Re B)\<^sup>2 - 2*sgn (Re B)*Re B*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2) + (Re B)\<^sup>2 - (Re A)\<^sup>2 < (Re A)\<^sup>2" + using mult_strict_left_mono[OF 2, of 2] + by (simp add: field_simps) + + have "(sgn (Re B))\<^sup>2 = 1" + using \Re B \ 0\ + by (simp add: sgn_if) + + hence "(-Re B + sgn (Re B) * sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2))\<^sup>2 < (Re A)\<^sup>2" + using \(Re B)\<^sup>2 > (Re A)\<^sup>2\ 3 + by (simp add: power2_diff field_simps) + + thus "in_ocircline_cmat_cvec unit_circle_cmat (calc_x_axis_intersection_cmat_cvec H)" + using * \(Re B)\<^sup>2 > (Re A)\<^sup>2\ + by (auto simp add: vec_cnj_def power2_eq_square split: if_split_asm) + qed +qed + + +lemma calc_x_axis_intersection: + assumes "is_poincare_line H" and "intersects_x_axis H" + shows "calc_x_axis_intersection H \ circline_set H \ circline_set x_axis" +proof (cases "is_line H") + case True + thus ?thesis + using assms + unfolding circline_set_def + by simp (transfer, transfer, auto simp add: vec_cnj_def) +next + case False + thus ?thesis + using assms + unfolding circline_set_def + proof (simp, transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + then obtain A B D where *: "H = (A, B, cnj B, D)" "is_real A" "is_real D" + using hermitean_elems + by (cases H) blast + assume "is_poincare_line_cmat H" + hence *: "H = (A, B, cnj B, A)" "is_real A" + using * + by auto + assume "\ circline_A0_cmat H" + hence "A \ 0" + using * + by auto + + assume "intersects_x_axis_cmat H" + hence "(Re B)\<^sup>2 > (Re A)\<^sup>2" + using * \A \ 0\ + by (auto simp add: power2_eq_square complex.expand) + + hence "Re B \ 0" + by auto + + show "on_circline_cmat_cvec H (calc_x_axis_intersection_cmat_cvec H) \ + on_circline_cmat_cvec x_axis_cmat (calc_x_axis_intersection_cmat_cvec H)" (is "?P1 \ ?P2") + proof + show "on_circline_cmat_cvec H (calc_x_axis_intersection_cmat_cvec H)" + proof (cases "circline_A0_cmat H") + case True + thus ?thesis + using * \is_poincare_line_cmat H\ \intersects_x_axis_cmat H\ + by (simp add: vec_cnj_def) + next + case False + let ?x = "calc_x_axis_intersection_cvec A B" + let ?nom = "fst ?x" and ?den = "snd ?x" + have x: "?x = (?nom, ?den)" + by simp + + hence "on_circline_cmat_cvec H (calc_x_axis_intersection_cvec A B)" + proof (subst *, subst x, subst on_circline_cmat_cvec_circline_equation) + have "(sgn(Re B))\<^sup>2 = 1" + using \Re B \ 0\ sgn_pos zero_less_power2 by fastforce + have "(sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2))\<^sup>2 = (Re B)\<^sup>2 - (Re A)\<^sup>2" + using \(Re B)\<^sup>2 > (Re A)\<^sup>2\ + by simp + + have "(-(Re B) + sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2))\<^sup>2 = + (-(Re B))\<^sup>2 + (sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2))\<^sup>2 - 2*(Re B)*sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)" + by (simp add: power2_diff) + also have "... = (Re B)*(Re B) + (sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2))\<^sup>2 - 2*(Re B)*sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)" + by (simp add: power2_eq_square) + also have "... = (Re B)*(Re B) + (sgn(Re B))\<^sup>2*(sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2))\<^sup>2 - 2*(Re B)*sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)" + by (simp add: power_mult_distrib) + also have "... = (Re B)*(Re B) + (Re B)\<^sup>2 - (Re A)\<^sup>2 - 2*(Re B)*sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)" + using \(sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2))\<^sup>2 = (Re B)\<^sup>2 - (Re A)\<^sup>2\ \(sgn(Re B))\<^sup>2 = 1\ + by simp + finally have "(-(Re B) + sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2))\<^sup>2 = + (Re B)*(Re B) + (Re B)\<^sup>2 - (Re A)\<^sup>2 - 2*(Re B)*sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)" + by simp + + have "is_real ?nom" "is_real ?den" + using \is_real A\ + by simp+ + hence "cnj (?nom) = ?nom" "cnj (?den) = ?den" + by (simp add:eq_cnj_iff_real)+ + hence "A*?nom*(cnj (?nom)) + B*?den*(cnj (?nom)) + (cnj B)*(cnj (?den))*?nom + A*?den*(cnj (?den)) + = A*?nom*?nom + B*?den*?nom + (cnj B)*?den*?nom + A*?den*?den" + by auto + also have "... = A*?nom*?nom + (B + (cnj B))*?den*?nom + A*?den*?den" + by (simp add:field_simps) + also have "... = A*?nom*?nom + 2*(Re B)*?den*?nom + A*?den*?den" + by (simp add:complex_add_cnj) + also have "... = A*?nom\<^sup>2 + 2*(Re B)*?den*?nom + A*?den*?den" + by (simp add:power2_eq_square) + also have "... = A*(-(Re B) + sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2))\<^sup>2 + + 2*(Re B)*A*(-(Re B) + sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)) + A*A*A" + unfolding calc_x_axis_intersection_cvec_def + by auto + also have "... = A*((Re B)*(Re B) + (Re B)\<^sup>2 - (Re A)\<^sup>2 - 2*(Re B)*sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)) + + 2*(Re B)*A*(-(Re B) + sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)) + A*A*A" + using \(-(Re B) + sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2))\<^sup>2 = + (Re B)*(Re B) + (Re B)\<^sup>2 - (Re A)\<^sup>2 - 2*(Re B)*sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)\ + by simp + also have "... = A*((Re B)*(Re B) + (Re B)\<^sup>2 - A\<^sup>2 - 2*(Re B)*sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)) + + 2*(Re B)*A*(-(Re B) + sgn(Re B)*sqrt((Re B)\<^sup>2 - (Re A)\<^sup>2)) + A*A*A" + using \is_real A\ + by simp + also have "... = 0" + apply (simp add:field_simps) + by (simp add: power2_eq_square) + finally have "A*?nom*(cnj (?nom)) + B*?den*(cnj (?nom)) + (cnj B)*(cnj (?den))*?nom + A*?den*(cnj (?den)) = 0" + by simp + thus "circline_equation A B (cnj B) A ?nom ?den" + by simp + qed + thus ?thesis + using * \is_poincare_line_cmat H\ \intersects_x_axis_cmat H\ + by (simp add: vec_cnj_def) + qed + next + show "on_circline_cmat_cvec x_axis_cmat (calc_x_axis_intersection_cmat_cvec H)" + using * \is_poincare_line_cmat H\ \intersects_x_axis_cmat H\ \is_real A\ + using eq_cnj_iff_real[of A] + by (simp add: vec_cnj_def) + qed + qed +qed + +lemma unique_calc_x_axis_intersection: + assumes "is_poincare_line H" and "H \ x_axis" + assumes "x \ unit_disc" and "x \ circline_set H \ circline_set x_axis" + shows "x = calc_x_axis_intersection H" +proof- + have *: "intersects_x_axis H" + using assms + using intersects_x_axis_iff[OF assms(1)] + by auto + show "x = calc_x_axis_intersection H" + using calc_x_axis_intersection[OF assms(1) *] + using calc_x_axis_intersection_in_unit_disc[OF assms(1) *] + using assms + using unique_is_poincare_line[of x "calc_x_axis_intersection H" H x_axis] + by auto +qed + +(* ------------------------------------------------------------------ *) +subsection\Check if an h-line intersects the positive part of the x-axis\ +(* ------------------------------------------------------------------ *) + +definition intersects_x_axis_positive_cmat :: "complex_mat \ bool" where + [simp]: "intersects_x_axis_positive_cmat H = (let (A, B, C, D) = H in Re A \ 0 \ Re B / Re A < -1)" + +lift_definition intersects_x_axis_positive_clmat :: "circline_mat \ bool" is intersects_x_axis_positive_cmat + done + +lift_definition intersects_x_axis_positive :: "circline \ bool" is intersects_x_axis_positive_clmat +proof (transfer) + fix H1 H2 + assume hh: "hermitean H1 \ H1 \ mat_zero" and "hermitean H2 \ H2 \ mat_zero" + obtain A1 B1 C1 D1 A2 B2 C2 D2 where *: "H1 = (A1, B1, C1, D1)" "H2 = (A2, B2, C2, D2)" + by (cases H1, cases H2, auto) + assume "circline_eq_cmat H1 H2" + then obtain k where "k \ 0 \ H2 = cor k *\<^sub>s\<^sub>m H1" + by auto + thus "intersects_x_axis_positive_cmat H1 = intersects_x_axis_positive_cmat H2" + using * + by simp +qed + +lemma intersects_x_axis_positive_mk_circline: + assumes "is_real A" and "A \ 0 \ B \ 0" + shows "intersects_x_axis_positive (mk_circline A B (cnj B) A) \ Re B / Re A < -1" +proof- + let ?H = "(A, B, (cnj B), A)" + have "hermitean ?H" + using `is_real A` + unfolding hermitean_def mat_adj_def mat_cnj_def + using eq_cnj_iff_real + by auto + moreover + have "?H \ mat_zero" + using assms + by auto + ultimately + show ?thesis + by (transfer, transfer, auto simp add: Let_def) +qed + + +lemma intersects_x_axis_positive_intersects_x_axis [simp]: + assumes "intersects_x_axis_positive H" + shows "intersects_x_axis H" +proof- + have "\ a aa. \ Re a \ 0; Re aa / Re a < - 1; \ (Re a)\<^sup>2 < (Re aa)\<^sup>2 \ \ aa = 0 \ a = 0" + by (smt less_divide_eq_1_pos one_less_power pos2 power2_minus power_divide zero_less_power2) + thus ?thesis + using assms + apply transfer + apply transfer + apply (auto simp add: hermitean_def mat_adj_def mat_cnj_def) + done +qed + +lemma add_less_abs_positive_iff: + fixes a b :: real + assumes "abs b < abs a" + shows "a + b > 0 \ a > 0" + using assms + by auto + +lemma calc_x_axis_intersection_positive_abs': + fixes A B :: real + assumes "B\<^sup>2 > A\<^sup>2" and "A \ 0" + shows "abs (sgn(B) * sqrt(B\<^sup>2 - A\<^sup>2) / A) < abs(-B/A)" +proof- + from assms have "B \ 0" + by auto + + have "B\<^sup>2 - A\<^sup>2 < B\<^sup>2" + using \A \ 0\ + by auto + hence "sqrt (B\<^sup>2 - A\<^sup>2) < abs B" + using real_sqrt_less_iff[of "B\<^sup>2 - A\<^sup>2" "B\<^sup>2"] + by simp + thus ?thesis + using assms \B \ 0\ + by (simp add: abs_mult divide_strict_right_mono) +qed + +lemma calc_intersect_x_axis_positive_lemma: + assumes "B\<^sup>2 > A\<^sup>2" and "A \ 0" + shows "(-B + sgn B * sqrt(B\<^sup>2 - A\<^sup>2)) / A > 0 \ -B/A > 1" +proof- + have "(-B + sgn B * sqrt(B\<^sup>2 - A\<^sup>2)) / A = -B / A + (sgn B * sqrt(B\<^sup>2 - A\<^sup>2)) / A" + using assms + by (simp add: field_simps) + moreover + have "-B / A + (sgn B * sqrt(B\<^sup>2 - A\<^sup>2)) / A > 0 \ - B / A > 0" + using add_less_abs_positive_iff[OF calc_x_axis_intersection_positive_abs'[OF assms]] + by simp + moreover + hence "(B/A)\<^sup>2 > 1" + using assms + by (simp add: power_divide) + hence "B/A > 1 \ B/A < -1" + by (smt one_power2 pos2 power2_minus power_0 power_strict_decreasing zero_power2) + hence "-B / A > 0 \ -B / A > 1" + by auto + ultimately + show ?thesis + using assms + by auto +qed + +lemma intersects_x_axis_positive_iff': + assumes "is_poincare_line H" + shows "intersects_x_axis_positive H \ + calc_x_axis_intersection H \ unit_disc \ calc_x_axis_intersection H \ circline_set H \ positive_x_axis" (is "?lhs \ ?rhs") +proof + let ?x = "calc_x_axis_intersection H" + assume ?lhs + hence "?x \ circline_set x_axis" "?x \ circline_set H" "?x \ unit_disc" + using calc_x_axis_intersection_in_unit_disc[OF assms] calc_x_axis_intersection[OF assms] + by auto + moreover + have "Re (to_complex ?x) > 0" + using \?lhs\ assms + proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where *: "H = (A, B, C, D)" + by (cases H, auto) + assume "intersects_x_axis_positive_cmat H" + hence **: "Re B / Re A < - 1" "Re A \ 0" + using * + by auto + have "(Re B)\<^sup>2 > (Re A)\<^sup>2" + using ** + by (smt divide_less_eq_1_neg divide_minus_left less_divide_eq_1_pos real_sqrt_abs real_sqrt_less_iff right_inverse_eq) + have "is_real A" "A \ 0" + using hh hermitean_elems * \Re A \ 0\ complex.expand[of A 0] + by auto + have "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" + using \(Re B)\<^sup>2 > (Re A)\<^sup>2\ \is_real A\ + by (smt cmod_power2 power2_less_0 zero_power2) + have ***: "0 < (- Re B + sgn (Re B) * sqrt ((Re B)\<^sup>2 - (Re A)\<^sup>2)) / Re A" + using calc_intersect_x_axis_positive_lemma[of "Re A" "Re B"] ** \(Re B)\<^sup>2 > (Re A)\<^sup>2\ + by auto + + assume "is_poincare_line_cmat H" + hence "A = D" + using * hh + by simp + + have "Re ((cor (sgn (Re B)) * cor (sqrt ((Re B)\<^sup>2 - (Re A)\<^sup>2)) - cor (Re B)) / A) = (sgn (Re B) * sqrt ((Re B)\<^sup>2 - (Re A)\<^sup>2) - Re B) / Re D" + using \is_real A\ \A = D\ + by (metis (no_types, lifting) Re_complex_of_real complex_of_real_Re of_real_diff of_real_divide of_real_mult) + thus "0 < Re (to_complex_cvec (calc_x_axis_intersection_cmat_cvec H))" + using * hh ** *** \(cmod B)\<^sup>2 > (cmod A)\<^sup>2\ \(Re B)\<^sup>2 > (Re A)\<^sup>2\ \A \ 0\ \A = D\ + by simp + qed + ultimately + show ?rhs + unfolding positive_x_axis_def + by auto +next + let ?x = "calc_x_axis_intersection H" + assume ?rhs + hence "Re (to_complex ?x) > 0" "?x \ \\<^sub>h" "?x \ circline_set x_axis" "?x \ unit_disc" "?x \ circline_set H" + unfolding positive_x_axis_def + by auto + hence "intersects_x_axis H" + using intersects_x_axis_iff[OF assms] + by auto + thus ?lhs + using \Re (to_complex ?x) > 0\ assms + proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where *: "H = (A, B, C, D)" + by (cases H, auto) + assume "0 < Re (to_complex_cvec (calc_x_axis_intersection_cmat_cvec H))" "intersects_x_axis_cmat H" "is_poincare_line_cmat H" + hence **: "A \ 0" "0 < Re ((cor (sgn (Re B)) * cor (sqrt ((Re B)\<^sup>2 - (Re A)\<^sup>2)) - cor (Re B)) / A)" "A = D" "is_real A" "(Re B)\<^sup>2 > (Re A)\<^sup>2" + using * hh hermitean_elems + by (auto split: if_split_asm) + + have "Re A \ 0" + using complex.expand[of A 0] \A \ 0\ \is_real A\ + by auto + + have "Re ((cor (sgn (Re B)) * cor (sqrt ((Re B)\<^sup>2 - (Re D)\<^sup>2)) - cor (Re B)) / D) = (sgn (Re B) * sqrt ((Re B)\<^sup>2 - (Re D)\<^sup>2) - Re B) / Re D" + using \is_real A\ \A = D\ + by (metis (no_types, lifting) Re_complex_of_real complex_of_real_Re of_real_diff of_real_divide of_real_mult) + + thus "intersects_x_axis_positive_cmat H" + using * ** \Re A \ 0\ + using calc_intersect_x_axis_positive_lemma[of "Re A" "Re B"] + by simp + qed +qed + +lemma intersects_x_axis_positive_iff: + assumes "is_poincare_line H" and "H \ x_axis" + shows "intersects_x_axis_positive H \ + (\ x. x \ unit_disc \ x \ circline_set H \ positive_x_axis)" (is "?lhs \ ?rhs") +proof + assume ?lhs + thus ?rhs + using intersects_x_axis_positive_iff'[OF assms(1)] + by auto +next + assume ?rhs + then obtain x where "x \ unit_disc" "x \ circline_set H \ positive_x_axis" + by auto + thus ?lhs + using unique_calc_x_axis_intersection[OF assms, of x] + using intersects_x_axis_positive_iff'[OF assms(1)] + unfolding positive_x_axis_def + by auto +qed + +(* ------------------------------------------------------------------ *) +subsection\Check if an h-line intersects the positive part of the y-axis\ +(* ------------------------------------------------------------------ *) + +definition intersects_y_axis_positive_cmat :: "complex_mat \ bool" where + [simp]: "intersects_y_axis_positive_cmat H = (let (A, B, C, D) = H in Re A \ 0 \ Im B / Re A < -1)" + +lift_definition intersects_y_axis_positive_clmat :: "circline_mat \ bool" is intersects_y_axis_positive_cmat + done + +lift_definition intersects_y_axis_positive :: "circline \ bool" is intersects_y_axis_positive_clmat +proof (transfer) + fix H1 H2 + assume hh: "hermitean H1 \ H1 \ mat_zero" and "hermitean H2 \ H2 \ mat_zero" + obtain A1 B1 C1 D1 A2 B2 C2 D2 where *: "H1 = (A1, B1, C1, D1)" "H2 = (A2, B2, C2, D2)" + by (cases H1, cases H2, auto) + assume "circline_eq_cmat H1 H2" + then obtain k where "k \ 0 \ H2 = cor k *\<^sub>s\<^sub>m H1" + by auto + thus "intersects_y_axis_positive_cmat H1 = intersects_y_axis_positive_cmat H2" + using * + by simp +qed + +lemma intersects_x_axis_positive_intersects_y_axis_positive [simp]: + shows "intersects_x_axis_positive (moebius_circline (moebius_rotation (-pi/2)) H) \ intersects_y_axis_positive H" + using hermitean_elems + unfolding moebius_rotation_def moebius_similarity_def + by simp (transfer, transfer, auto simp add: mat_adj_def mat_cnj_def) + +lemma intersects_y_axis_positive_iff: + assumes "is_poincare_line H" "H \ y_axis" + shows "(\ y \ unit_disc. y \ circline_set H \ positive_y_axis) \ intersects_y_axis_positive H" (is "?lhs \ ?rhs") +proof- + let ?R = "moebius_rotation (-pi / 2)" + let ?H' = "moebius_circline ?R H" + have 1: "is_poincare_line ?H'" + using assms + using unit_circle_fix_preserve_is_poincare_line[OF _ assms(1), of ?R] + by simp + + have 2: "moebius_circline ?R H \ x_axis" + proof (rule ccontr) + assume "\ ?thesis" + hence "H = moebius_circline (moebius_rotation (pi/2)) x_axis" + using moebius_circline_comp_inv_left[of ?R H] + by auto + thus False + using \H \ y_axis\ + by auto + qed + + show ?thesis + proof + assume "?lhs" + then obtain y where "y \ unit_disc" "y \ circline_set H \ positive_y_axis" + by auto + hence "moebius_pt ?R y \ unit_disc" "moebius_pt ?R y \ circline_set ?H' \ positive_x_axis" + using rotation_minus_pi_2_positive_y_axis + by auto + thus ?rhs + using intersects_x_axis_positive_iff[OF 1 2] + using intersects_x_axis_positive_intersects_y_axis_positive[of H] + by auto + next + assume "intersects_y_axis_positive H" + hence "intersects_x_axis_positive ?H'" + using intersects_x_axis_positive_intersects_y_axis_positive[of H] + by simp + then obtain x where *: "x \ unit_disc" "x \ circline_set ?H' \ positive_x_axis" + using intersects_x_axis_positive_iff[OF 1 2] + by auto + let ?y = "moebius_pt (-?R) x" + have "?y \ unit_disc \ ?y \ circline_set H \ positive_y_axis" + using * rotation_minus_pi_2_positive_y_axis[symmetric] + by (metis Int_iff circline_set_moebius_circline_E image_eqI moebius_pt_comp_inv_image_left moebius_rotation_uminus uminus_moebius_def unit_disc_fix_discI unit_disc_fix_rotation) + thus ?lhs + by auto + qed +qed + +(* ------------------------------------------------------------------ *) +subsection\Position of the intersection point in the unit disc\ +(* ------------------------------------------------------------------ *) + +text\Check if the intersection point of one h-line with the x-axis is located more outward the edge +of the disc than the intersection point of another h-line.\ + +definition outward_cmat :: "complex_mat \ complex_mat \ bool" where + [simp]: "outward_cmat H1 H2 = (let (A1, B1, C1, D1) = H1; (A2, B2, C2, D2) = H2 + in -Re B1/Re A1 \ -Re B2/Re A2)" +lift_definition outward_clmat :: "circline_mat \ circline_mat \ bool" is outward_cmat + done +lift_definition outward :: "circline \ circline \ bool" is outward_clmat + apply transfer + apply simp + apply (case_tac circline_mat1, case_tac circline_mat2, case_tac circline_mat3, case_tac circline_mat4) + apply simp + apply (erule_tac exE)+ + apply (erule_tac conjE)+ + apply simp + done + +lemma outward_mk_circline: + assumes "is_real A1" and "is_real A2" and "A1 \ 0 \ B1 \ 0" and "A2 \ 0 \ B2 \ 0" + shows "outward (mk_circline A1 B1 (cnj B1) A1) (mk_circline A2 B2 (cnj B2) A2) \ - Re B1 / Re A1 \ - Re B2 / Re A2" +proof- + let ?H1 = "(A1, B1, (cnj B1), A1)" + let ?H2 = "(A2, B2, (cnj B2), A2)" + have "hermitean ?H1" "hermitean ?H2" + using `is_real A1` `is_real A2` + unfolding hermitean_def mat_adj_def mat_cnj_def + using eq_cnj_iff_real + by auto + moreover + have "?H1 \ mat_zero" "?H2 \ mat_zero" + using assms + by auto + ultimately + show ?thesis + by (transfer, transfer, auto simp add: Let_def) +qed + +lemma calc_x_axis_intersection_fun_mono: + fixes x1 x2 :: real + assumes "x1 > 1" and "x2 > x1" + shows "x1 - sqrt(x1\<^sup>2 - 1) > x2 - sqrt(x2\<^sup>2 - 1)" + using assms +proof- + have *: "sqrt(x1\<^sup>2 - 1) + sqrt(x2\<^sup>2 - 1) > 0" + using assms + by (smt one_less_power pos2 real_sqrt_gt_zero) + + have "sqrt(x1\<^sup>2 - 1) < x1" + using real_sqrt_less_iff[of "x1\<^sup>2 - 1" "x1\<^sup>2"] \x1 > 1\ + by auto + moreover + have "sqrt(x2\<^sup>2 - 1) < x2" + using real_sqrt_less_iff[of "x2\<^sup>2 - 1" "x2\<^sup>2"] \x1 > 1\ \x2 > x1\ + by auto + ultimately + have "sqrt(x1\<^sup>2 - 1) + sqrt(x2\<^sup>2 - 1) < x1 + x2" + by simp + hence "(x1 + x2) / (sqrt(x1\<^sup>2 - 1) + sqrt(x2\<^sup>2 - 1)) > 1" + using * + using less_divide_eq_1_pos[of "sqrt(x1\<^sup>2 - 1) + sqrt(x2\<^sup>2 - 1)" "x1 + x2"] + by simp + hence "(x2\<^sup>2 - x1\<^sup>2) / (sqrt(x1\<^sup>2 - 1) + sqrt(x2\<^sup>2 - 1)) > x2 - x1" + using \x2 > x1\ + using mult_less_cancel_left_pos[of "x2 - x1" 1 "(x2 + x1) / (sqrt(x1\<^sup>2 - 1) + sqrt(x2\<^sup>2 - 1))"] + by (simp add: power2_eq_square field_simps) + moreover + have "(x2\<^sup>2 - x1\<^sup>2) = (sqrt(x1\<^sup>2 - 1) + sqrt(x2\<^sup>2 - 1)) * ((sqrt(x2\<^sup>2 - 1) - sqrt(x1\<^sup>2 - 1)))" + using \x1 > 1\ \x2 > x1\ + by (simp add: field_simps) + ultimately + have "sqrt(x2\<^sup>2 - 1) - sqrt(x1\<^sup>2 - 1) > x2 - x1" + using * + by simp + thus ?thesis + by simp +qed + +lemma calc_x_axis_intersection_mono: + fixes a1 b1 a2 b2 :: real + assumes "-b1/a1 > 1" and "a1 \ 0" and "-b2/a2 \ -b1/a1" and "a2 \ 0" + shows "(-b1 + sgn b1 * sqrt(b1\<^sup>2 - a1\<^sup>2)) / a1 \ (-b2 + sgn b2 * sqrt(b2\<^sup>2 - a2\<^sup>2)) / a2" (is "?lhs \ ?rhs") +proof- + have "?lhs = -b1/a1 - sqrt((-b1/a1)\<^sup>2 - 1)" + proof (cases "b1 > 0") + case True + hence "a1 < 0" + using assms + by (smt divide_neg_pos) + thus ?thesis + using \b1 > 0\ \a1 < 0\ + by (simp add: real_sqrt_divide field_simps) + next + case False + hence "b1 < 0" + using assms + by (cases "b1 = 0") auto + hence "a1 > 0" + using assms + by (smt divide_pos_neg) + thus ?thesis + using \b1 < 0\ \a1 > 0\ + by (simp add: real_sqrt_divide field_simps) + qed + + moreover + + have "?rhs = -b2/a2 - sqrt((-b2/a2)\<^sup>2 - 1)" + proof (cases "b2 > 0") + case True + hence "a2 < 0" + using assms + by (smt divide_neg_pos) + thus ?thesis + using \b2 > 0\ \a2 < 0\ + by (simp add: real_sqrt_divide field_simps) + next + case False + hence "b2 < 0" + using assms + by (cases "b2 = 0") auto + hence "a2 > 0" + using assms + by (smt divide_pos_neg) + thus ?thesis + using \b2 < 0\ \a2 > 0\ + by (simp add: real_sqrt_divide field_simps) + qed + + ultimately + + show ?thesis + using calc_x_axis_intersection_fun_mono[of "-b1/a1" "-b2/a2"] + using assms + by (cases "-b1/a1=-b2/a2", auto) +qed + +lemma outward: + assumes "is_poincare_line H1" and "is_poincare_line H2" + assumes "intersects_x_axis_positive H1" and "intersects_x_axis_positive H2" + assumes "outward H1 H2" + shows "Re (to_complex (calc_x_axis_intersection H1)) \ Re (to_complex (calc_x_axis_intersection H2))" +proof- + have "intersects_x_axis H1" "intersects_x_axis H2" + using assms + by auto + thus ?thesis + using assms + proof (transfer, transfer) + fix H1 H2 + assume hh: "hermitean H1 \ H1 \ mat_zero" "hermitean H2 \ H2 \ mat_zero" + obtain A1 B1 C1 D1 A2 B2 C2 D2 where *: "H1 = (A1, B1, C1, D1)" "H2 = (A2, B2, C2, D2)" + by (cases H1, cases H2, auto) + have "is_real A1" "is_real A2" + using hermitean_elems * hh + by auto + assume 1: "intersects_x_axis_positive_cmat H1" "intersects_x_axis_positive_cmat H2" + assume 2: "intersects_x_axis_cmat H1" "intersects_x_axis_cmat H2" + assume 3: "is_poincare_line_cmat H1" "is_poincare_line_cmat H2" + assume 4: "outward_cmat H1 H2" + have "A1 \ 0" "A2 \ 0" + using * \is_real A1\ \is_real A2\ 1 complex.expand[of A1 0] complex.expand[of A2 0] + by auto + hence "(sgn (Re B2) * sqrt ((Re B2)\<^sup>2 - (Re A2)\<^sup>2) - Re B2) / Re A2 + \ (sgn (Re B1) * sqrt ((Re B1)\<^sup>2 - (Re A1)\<^sup>2) - Re B1) / Re A1" + using calc_x_axis_intersection_mono[of "Re B1" "Re A1" "Re B2" "Re A2"] + using 1 4 * + by simp + moreover + have "(sgn (Re B2) * sqrt ((Re B2)\<^sup>2 - (Re A2)\<^sup>2) - Re B2) / Re A2 = + Re ((cor (sgn (Re B2)) * cor (sqrt ((Re B2)\<^sup>2 - (Re A2)\<^sup>2)) - cor (Re B2)) / A2)" + using \is_real A2\ \A2 \ 0\ + by (simp add: Re_divide_real) + moreover + have "(sgn (Re B1) * sqrt ((Re B1)\<^sup>2 - (Re A1)\<^sup>2) - Re B1) / Re A1 = + Re ((cor (sgn (Re B1)) * cor (sqrt ((Re B1)\<^sup>2 - (Re A1)\<^sup>2)) - cor (Re B1)) / A1)" + using \is_real A1\ \A1 \ 0\ + by (simp add: Re_divide_real) + ultimately + show "Re (to_complex_cvec (calc_x_axis_intersection_cmat_cvec H2)) + \ Re (to_complex_cvec (calc_x_axis_intersection_cmat_cvec H1))" + using 2 3 \A1 \ 0\ \A2 \ 0\ * \is_real A1\ \is_real A2\ + by (simp del: is_poincare_line_cmat_def intersects_x_axis_cmat_def) + qed +qed + +(* ------------------------------------------------------------------ *) +subsection\Ideal points and x-axis intersection\ +(* ------------------------------------------------------------------ *) + +lemma ideal_points_intersects_x_axis: + assumes "is_poincare_line H" and "ideal_points H = {i1, i2}" and "H \ x_axis" + shows "intersects_x_axis H \ Im (to_complex i1) * Im (to_complex i2) < 0" + using assms +proof- + have "i1 \ i2" + using assms(1) assms(2) ex_poincare_line_points ideal_points_different(1) + by blast + + have "calc_ideal_points H = {i1, i2}" + using assms + using ideal_points_unique + by auto + + have "\ i1 \ calc_ideal_points H. + \ i2 \ calc_ideal_points H. + is_poincare_line H \ H \ x_axis \ i1 \ i2 \ (Im (to_complex i1) * Im (to_complex i2) < 0 \ intersects_x_axis H)" + proof (transfer, transfer, (rule ballI)+, rule impI, (erule conjE)+, case_tac H, case_tac i1, case_tac i2) + fix i11 i12 i21 i22 A B C D H i1 i2 + assume H: "H = (A, B, C, D)" "hermitean H" "H \ mat_zero" + assume line: "is_poincare_line_cmat H" + assume i1: "i1 = (i11, i12)" "i1 \ calc_ideal_points_cmat_cvec H" + assume i2: "i2 = (i21, i22)" "i2 \ calc_ideal_points_cmat_cvec H" + assume different: "\ i1 \\<^sub>v i2" + assume not_x_axis: "\ circline_eq_cmat H x_axis_cmat" + + have "is_real A" "is_real D" "C = cnj B" + using H hermitean_elems + by auto + have "(cmod A)\<^sup>2 < (cmod B)\<^sup>2" "A = D" + using line H + by auto + + let ?discr = "sqrt ((cmod B)\<^sup>2 - (Re D)\<^sup>2)" + let ?den = "(cmod B)\<^sup>2" + let ?i1 = "B * (- D - \ * ?discr)" + let ?i2 = "B * (- D + \ * ?discr)" + + have "i11 = ?i1 \ i11 = ?i2" "i12 = ?den" + "i21 = ?i1 \ i21 = ?i2" "i22 = ?den" + using i1 i2 H line + by (auto split: if_split_asm) + hence i: "i11 = ?i1 \ i21 = ?i2 \ i11 = ?i2 \ i21 = ?i1" + using `\ i1 \\<^sub>v i2` i1 i2 + by auto + + have "Im (i11 / i12) * Im (i21 / i22) = Im (?i1 / ?den) * Im (?i2 / ?den)" + using i `i12 = ?den` `i22 = ?den` + by auto + also have "... = Im (?i1) * Im (?i2) / ?den\<^sup>2" + by simp + also have "... = (Im B * (Im B * (Re D * Re D)) - Re B * (Re B * ((cmod B)\<^sup>2 - (Re D)\<^sup>2))) / cmod B ^ 4" + using `(cmod B)\<^sup>2 > (cmod A)\<^sup>2` `A = D` + using `is_real D` cmod_eq_Re[of A] + by (auto simp add: field_simps) + also have "... = ((Im B)\<^sup>2 * (Re D)\<^sup>2 - (Re B)\<^sup>2 * ((Re B)\<^sup>2 + (Im B)\<^sup>2 - (Re D)\<^sup>2)) / cmod B ^ 4" + proof- + have "cmod B * cmod B = Re B * Re B + Im B * Im B" + by (metis cmod_power2 power2_eq_square) + thus ?thesis + by (simp add: power2_eq_square) + qed + also have "... = (((Re D)\<^sup>2 - (Re B)\<^sup>2) * ((Re B)\<^sup>2 + (Im B)\<^sup>2)) / cmod B ^ 4" + by (simp add: power2_eq_square field_simps) + finally have Im_product: "Im (i11 / i12) * Im (i21 / i22) = ((Re D)\<^sup>2 - (Re B)\<^sup>2) * ((Re B)\<^sup>2 + (Im B)\<^sup>2) / cmod B ^ 4" + . + + show "Im (to_complex_cvec i1) * Im (to_complex_cvec i2) < 0 \ intersects_x_axis_cmat H" + proof safe + assume opposite: "Im (to_complex_cvec i1) * Im (to_complex_cvec i2) < 0" + show "intersects_x_axis_cmat H" + proof- + have "((Re D)\<^sup>2 - (Re B)\<^sup>2) * ((Re B)\<^sup>2 + (Im B)\<^sup>2) / cmod B ^ 4 < 0" + using Im_product opposite i1 i2 + by simp + hence "((Re D)\<^sup>2 - (Re B)\<^sup>2) * ((Re B)\<^sup>2 + (Im B)\<^sup>2) < 0" + by (simp add: divide_less_0_iff) + hence "(Re D)\<^sup>2 < (Re B)\<^sup>2" + by (simp add: mult_less_0_iff not_sum_power2_lt_zero) + thus ?thesis + using H `A = D` `is_real D` + by auto + qed + next + have *: "(\k. k * Im B = 1 \ k = 0) \ Im B = 0" + apply (safe, erule_tac x="1 / Im B" in allE) + using divide_cancel_left by fastforce + assume "intersects_x_axis_cmat H" + hence "Re D = 0 \ (Re D)\<^sup>2 < (Re B)\<^sup>2" + using H `A = D` + by auto + hence "(Re D)\<^sup>2 < (Re B)\<^sup>2" + using `is_real D` line H `C = cnj B` + using not_x_axis * + by (auto simp add: complex_eq_iff) + hence "((Re D)\<^sup>2 - (Re B)\<^sup>2) * ((Re B)\<^sup>2 + (Im B)\<^sup>2) < 0" + by (metis add_cancel_left_left diff_less_eq mult_eq_0_iff mult_less_0_iff power2_eq_square power2_less_0 sum_squares_gt_zero_iff) + thus "Im (to_complex_cvec i1) * Im (to_complex_cvec i2) < 0" + using Im_product i1 i2 + using divide_eq_0_iff divide_less_0_iff prod.simps(2) to_complex_cvec_def zero_complex.simps(1) zero_less_norm_iff + by fastforce + qed + qed + thus ?thesis + using assms `calc_ideal_points H = {i1, i2}` `i1 \ i2` + by auto +qed + +end diff --git a/thys/Poincare_Disc/Poincare_Lines_Ideal_Points.thy b/thys/Poincare_Disc/Poincare_Lines_Ideal_Points.thy new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/Poincare_Lines_Ideal_Points.thy @@ -0,0 +1,683 @@ +theory Poincare_Lines_Ideal_Points +imports Poincare_Lines +begin + +(* ------------------------------------------------------------------ *) +subsection\Ideal points of h-lines\ +(* ------------------------------------------------------------------ *) + +(* TODO: Introduce ideal points for the oriented circline - + it would be a list, not a set of two points *) + +text\\emph{Ideal points} of an h-line are points where the h-line intersects the unit disc.\ + +(* ------------------------------------------------------------------ *) +subsubsection \Calculation of ideal points\ +(* ------------------------------------------------------------------ *) + +text \We decided to define ideal points constructively, i.e., we calculate the coordinates of ideal +points for a given h-line explicitly. Namely, if the h-line is determined by $A$ and $B$, the two +intersection points are $$\frac{B}{|B|^2}\left(-A \pm i\cdot \sqrt{|B|^2 - A^2}\right).$$\ + +definition calc_ideal_point1_cvec :: "complex \ complex \ complex_vec" where + [simp]: "calc_ideal_point1_cvec A B = + (let discr = Re ((cmod B)\<^sup>2 - (Re A)\<^sup>2) in + (B*(-A - \*sqrt(discr)), (cmod B)\<^sup>2))" + +definition calc_ideal_point2_cvec :: "complex \ complex \ complex_vec" where + [simp]: "calc_ideal_point2_cvec A B = + (let discr = Re ((cmod B)\<^sup>2 - (Re A)\<^sup>2) in + (B*(-A + \*sqrt(discr)), (cmod B)\<^sup>2))" + +definition calc_ideal_points_cmat_cvec :: "complex_mat \ complex_vec set" where + [simp]: "calc_ideal_points_cmat_cvec H = + (if is_poincare_line_cmat H then + let (A, B, C, D) = H + in {calc_ideal_point1_cvec A B, calc_ideal_point2_cvec A B} + else + {(-1, 1), (1, 1)})" + +lift_definition calc_ideal_points_clmat_hcoords :: "circline_mat \ complex_homo_coords set" is calc_ideal_points_cmat_cvec + by (auto simp add: Let_def split: if_split_asm) + +lift_definition calc_ideal_points :: "circline \ complex_homo set" is calc_ideal_points_clmat_hcoords +proof transfer + fix H1 H2 + assume hh: "hermitean H1 \ H1 \ mat_zero" "hermitean H2 \ H2 \ mat_zero" + obtain A1 B1 C1 D1 A2 B2 C2 D2 where *: "H1 = (A1, B1, C1, D1)" "H2 = (A2, B2, C2, D2)" + by (cases H1, cases H2, auto) + assume "circline_eq_cmat H1 H2" + then obtain k where k: "k \ 0" "H2 = cor k *\<^sub>s\<^sub>m H1" + by auto + thus "rel_set (\\<^sub>v) (calc_ideal_points_cmat_cvec H1) (calc_ideal_points_cmat_cvec H2)" + proof (cases "is_poincare_line_cmat H1") + case True + hence "is_poincare_line_cmat H2" + using k * hermitean_mult_real[of H1 k] hh + by (auto simp add: power2_eq_square) + have **: "sqrt (\k\ * cmod B1 * (\k\ * cmod B1) - k * Re D1 * (k * Re D1)) = + \k\ * sqrt(cmod B1 * cmod B1 - Re D1 * Re D1)" + proof- + have "\k\ * cmod B1 * (\k\ * cmod B1) - k * Re D1 * (k * Re D1) = + k\<^sup>2 * (cmod B1 * cmod B1 - Re D1 * Re D1)" + by (simp add: power2_eq_square field_simps) + thus ?thesis + by (simp add: real_sqrt_mult) + qed + show ?thesis + using \is_poincare_line_cmat H1\ \is_poincare_line_cmat H2\ + using * k + apply (simp add: Let_def) + apply safe + apply (simp add: power2_eq_square rel_set_def) + apply safe + apply (cases "k > 0") + apply (rule_tac x="(cor k)\<^sup>2" in exI) + apply (subst **) + apply (simp add: power2_eq_square field_simps) + apply (erule notE, rule_tac x="(cor k)\<^sup>2" in exI) + apply (subst **) + apply (simp add: power2_eq_square field_simps) + apply (cases "k > 0") + apply (erule notE, rule_tac x="(cor k)\<^sup>2" in exI) + apply (subst **) + apply (simp add: power2_eq_square field_simps) + apply (rule_tac x="(cor k)\<^sup>2" in exI) + apply (subst **) + apply (simp add: power2_eq_square field_simps) + apply (cases "k > 0") + apply (rule_tac x="(cor k)\<^sup>2" in exI) + apply (subst **) + apply (simp add: power2_eq_square field_simps) + apply (erule notE, rule_tac x="(cor k)\<^sup>2" in exI) + apply (subst **) + apply (simp add: power2_eq_square field_simps) + apply (cases "k > 0") + apply (erule notE, rule_tac x="(cor k)\<^sup>2" in exI) + apply (subst **) + apply (simp add: power2_eq_square field_simps) + apply (rule_tac x="(cor k)\<^sup>2" in exI) + apply (subst **) + apply (simp add: power2_eq_square field_simps) + done + next + case False + hence "\ is_poincare_line_cmat H2" + using k * hermitean_mult_real[of H1 k] hh + by (auto simp add: power2_eq_square) + have "rel_set (\\<^sub>v) {(- 1, 1), (1, 1)} {(- 1, 1), (1, 1)}" + by (simp add: rel_set_def) + thus ?thesis + using \\ is_poincare_line_cmat H1\ \\ is_poincare_line_cmat H2\ + using * + apply (simp add: Let_def) + apply safe + done + qed +qed + +text \Correctness of the calculation\ + +text\We show that for every h-line its two calculated ideal points are different and are on the +intersection of that line and the unit circle.\ + +text \Calculated ideal points are on the unit circle\ + +lemma calc_ideal_point_1_unit: + assumes "is_real A" "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" + assumes "(z1, z2) = calc_ideal_point1_cvec A B" + shows "z1 * cnj z1 = z2 * cnj z2" +proof- + let ?discr = "Re ((cmod B)\<^sup>2 - (Re A)\<^sup>2)" + have "?discr > 0" + using assms + by (simp add: cmod_power2) + have "(B*(-A - \*sqrt(?discr))) * cnj (B*(-A - \*sqrt(?discr))) = (B * cnj B) * (A\<^sup>2 + cor (abs ?discr))" + using \is_real A\ eq_cnj_iff_real[of A] + by (simp add: field_simps power2_eq_square) + also have "... = (B * cnj B) * (cmod B)\<^sup>2" + using \?discr > 0\ + using assms + using complex_of_real_Re[of "(cmod B)\<^sup>2 - (Re A)\<^sup>2"] complex_of_real_Re[of A] \is_real A\ + by (simp add: power2_eq_square) + also have "... = (cmod B)\<^sup>2 * cnj ((cmod B)\<^sup>2)" + using complex_cnj_complex_of_real complex_mult_cnj_cmod + by presburger + finally show ?thesis + using assms + by simp +qed + +lemma calc_ideal_point_2_unit: + assumes "is_real A" "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" + assumes "(z1, z2) = calc_ideal_point2_cvec A B" + shows "z1 * cnj z1 = z2 * cnj z2" +proof- + let ?discr = "Re ((cmod B)\<^sup>2 - (Re A)\<^sup>2)" + have "?discr > 0" + using assms + by (simp add: cmod_power2) + have "(B*(-A + \*sqrt(?discr))) * cnj (B*(-A + \*sqrt(?discr))) = (B * cnj B) * (A\<^sup>2 + cor (abs ?discr))" + using \is_real A\ eq_cnj_iff_real[of A] + by (simp add: field_simps power2_eq_square) + also have "... = (B * cnj B) * (cmod B)\<^sup>2" + using \?discr > 0\ + using assms + using complex_of_real_Re[of "(cmod B)\<^sup>2 - (Re A)\<^sup>2"] complex_of_real_Re[of A] \is_real A\ + by (simp add: power2_eq_square) + also have "... = (cmod B)\<^sup>2 * cnj ((cmod B)\<^sup>2)" + using complex_cnj_complex_of_real complex_mult_cnj_cmod + by presburger + finally show ?thesis + using assms + by simp +qed + +lemma calc_ideal_points_on_unit_circle: + shows "\ z \ calc_ideal_points H. z \ circline_set unit_circle" + unfolding circline_set_def + apply simp +proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where *: "H = (A, B, C, D)" + by (cases H, auto) + have "\ (z1, z2) \ calc_ideal_points_cmat_cvec H. z1 * cnj z1 = z2 * cnj z2" + using hermitean_elems[of A B C D] + unfolding calc_ideal_points_cmat_cvec_def + using calc_ideal_point_1_unit[of A B] + using calc_ideal_point_2_unit[of A B] + using hh * + apply (cases "calc_ideal_point1_cvec A B", cases "calc_ideal_point2_cvec A B") + apply (auto simp add: Let_def simp del: calc_ideal_point1_cvec_def calc_ideal_point2_cvec_def) + done + thus "Ball (calc_ideal_points_cmat_cvec H) (on_circline_cmat_cvec unit_circle_cmat)" + using on_circline_cmat_cvec_unit + by (auto simp del: on_circline_cmat_cvec_def calc_ideal_points_cmat_cvec_def) +qed + +text \Calculated ideal points are on the h-line\ + +lemma calc_ideal_point1_sq: + assumes "(z1, z2) = calc_ideal_point1_cvec A B" "is_real A" "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" + shows "z1 * cnj z1 + z2 * cnj z2 = 2 * (B * cnj B)\<^sup>2" +proof- + let ?discr = "Re ((cmod B)\<^sup>2 - (Re A)\<^sup>2)" + have "?discr > 0" + using assms + by (simp add: cmod_power2) + have "z1 * cnj z1 = (B * cnj B) * (-A + \*sqrt(?discr))*(-A - \*sqrt(?discr))" + using assms eq_cnj_iff_real[of A] + by (simp) + also have "... = (B * cnj B) * (A\<^sup>2 + ?discr)" + using complex_of_real_Re[of A] \is_real A\ \?discr > 0\ + by (simp add: power2_eq_square field_simps) + finally + have "z1 * cnj z1 = (B * cnj B)\<^sup>2" + using complex_of_real_Re[of "(cmod B)\<^sup>2 - (Re A)\<^sup>2"] complex_of_real_Re[of A] \is_real A\ + using complex_mult_cnj_cmod[of B] + by (simp add: power2_eq_square) + moreover + have "z2 * cnj z2 = (B * cnj B)\<^sup>2" + using assms + by simp + ultimately + show ?thesis + by simp +qed + +lemma calc_ideal_point2_sq: + assumes "(z1, z2) = calc_ideal_point2_cvec A B" "is_real A" "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" + shows "z1 * cnj z1 + z2 * cnj z2 = 2 * (B * cnj B)\<^sup>2" +proof- + let ?discr = "Re ((cmod B)\<^sup>2 - (Re A)\<^sup>2)" + have "?discr > 0" + using assms + by (simp add: cmod_power2) + have "z1 * cnj z1 = (B * cnj B) * (-A + \*sqrt(?discr))*(-A - \*sqrt(?discr))" + using assms eq_cnj_iff_real[of A] + by simp + also have "... = (B * cnj B) * (A\<^sup>2 + ?discr)" + using complex_of_real_Re[of A] \is_real A\ \?discr > 0\ + by (simp add: power2_eq_square field_simps) + finally + have "z1 * cnj z1 = (B * cnj B)\<^sup>2" + using complex_of_real_Re[of "(cmod B)\<^sup>2 - (Re A)\<^sup>2"] complex_of_real_Re[of A] \is_real A\ + using complex_mult_cnj_cmod[of B] + by (simp add: power2_eq_square) + moreover + have "z2 * cnj z2 = (B * cnj B)\<^sup>2" + using assms + by simp + ultimately + show ?thesis + by simp +qed + +lemma calc_ideal_point1_mix: + assumes "(z1, z2) = calc_ideal_point1_cvec A B" "is_real A" "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" + shows "B * cnj z1 * z2 + cnj B * z1 * cnj z2 = - 2 * A * (B * cnj B)\<^sup>2 " +proof- + have "B*cnj z1 + cnj B*z1 = -2*A*B*cnj B" + using assms eq_cnj_iff_real[of A] + by (simp, simp add: field_simps) + moreover + have "cnj z2 = z2" + using assms + by simp + hence "B*cnj z1*z2 + cnj B*z1*cnj z2 = (B*cnj z1 + cnj B*z1)*z2" + by (simp add: field_simps) + ultimately + have "B*cnj z1*z2 + cnj B*z1*cnj z2 = -2*A*(B* cnj B)*z2" + by simp + also have "\ = -2*A*(B * cnj B)\<^sup>2" + using assms + using complex_mult_cnj_cmod[of B] + by (simp add: power2_eq_square) + finally + show ?thesis + . +qed + +lemma calc_ideal_point2_mix: + assumes "(z1, z2) = calc_ideal_point2_cvec A B" "is_real A" "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" + shows "B * cnj z1 * z2 + cnj B * z1 * cnj z2 = - 2 * A * (B * cnj B)\<^sup>2 " +proof- + have "B*cnj z1 + cnj B*z1 = -2*A*B*cnj B" + using assms eq_cnj_iff_real[of A] + by (simp, simp add: field_simps) + moreover + have "cnj z2 = z2" + using assms + by simp + hence "B*cnj z1*z2 + cnj B*z1*cnj z2 = (B*cnj z1 + cnj B*z1)*z2" + by (simp add: field_simps) + ultimately + have "B*cnj z1*z2 + cnj B*z1*cnj z2 = -2*A*(B* cnj B)*z2" + by simp + also have "\ = -2*A*(B * cnj B)\<^sup>2" + using assms + using complex_mult_cnj_cmod[of B] + by (simp add: power2_eq_square) + finally + show ?thesis + . +qed + +lemma calc_ideal_point1_on_circline: + assumes "(z1, z2) = calc_ideal_point1_cvec A B" "is_real A" "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" + shows "A*z1*cnj z1 + B*cnj z1*z2 + cnj B*z1*cnj z2 + A*z2*cnj z2 = 0" (is "?lhs = 0") +proof- + have "?lhs = A * (z1 * cnj z1 + z2 * cnj z2) + (B * cnj z1 * z2 + cnj B * z1 * cnj z2)" + by (simp add: field_simps) + also have "... = 2*A*(B*cnj B)\<^sup>2 + (-2*A*(B*cnj B)\<^sup>2)" + using calc_ideal_point1_sq[OF assms] + using calc_ideal_point1_mix[OF assms] + by simp + finally + show ?thesis + by simp +qed + +lemma calc_ideal_point2_on_circline: + assumes "(z1, z2) = calc_ideal_point2_cvec A B" "is_real A" "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" + shows "A*z1*cnj z1 + B*cnj z1*z2 + cnj B*z1*cnj z2 + A*z2*cnj z2 = 0" (is "?lhs = 0") +proof- + have "?lhs = A * (z1 * cnj z1 + z2 * cnj z2) + (B * cnj z1 * z2 + cnj B * z1 * cnj z2)" + by (simp add: field_simps) + also have "... = 2*A*(B*cnj B)\<^sup>2 + (-2*A*(B*cnj B)\<^sup>2)" + using calc_ideal_point2_sq[OF assms] + using calc_ideal_point2_mix[OF assms] + by simp + finally + show ?thesis + by simp +qed + +lemma calc_ideal_points_on_circline: + assumes "is_poincare_line H" + shows "\ z \ calc_ideal_points H. z \ circline_set H" + using assms + unfolding circline_set_def + apply simp +proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" + obtain A B C D where *: "H = (A, B, C, D)" + by (cases H, auto) + obtain z11 z12 z21 z22 where **: "(z11, z12) = calc_ideal_point1_cvec A B" "(z21, z22) = calc_ideal_point2_cvec A B" + by (cases "calc_ideal_point1_cvec A B", cases "calc_ideal_point2_cvec A B") auto + + assume "is_poincare_line_cmat H" + hence "\ (z1, z2) \ calc_ideal_points_cmat_cvec H. A*z1*cnj z1 + B*cnj z1*z2 + C*z1*cnj z2 + D*z2*cnj z2 = 0" + using * ** hh + using hermitean_elems[of A B C D] + using calc_ideal_point1_on_circline[of z11 z12 A B] + using calc_ideal_point2_on_circline[of z21 z22 A B] + by (auto simp del: calc_ideal_point1_cvec_def calc_ideal_point2_cvec_def) + thus "Ball (calc_ideal_points_cmat_cvec H) (on_circline_cmat_cvec H)" + using on_circline_cmat_cvec_circline_equation * + by (auto simp del: on_circline_cmat_cvec_def calc_ideal_points_cmat_cvec_def simp add: field_simps) +qed + +text \Calculated ideal points of an h-line are different\ + +lemma calc_ideal_points_cvec_different [simp]: + assumes "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" "is_real A" + shows "\ (calc_ideal_point1_cvec A B \\<^sub>v calc_ideal_point2_cvec A B)" + using assms + by (auto) (auto simp add: cmod_def) + +lemma calc_ideal_points_different: + assumes "is_poincare_line H" + shows "\ i1 \ (calc_ideal_points H). \ i2 \ (calc_ideal_points H). i1 \ i2" + using assms +proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" "is_poincare_line_cmat H" + obtain A B C D where *: "H = (A, B, C, D)" + by (cases H, auto) + hence "is_real A" using hh hermitean_elems by auto + thus "\i1\calc_ideal_points_cmat_cvec H. \i2\calc_ideal_points_cmat_cvec H. \ i1 \\<^sub>v i2" + using * hh calc_ideal_points_cvec_different[of A B] + apply (rule_tac x="calc_ideal_point1_cvec A B" in bexI) + apply (rule_tac x="calc_ideal_point2_cvec A B" in bexI) + by auto +qed + +lemma two_calc_ideal_points [simp]: + assumes "is_poincare_line H" + shows "card (calc_ideal_points H) = 2" +proof- + have "\ x \ calc_ideal_points H. \ y \ calc_ideal_points H. \ z \ calc_ideal_points H. z = x \ z = y" + by (transfer, transfer, case_tac H, simp del: calc_ideal_point1_cvec_def calc_ideal_point2_cvec_def) + then obtain x y where *: "calc_ideal_points H = {x, y}" + by auto + moreover + have "x \ y" + using calc_ideal_points_different[OF assms] * + by auto + ultimately + show ?thesis + by auto +qed + +subsubsection \Ideal points\ + +text \Next we give a genuine definition of ideal points -- these are the intersections of the h-line with the unit circle\ + +definition ideal_points :: "circline \ complex_homo set" where + "ideal_points H = circline_intersection H unit_circle" + +text \Ideal points are on the unit circle and on the h-line\ +lemma ideal_points_on_unit_circle: + shows "\ z \ ideal_points H. z \ circline_set unit_circle" + unfolding ideal_points_def circline_intersection_def circline_set_def + by simp + +lemma ideal_points_on_circline: + shows "\ z \ ideal_points H. z \ circline_set H" + unfolding ideal_points_def circline_intersection_def circline_set_def + by simp + + +text \For each h-line there are exactly two ideal points\ +lemma two_ideal_points: + assumes "is_poincare_line H" + shows "card (ideal_points H) = 2" +proof- + have "H \ unit_circle" + using assms not_is_poincare_line_unit_circle + by auto + let ?int = "circline_intersection H unit_circle" + obtain i1 i2 where "i1 \ ?int" "i2 \ ?int" "i1 \ i2" + using calc_ideal_points_on_circline[OF assms] + using calc_ideal_points_on_unit_circle[of H] + using calc_ideal_points_different[OF assms] + unfolding circline_intersection_def circline_set_def + by auto + thus ?thesis + unfolding ideal_points_def + using circline_intersection_at_most_2_points[OF \H \ unit_circle\] + using card_geq_2_iff_contains_2_elems[of ?int] + by auto +qed + +text \They are exactly the two points that our calculation finds\ +lemma ideal_points_unique: + assumes "is_poincare_line H" + shows "ideal_points H = calc_ideal_points H" +proof- + have "calc_ideal_points H \ ideal_points H" + using calc_ideal_points_on_circline[OF assms] + using calc_ideal_points_on_unit_circle[of H] + unfolding ideal_points_def circline_intersection_def circline_set_def + by auto + moreover + have "H \ unit_circle" + using not_is_poincare_line_unit_circle assms + by auto + hence "finite (ideal_points H)" + using circline_intersection_at_most_2_points[of H unit_circle] + unfolding ideal_points_def + by auto + ultimately + show ?thesis + using card_subset_eq[of "ideal_points H" "calc_ideal_points H"] + using two_calc_ideal_points[OF assms] + using two_ideal_points[OF assms] + by auto +qed + +text \For each h-line we can obtain two different ideal points\ +lemma obtain_ideal_points: + assumes "is_poincare_line H" + obtains i1 i2 where "i1 \ i2" "ideal_points H = {i1, i2}" + using two_ideal_points[OF assms] card_eq_2_iff_doubleton[of "ideal_points H"] + by blast + +text \Ideal points of each h-line constructed from two points in the disc are different than those two points\ +lemma ideal_points_different: + assumes "u \ unit_disc" "v \ unit_disc" "u \ v" + assumes "ideal_points (poincare_line u v) = {i1, i2}" + shows "i1 \ i2" "u \ i1" "u \ i2" "v \ i1" "v \ i2" +proof- + have "i1 \ ocircline_set ounit_circle" "i2 \ ocircline_set ounit_circle" + using assms(3) assms(4) ideal_points_on_unit_circle is_poincare_line_poincare_line + by fastforce+ + thus "u \ i1" "u \ i2" "v \ i1" "v \ i2" + using assms(1-2) + using disc_inter_ocircline_set[of ounit_circle] + unfolding unit_disc_def + by auto + show "i1 \ i2" + using assms + by (metis doubleton_eq_iff is_poincare_line_poincare_line obtain_ideal_points) +qed + +text \H-line is uniquely determined by its ideal points\ +lemma ideal_points_line_unique: + assumes "is_poincare_line H" "ideal_points H = {i1, i2}" + shows "H = poincare_line i1 i2" + by (smt assms(1) assms(2) calc_ideal_points_on_unit_circle circline_set_def ex_poincare_line_points ideal_points_different(1) ideal_points_on_circline ideal_points_unique insertI1 insert_commute inversion_unit_circle mem_Collect_eq unique_poincare_line_general) + +text \Ideal points of some special h-lines\ + +text\Ideal points of @{term x_axis}\ +lemma ideal_points_x_axis + [simp]: "ideal_points x_axis = {of_complex (-1), of_complex 1}" +proof (subst ideal_points_unique, simp) + have "calc_ideal_points_clmat_hcoords x_axis_clmat = {of_complex_hcoords (- 1), of_complex_hcoords 1}" + by transfer auto + thus "calc_ideal_points x_axis = {of_complex (- 1), of_complex 1}" + by (simp add: calc_ideal_points.abs_eq of_complex.abs_eq x_axis_def) +qed + +text \Ideal points are proportional vectors only if h-line is a line segment passing trough zero\ +lemma ideal_points_proportional: + assumes "is_poincare_line H" "ideal_points H = {i1, i2}" "to_complex i1 = cor k * to_complex i2" + shows "0\<^sub>h \ circline_set H" +proof- + have "i1 \ i2" + using `ideal_points H = {i1, i2}` + using `is_poincare_line H` ex_poincare_line_points ideal_points_different(1) by blast + + have "i1 \ circline_set unit_circle" "i2 \ circline_set unit_circle" + using assms calc_ideal_points_on_unit_circle ideal_points_unique + by blast+ + + hence "cmod (cor k) = 1" + using `to_complex i1 = cor k * to_complex i2` + by (metis (mono_tags, lifting) circline_set_unit_circle imageE mem_Collect_eq mult.right_neutral norm_mult to_complex_of_complex unit_circle_set_def) + hence "k = -1" + using `to_complex i1 = cor k * to_complex i2` `i1 \ i2` + using \i1 \ circline_set unit_circle\ \i2 \ circline_set unit_circle\ + by (metis (no_types, lifting) circline_set_unit_circle complex_cnj_complex_of_real complex_mult_cnj_cmod cor_neg_one imageE mult_cancel_right2 norm_one of_real_eq_iff square_eq_1_iff to_complex_of_complex) + + have "\ i1 \ calc_ideal_points H. \ i2 \ calc_ideal_points H. is_poincare_line H \ i1 \ i2 \ to_complex i1 = - to_complex i2 \ + 0\<^sub>h \ circline_set H" + unfolding circline_set_def + proof (simp, transfer, transfer, safe) + fix A B C D i11 i12 i21 i22 k + assume H:"hermitean (A, B, C, D)" "(A, B, C, D) \ mat_zero" + assume line: "is_poincare_line_cmat (A, B, C, D)" + assume i1: "(i11, i12) \ calc_ideal_points_cmat_cvec (A, B, C, D)" + assume i2:"(i21, i22) \ calc_ideal_points_cmat_cvec (A, B, C, D)" + assume "\ (i11, i12) \\<^sub>v (i21, i22)" + assume opposite: "to_complex_cvec (i11, i12) = - to_complex_cvec (i21, i22)" + + + let ?discr = "sqrt ((cmod B)\<^sup>2 - (Re D)\<^sup>2)" + let ?den = "(cmod B)\<^sup>2" + let ?i1 = "B * (- D - \ * ?discr)" + let ?i2 = "B * (- D + \ * ?discr)" + + have "i11 = ?i1 \ i11 = ?i2" "i12 = ?den" + "i21 = ?i1 \ i21 = ?i2" "i22 = ?den" + using i1 i2 H line + by (auto split: if_split_asm) + hence i: "i11 = ?i1 \ i21 = ?i2 \ i11 = ?i2 \ i21 = ?i1" + using `\ (i11, i12) \\<^sub>v (i21, i22)` + by auto + + have "?den \ 0" + using line + by auto + + hence "i11 = - i21" + using opposite `i12 = ?den` `i22 = ?den` + by (simp add: nonzero_neg_divide_eq_eq2) + + hence "?i1 = - ?i2" + using i + by (metis add.inverse_inverse) + + hence "D = 0" + using `?den \ 0` + by (simp add: field_simps) + + thus "on_circline_cmat_cvec (A, B, C, D) 0\<^sub>v" + by (simp add: vec_cnj_def) + qed + + thus ?thesis + using assms `k = -1` + using calc_ideal_points_different ideal_points_unique + by fastforce +qed + +text \Transformations of ideal points\ + +text \Möbius transformations that fix the unit disc when acting on h-lines map their ideal points to ideal points.\ +lemma ideal_points_moebius_circline [simp]: + assumes "unit_circle_fix M" "is_poincare_line H" + shows "ideal_points (moebius_circline M H) = (moebius_pt M) ` (ideal_points H)" (is "?I' = ?M ` ?I") +proof- + obtain i1 i2 where *: "i1 \ i2" "?I = {i1, i2}" + using assms(2) + by (rule obtain_ideal_points) + let ?Mi1 = "?M i1" and ?Mi2 = "?M i2" + have "?Mi1 \ ?M ` (circline_set H)" + "?Mi2 \ ?M ` (circline_set H)" + "?Mi1 \ ?M ` (circline_set unit_circle)" + "?Mi2 \ ?M ` (circline_set unit_circle)" + using * + unfolding ideal_points_def circline_intersection_def circline_set_def + by blast+ + hence "?Mi1 \ ?I'" + "?Mi2 \ ?I'" + using unit_circle_fix_iff[of M] assms + unfolding ideal_points_def circline_intersection_def circline_set_def + by (metis mem_Collect_eq moebius_circline)+ + moreover + have "?Mi1 \ ?Mi2" + using bij_moebius_pt[of M] * + using moebius_pt_invert by blast + moreover + have "is_poincare_line (moebius_circline M H)" + using assms unit_circle_fix_preserve_is_poincare_line + by simp + ultimately + have "?I' = {?Mi1, ?Mi2}" + using two_ideal_points[of "moebius_circline M H"] + using card_eq_2_doubleton[of ?I' ?Mi1 ?Mi2] + by simp + thus ?thesis + using *(2) + by auto +qed + +lemma ideal_points_poincare_line_moebius [simp]: + assumes "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "u \ v" + assumes "ideal_points (poincare_line u v) = {i1, i2}" + shows "ideal_points (poincare_line (moebius_pt M u) (moebius_pt M v)) = {moebius_pt M i1, moebius_pt M i2}" + using assms + by auto + +text \Conjugation also maps ideal points to ideal points\ +lemma ideal_points_conjugate [simp]: + assumes "is_poincare_line H" + shows "ideal_points (conjugate_circline H) = conjugate ` (ideal_points H)" (is "?I' = ?M ` ?I") +proof- + obtain i1 i2 where *: "i1 \ i2" "?I = {i1, i2}" + using assms + by (rule obtain_ideal_points) + let ?Mi1 = "?M i1" and ?Mi2 = "?M i2" + have "?Mi1 \ ?M ` (circline_set H)" + "?Mi2 \ ?M ` (circline_set H)" + "?Mi1 \ ?M ` (circline_set unit_circle)" + "?Mi2 \ ?M ` (circline_set unit_circle)" + using * + unfolding ideal_points_def circline_intersection_def circline_set_def + by blast+ + hence "?Mi1 \ ?I'" + "?Mi2 \ ?I'" + unfolding ideal_points_def circline_intersection_def circline_set_def + using circline_set_conjugate_circline circline_set_def conjugate_unit_circle_set + by blast+ + moreover + have "?Mi1 \ ?Mi2" + using \i1 \ i2\ + by (auto simp add: conjugate_inj) + moreover + have "is_poincare_line (conjugate_circline H)" + using assms + by simp + ultimately + have "?I' = {?Mi1, ?Mi2}" + using two_ideal_points[of "conjugate_circline H"] + using card_eq_2_doubleton[of ?I' ?Mi1 ?Mi2] + by simp + thus ?thesis + using *(2) + by auto +qed + +lemma ideal_points_poincare_line_conjugate [simp]: + assumes"u \ unit_disc" "v \ unit_disc" "u \ v" + assumes "ideal_points (poincare_line u v) = {i1, i2}" + shows "ideal_points (poincare_line (conjugate u) (conjugate v)) = {conjugate i1, conjugate i2}" + using assms + by auto + +end diff --git a/thys/Poincare_Disc/Poincare_Perpendicular.thy b/thys/Poincare_Disc/Poincare_Perpendicular.thy new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/Poincare_Perpendicular.thy @@ -0,0 +1,637 @@ +theory Poincare_Perpendicular + imports Poincare_Lines_Axis_Intersections +begin + +(* ------------------------------------------------------------------ *) +section\H-perpendicular h-lines in the Poincar\'e model\ +(* ------------------------------------------------------------------ *) + +definition perpendicular_to_x_axis_cmat :: "complex_mat \ bool" where + [simp]: "perpendicular_to_x_axis_cmat H \ (let (A, B, C, D) = H in is_real B)" + +lift_definition perpendicular_to_x_axis_clmat :: "circline_mat \ bool" is perpendicular_to_x_axis_cmat + done + +lift_definition perpendicular_to_x_axis :: "circline \ bool" is perpendicular_to_x_axis_clmat + by transfer auto + +lemma perpendicular_to_x_axis: + assumes "is_poincare_line H" + shows "perpendicular_to_x_axis H \ perpendicular x_axis H" + using assms + unfolding perpendicular_def +proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" "is_poincare_line_cmat H" + obtain A B C D where *: "H = (A, B, C, D)" + by (cases H, auto) + hence "is_real A" "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" "H = (A, B, cnj B, A)" + using hermitean_elems[of A B C D] hh + by auto + thus "perpendicular_to_x_axis_cmat H = + (cos_angle_cmat (of_circline_cmat x_axis_cmat) (of_circline_cmat H) = 0)" + using cmod_square[of B] cmod_square[of A] + by simp +qed + +lemma perpendicular_to_x_axis_y_axis: + assumes "perpendicular_to_x_axis (poincare_line 0\<^sub>h (of_complex z))" "z \ 0" + shows "is_imag z" + using assms + by (transfer, transfer, simp) + + +lemma wlog_perpendicular_axes: + assumes in_disc: "u \ unit_disc" "v \ unit_disc" "z \ unit_disc" + assumes perpendicular: "is_poincare_line H1" "is_poincare_line H2" "perpendicular H1 H2" + assumes "z \ circline_set H1 \ circline_set H2" "u \ circline_set H1" "v \ circline_set H2" + assumes axes: "\ x y. \is_real x; 0 \ Re x; Re x < 1; is_imag y; 0 \ Im y; Im y < 1\ \ P 0\<^sub>h (of_complex x) (of_complex y)" + assumes moebius: "\ M u v w. \unit_disc_fix M; u \ unit_disc; v \ unit_disc; w \ unit_disc; P (moebius_pt M u) (moebius_pt M v) (moebius_pt M w) \ \ P u v w" + assumes conjugate: "\ u v w. \u \ unit_disc; v \ unit_disc; w \ unit_disc; P (conjugate u) (conjugate v) (conjugate w) \ \ P u v w" + shows "P z u v" +proof- + have "\ v H1 H2. is_poincare_line H1 \ is_poincare_line H2 \ perpendicular H1 H2 \ + z \ circline_set H1 \ circline_set H2 \ u \ circline_set H1 \ v \ circline_set H2 \ v \ unit_disc \ P z u v" (is "?P z u") + proof (rule wlog_x_axis[where P="?P"]) + fix x + assume x: "is_real x" "Re x \ 0" "Re x < 1" + have "of_complex x \ unit_disc" + using x + by (simp add: cmod_eq_Re) + + show "?P 0\<^sub>h (of_complex x)" + proof safe + fix v H1 H2 + assume "v \ unit_disc" + then obtain y where y: "v = of_complex y" + using inf_or_of_complex[of v] + by auto + + assume 1: "is_poincare_line H1" "is_poincare_line H2" "perpendicular H1 H2" + assume 2: "0\<^sub>h \ circline_set H1" "0\<^sub>h \ circline_set H2" "of_complex x \ circline_set H1" "v \ circline_set H2" + + show "P 0\<^sub>h (of_complex x) v" + proof (cases "of_complex x = 0\<^sub>h") + case True + show "P 0\<^sub>h (of_complex x) v" + proof (cases "v = 0\<^sub>h") + case True + thus ?thesis + using \of_complex x = 0\<^sub>h\ + using axes[of 0 0] + by simp + next + case False + show ?thesis + proof (rule wlog_rotation_to_positive_y_axis) + show "v \ unit_disc" "v \ 0\<^sub>h" + by fact+ + next + fix y + assume "is_imag y" "0 < Im y" "Im y < 1" + thus "P 0\<^sub>h (of_complex x) (of_complex y)" + using x axes[of x y] + by simp + next + fix \ u + assume "u \ unit_disc" "u \ 0\<^sub>h" + "P 0\<^sub>h (of_complex x) (moebius_pt (moebius_rotation \) u)" + thus "P 0\<^sub>h (of_complex x) u" + using \of_complex x = 0\<^sub>h\ + using moebius[of "moebius_rotation \" "0\<^sub>h" "0\<^sub>h" u] + by simp + qed + qed + next + case False + hence *: "poincare_line 0\<^sub>h (of_complex x) = x_axis" + using x poincare_line_0_real_is_x_axis[of "of_complex x"] + unfolding circline_set_x_axis + by auto + hence "H1 = x_axis" + using unique_poincare_line[of "0\<^sub>h" "of_complex x" H1] 1 2 + using \of_complex x \ unit_disc\ False + by simp + have "is_imag y" + proof (cases "y = 0") + case True + thus ?thesis + by simp + next + case False + hence "0\<^sub>h \ of_complex y" + using of_complex_zero_iff[of y] + by metis + hence "H2 = poincare_line 0\<^sub>h (of_complex y)" + using 1 2 \v \ unit_disc\ + using unique_poincare_line[of "0\<^sub>h" "of_complex y" H2] y + by simp + thus ?thesis + using 1 \H1 = x_axis\ + using perpendicular_to_x_axis_y_axis[of y] False + using perpendicular_to_x_axis[of H2] + by simp + qed + show "P 0\<^sub>h (of_complex x) v" + proof (cases "Im y \ 0") + case True + thus ?thesis + using axes[of x y] x y \is_imag y\ \v \ unit_disc\ + by (simp add: cmod_eq_Im) + next + case False + show ?thesis + proof (rule conjugate) + have "Im (cnj y) < 1" + using \v \ unit_disc\ y \is_imag y\ eq_minus_cnj_iff_imag[of y] + by (simp add: cmod_eq_Im) + thus "P (conjugate 0\<^sub>h) (conjugate (of_complex x)) (conjugate v)" + using \is_real x\ eq_cnj_iff_real[of x] y \is_imag y\ + using axes[OF x, of "cnj y"] False + by simp + show "0\<^sub>h \ unit_disc" "of_complex x \ unit_disc" "v \ unit_disc" + by (simp, fact+) + qed + qed + qed + qed + next + show "z \ unit_disc" "u \ unit_disc" + by fact+ + next + fix M u v + assume *: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" + assume **: "?P (moebius_pt M u) (moebius_pt M v)" + show "?P u v" + proof safe + fix w H1 H2 + assume ***: "is_poincare_line H1" "is_poincare_line H2" "perpendicular H1 H2" + "u \ circline_set H1" "u \ circline_set H2" + "v \ circline_set H1" "w \ circline_set H2" "w \ unit_disc" + thus "P u v w" + using moebius[of M u v w] * + using **[rule_format, of "moebius_circline M H1" "moebius_circline M H2" "moebius_pt M w"] + by simp + qed + qed + thus ?thesis + using assms + by blast +qed + +lemma wlog_perpendicular_foot: + assumes in_disc: "u \ unit_disc" "v \ unit_disc" "w \ unit_disc" "z \ unit_disc" + assumes perpendicular: "u \ v" "is_poincare_line H" "perpendicular (poincare_line u v) H" + assumes "z \ circline_set (poincare_line u v) \ circline_set H" "w \ circline_set H" + assumes axes: "\ u v w. \is_real u; 0 < Re u; Re u < 1; is_real v; -1 < Re v; Re v < 1; Re u \ Re v; is_imag w; 0 \ Im w; Im w < 1\ \ P 0\<^sub>h (of_complex u) (of_complex v) (of_complex w)" + assumes moebius: "\ M z u v w. \unit_disc_fix M; u \ unit_disc; v \ unit_disc; w \ unit_disc; z \ unit_disc; P (moebius_pt M z) (moebius_pt M u) (moebius_pt M v) (moebius_pt M w) \ \ P z u v w" + assumes conjugate: "\ z u v w. \u \ unit_disc; v \ unit_disc; w \ unit_disc; P (conjugate z) (conjugate u) (conjugate v) (conjugate w) \ \ P z u v w" + assumes perm: "P z v u w \ P z u v w" + shows "P z u v w" +proof- + obtain m n where mn: "m = u \ m = v" "n = u \ n = v" "m \ n" "m \ z" + using \u \ v\ + by auto + + have "n \ circline_set (poincare_line z m)" + using \z \ circline_set (poincare_line u v) \ circline_set H\ + using mn + using unique_poincare_line[of z m "poincare_line u v", symmetric] in_disc + by auto + + have "\ n. n \ unit_disc \ m \ n \ n \ circline_set (poincare_line z m) \ m \ z \ P z m n w" (is "?Q z m w") + proof (rule wlog_perpendicular_axes[where P="?Q"]) + show "is_poincare_line (poincare_line u v)" + using \u \ v\ + by auto + next + show "is_poincare_line H" + by fact + next + show "m \ unit_disc" "m \ circline_set (poincare_line u v)" + using mn in_disc + by auto + next + show "w \ unit_disc" "z \ unit_disc" + by fact+ + next + show "z \ circline_set (poincare_line u v) \ circline_set H" + by fact + next + show "perpendicular (poincare_line u v) H" + by fact + next + show "w \ circline_set H" + by fact + next + fix x y + assume xy: "is_real x" "0 \ Re x" "Re x < 1" "is_imag y" "0 \ Im y" "Im y < 1" + show "?Q 0\<^sub>h (of_complex x) (of_complex y)" + proof safe + fix n + assume "n \ unit_disc" "of_complex x \ n" + assume "n \ circline_set (poincare_line 0\<^sub>h (of_complex x))" "of_complex x \ 0\<^sub>h" + hence "n \ circline_set x_axis" + using poincare_line_0_real_is_x_axis[of "of_complex x"] xy + by (auto simp add: circline_set_x_axis) + then obtain n' where n': "n = of_complex n'" + using inf_or_of_complex[of n] \n \ unit_disc\ + by auto + hence "is_real n'" + using \n \ circline_set x_axis\ + using of_complex_inj + unfolding circline_set_x_axis + by auto + hence "-1 < Re n'" "Re n' < 1" + using \n \ unit_disc\ n' + by (auto simp add: cmod_eq_Re) + + have "Re n' \ Re x" + using complex.expand[of n' x] \is_real n'\ \is_real x\ \of_complex x \ n\ n' + by auto + + have "Re x > 0" + using xy \of_complex x \ 0\<^sub>h\ + by (cases "Re x = 0", auto simp add: complex.expand) + + show "P 0\<^sub>h (of_complex x) n (of_complex y)" + using axes[of x n' y] xy n' \Re x > 0\ \is_real n'\ \-1 < Re n'\ \Re n' < 1\ \Re n' \ Re x\ + by simp + qed + next + fix M u v w + assume 1: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "w \ unit_disc" + assume 2: "?Q (moebius_pt M u) (moebius_pt M v) (moebius_pt M w)" + show "?Q u v w" + proof safe + fix n + assume "n \ unit_disc" "v \ n" "n \ circline_set (poincare_line u v)" "v \ u" + thus "P u v n w" + using moebius[of M v n w u] 1 2[rule_format, of "moebius_pt M n"] + by fastforce + qed + next + fix u v w + assume 1: "u \ unit_disc" "v \ unit_disc" "w \ unit_disc" + assume 2: "?Q (conjugate u) (conjugate v) (conjugate w)" + show "?Q u v w" + proof safe + fix n + assume "n \ unit_disc" "v \ n" "n \ circline_set (poincare_line u v)" "v \ u" + thus "P u v n w" + using conjugate[of v n w u] 1 2[rule_format, of "conjugate n"] + using conjugate_inj + by auto + qed + qed + thus ?thesis + using mn in_disc \n \ circline_set (poincare_line z m)\ perm + by auto +qed + +lemma perpendicular_to_x_axis_intersects_x_axis: + assumes "is_poincare_line H" "perpendicular_to_x_axis H" + shows "intersects_x_axis H" + using assms hermitean_elems + by (transfer, transfer, auto simp add: cmod_eq_Re) + + +lemma perpendicular_intersects: + assumes "is_poincare_line H1" "is_poincare_line H2" + assumes "perpendicular H1 H2" + shows "\ z. z \ unit_disc \ z \ circline_set H1 \ circline_set H2" (is "?P' H1 H2") +proof- + have "\ H2. is_poincare_line H2 \ perpendicular H1 H2 \ ?P' H1 H2" (is "?P H1") + proof (rule wlog_line_x_axis) + show "?P x_axis" + proof safe + fix H2 + assume "is_poincare_line H2" "perpendicular x_axis H2" + thus "\z. z \ unit_disc \ z \ circline_set x_axis \ circline_set H2" + using perpendicular_to_x_axis[of H2] + using perpendicular_to_x_axis_intersects_x_axis[of H2] + using intersects_x_axis_iff[of H2] + by auto + qed + next + fix M + assume "unit_disc_fix M" + assume *: "?P (moebius_circline M H1)" + show "?P H1" + proof safe + fix H2 + assume "is_poincare_line H2" "perpendicular H1 H2" + then obtain z where "z \ unit_disc" "z \ circline_set (moebius_circline M H1) \ z \ circline_set (moebius_circline M H2)" + using *[rule_format, of "moebius_circline M H2"] \unit_disc_fix M\ + by auto + thus "\z. z \ unit_disc \ z \ circline_set H1 \ circline_set H2" + using \unit_disc_fix M\ + by (rule_tac x="moebius_pt (-M) z" in exI) + (metis IntI add.inverse_inverse circline_set_moebius_circline_iff moebius_pt_comp_inv_left uminus_moebius_def unit_disc_fix_discI unit_disc_fix_moebius_uminus) + qed + next + show "is_poincare_line H1" + by fact + qed + thus ?thesis + using assms + by auto +qed + + +definition calc_perpendicular_to_x_axis_cmat :: "complex_vec \ complex_mat" where + [simp]: "calc_perpendicular_to_x_axis_cmat z = + (let (z1, z2) = z + in if z1*cnj z2 + z2*cnj z1 = 0 then + (0, 1, 1, 0) + else + let A = z1*cnj z2 + z2*cnj z1; + B = -(z1*cnj z1 + z2*cnj z2) + in (A, B, B, A) + )" + +lift_definition calc_perpendicular_to_x_axis_clmat :: "complex_homo_coords \ circline_mat" is calc_perpendicular_to_x_axis_cmat + by (auto simp add: hermitean_def mat_adj_def mat_cnj_def Let_def split: if_split_asm) + +lift_definition calc_perpendicular_to_x_axis :: "complex_homo \ circline" is calc_perpendicular_to_x_axis_clmat +proof (transfer) + fix z w + assume "z \ vec_zero" "w \ vec_zero" + obtain z1 z2 w1 w2 where zw: "z = (z1, z2)" "w = (w1, w2)" + by (cases z, cases w, auto) + assume "z \\<^sub>v w" + then obtain k where *: "k \ 0" "w1 = k*z1" "w2 = k*z2" + using zw + by auto + have "w1 * cnj w2 + w2 * cnj w1 = (k * cnj k) * (z1 * cnj z2 + z2 * cnj z1)" + using * + by (auto simp add: field_simps) + moreover + have "w1 * cnj w1 + w2 * cnj w2 = (k * cnj k) * (z1 * cnj z1 + z2 * cnj z2)" + using * + by (auto simp add: field_simps) + ultimately + show "circline_eq_cmat (calc_perpendicular_to_x_axis_cmat z) (calc_perpendicular_to_x_axis_cmat w)" + using zw * + apply (auto simp add: Let_def) + apply (rule_tac x="Re (k * cnj k)" in exI, auto simp add: complex.expand field_simps) + done +qed + +lemma calc_perpendicular_to_x_axis: + assumes "z \ of_complex 1" "z \ of_complex (-1)" + shows "z \ circline_set (calc_perpendicular_to_x_axis z) \ + is_poincare_line (calc_perpendicular_to_x_axis z) \ + perpendicular_to_x_axis (calc_perpendicular_to_x_axis z)" + using assms + unfolding circline_set_def perpendicular_def +proof (simp, transfer, transfer) + fix z :: complex_vec + obtain z1 z2 where z: "z = (z1, z2)" + by (cases z, auto) + assume **: "\ z \\<^sub>v of_complex_cvec 1" "\ z \\<^sub>v of_complex_cvec (- 1)" + show "on_circline_cmat_cvec (calc_perpendicular_to_x_axis_cmat z) z \ + is_poincare_line_cmat (calc_perpendicular_to_x_axis_cmat z) \ + perpendicular_to_x_axis_cmat (calc_perpendicular_to_x_axis_cmat z)" + proof (cases "z1*cnj z2 + z2*cnj z1 = 0") + case True + thus ?thesis + using z + by (simp add: vec_cnj_def hermitean_def mat_adj_def mat_cnj_def mult.commute) + next + case False + hence "z2 \ 0" + using z + by auto + hence "Re (z2 * cnj z2) \ 0" + using \z2 \ 0\ + by (auto simp add: complex.expand) + + have "z1 \ -z2 \ z1 \ z2" + proof (rule ccontr) + assume "\ ?thesis" + hence "z \\<^sub>v of_complex_cvec 1 \ z \\<^sub>v of_complex_cvec (-1)" + using z \z2 \ 0\ + by auto + thus False + using ** + by auto + qed + + let ?A = "z1*cnj z2 + z2*cnj z1" and ?B = "-(z1*cnj z1 + z2*cnj z2)" + have "Re(z1*cnj z1 + z2*cnj z2) \ 0" + by auto + hence "Re ?B \ 0" + by (smt uminus_complex.simps(1)) + hence "abs (Re ?B) = - Re ?B" + by auto + also have "... = (Re z1)\<^sup>2 + (Im z1)\<^sup>2 + (Re z2)\<^sup>2 + (Im z2)\<^sup>2" + by (simp add: power2_eq_square[symmetric]) + also have "... > abs (Re ?A)" + proof (cases "Re ?A \ 0") + case False + have "(Re z1 + Re z2)\<^sup>2 + (Im z1 + Im z2)\<^sup>2 > 0" + using \z1 \ -z2 \ z1 \ z2\ + by (metis add.commute add.inverse_unique complex_neq_0 plus_complex.code plus_complex.simps) + thus ?thesis + using False + by (simp add: power2_sum power2_eq_square field_simps) + next + case True + have "(Re z1 - Re z2)\<^sup>2 + (Im z1 - Im z2)\<^sup>2 > 0" + using \z1 \ -z2 \ z1 \ z2\ + by (meson complex_eq_iff right_minus_eq sum_power2_gt_zero_iff) + thus ?thesis + using True + by (simp add: power2_sum power2_eq_square field_simps) + qed + finally + have "abs (Re ?B) > abs (Re ?A)" + . + moreover + have "cmod ?B = abs (Re ?B)" "cmod ?A = abs (Re ?A)" + by (simp_all add: cmod_eq_Re) + ultimately + have "(cmod ?B)\<^sup>2 > (cmod ?A)\<^sup>2" + by (smt power2_le_imp_le) + thus ?thesis + using z False + by (simp_all add: Let_def hermitean_def mat_adj_def mat_cnj_def cmod_eq_Re vec_cnj_def field_simps) + qed +qed + +lemma ex_perpendicular: + assumes "is_poincare_line H" "z \ unit_disc" + shows "\ H'. is_poincare_line H' \ perpendicular H H' \ z \ circline_set H'" (is "?P' H z") +proof- + have "\ z. z \ unit_disc \ ?P' H z" (is "?P H") + proof (rule wlog_line_x_axis) + show "?P x_axis" + proof safe + fix z + assume "z \ unit_disc" + then have "z \ of_complex 1" "z \ of_complex (-1)" + by auto + thus "?P' x_axis z" + using \z \ unit_disc\ + using calc_perpendicular_to_x_axis[of z] perpendicular_to_x_axis + by (rule_tac x = "calc_perpendicular_to_x_axis z" in exI, auto) + qed + next + fix M + assume "unit_disc_fix M" + assume *: "?P (moebius_circline M H)" + show "?P H" + proof safe + fix z + assume "z \ unit_disc" + hence "moebius_pt M z \ unit_disc" + using \unit_disc_fix M\ + by auto + then obtain H' where *: "is_poincare_line H'" "perpendicular (moebius_circline M H) H'" "moebius_pt M z \ circline_set H'" + using * + by auto + have h: "H = moebius_circline (-M) (moebius_circline M H)" + by auto + show "?P' H z" + using * \unit_disc_fix M\ + apply (subst h) + apply (rule_tac x="moebius_circline (-M) H'" in exI) + apply (simp del: moebius_circline_comp_inv_left) + done + qed + qed fact + thus ?thesis + using assms + by simp +qed + +lemma ex_perpendicular_foot: + assumes "is_poincare_line H" "z \ unit_disc" + shows "\ H'. is_poincare_line H' \ z \ circline_set H' \ perpendicular H H' \ + (\ z' \ unit_disc. z' \ circline_set H' \ circline_set H)" + using assms + using ex_perpendicular[OF assms] + using perpendicular_intersects[of H] + by blast + +lemma Pythagoras: + assumes in_disc: "u \ unit_disc" "v \ unit_disc" "w \ unit_disc" "v \ w" + assumes "distinct[u, v, w] \ perpendicular (poincare_line u v) (poincare_line u w)" + shows "cosh (poincare_distance v w) = cosh (poincare_distance u v) * cosh (poincare_distance u w)" (is "?P' u v w") +proof (cases "distinct [u, v, w]") + case False + thus "?thesis" + using in_disc + by (auto simp add: poincare_distance_sym) +next + case True + have "distinct [u, v, w] \ ?P' u v w" (is "?P u v w") + proof (rule wlog_perpendicular_axes[where P="?P"]) + show "is_poincare_line (poincare_line u v)" "is_poincare_line (poincare_line u w)" + using \distinct [u, v, w]\ + by simp_all + next + show "perpendicular (poincare_line u v) (poincare_line u w)" + using True assms + by simp + next + show "u \ unit_disc" "v \ unit_disc" "w \ unit_disc" + by fact+ + next + show "v \ circline_set (poincare_line u v)" "w \ circline_set (poincare_line u w)" + "u \ circline_set (poincare_line u v) \ circline_set (poincare_line u w)" + using \distinct [u, v, w]\ + by auto + next + fix x y + assume x: "is_real x" "0 \ Re x" "Re x < 1" + assume y: "is_imag y" "0 \ Im y" "Im y < 1" + + have "of_complex x \ unit_disc" "of_complex y \ unit_disc" + using x y + by (simp_all add: cmod_eq_Re cmod_eq_Im) + + show "?P 0\<^sub>h (of_complex x) (of_complex y)" + proof + assume "distinct [0\<^sub>h, of_complex x, of_complex y]" + hence "x \ 0" "y \ 0" + by auto + + let ?den1 = "1 - (cmod x)\<^sup>2" and ?den2 = "1 - (cmod y)\<^sup>2" + have "?den1 > 0" "?den2 > 0" + using x y + by (simp_all add: cmod_eq_Re cmod_eq_Im abs_square_less_1) + + let ?d1 = "1 + 2 * (cmod x)\<^sup>2 / ?den1" + have "cosh (poincare_distance 0\<^sub>h (of_complex x)) = ?d1" + using \?den1 > 0\ + using poincare_distance_formula[of "0\<^sub>h" "of_complex x"] \of_complex x \ unit_disc\ + by simp + + moreover + + let ?d2 = "1 + 2 * (cmod y)\<^sup>2 / ?den2" + have "cosh (poincare_distance 0\<^sub>h (of_complex y)) = ?d2" + using \?den2 > 0\ \of_complex y \ unit_disc\ + using poincare_distance_formula[of "0\<^sub>h" "of_complex y"] + by simp + + moreover + let ?den = "?den1 * ?den2" + let ?d3 = "1 + 2 * (cmod (x - y))\<^sup>2 / ?den" + have "cosh (poincare_distance (of_complex x) (of_complex y)) = ?d3" + using \of_complex x \ unit_disc\ \of_complex y \ unit_disc\ + using \?den1 > 0\ \?den2 > 0\ + using poincare_distance_formula[of "of_complex x" "of_complex y"] + by simp + moreover + have "?d1 * ?d2 = ?d3" + proof- + have "?d3 = ((1 - (cmod x)\<^sup>2) * (1 - (cmod y)\<^sup>2) + 2 * (cmod (x - y))\<^sup>2) / ?den" + using \?den1 > 0\ \?den2 > 0\ + by (subst add_num_frac, simp, simp) + also have "... = (Re ((1 - x * cnj x) * (1 - y * cnj y) + 2 * (x - y)*cnj (x - y)) / ?den)" + using \is_real x\ \is_imag y\ + by ((subst cmod_square)+, simp) + also have "... = Re (1 + x * cnj x * y * cnj y + + x * cnj x - 2 * y * cnj x - 2 * x * cnj y + y * cnj y) / ?den" + by (simp add: field_simps) + also have "... = Re ((1 + y * cnj y) * (1 + x * cnj x)) / ?den" + using \is_real x\ \is_imag y\ + by (simp add: field_simps) + finally + show ?thesis + using \?den1 > 0\ \?den2 > 0\ + apply (subst add_num_frac, simp) + apply (subst add_num_frac, simp) + apply simp + apply (subst cmod_square)+ + apply (simp add: field_simps) + done + qed + ultimately + show "?P' 0\<^sub>h (of_complex x) (of_complex y)" + by simp + qed + next + fix M u v w + assume 1: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "w \ unit_disc" + assume 2: "?P (moebius_pt M u) (moebius_pt M v) (moebius_pt M w)" + show "?P u v w" + using 1 2 + by auto + next + fix u v w + assume 1: "u \ unit_disc" "v \ unit_disc" "w \ unit_disc" + assume 2: "?P (conjugate u) (conjugate v) (conjugate w)" + show "?P u v w" + using 1 2 + by (auto simp add: conjugate_inj) + qed + thus ?thesis + using True + by simp +qed + +end \ No newline at end of file diff --git a/thys/Poincare_Disc/Poincare_Tarski.thy b/thys/Poincare_Disc/Poincare_Tarski.thy new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/Poincare_Tarski.thy @@ -0,0 +1,3045 @@ +section \Poincar\'e model satisfies Tarski axioms\ + +theory Poincare_Tarski + imports Poincare Poincare_Lines_Axis_Intersections Tarski +begin + +(* ------------------------------------------------------------------ *) +subsection\Pasch axiom\ +(* ------------------------------------------------------------------ *) + +lemma Pasch_fun_mono: + fixes r1 r2 :: real + assumes "0 < r1" and "r1 \ r2" and "r2 < 1" + shows "r1 + 1/r1 \ r2 + 1/r2" +proof (cases "r1 = r2") + case True + thus ?thesis + by simp +next + case False + hence "r2 - r1 > 0" + using assms + by simp + + have "r1 * r2 < 1" + using assms + by (smt mult_le_cancel_left1) + hence "1 / (r1 * r2) > 1" + using assms + by simp + hence "(r2 - r1) / (r1 * r2) > (r2 - r1)" + using \r2 - r1 > 0\ + using mult_less_cancel_left_pos[of "r2 - r1" 1 "1 / (r1 * r2)"] + by simp + hence "1 / r1 - 1 / r2 > r2 - r1" + using assms + by (simp add: field_simps) + thus ?thesis + by simp +qed + +text\Pasch axiom, non-degenerative case.\ +lemma Pasch_nondeg: + assumes "x \ unit_disc" and "y \ unit_disc" and "z \ unit_disc" and "u \ unit_disc" and "v \ unit_disc" + assumes "distinct [x, y, z, u, v]" + assumes "\ poincare_collinear {x, y, z}" + assumes "poincare_between x u z" and "poincare_between y v z" + shows "\ a. a \ unit_disc \ poincare_between u a y \ poincare_between x a v" +proof- + have "\ y z u. distinct [x, y, z, u, v] \ \ poincare_collinear {x, y, z} \ y \ unit_disc \ z \ unit_disc \ u \ unit_disc \ + poincare_between x u z \ poincare_between y v z \ (\ a. a \ unit_disc \ poincare_between u a y \ poincare_between x a v)" (is "?P x v") + proof (rule wlog_positive_x_axis[where P="?P"]) + fix v + assume v: "is_real v" "0 < Re v" "Re v < 1" + hence "of_complex v \ unit_disc" + by (auto simp add: cmod_eq_Re) + show "?P 0\<^sub>h (of_complex v)" + proof safe + fix y z u + assume distinct: "distinct [0\<^sub>h, y, z, u, of_complex v]" + assume in_disc: "y \ unit_disc" "z \ unit_disc" "u \ unit_disc" + then obtain y' z' u' + where *: "y = of_complex y'" "z = of_complex z'" "u = of_complex u'" + using inf_or_of_complex inf_notin_unit_disc + by metis + + have "y' \ 0" "z' \ 0" "u' \ 0" "v \ 0" "y' \ z'" "y' \ u'" "z' \ u'" "y \ z" "y \ u" "z \ u" + using of_complex_inj distinct * + by auto + + note distinct = distinct this + + assume "\ poincare_collinear {0\<^sub>h, y, z}" + + hence nondeg_yz: "y'*cnj z' \ cnj y' * z'" + using * poincare_collinear_zero_iff[of y' z'] in_disc distinct + by auto + + assume "poincare_between 0\<^sub>h u z" + + hence "arg u' = arg z'" "cmod u' \ cmod z'" + using * poincare_between_0uv[of u z] distinct in_disc + by auto + + then obtain \ ru rz where + uz_polar: "u' = cor ru * cis \" "z' = cor rz * cis \" "0 < ru" "ru \ rz" "0 < rz" and + "\ = arg u'" "\ = arg z'" + using * \u' \ 0\ \z' \ 0\ + by (smt cmod_cis norm_le_zero_iff) + + obtain \ ry where + y_polar: "y' = cor ry * cis \" "ry > 0" and "\ = arg y'" + using \y' \ 0\ + by (smt cmod_cis norm_le_zero_iff) + + from in_disc * \u' = cor ru * cis \\ \z' = cor rz * cis \\ \y' = cor ry * cis \\ + have "ru < 1" "rz < 1" "ry < 1" + by simp_all + + note polar = this y_polar uz_polar + + have nondeg: "cis \ * cis (- \) \ cis (- \) * cis \" + using nondeg_yz polar + by simp + + let ?yz = "poincare_line y z" + let ?v = "calc_x_axis_intersection ?yz" + + assume "poincare_between y (of_complex v) z" + + hence "of_complex v \ circline_set ?yz" + using in_disc \of_complex v \ unit_disc\ + using distinct poincare_between_poincare_collinear[of y "of_complex v" z] + using unique_poincare_line[of y z] + by (auto simp add: poincare_collinear_def) + moreover + have "of_complex v \ circline_set x_axis" + using \is_real v\ + unfolding circline_set_x_axis + by auto + moreover + have "?yz \ x_axis" + proof (rule ccontr) + assume "\ ?thesis" + hence "{0\<^sub>h, y, z} \ circline_set (poincare_line y z)" + unfolding circline_set_def + using distinct poincare_line[of y z] + by auto + hence "poincare_collinear {0\<^sub>h, y, z}" + unfolding poincare_collinear_def + using distinct + by force + thus False + using \\ poincare_collinear {0\<^sub>h, y, z}\ + by simp + qed + ultimately + have "?v = of_complex v" "intersects_x_axis ?yz" + using unique_calc_x_axis_intersection[of "poincare_line y z" "of_complex v"] + using intersects_x_axis_iff[of ?yz] + using distinct \of_complex v \ unit_disc\ + by (metis IntI is_poincare_line_poincare_line)+ + + have "intersects_x_axis_positive ?yz" + using \Re v > 0\ \of_complex v \ unit_disc\ + using \of_complex v \ circline_set ?yz\ \of_complex v \ circline_set x_axis\ + using intersects_x_axis_positive_iff[of ?yz] \y \ z\ \?yz \ x_axis\ + unfolding positive_x_axis_def + by force + + have "y \ circline_set x_axis" + proof (rule ccontr) + assume "\ ?thesis" + moreover + hence "poincare_line y (of_complex v) = x_axis" + using distinct \of_complex v \ circline_set x_axis\ + using in_disc \of_complex v \ unit_disc\ + using unique_poincare_line[of y "of_complex v" x_axis] + by simp + moreover + have "z \ circline_set (poincare_line y (of_complex v))" + using \of_complex v \ circline_set ?yz\ + using unique_poincare_line[of y "of_complex v" "poincare_line y z"] + using in_disc \of_complex v \ unit_disc\ distinct + using poincare_line[of y z] + unfolding circline_set_def + by (metis distinct_length_2_or_more is_poincare_line_poincare_line mem_Collect_eq) + ultimately + have "y \ circline_set x_axis" "z \ circline_set x_axis" + by auto + hence "poincare_collinear {0\<^sub>h, y, z}" + unfolding poincare_collinear_def + by force + thus False + using \\ poincare_collinear {0\<^sub>h, y, z}\ + by simp + qed + + moreover + + have "z \ circline_set x_axis" + proof (rule ccontr) + assume "\ ?thesis" + moreover + hence "poincare_line z (of_complex v) = x_axis" + using distinct \of_complex v \ circline_set x_axis\ + using in_disc \of_complex v \ unit_disc\ + using unique_poincare_line[of z "of_complex v" x_axis] + by simp + moreover + have "y \ circline_set (poincare_line z (of_complex v))" + using \of_complex v \ circline_set ?yz\ + using unique_poincare_line[of z "of_complex v" "poincare_line y z"] + using in_disc \of_complex v \ unit_disc\ distinct + using poincare_line[of y z] + unfolding circline_set_def + by (metis distinct_length_2_or_more is_poincare_line_poincare_line mem_Collect_eq) + ultimately + have "y \ circline_set x_axis" "z \ circline_set x_axis" + by auto + hence "poincare_collinear {0\<^sub>h, y, z}" + unfolding poincare_collinear_def + by force + thus False + using \\ poincare_collinear {0\<^sub>h, y, z}\ + by simp + qed + + ultimately + + have "\ * \ < 0" + using \poincare_between y (of_complex v) z\ + using poincare_between_x_axis_intersection[of y z "of_complex v"] + using in_disc \of_complex v \ unit_disc\ distinct + using \of_complex v \ circline_set ?yz\ \of_complex v \ circline_set x_axis\ + using \\ = arg z'\ \\ = arg y'\ * + by (simp add: field_simps) + + have "\ \ pi" "\ \ 0" + using \z \ circline_set x_axis\ * polar cis_pi + unfolding circline_set_x_axis + by auto + + have "\ \ pi" "\ \ 0" + using \y \ circline_set x_axis\ * polar cis_pi + unfolding circline_set_x_axis + by auto + + have phi_sin: "\ > 0 \ sin \ > 0" "\ < 0 \ sin \ < 0" + using \\ = arg z'\ \\ \ 0\ \\ \ pi\ + using arg_bounded[of z'] + by (smt sin_gt_zero sin_le_zero sin_pi_minus sin_0_iff_canon sin_ge_zero)+ + + have theta_sin: "\ > 0 \ sin \ > 0" "\ < 0 \ sin \ < 0" + using \\ = arg y'\ \\ \ 0\ \\ \ pi\ + using arg_bounded[of y'] + by (smt sin_gt_zero sin_le_zero sin_pi_minus sin_0_iff_canon sin_ge_zero)+ + + have "sin \ * sin \ < 0" + using \\ * \ < 0\ phi_sin theta_sin + by (simp add: mult_less_0_iff) + + have "sin (\ - \) \ 0" + proof (rule ccontr) + assume "\ ?thesis" + hence "sin (\ - \) = 0" + by simp + have "- 2 * pi < \ - \" "\ - \ < 2 * pi" + using \\ = arg z'\ \\ = arg y'\ arg_bounded[of z'] arg_bounded[of y'] \\ \ pi\ \\ \ pi\ + by auto + hence "\ - \ = -pi \ \ - \ = 0 \ \ - \ = pi" + using \sin (\ - \) = 0\ + by (smt sin_0_iff_canon sin_periodic_pi2) + moreover + { + assume "\ - \ = - pi" + hence "\ = \ - pi" + by simp + hence False + using nondeg_yz + using \y' = cor ry * cis \\ \z' = cor rz * cis \\ \rz > 0\ \ry > 0\ + by auto + } + moreover + { + assume "\ - \ = 0" + hence "\ = \" + by simp + hence False + using \y' = cor ry * cis \\ \z' = cor rz * cis \\ \rz > 0\ \ry > 0\ + using nondeg_yz + by auto + } + moreover + { + assume "\ - \ = pi" + hence "\ = \ + pi" + by simp + hence False + using \y' = cor ry * cis \\ \z' = cor rz * cis \\ \rz > 0\ \ry > 0\ + using nondeg_yz + by auto + } + ultimately + show False + by auto + qed + + have "u \ circline_set x_axis" + proof- + have "\ is_real u'" + using * polar in_disc + using \\ \ 0\ \\ = arg u'\ \\ \ pi\ phi_sin(1) phi_sin(2) + by (metis is_real_arg2) + moreover + have "u \ \\<^sub>h" + using in_disc + by auto + ultimately + show ?thesis + using * of_complex_inj[of u'] + unfolding circline_set_x_axis + by auto + qed + + let ?yu = "poincare_line y u" + have nondeg_yu: "y' * cnj u' \ cnj u' * u'" + using nondeg_yz polar \ru > 0\ \rz > 0\ distinct + by auto + + { + (* derive results simultaneously for both u and z *) + fix r :: real + assume "r > 0" + + have den: "cor ry * cis \ * cnj 1 * cnj (cor r * cis \) * 1 - cor r * cis \ * cnj 1 * cnj (cor ry * cis \) * 1 \ 0" + using \0 < r\ \0 < ry\ nondeg + by auto + + let ?A = "2 * r * ry * sin(\ - \)" + let ?B = "\ * (r * cis \ * (1 + ry\<^sup>2) - ry * cis \ * (1 + r\<^sup>2))" + let ?ReB = "ry * (1 + r\<^sup>2) * sin \ - r * (1 + ry\<^sup>2) * sin \" + + have "Re (\ * (r * cis (-\) * ry * cis (\) - ry * cis (-\) * r * cis (\))) = ?A" + by (simp add: sin_diff field_simps) + moreover + have "cor ry * cis (- \) * (cor ry * cis \) = ry\<^sup>2" "cor r * cis (- \) * (cor r * cis \) = r\<^sup>2" + by (metis cis_inverse cis_neq_zero divide_complex_def cor_squared nonzero_mult_div_cancel_right power2_eq_square semiring_normalization_rules(15))+ + ultimately + have 1: "poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \)) (of_complex_cvec (cor r * cis \)) = (?A, ?B, cnj ?B, ?A)" + using den + unfolding poincare_line_cvec_cmat_def of_complex_cvec_def Let_def prod.case + by (simp add: field_simps) + + have 2: "is_real ?A" + by simp + let ?mix = "cis \ * cis (- \) - cis (- \) * cis \" + have "is_imag ?mix" + using eq_minus_cnj_iff_imag[of ?mix] + by simp + hence "Im ?mix \ 0" + using nondeg + using complex.expand[of ?mix 0] + by auto + hence 3: "Re ?A \ 0" + using \r > 0\ \ry > 0\ + by (simp add: sin_diff field_simps) + + have "?A \ 0" + using 2 3 + by auto + hence 4: "cor ?A \ 0" + using 2 3 + by (metis zero_complex.simps(1)) + + have 5: "?ReB / ?A = (sin \) / (2 * sin(\ - \)) * (1/r + r) - (sin \) / (2 * sin (\ - \)) * (1/ry + ry)" + using \ry > 0\ \r > 0\ + apply (subst diff_divide_distrib) + apply (subst add_frac_num, simp) + apply (subst add_frac_num, simp) + apply (simp add: power2_eq_square mult.commute) + apply (simp add: field_simps) + done + + have "poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \)) (of_complex_cvec (cor r * cis \)) = (?A, ?B, cnj ?B, ?A) \ + is_real ?A \ Re ?A \ 0 \ ?A \ 0 \ cor ?A \ 0 \ + Re ?B = ?ReB \ + ?ReB / ?A = (sin \) / (2 * sin(\ - \)) * (1/r + r) - (sin \) / (2 * sin (\ - \)) * (1/ry + ry)" + using 1 2 3 4 5 + by auto + } + note ** = this + + let ?Ayz = "2 * rz * ry * sin (\ - \)" + let ?Byz = "\ * (rz * cis \ * (1 + ry\<^sup>2) - ry * cis \ * (1 + rz\<^sup>2))" + let ?ReByz = "ry * (1 + rz\<^sup>2) * sin \ - rz * (1 + ry\<^sup>2) * sin \" + let ?Kz = "(sin \) / (2 * sin(\ - \)) * (1/rz + rz) - (sin \) / (2 * sin (\ - \)) * (1/ry + ry)" + have yz: "poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \)) (of_complex_cvec (cor rz * cis \)) = (?Ayz, ?Byz, cnj ?Byz, ?Ayz)" + "is_real ?Ayz" "Re ?Ayz \ 0" "?Ayz \ 0" "cor ?Ayz \ 0" "Re ?Byz = ?ReByz" and Kz: "?ReByz / ?Ayz = ?Kz" + using **[OF \0 < rz\] + by auto + + let ?Ayu = "2 * ru * ry * sin (\ - \)" + let ?Byu = "\ * (ru * cis \ * (1 + ry\<^sup>2) - ry * cis \ * (1 + ru\<^sup>2))" + let ?ReByu = "ry * (1 + ru\<^sup>2) * sin \ - ru * (1 + ry\<^sup>2) * sin \" + let ?Ku = "(sin \) / (2 * sin(\ - \)) * (1/ru + ru) - (sin \) / (2 * sin (\ - \)) * (1/ry + ry)" + have yu: "poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \)) (of_complex_cvec (cor ru * cis \)) = (?Ayu, ?Byu, cnj ?Byu, ?Ayu)" + "is_real ?Ayu" "Re ?Ayu \ 0" "?Ayu \ 0" "cor ?Ayu \ 0" "Re ?Byu = ?ReByu" and Ku: "?ReByu / ?Ayu = ?Ku" + using **[OF \0 < ru\] + by auto + + have "?Ayz \ 0" + using \sin (\ - \) \ 0\ \ry > 0\ \rz > 0\ + by auto + + have "Re ?Byz / ?Ayz < -1" + using \intersects_x_axis_positive ?yz\ + * \y' = cor ry * cis \\ \z' = cor rz * cis \\ \u' = cor ru * cis \\ + apply simp + apply (transfer fixing: ry rz ru \ \) + apply (transfer fixing: ry rz ru \ \) + proof- + assume "intersects_x_axis_positive_cmat (poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \)) (of_complex_cvec (cor rz * cis \)))" + thus "(ry * sin \ * (1 + rz\<^sup>2) - rz * sin \ * (1 + ry\<^sup>2)) / (2 * rz * ry * sin (\ - \)) < - 1" + using yz + by simp + qed + + have "?ReByz / ?Ayz \ ?ReByu / ?Ayu" + proof (cases "sin \ > 0") + case True + hence "sin \ < 0" + using \sin \ * sin \ < 0\ + by (smt mult_nonneg_nonneg) + + have "?ReByz < 0" + proof- + have "ry * (1 + rz\<^sup>2) * sin \ < 0" + using \ry > 0\ \rz > 0\ + using \sin \ < 0\ + by (smt mult_pos_neg mult_pos_pos zero_less_power) + moreover + have "rz * (1 + ry\<^sup>2) * sin \ > 0" + using \ry > 0\ \rz > 0\ + using \sin \ > 0\ + by (smt mult_pos_neg mult_pos_pos zero_less_power) + ultimately + show ?thesis + by simp + qed + have "?Ayz > 0" + using \Re ?Byz / ?Ayz < -1\ \Re ?Byz = ?ReByz\ \?ReByz < 0\ + by (smt divide_less_0_iff) + hence "sin (\ - \) > 0" + using \ry > 0\ \rz > 0\ + by (smt mult_pos_pos zero_less_mult_pos) + + have "1 / ru + ru \ 1 / rz + rz" + using Pasch_fun_mono[of ru rz] \0 < ru\ \ru \ rz\ \rz < 1\ + by simp + hence "sin \ * (1 / ru + ru) \ sin \ * (1 / rz + rz)" + using \sin \ < 0\ + by auto + thus ?thesis + using \ru > 0\ \rz > 0\ \ru \ rz\ \rz < 1\ \?Ayz > 0\ \sin (\ - \) > 0\ + using divide_right_mono[of "sin \ * (1 / ru + ru)" "sin \ * (1 / rz + rz)" "2 * sin (\ - \)"] + by (subst Kz, subst Ku) simp + next + assume "\ sin \ > 0" + hence "sin \ < 0" + using \sin \ * sin \ < 0\ + by (cases "sin \ = 0", simp_all) + hence "sin \ > 0" + using \sin \ * sin \ < 0\ + by (smt mult_nonpos_nonpos) + have "?ReByz > 0" + proof- + have "ry * (1 + rz\<^sup>2) * sin \ > 0" + using \ry > 0\ \rz > 0\ + using \sin \ > 0\ + by (smt mult_pos_neg mult_pos_pos zero_less_power) + moreover + have "rz * (1 + ry\<^sup>2) * sin \ < 0" + using \ry > 0\ \rz > 0\ + using \sin \ < 0\ + by (smt mult_pos_neg mult_pos_pos zero_less_power) + ultimately + show ?thesis + by simp + qed + have "?Ayz < 0" + using \Re ?Byz / ?Ayz < -1\ \?Ayz \ 0\ \Re ?Byz = ?ReByz\ \?ReByz > 0\ + by (smt divide_less_0_iff) + hence "sin (\ - \) < 0" + using \ry > 0\ \rz > 0\ + by (smt mult_nonneg_nonneg) + + have "1 / ru + ru \ 1 / rz + rz" + using Pasch_fun_mono[of ru rz] \0 < ru\ \ru \ rz\ \rz < 1\ + by simp + hence "sin \ * (1 / ru + ru) \ sin \ * (1 / rz + rz)" + using \sin \ > 0\ + by auto + thus ?thesis + using \ru > 0\ \rz > 0\ \ru \ rz\ \rz < 1\ \?Ayz < 0\ \sin (\ - \) < 0\ + using divide_right_mono_neg[of "sin \ * (1 / rz + rz)" "sin \ * (1 / ru + ru)" "2 * sin (\ - \)"] + by (subst Kz, subst Ku) simp + qed + + have "intersects_x_axis_positive ?yu" + using * \y' = cor ry * cis \\ \z' = cor rz * cis \\ \u' = cor ru * cis \\ + apply simp + apply (transfer fixing: ry rz ru \ \) + apply (transfer fixing: ry rz ru \ \) + proof- + have "Re ?Byu / ?Ayu < -1" + using \Re ?Byz / ?Ayz < -1\ \?ReByz / ?Ayz \ ?ReByu / ?Ayu\ + by (subst (asm) \Re ?Byz = ?ReByz\, subst \Re ?Byu = ?ReByu\) simp + thus "intersects_x_axis_positive_cmat (poincare_line_cvec_cmat (of_complex_cvec (cor ry * cis \)) (of_complex_cvec (cor ru * cis \)))" + using yu + by simp + qed + + let ?a = "calc_x_axis_intersection ?yu" + have "?a \ positive_x_axis" "?a \ circline_set ?yu" "?a \ unit_disc" + using \intersects_x_axis_positive ?yu\ + using intersects_x_axis_positive_iff'[of ?yu] \y \ u\ + by auto + + then obtain a' where a': "?a = of_complex a'" "is_real a'" "Re a' > 0" "Re a' < 1" + unfolding positive_x_axis_def circline_set_x_axis + by (auto simp add: cmod_eq_Re) + + have "intersects_x_axis ?yz" "intersects_x_axis ?yu" + using \intersects_x_axis_positive ?yz\ \intersects_x_axis_positive ?yu\ + by auto + + show "\a. a \ unit_disc \ poincare_between u a y \ poincare_between 0\<^sub>h a (of_complex v)" + proof (rule_tac x="?a" in exI, safe) + show "poincare_between u ?a y" + using poincare_between_x_axis_intersection[of y u ?a] + using calc_x_axis_intersection[OF is_poincare_line_poincare_line[OF \y \ u\] \intersects_x_axis ?yu\] + using calc_x_axis_intersection_in_unit_disc[OF is_poincare_line_poincare_line[OF \y \ u\] \intersects_x_axis ?yu\] + using in_disc \y \ u\ \y \ circline_set x_axis\ \u \ circline_set x_axis\ + using * \\ = arg u'\ \\ = arg y'\ \\ * \ < 0\ + by (subst poincare_between_rev, auto simp add: mult.commute) + next + show "poincare_between 0\<^sub>h ?a (of_complex v)" + proof- + have "-?ReByz / ?Ayz \ -?ReByu / ?Ayu" + using \?ReByz / ?Ayz \ ?ReByu / ?Ayu\ + by linarith + have "outward ?yz ?yu" + using * \y' = cor ry * cis \\ \z' = cor rz * cis \\ \u' = cor ru * cis \\ + apply simp + apply (transfer fixing: ry rz ru \ \) + apply (transfer fixing: ry rz ru \ \) + apply (subst yz yu)+ + unfolding outward_cmat_def + apply (simp only: Let_def prod.case) + apply (subst yz yu)+ + using \-?ReByz / ?Ayz \ -?ReByu / ?Ayu\ + by simp + hence "Re a' \ Re v" + using \?v = of_complex v\ + using \?a = of_complex a'\ + using \intersects_x_axis_positive ?yz\ \intersects_x_axis_positive ?yu\ + using outward[OF is_poincare_line_poincare_line[OF \y \ z\] is_poincare_line_poincare_line[OF \y \ u\]] + by simp + thus ?thesis + using \?v = of_complex v\ + using poincare_between_x_axis_0uv[of "Re a'" "Re v"] a' v + by simp + qed + next + show "?a \ unit_disc" + by fact + qed + qed + next + show "x \ unit_disc" "v \ unit_disc" "x \ v" + using assms + by auto + next + fix M x v + let ?Mx = "moebius_pt M x" and ?Mv = "moebius_pt M v" + assume 1: "unit_disc_fix M" "x \ unit_disc" "v \ unit_disc" "x \ v" + assume 2: "?P ?Mx ?Mv" + show "?P x v" + proof safe + fix y z u + let ?My = "moebius_pt M y" and ?Mz = "moebius_pt M z" and ?Mu = "moebius_pt M u" + assume "distinct [x, y, z, u, v]" "\ poincare_collinear {x, y, z}" "y \ unit_disc" "z \ unit_disc" "u \ unit_disc" + "poincare_between x u z" "poincare_between y v z" + hence "\ Ma. Ma \ unit_disc \ poincare_between ?Mu Ma ?My \ poincare_between ?Mx Ma ?Mv" + using 1 2[rule_format, of ?My ?Mz ?Mu] + by simp + then obtain Ma where Ma: "Ma \ unit_disc" "poincare_between ?Mu Ma ?My \ poincare_between ?Mx Ma ?Mv" + by blast + let ?a = "moebius_pt (-M) Ma" + let ?Ma = "moebius_pt M ?a" + have "?Ma = Ma" + by (metis moebius_pt_invert uminus_moebius_def) + hence "?Ma \ unit_disc" "poincare_between ?Mu ?Ma ?My \ poincare_between ?Mx ?Ma ?Mv" + using Ma + by auto + thus "\a. a \ unit_disc \ poincare_between u a y \ poincare_between x a v" + using unit_disc_fix_moebius_inv[OF \unit_disc_fix M\] \unit_disc_fix M\ \Ma \ unit_disc\ + using \u \ unit_disc\ \v \ unit_disc\ \x \ unit_disc\ \y \ unit_disc\ + by (rule_tac x="?a" in exI, simp del: moebius_pt_comp_inv_right) + qed + qed + thus ?thesis + using assms + by auto +qed + +text\Pasch axiom, only degenerative cases.\ +lemma Pasch_deg: + assumes "x \ unit_disc" and "y \ unit_disc" and "z \ unit_disc" and "u \ unit_disc" and "v \ unit_disc" + assumes "\ distinct [x, y, z, u, v] \ poincare_collinear {x, y, z}" + assumes "poincare_between x u z" and "poincare_between y v z" + shows "\ a. a \ unit_disc \ poincare_between u a y \ poincare_between x a v" +proof(cases "poincare_collinear {x, y, z}") + case True + hence "poincare_between x y z \ poincare_between y x z \ poincare_between y z x" + using assms(1, 2, 3) poincare_collinear3_between poincare_between_rev by blast + show ?thesis + proof(cases "poincare_between x y z") + case True + have "poincare_between x y v" + using True assms poincare_between_transitivity + by (meson poincare_between_rev) + thus ?thesis + using assms(2) + by (rule_tac x="y" in exI, simp) + next + case False + hence "poincare_between y x z \ poincare_between y z x" + using \poincare_between x y z \ poincare_between y x z \ poincare_between y z x\ + by simp + show ?thesis + proof(cases "poincare_between y x z") + case True + hence "poincare_between u x y" + using assms + by (meson poincare_between_rev poincare_between_transitivity) + thus ?thesis + using assms + by (rule_tac x="x" in exI, simp) + next + case False + hence "poincare_between y z x" + using \poincare_between y x z \ poincare_between y z x\ + by auto + hence "poincare_between x z v" + using assms + by (meson poincare_between_rev poincare_between_transitivity) + hence "poincare_between x u v" + using assms poincare_between_transitivity poincare_between_rev + by (smt poincare_between_sum_distances) + thus ?thesis + using assms + by (rule_tac x="u" in exI, simp) + qed + qed +next + case False + hence "\ distinct [x, y, z, u, v]" + using assms(6) by auto + show ?thesis + proof(cases "u=z") + case True + thus ?thesis + using assms + apply(rule_tac x="v" in exI) + by(simp add:poincare_between_rev) + next + case False (* "u \ z" *) + hence "x \ z" + using assms poincare_between_sandwich by blast + show ?thesis + proof(cases "v=z") + case True + thus ?thesis + using assms + by (rule_tac x="u" in exI, simp) + next + case False (* v \ z *) + hence "y \ z" + using assms poincare_between_sandwich by blast + show ?thesis + proof(cases "u = x") + case True + thus ?thesis + using assms + by (rule_tac x="x" in exI, simp) + next + case False (*u \ x*) + have "x \ y" + using assms \\ poincare_collinear {x, y, z}\ + by fastforce + have "x \ v" + using assms \\ poincare_collinear {x, y, z}\ + by (metis insert_commute poincare_between_poincare_collinear) + have "u \ y" + using assms \\ poincare_collinear {x, y, z}\ + using poincare_between_poincare_collinear by blast + have "u \ v" + proof(rule ccontr) + assume "\ u \ v" + hence "poincare_between x v z" + using assms by auto + hence "x \ circline_set (poincare_line z v)" + using poincare_between_rev[of x v z] + using poincare_between_poincare_line_uvz[of z v x] + using assms \v \ z\ + by auto + have "y \ circline_set (poincare_line z v)" + using assms \\ u \ v\ + using poincare_between_rev[of y v z] + using poincare_between_poincare_line_uvz[of z v y] + using assms \v \ z\ + by auto + have "z \ circline_set (poincare_line z v)" + using ex_poincare_line_two_points[of z v] \v \ z\ + by auto + have "is_poincare_line (poincare_line z v)" + using \v \ z\ + by auto + hence "poincare_collinear {x, y, z}" + using \x \ circline_set (poincare_line z v)\ + using \y \ circline_set (poincare_line z v)\ + using \z \ circline_set (poincare_line z v)\ + unfolding poincare_collinear_def + by (rule_tac x="poincare_line z v" in exI, simp) + thus False + using \\ poincare_collinear {x, y, z}\ by simp + qed + have "v = y" + using \u \ v\ \u \ y\ \x \ v\ \x \ y\ \u \ x\ \y \ z\ \v \ z\ \x \ z\ \u \ z\ + using \\ distinct [x, y, z, u, v]\ + by auto + thus ?thesis + using assms + by (rule_tac x="y" in exI, simp) + qed + qed + qed +qed + +text \Axiom of Pasch\ +lemma Pasch: + assumes "x \ unit_disc" and "y \ unit_disc" and "z \ unit_disc" and "u \ unit_disc" and "v \ unit_disc" + assumes "poincare_between x u z" and "poincare_between y v z" + shows "\ a. a \ unit_disc \ poincare_between u a y \ poincare_between x a v" +proof(cases "distinct [x, y, z, u, v] \ \ poincare_collinear {x, y, z}") + case True + thus ?thesis + using assms Pasch_nondeg by auto +next + case False + thus ?thesis + using assms Pasch_deg by auto +qed + +(* ------------------------------------------------------------------ *) +subsection\Segment construction axiom\ +(* ------------------------------------------------------------------ *) + +lemma segment_construction: + assumes "x \ unit_disc" and "y \ unit_disc" + assumes "a \ unit_disc" and "b \ unit_disc" + shows "\ z. z \ unit_disc \ poincare_between x y z \ poincare_distance y z = poincare_distance a b" +proof- + obtain d where d: "d = poincare_distance a b" + by auto + have "d \ 0" + using assms + by (simp add: d poincare_distance_ge0) + + have "\ z. z \ unit_disc \ poincare_between x y z \ poincare_distance y z = d" (is "?P x y") + proof (cases "x = y") + case True + have "\ z. z \ unit_disc \ poincare_distance x z = d" + proof (rule wlog_zero) + show "\ z. z \ unit_disc \ poincare_distance 0\<^sub>h z = d" + using ex_x_axis_poincare_distance_negative[of d] \d \ 0\ + by blast + next + show "x \ unit_disc" + by fact + next + fix a u + assume "u \ unit_disc" "cmod a < 1" + assume "\z. z \ unit_disc \ poincare_distance (moebius_pt (blaschke a) u) z = d" + then obtain z where *: "z \ unit_disc" "poincare_distance (moebius_pt (blaschke a) u) z = d" + by auto + obtain z' where z': "z = moebius_pt (blaschke a) z'" "z' \ unit_disc" + using \z \ unit_disc\ + using unit_disc_fix_iff[of "blaschke a"] \cmod a < 1\ + using blaschke_unit_disc_fix[of a] + by blast + + show "\z. z \ unit_disc \ poincare_distance u z = d" + using * z' \u : unit_disc\ + using blaschke_unit_disc_fix[of a] \cmod a < 1\ + by (rule_tac x=z' in exI, simp) + qed + thus ?thesis + using \x = y\ + unfolding poincare_between_def + by auto + next + case False + show ?thesis + proof (rule wlog_positive_x_axis[where P="\ y x. ?P x y"]) + fix x + assume "is_real x" "0 < Re x" "Re x < 1" + + then obtain z where z: "is_real z" "Re z \ 0" "- 1 < Re z" "of_complex z \ unit_disc" + "of_complex z \ unit_disc" "of_complex z \ circline_set x_axis" "poincare_distance 0\<^sub>h (of_complex z) = d" + using ex_x_axis_poincare_distance_negative[of d] \d \ 0\ + by auto + + have "poincare_between (of_complex x) 0\<^sub>h (of_complex z)" + proof (cases "z = 0") + case True + thus ?thesis + unfolding poincare_between_def + by auto + next + case False + have "x \ 0" + using \is_real x\ \Re x > 0\ + by auto + thus ?thesis + using poincare_between_x_axis_u0v[of x z] + using z \is_real x\ \x \ 0\ \Re x > 0\ False + using complex_eq_if_Re_eq mult_pos_neg + by fastforce + qed + thus "?P (of_complex x) 0\<^sub>h" + using \poincare_distance 0\<^sub>h (of_complex z) = d\ \of_complex z \ unit_disc\ + by blast + next + show "x \ unit_disc" "y \ unit_disc" + by fact+ + next + show "y \ x" using \x \ y\ by simp + next + fix M u v + assume "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "u \ v" + assume "?P (moebius_pt M v) (moebius_pt M u)" + then obtain z where *: "z \ unit_disc" "poincare_between (moebius_pt M v) (moebius_pt M u) z" "poincare_distance (moebius_pt M u) z = d" + by auto + obtain z' where z': "z = moebius_pt M z'" "z' \ unit_disc" + using \z \ unit_disc\ + using unit_disc_fix_iff[of M] \unit_disc_fix M\ + by blast + thus "?P v u" + using * \u \ unit_disc\ \v \ unit_disc\ \unit_disc_fix M\ + by auto + qed + qed + thus ?thesis + using assms d + by auto +qed + +(* ------------------------------------------------------------------ *) +subsection\Five segment axiom\ +(* ------------------------------------------------------------------ *) + +lemma five_segment_axiom: + assumes + in_disc: "x \ unit_disc" "y \ unit_disc" "z \ unit_disc" "u \ unit_disc" and + in_disc': "x' \ unit_disc" "y' \ unit_disc" "z' \ unit_disc" "u' \ unit_disc" and + "x \ y" and + betw: "poincare_between x y z" "poincare_between x' y' z'" and + xy: "poincare_distance x y = poincare_distance x' y'" and + xu: "poincare_distance x u = poincare_distance x' u'" and + yu: "poincare_distance y u = poincare_distance y' u'" and + yz: "poincare_distance y z = poincare_distance y' z'" + shows + "poincare_distance z u = poincare_distance z' u'" +proof- + from assms obtain M where + M: "unit_disc_fix_f M" "M x = x'" "M u = u'" "M y = y'" + using unit_disc_fix_f_congruent_triangles[of x y u] + by blast + have "M z = z'" + proof (rule unique_poincare_distance_on_ray[where u=x' and v=y' and y="M z" and z=z' and d="poincare_distance x z"]) + show "0 \ poincare_distance x z" + using poincare_distance_ge0 in_disc + by simp + next + show "x' \ y'" + using M \x \ y\ + using in_disc in_disc' poincare_distance_eq_0_iff xy + by auto + next + show "poincare_distance x' (M z) = poincare_distance x z" + using M in_disc + unfolding unit_disc_fix_f_def + by auto + next + show "M z \ unit_disc" + using M in_disc + unfolding unit_disc_fix_f_def + by auto + next + show "poincare_distance x' z' = poincare_distance x z" + using xy yz betw + using poincare_between_sum_distances[of x y z] + using poincare_between_sum_distances[of x' y' z'] + using in_disc in_disc' + by auto + next + show "poincare_between x' y' (M z)" + using M + using in_disc betw + unfolding unit_disc_fix_f_def + by auto + qed fact+ + thus ?thesis + using \unit_disc_fix_f M\ + using in_disc in_disc' + \M u = u'\ + unfolding unit_disc_fix_f_def + by auto +qed + +(* ------------------------------------------------------------------ *) +subsection\Upper dimension axiom\ +(* ------------------------------------------------------------------ *) + +lemma upper_dimension_axiom: + assumes in_disc: "x \ unit_disc" "y \ unit_disc" "z \ unit_disc" "u \ unit_disc" "v \ unit_disc" + assumes "poincare_distance x u = poincare_distance x v" + "poincare_distance y u = poincare_distance y v" + "poincare_distance z u = poincare_distance z v" + "u \ v" + shows "poincare_between x y z \ poincare_between y z x \ poincare_between z x y" +proof (cases "x = y \ y = z \ x = z") + case True + thus ?thesis + using in_disc + by auto +next + case False + hence "x \ y" "x \ z" "y \ z" + by auto + let ?cong = "\ a b a' b'. poincare_distance a b = poincare_distance a' b'" + have "\ z u v. z \ unit_disc \ u \ unit_disc \ v \ unit_disc \ + ?cong x u x v \ ?cong y u y v \ ?cong z u z v \ u \ v \ + poincare_collinear {x, y, z}" (is "?P x y") + proof (rule wlog_positive_x_axis[where P="?P"]) + fix x + assume x: "is_real x" "0 < Re x" "Re x < 1" + hence "x \ 0" + by auto + have "0\<^sub>h \ circline_set x_axis" + by simp + show "?P 0\<^sub>h (of_complex x)" + proof safe + fix z u v + assume in_disc: "z \ unit_disc" "u \ unit_disc" "v \ unit_disc" + then obtain z' u' v' where zuv: "z = of_complex z'" "u = of_complex u'" "v = of_complex v'" + using inf_or_of_complex[of z] inf_or_of_complex[of u] inf_or_of_complex[of v] + by auto + + assume cong: "?cong 0\<^sub>h u 0\<^sub>h v" "?cong (of_complex x) u (of_complex x) v" "?cong z u z v" "u \ v" + + let ?r0 = "poincare_distance 0\<^sub>h u" and + ?rx = "poincare_distance (of_complex x) u" + + have "?r0 > 0" "?rx > 0" + using in_disc cong + using poincare_distance_eq_0_iff[of "0\<^sub>h" u] poincare_distance_ge0[of "0\<^sub>h" u] + using poincare_distance_eq_0_iff[of "0\<^sub>h" v] poincare_distance_ge0[of "0\<^sub>h" v] + using poincare_distance_eq_0_iff[of "of_complex x" u] poincare_distance_ge0[of "of_complex x" u] + using poincare_distance_eq_0_iff[of "of_complex x" v] poincare_distance_ge0[of "of_complex x" v] + using x + by (auto simp add: cmod_eq_Re) + + let ?pc0 = "poincare_circle 0\<^sub>h ?r0" and + ?pcx = "poincare_circle (of_complex x) ?rx" + have "u \ ?pc0 \ ?pcx" "v \ ?pc0 \ ?pcx" + using in_disc cong + by (auto simp add: poincare_circle_def) + hence "u = conjugate v" + using intersect_poincare_circles_x_axis[of 0 x ?r0 ?rx u v] + using x \x \ 0\ \u \ v\ \?r0 > 0\ \?rx > 0\ + by simp + + let ?ru = "poincare_distance u z" + have "?ru > 0" + using poincare_distance_ge0[of u z] in_disc + using cong + using poincare_distance_eq_0_iff[of z u] poincare_distance_eq_0_iff[of z v] + using poincare_distance_eq_0_iff + by force + + have "z \ poincare_circle u ?ru \ poincare_circle v ?ru" + using cong in_disc + unfolding poincare_circle_def + by (simp add: poincare_distance_sym) + + hence "is_real z'" + using intersect_poincare_circles_conjugate_centers[of u v ?ru z] \u = conjugate v\ zuv + using in_disc \u \ v\ \?ru > 0\ + by simp + + thus "poincare_collinear {0\<^sub>h, of_complex x, z}" + using poincare_line_0_real_is_x_axis[of "of_complex x"] x \x \ 0\ zuv \0\<^sub>h \ circline_set x_axis\ + unfolding poincare_collinear_def + by (rule_tac x=x_axis in exI, auto simp add: circline_set_x_axis) + qed + next + fix M x y + assume 1: "unit_disc_fix M" "x \ unit_disc" "y \ unit_disc" "x \ y" + assume 2: "?P (moebius_pt M x) (moebius_pt M y)" + show "?P x y" + proof safe + fix z u v + assume "z \ unit_disc" "u \ unit_disc" "v \ unit_disc" + "?cong x u x v" "?cong y u y v" "?cong z u z v" "u \ v" + hence "poincare_collinear {moebius_pt M x, moebius_pt M y, moebius_pt M z}" + using 1 2[rule_format, of "moebius_pt M z" "moebius_pt M u" "moebius_pt M v"] + by simp + then obtain p where "is_poincare_line p" "{moebius_pt M x, moebius_pt M y, moebius_pt M z} \ circline_set p" + unfolding poincare_collinear_def + by auto + thus "poincare_collinear {x, y, z}" + using \unit_disc_fix M\ + unfolding poincare_collinear_def + by (rule_tac x="moebius_circline (-M) p" in exI, auto) + qed + qed fact+ + + thus ?thesis + using assms + using poincare_collinear3_between[of x y z] + using poincare_between_rev + by auto +qed + +(* ------------------------------------------------------------------ *) +subsection\Lower dimension axiom\ +(* ------------------------------------------------------------------ *) + +lemma lower_dimension_axiom: + shows "\ a \ unit_disc. \ b \ unit_disc. \ c \ unit_disc. + \ poincare_between a b c \ \ poincare_between b c a \ \ poincare_between c a b" +proof- + let ?u = "of_complex (1/2)" and ?v = "of_complex (\/2)" + have 1: "0\<^sub>h \ unit_disc" and 2: "?u \ unit_disc" and 3: "?v \ unit_disc" + by simp_all + have *: "\ poincare_collinear {0\<^sub>h, ?u, ?v}" + proof (rule ccontr) + assume "\ ?thesis" + then obtain p where "is_poincare_line p" "{0\<^sub>h, ?u, ?v} \ circline_set p" + unfolding poincare_collinear_def + by auto + moreover + have "of_complex (1 / 2) \ of_complex (\ / 2)" + using of_complex_inj + by fastforce + ultimately + have "0\<^sub>h \ circline_set (poincare_line ?u ?v)" + using unique_poincare_line[of ?u ?v p] + by auto + thus False + unfolding circline_set_def + by simp (transfer, transfer, simp add: vec_cnj_def) + qed + show ?thesis + apply (rule_tac x="0\<^sub>h" in bexI, rule_tac x="?u" in bexI, rule_tac x="?v" in bexI) + apply (rule ccontr, auto) + using * + using poincare_between_poincare_collinear[OF 1 2 3] + using poincare_between_poincare_collinear[OF 2 3 1] + using poincare_between_poincare_collinear[OF 3 1 2] + by (metis insert_commute)+ +qed + +(* ------------------------------------------------------------------ *) +subsection\Negated Euclidean axiom\ +(* ------------------------------------------------------------------ *) + +lemma negated_euclidean_axiom_aux: + assumes "on_circline H (of_complex (1/2 + \/2))" and "is_poincare_line H" + assumes "intersects_x_axis_positive H" + shows "\ intersects_y_axis_positive H" + using assms +proof (transfer, transfer) + fix H + assume hh: "hermitean H \ H \ mat_zero" "is_poincare_line_cmat H" + obtain A B C D where "H = (A, B, C, D)" + by (cases H, auto) + hence *: "is_real A" "H = (A, B, cnj B, A)" "(cmod B)\<^sup>2 > (cmod A)\<^sup>2" + using hermitean_elems[of A B C D] hh + by auto + + assume "intersects_x_axis_positive_cmat H" + hence "Re A \ 0" "Re B / Re A < - 1" + using * + by auto + + assume "on_circline_cmat_cvec H (of_complex_cvec (1 / 2 + \ / 2))" + hence "6*A + 4*Re B + 4*Im B = 0" + using * + unfolding cor_mult + apply (subst Re_express_cnj[of B]) + apply (subst Im_express_cnj[of B]) + apply (simp add: vec_cnj_def) + apply (simp add: field_simps) + done + hence "Re (6*A + 4*Re B + 4*Im B) = 0" + by simp + hence "3*Re A + 2*Re B + 2*Im B = 0" + using \is_real A\ + by simp + + hence "3/2 + Re B/Re A + Im B/Re A = 0" + using \Re A \ 0\ + by (simp add: field_simps) + + hence "-Im B/Re A - 3/2 < -1" + using \Re B / Re A < -1\ + by simp + hence "Im B/Re A > -1/2" + by (simp add: field_simps) + thus "\ intersects_y_axis_positive_cmat H" + using * + by simp +qed + +lemma negated_euclidean_axiom: + shows "\ a b c d t. + a \ unit_disc \ b \ unit_disc \ c \ unit_disc \ d \ unit_disc \ t \ unit_disc \ + poincare_between a d t \ poincare_between b d c \ a \ d \ + (\ x y. x \ unit_disc \ y \ unit_disc \ + poincare_between a b x \ poincare_between x t y \ \ poincare_between a c y)" +proof- + let ?a = "0\<^sub>h" + let ?b = "of_complex (1/2)" + let ?c = "of_complex (\/2)" + let ?dl = "(5 - sqrt 17) / 4" + let ?d = "of_complex (?dl + \*?dl)" + let ?t = "of_complex (1/2 + \/2)" + + have "?dl \ 0" + proof- + have "(sqrt 17)\<^sup>2 \ 5\<^sup>2" + by simp + hence "sqrt 17 \ 5" + by force + thus ?thesis + by simp + qed + + have "?d \ ?a" + proof (rule ccontr) + assume "\ ?thesis" + hence "?dl + \*?dl = 0" + by simp + hence "Re (?dl + \*?dl) = 0" + by simp + thus False + using \?dl \ 0\ + by simp + qed + + have "?dl > 0" + proof- + have "(sqrt 17)\<^sup>2 < 5\<^sup>2" + by (simp add: power2_eq_square) + hence "sqrt 17 < 5" + by (rule power2_less_imp_less, simp) + thus ?thesis + by simp + qed + + have "?a \ ?b" + by (metis divide_eq_0_iff of_complex_zero_iff zero_neq_numeral zero_neq_one) + + have "?a \ ?c" + by (metis complex_i_not_zero divide_eq_0_iff of_complex_zero_iff zero_neq_numeral) + + show ?thesis + proof (rule_tac x="?a" in exI, rule_tac x="?b" in exI, rule_tac x="?c" in exI, rule_tac x="?d" in exI, rule_tac x="?t" in exI, safe) + + + show "?a \ unit_disc" "?b \ unit_disc" "?c \ unit_disc" "?t \ unit_disc" + by (auto simp add: cmod_def power2_eq_square) + + have cmod_d: "cmod (?dl + \*?dl) = ?dl * sqrt 2" + using \?dl > 0\ + unfolding cmod_def + by (simp add: real_sqrt_mult) + + show "?d \ unit_disc" + proof- + have "?dl < 1 / sqrt 2" + proof- + have "17\<^sup>2 < (5 * sqrt 17)\<^sup>2" + by (simp add: field_simps) + hence "17 < 5 * sqrt 17" + by (rule power2_less_imp_less, simp) + hence "?dl\<^sup>2 < (1 / sqrt 2)\<^sup>2" + by (simp add: power2_eq_square field_simps) + thus "?dl < 1 / sqrt 2" + by (rule power2_less_imp_less, simp) + qed + thus ?thesis + using cmod_d + by (simp add: field_simps) + qed + + have cmod_d: "1 - (cmod (to_complex ?d))\<^sup>2 = (-17 + 5*sqrt 17) / 4" (is "_ = ?cmod_d") + apply (simp only: to_complex_of_complex) + apply (subst cmod_d) + apply (simp add: power_mult_distrib) + apply (simp add: power2_eq_square field_simps) + done + + have cmod_d_c: "(cmod (to_complex ?d - to_complex ?c))\<^sup>2 = (17 - 4*sqrt 17) / 4" (is "_ = ?cmod_dc") + unfolding cmod_square + by (simp add: field_simps) + + have cmod_c: "1 - (cmod (to_complex ?c))\<^sup>2 = 3/4" (is "_ = ?cmod_c") + by (simp add: power2_eq_square) + + have xx: "\ x::real. x + x = 2*x" + by simp + + have "cmod ((to_complex ?b) - (to_complex ?d)) = cmod ((to_complex ?d) - (to_complex ?c))" + by (simp add: cmod_def power2_eq_square field_simps) + moreover + have "cmod (to_complex ?b) = cmod (to_complex ?c)" + by simp + ultimately + have *: "poincare_distance_formula' (to_complex ?b) (to_complex ?d) = + poincare_distance_formula' (to_complex ?d) (to_complex ?c)" + unfolding poincare_distance_formula'_def + by simp + + have **: "poincare_distance_formula' (to_complex ?d) (to_complex ?c) = (sqrt 17) / 3" + unfolding poincare_distance_formula'_def + proof (subst cmod_d, subst cmod_c, subst cmod_d_c) + have "(sqrt 17 * 15)\<^sup>2 \ 51\<^sup>2" + by simp + hence "sqrt 17 * 15 \ 51" + by force + hence "sqrt 17 * 15 - 51 \ 0" + by simp + + have "(5 * sqrt 17)\<^sup>2 \ 17\<^sup>2" + by simp + hence "5 * sqrt 17 \ 17" + by force + hence "?cmod_d * ?cmod_c \ 0" + by simp + hence "1 + 2 * (?cmod_dc / (?cmod_d * ?cmod_c)) = (?cmod_d * ?cmod_c + 2 * ?cmod_dc) / (?cmod_d * ?cmod_c)" + using add_frac_num[of "?cmod_d * ?cmod_c" "2 * ?cmod_dc" 1] + by (simp add: field_simps) + also have "... = (64 * (85 - sqrt 17 * 17)) / (64 * (sqrt 17 * 15 - 51))" + by (simp add: field_simps) + also have "... = (85 - sqrt 17 * 17) / (sqrt 17 * 15 - 51)" + by (rule mult_divide_mult_cancel_left, simp) + also have "... = sqrt 17 / 3" + by (subst frac_eq_eq, fact, simp, simp add: field_simps) + finally + show "1 + 2 * (?cmod_dc / (?cmod_d * ?cmod_c)) = sqrt 17 / 3" + . + qed + + have "sqrt 17 \ 3" + proof- + have "(sqrt 17)\<^sup>2 \ 3\<^sup>2" + by simp + thus ?thesis + by (rule power2_le_imp_le, simp) + qed + thus "poincare_between ?b ?d ?c" + unfolding poincare_between_sum_distances[OF \?b \ unit_disc\ \?d \ unit_disc\ \?c \ unit_disc\] + unfolding poincare_distance_formula[OF \?b \ unit_disc\ \?d \ unit_disc\] + unfolding poincare_distance_formula[OF \?d \ unit_disc\ \?c \ unit_disc\] + unfolding poincare_distance_formula[OF \?b \ unit_disc\ \?c \ unit_disc\] + unfolding poincare_distance_formula_def + apply (subst *, subst xx, subst **, subst arcosh_double) + apply (simp_all add: cmod_def power2_eq_square) + done + + show "poincare_between ?a ?d ?t" + proof (subst poincare_between_0uv[OF \?d \ unit_disc\ \?t \ unit_disc\ \?d \ ?a\]) + show "?t \ 0\<^sub>h" + proof (rule ccontr) + assume "\ ?thesis" + hence "1/2 + \/2 = 0" + by simp + hence "Re (1/2 + \/2) = 0" + by simp + thus False + by simp + qed + next + have "19\<^sup>2 \ (5 * sqrt 17)\<^sup>2" + by simp + hence "19 \ 5 * sqrt 17" + by (rule power2_le_imp_le, simp) + hence "cmod (to_complex ?d) \ cmod (to_complex ?t)" + by (simp add: Let_def cmod_def power2_eq_square field_simps) + moreover + have "arg (to_complex ?d) = arg (to_complex ?t)" + proof- + have 1: "to_complex ?d = ((5 - sqrt 17) / 4) * (1 + \)" + by (simp add: field_simps) + + have 2: "to_complex ?t = (cor (1/2)) * (1 + \)" + by (simp add: field_simps) + + have "(sqrt 17)\<^sup>2 < 5\<^sup>2" + by simp + hence "sqrt 17 < 5" + by (rule power2_less_imp_less, simp) + hence 3: "(5 - sqrt 17) / 4 > 0" + by simp + + have 4: "(1::real) / 2 > 0" + by simp + + show ?thesis + apply (subst 1, subst 2) + apply (subst arg_mult_real_positive[OF 3]) + apply (subst arg_mult_real_positive[OF 4]) + by simp + qed + ultimately + show "let d' = to_complex ?d; t' = to_complex ?t in arg d' = arg t' \ cmod d' \ cmod t'" + by simp + qed + + show "?a = ?d \ False" + using \?d \ ?a\ + by simp + + fix x y + assume "x \ unit_disc" "y \ unit_disc" + + assume abx: "poincare_between ?a ?b x" + hence "x \ circline_set x_axis" + using poincare_between_poincare_line_uvz[of ?a ?b x] \x \ unit_disc\ \?a \ ?b\ + using poincare_line_0_real_is_x_axis[of ?b] + by (auto simp add: circline_set_x_axis) + + have "x \ 0\<^sub>h" + using abx poincare_between_sandwich[of ?a ?b] \?a \ ?b\ + by auto + + have "x \ positive_x_axis" + using \x \ circline_set x_axis\ \x \ 0\<^sub>h\ \x \ unit_disc\ + using abx poincare_between_x_axis_0uv[of "1/2" "Re (to_complex x)"] + unfolding circline_set_x_axis positive_x_axis_def + by (auto simp add: cmod_eq_Re abs_less_iff complex_eq_if_Re_eq) + + assume acy: "poincare_between ?a ?c y" + hence "y \ circline_set y_axis" + using poincare_between_poincare_line_uvz[of ?a ?c y] \y \ unit_disc\ \?a \ ?c\ + using poincare_line_0_imag_is_y_axis[of ?c] + by (auto simp add: circline_set_y_axis) + + have "y \ 0\<^sub>h" + using acy poincare_between_sandwich[of ?a ?c] \?a \ ?c\ + by auto + + have "y \ positive_y_axis" + proof- + have " \x. \x \ 0; poincare_between 0\<^sub>h (of_complex (\ / 2)) (of_complex x); is_imag x; - 1 < Im x\ \ 0 < Im x" + by (smt add.left_neutral complex.expand divide_complex_def complex_eq divide_less_0_1_iff divide_less_eq_1_pos imaginary_unit.simps(1) mult.left_neutral of_real_1 of_real_add of_real_divide of_real_eq_0_iff one_add_one poincare_between_y_axis_0uv zero_complex.simps(1) zero_complex.simps(2) zero_less_divide_1_iff) + thus ?thesis + using \y \ circline_set y_axis\ \y \ 0\<^sub>h\ \y \ unit_disc\ + using acy + unfolding circline_set_y_axis positive_y_axis_def + by (auto simp add: cmod_eq_Im abs_less_iff) + qed + + have "x \ y" + using \x \ positive_x_axis\ \y \ positive_y_axis\ + unfolding positive_x_axis_def positive_y_axis_def circline_set_x_axis circline_set_y_axis + by auto + + assume xty: "poincare_between x ?t y" + + let ?xy = "poincare_line x y" + + have "?t \ circline_set ?xy" + using xty poincare_between_poincare_line_uzv[OF \x \ y\ \x \ unit_disc\ \y \ unit_disc\ \?t \ unit_disc\] + by simp + + moreover + + have "?xy \ x_axis" + using poincare_line_circline_set[OF \x \ y\] \y \ positive_y_axis\ + by (auto simp add: circline_set_x_axis positive_y_axis_def) + hence "intersects_x_axis_positive ?xy" + using intersects_x_axis_positive_iff[of "?xy"] \x \ y\ \x \ unit_disc\ \x \ positive_x_axis\ + by auto + + moreover + + have "?xy \ y_axis" + using poincare_line_circline_set[OF \x \ y\] \x \ positive_x_axis\ + by (auto simp add: circline_set_y_axis positive_x_axis_def) + hence "intersects_y_axis_positive ?xy" + using intersects_y_axis_positive_iff[of "?xy"] \x \ y\ \y \ unit_disc\ \y \ positive_y_axis\ + by auto + + ultimately + + show False + using negated_euclidean_axiom_aux[of ?xy] \x \ y\ + unfolding circline_set_def + by auto + qed +qed + +text \Alternate form of the Euclidean axiom -- this one is much easier to prove\ +lemma negated_euclidean_axiom': + shows "\ a b c. + a \ unit_disc \ b \ unit_disc \ c \ unit_disc \ \(poincare_collinear {a, b, c}) \ + \(\ x. x \ unit_disc \ + poincare_distance a x = poincare_distance b x \ + poincare_distance a x = poincare_distance c x)" +proof- + let ?a = "of_complex (\/2)" + let ?b = "of_complex (-\/2)" + let ?c = "of_complex (1/5)" + + have "(\/2) \ (-\/2)" + by simp + hence "?a \ ?b" + by (metis to_complex_of_complex) + have "(\/2) \ (1/5)" + by simp + hence "?a \ ?c" + by (metis to_complex_of_complex) + have "(-\/2) \ (1/5)" + by (metis add.inverse_inverse cmod_divide div_by_1 divide_divide_eq_right inverse_eq_divide minus_divide_left mult.commute norm_ii norm_minus_cancel norm_numeral norm_one numeral_One numeral_eq_iff semiring_norm(88)) + hence "?b \ ?c" + by (metis to_complex_of_complex) + + have "?a \ unit_disc" "?b \ unit_disc" "?c \ unit_disc" + by auto + + moreover + + have "\(poincare_collinear {?a, ?b, ?c})" + unfolding poincare_collinear_def + proof(rule ccontr) + assume " \ (\p. is_poincare_line p \ {?a, ?b, ?c} \ circline_set p)" + then obtain p where "is_poincare_line p \ {?a, ?b, ?c} \ circline_set p" + by auto + let ?ab = "poincare_line ?a ?b" + have "p = ?ab" + using \is_poincare_line p \ {?a, ?b, ?c} \ circline_set p\ + using unique_poincare_line[of ?a ?b] \?a \ ?b\ \?a \ unit_disc\ \?b \ unit_disc\ + by auto + have "?c \ circline_set ?ab" + proof(rule ccontr) + assume "\ ?c \ circline_set ?ab" + have "poincare_between ?a 0\<^sub>h ?b" + unfolding poincare_between_def + using cross_ratio_0inf by auto + hence "0\<^sub>h \ circline_set ?ab" + using \?a \ ?b\ \?a \ unit_disc\ \?b \ unit_disc\ + using poincare_between_poincare_line_uzv zero_in_unit_disc + by blast + hence "?ab = poincare_line 0\<^sub>h ?a" + using unique_poincare_line[of ?a ?b] \?a \ ?b\ \?a \ unit_disc\ \?b \ unit_disc\ + using \is_poincare_line p \ {?a, ?b, ?c} \ circline_set p\ + using \p = ?ab\ poincare_line_circline_set(1) unique_poincare_line + by (metis add.inverse_neutral divide_minus_left of_complex_zero_iff zero_in_unit_disc) + hence "(\/2) * cnj(1/5) = cnj(\/2) * (1/5)" + using poincare_collinear_zero_iff[of "(\/2)" "(1/5)"] + using \?a \ ?c\ \\ ?c \ circline_set ?ab\ \?a \ unit_disc\ \?c \ unit_disc\ \p = ?ab\ + using \0\<^sub>h \ circline_set ?ab\ \is_poincare_line p \ {?a, ?b, ?c} \ circline_set p\ + using poincare_collinear_def by auto + thus False + by simp + qed + thus False + using \p = ?ab\ \is_poincare_line p \ {?a, ?b, ?c} \ circline_set p\ + by auto + qed + + moreover + + have "\(\ x. x \ unit_disc \ + poincare_distance ?a x = poincare_distance ?b x \ + poincare_distance ?a x = poincare_distance ?c x)" + proof(rule ccontr) + assume "\ ?thesis" + then obtain x where "x \ unit_disc" "poincare_distance ?a x = poincare_distance ?b x" + "poincare_distance ?a x = poincare_distance ?c x" + by blast + let ?x = "to_complex x" + have "poincare_distance_formula' (\/2) ?x = poincare_distance_formula' (-\/2) ?x" + using \poincare_distance ?a x = poincare_distance ?b x\ + using \x \ unit_disc\ \?a \ unit_disc\ \?b \ unit_disc\ + by (metis cosh_dist to_complex_of_complex) + hence "(cmod (\ / 2 - ?x))\<^sup>2 = (cmod (- \ / 2 - ?x))\<^sup>2" + unfolding poincare_distance_formula'_def + apply (simp add:field_simps) + using \x \ unit_disc\ unit_disc_cmod_square_lt_1 by fastforce + hence "Im ?x = 0" + unfolding cmod_def + by (simp add: power2_eq_iff) + + have "1 - (Re ?x)\<^sup>2 \ 0" + using \x \ unit_disc\ unit_disc_cmod_square_lt_1 + using cmod_power2 by force + hence "24 - 24 * (Re ?x)\<^sup>2 \ 0" + by simp + have "poincare_distance_formula' (\/2) ?x = poincare_distance_formula' (1/5) ?x" + using \poincare_distance ?a x = poincare_distance ?c x\ + using \x \ unit_disc\ \?a \ unit_disc\ \?c \ unit_disc\ + by (metis cosh_dist to_complex_of_complex) + hence "(2 + 8 * (Re ?x)\<^sup>2) /(3 - 3 * (Re ?x)\<^sup>2) = 2 * (1 - Re ?x * 5)\<^sup>2 / (24 - 24 * (Re ?x)\<^sup>2)" (is "?lhs = ?rhs") + unfolding poincare_distance_formula'_def + apply (simp add:field_simps) + unfolding cmod_def + using \Im ?x = 0\ + by (simp add:field_simps) + hence *: "?lhs * (24 - 24 * (Re ?x)\<^sup>2) = ?rhs * (24 - 24 * (Re ?x)\<^sup>2) " + using \(24 - 24 * (Re ?x)\<^sup>2) \ 0\ + by simp + have "?lhs * (24 - 24 * (Re ?x)\<^sup>2) = (2 + 8 * (Re ?x)\<^sup>2) * 8" + using \(24 - 24 * (Re ?x)\<^sup>2) \ 0\ \1 - (Re ?x)\<^sup>2 \ 0\ + by (simp add:field_simps) + have "?rhs * (24 - 24 * (Re ?x)\<^sup>2) = 2 * (1 - Re ?x * 5)\<^sup>2" + using \(24 - 24 * (Re ?x)\<^sup>2) \ 0\ \1 - (Re ?x)\<^sup>2 \ 0\ + by (simp add:field_simps) + hence "(2 + 8 * (Re ?x)\<^sup>2) * 8 = 2 * (1 - Re ?x * 5)\<^sup>2" + using * \?lhs * (24 - 24 * (Re ?x)\<^sup>2) = (2 + 8 * (Re ?x)\<^sup>2) * 8\ + by simp + hence "7 * (Re ?x)\<^sup>2 + 10 * (Re ?x) + 7 = 0" + by (simp add:field_simps comm_ring_1_class.power2_diff) + thus False + using discriminant_iff[of 7 "Re (to_complex x)" 10 7] discrim_def[of 7 10 7] + by auto + qed + + ultimately show ?thesis + apply (rule_tac x="?a" in exI) + apply (rule_tac x="?b" in exI) + apply (rule_tac x="?c" in exI) + by auto +qed + +(* ------------------------------------------------------------------ *) +subsection\Continuity axiom\ +(* ------------------------------------------------------------------ *) + +text \The set $\phi$ is on the left of the set $\psi$\ +abbreviation set_order where + "set_order A \ \ \ \x\ unit_disc. \y\ unit_disc. \ x \ \ y \ poincare_between A x y" +text \The point $B$ is between the sets $\phi$ and $\psi$\ +abbreviation point_between_sets where + "point_between_sets \ B \ \ \x\ unit_disc. \y\ unit_disc. \ x \ \ y \ poincare_between x B y" + +lemma continuity: + assumes "\ A \ unit_disc. set_order A \ \" + shows "\ B \ unit_disc. point_between_sets \ B \" +proof (cases "(\ x0 \ unit_disc. \ x0) \ (\ y0 \ unit_disc. \ y0)") + case False + thus ?thesis + using assms by blast +next + case True + then obtain Y0 where "\ Y0" "Y0 \ unit_disc" + by auto + obtain A where *: "A \ unit_disc" "set_order A \ \" + using assms + by auto + show ?thesis + proof(cases "\ x \ unit_disc. \ x \ x = A") + case True + thus ?thesis + using \A \ unit_disc\ + using poincare_between_nonstrict(1) by blast + next + case False + then obtain X0 where "\ X0" "X0 \ A" "X0 \ unit_disc" + by auto + have "Y0 \ A" + proof(rule ccontr) + assume "\ Y0 \ A" + hence "\ x \ unit_disc. \ x \ poincare_between A x A" + using * \\ Y0\ + by (cases A) force + hence "\ x \ unit_disc. \ x \ x = A" + using * poincare_between_sandwich by blast + thus False + using False by auto + qed + + show ?thesis + proof (cases "\ B \ unit_disc. \ B \ \ B") + case True + then obtain B where "B \ unit_disc" "\ B" "\ B" + by auto + hence "\ x \ unit_disc. \ x \ poincare_between A x B" + using * by auto + have "\ y \ unit_disc. \ y \ poincare_between A B y" + using * \B \ unit_disc\ \\ B\ + by auto + + show ?thesis + proof(rule+) + show "B \ unit_disc" + by fact + next + fix x y + assume "x \ unit_disc" "y \ unit_disc" "\ x \ \ y" + hence "poincare_between A x B" "poincare_between A B y" + using \\ x \ unit_disc. \ x \ poincare_between A x B\ + using \\ y \ unit_disc. \ y \ poincare_between A B y\ + by simp+ + thus "poincare_between x B y" + using \x \ unit_disc\ \y \ unit_disc\ \B \ unit_disc\ \A \ unit_disc\ + using poincare_between_transitivity[of A x B y] + by simp + qed + next + case False + have "poincare_between A X0 Y0" + using \\ X0\ \\ Y0\ * \Y0 \ unit_disc\ \X0 \ unit_disc\ + by auto + have "\ \. \ \. set_order A \ \ \ \ (\ B \ unit_disc. \ B \ \ B) \ \ X0 \ + (\ y \ unit_disc. \ y) \ (\ x \ unit_disc. \ x) + \ (\ B \ unit_disc. point_between_sets \ B \)" + (is "?P A X0") + proof (rule wlog_positive_x_axis[where P="?P"]) + show "A \ unit_disc" + by fact + next + show "X0 \ unit_disc" + by fact + next + show "A \ X0" + using \X0 \ A\ by simp + next + fix M u v + let ?M = "\ x. moebius_pt M x" + let ?Mu = "?M u" and ?Mv = "?M v" + assume hip: "unit_disc_fix M" "u \ unit_disc" "v \ unit_disc" "u \ v" + "?P ?Mu ?Mv" + show "?P u v" + proof safe + fix \ \ x y + assume "set_order u \ \" "\ (\B\unit_disc. \ B \ \ B)" "\ v" + "y \ unit_disc" "\ y" "x \ unit_disc" "\ x" + + let ?M\ = "\ X'. \ X. \ X \ ?M X = X'" + let ?M\ = "\ X'. \ X. \ X \ ?M X = X'" + + obtain M\ where "M\ = ?M\" by simp + obtain M\ where "M\ = ?M\" by simp + + have "M\ ?Mv" + using \\ v\ using \M\ = ?M\\ + by blast + moreover + have "\ (\ B \unit_disc. M\ B \ M\ B)" + using \\ (\B\unit_disc. \ B \ \ B)\ + using \M\ = ?M\\ \M\ = ?M\\ + by (metis hip(1) moebius_pt_invert unit_disc_fix_discI unit_disc_fix_moebius_inv) + moreover + have "\ y \ unit_disc. M\ y" + using \y \ unit_disc\ \\ y\ \M\ = ?M\\ \unit_disc_fix M\ + by auto + moreover + have "set_order ?Mu ?M\ ?M\" + proof ((rule ballI)+, rule impI) + fix Mx My + assume "Mx \ unit_disc" "My \ unit_disc" "?M\ Mx \ ?M\ My" + then obtain x y where "\ x \ ?M x = Mx" "\ y \ ?M y = My" + by blast + + hence "x \ unit_disc" "y \ unit_disc" + using \Mx \ unit_disc\ \My \ unit_disc\ \unit_disc_fix M\ + by (metis moebius_pt_comp_inv_left unit_disc_fix_discI unit_disc_fix_moebius_inv)+ + + hence "poincare_between u x y" + using \set_order u \ \\ + using \Mx \ unit_disc\ \My \ unit_disc\ \\ x \ ?M x = Mx\ \\ y \ ?M y = My\ + by blast + then show "poincare_between ?Mu Mx My" + using \\ x \ ?M x = Mx\ \\ y \ ?M y = My\ + using \x \ unit_disc\ \y \ unit_disc\ \u \ unit_disc\ \unit_disc_fix M\ + using unit_disc_fix_moebius_preserve_poincare_between by blast + qed + + hence "set_order ?Mu M\ M\" + using \M\ = ?M\\ \M\ = ?M\\ + by simp + ultimately + have "\ Mb \ unit_disc. point_between_sets M\ Mb M\" + using hip(5) + by blast + then obtain Mb where bbb: + "Mb \ unit_disc" "point_between_sets ?M\ Mb ?M\" + using \M\ = ?M\\ \M\ = ?M\\ + by auto + + let ?b = "moebius_pt (moebius_inv M) Mb" + show "\ b \ unit_disc. point_between_sets \ b \" + proof (rule_tac x="?b" in bexI, (rule ballI)+, rule impI) + fix x y + assume "x \ unit_disc" "y \ unit_disc" "\ x \ \ y" + hence "poincare_between u x y" + using \set_order u \ \\ + by blast + + let ?Mx = "?M x" and ?My = "?M y" + + have "?M\ ?Mx" "?M\ ?My" + using \\ x \ \ y\ + by blast+ + have "?Mx \ unit_disc" "?My \ unit_disc" + using \x \ unit_disc\ \unit_disc_fix M\ \y \ unit_disc\ + by auto + + hence "poincare_between ?Mx Mb ?My" + using \?M\ ?Mx\ \?M\ ?My\ \?Mx \ unit_disc\ \?My \ unit_disc\ bbb + by auto + + then show "poincare_between x ?b y" + using \unit_disc_fix M\ + using \x \ unit_disc\ \y \ unit_disc\ \Mb \ unit_disc\ \?Mx \ unit_disc\ \?My \ unit_disc\ + using unit_disc_fix_moebius_preserve_poincare_between[of M x ?b y] + by auto + next + show "?b \ unit_disc" + using bbb \unit_disc_fix M\ + by auto + qed + qed + next + fix X + assume xx: "is_real X" "0 < Re X" "Re X < 1" + let ?X = "of_complex X" + show "?P 0\<^sub>h ?X" + proof ((rule allI)+, rule impI, (erule conjE)+) + fix \ \ + assume "set_order 0\<^sub>h \ \" "\ (\B\unit_disc. \ B \ \ B)" "\ ?X" + "\y\unit_disc. \ y" "\x\unit_disc. \ x" + have "?X \ unit_disc" + using xx + by (simp add: cmod_eq_Re) + + have \pos: "\ y \ unit_disc. \ y \ (is_real (to_complex y) \ Re (to_complex y) > 0)" + proof(rule ballI, rule impI) + fix y + let ?y = "to_complex y" + assume "y \ unit_disc" "\ y" + + hence "poincare_between 0\<^sub>h ?X y" + using \set_order 0\<^sub>h \ \\ + using \?X \ unit_disc\ \\ ?X\ + by auto + + thus "is_real ?y \ 0 < Re ?y" + using xx \?X \ unit_disc\ \y \ unit_disc\ + by (metis (mono_tags, hide_lams) arg_0_iff of_complex_zero_iff poincare_between_0uv poincare_between_sandwich to_complex_of_complex unit_disc_to_complex_inj zero_in_unit_disc) + qed + + have \noneg: "\ x \ unit_disc. \ x \ (is_real (to_complex x) \ Re (to_complex x) \ 0)" + proof(rule ballI, rule impI) + fix x + assume "x \ unit_disc" "\ x" + + obtain y where "y \ unit_disc" "\ y" + using \\ y \ unit_disc. \ y\ by blast + + let ?x = "to_complex x" and ?y = "to_complex y" + + have "is_real ?y" "Re ?y > 0" + using \pos \\ y\ \y \ unit_disc\ + by auto + + have "poincare_between 0\<^sub>h x y" + using \set_order 0\<^sub>h \ \\ + using \x \ unit_disc\ \\ x\ \y\unit_disc\ \\ y\ + by auto + + thus "is_real ?x \ 0 \ Re ?x" + using \x \ unit_disc\ \y \ unit_disc\ \is_real (to_complex y)\ \\ y\ + using \set_order 0\<^sub>h \ \\ + using \\ ?X\ \?X \ unit_disc\ \Re ?y > 0\ + by (metis arg_0_iff le_less of_complex_zero poincare_between_0uv to_complex_of_complex zero_complex.simps(1) zero_complex.simps(2)) + qed + + have \less\: "\x\unit_disc. \y\unit_disc. \ x \ \ y \ Re (to_complex x) < Re (to_complex y)" + proof((rule ballI)+, rule impI) + fix x y + let ?x = "to_complex x" and ?y = "to_complex y" + assume "x \ unit_disc" "y \ unit_disc" "\ x \ \ y" + + hence "poincare_between 0\<^sub>h x y" + using \set_order 0\<^sub>h \ \\ + by auto + moreover + have "is_real ?x" "Re ?x \ 0" + using \noneg + using \x \ unit_disc\ \\ x \ \ y\ by auto + moreover + have "is_real ?y" "Re ?y > 0" + using \pos + using \y \ unit_disc\ \\ x \ \ y\ by auto + ultimately + have "Re ?x \ Re ?y" + using \x \ unit_disc\ \y \ unit_disc\ + by (metis Re_complex_of_real arg_0_iff le_less of_complex_zero poincare_between_0uv rcis_cmod_arg rcis_zero_arg to_complex_of_complex) + + have "Re ?x \ Re ?y" + using \\ x \ \ y\ \is_real ?x\ \is_real ?y\ + using \\ (\B\unit_disc. \ B \ \ B)\ \x \ unit_disc\ \y \ unit_disc\ + by (metis complex.expand unit_disc_to_complex_inj) + + thus "Re ?x < Re ?y" + using \Re ?x \ Re ?y\ by auto + qed + + have "\ b \ unit_disc. \ x \ unit_disc. \ y \ unit_disc. + is_real (to_complex b) \ + (\ x \ \ y \ (Re (to_complex x) \ Re (to_complex b) \ Re (to_complex b) \ Re (to_complex y)))" + proof- + let ?Phi = "{x. (of_complex (cor x)) \ unit_disc \ \ (of_complex (cor x))}" + + have "\ x \ unit_disc. \ x \ Re (to_complex x) \ Sup ?Phi" + proof(safe) + fix x + let ?x = "to_complex x" + assume "x \ unit_disc" "\ x" + hence "is_real ?x" "Re ?x \ 0" + using \noneg + by auto + hence "cor (Re ?x) = ?x" + using complex_of_real_Re by blast + hence "of_complex (cor (Re ?x)) \ unit_disc" + using \x \ unit_disc\ + by (metis inf_notin_unit_disc of_complex_to_complex) + moreover + have "\ (of_complex (cor (Re ?x)))" + using \cor (Re ?x) = ?x\ \\ x\ \x \ unit_disc\ + by (metis inf_notin_unit_disc of_complex_to_complex) + ultimately + have "Re ?x \ ?Phi" + by auto + + have "\M. \x \ ?Phi. x \ M" + using \less\ + using \\ y \ unit_disc. \ y\ + by (metis (mono_tags, lifting) Re_complex_of_real le_less mem_Collect_eq to_complex_of_complex) + + thus "Re ?x \ Sup ?Phi" + using cSup_upper[of "Re ?x" ?Phi] + unfolding bdd_above_def + using \Re ?x \ ?Phi\ + by auto + qed + + have "\ y \ unit_disc. \ y \ Sup ?Phi \ Re (to_complex y)" + proof (safe) + fix y + let ?y = "to_complex y" + assume "\ y" "y \ unit_disc" + show "Sup ?Phi \ Re ?y" + proof (rule ccontr) + assume "\ ?thesis" + hence "Re ?y < Sup ?Phi" + by auto + + have "\ x. \ (of_complex (cor x)) \ (of_complex (cor x)) \ unit_disc" + proof - + obtain x' where "x' \ unit_disc" "\ x'" + using \\ x \ unit_disc. \ x\ by blast + let ?x' = "to_complex x'" + have "is_real ?x'" + using \x' \ unit_disc\ \\ x'\ + using \noneg + by auto + hence "cor (Re ?x') = ?x'" + using complex_of_real_Re by blast + hence "x' = of_complex (cor (Re ?x'))" + using \x' \ unit_disc\ + by (metis inf_notin_unit_disc of_complex_to_complex) + show ?thesis + apply (rule_tac x="Re ?x'" in exI) + using \x' \ unit_disc\ + apply (subst (asm) \x' = of_complex (cor (Re ?x'))\, simp) + using \\ x'\ + by (subst (asm) (2) \x' = of_complex (cor (Re ?x'))\, simp) + qed + + hence "?Phi \ {}" + by auto + + then obtain x where "\ (of_complex (cor x))" "Re ?y < x" + "(of_complex (cor x)) \ unit_disc" + using \Re ?y < Sup ?Phi\ + using less_cSupE[of "Re ?y" ?Phi] + by auto + moreover + have "Re ?y < Re (to_complex (of_complex (cor x)))" + using \Re ?y < x\ + by simp + ultimately + show False + using \less\ + using \\ y\ \y \ unit_disc\ + by (metis less_not_sym) + qed + qed + + thus ?thesis + using \\ x \ unit_disc. \ x \ Re (to_complex x) \ Sup ?Phi\ + apply (rule_tac x="(of_complex (cor (Sup ?Phi)))" in bexI, simp) + using \\y\unit_disc. \ y\ \\ ?X\ \?X \ unit_disc\ + using \\y\unit_disc. \ y \ is_real (to_complex y) \ 0 < Re (to_complex y)\ + by (smt complex_of_real_Re inf_notin_unit_disc norm_of_real of_complex_to_complex to_complex_of_complex unit_disc_iff_cmod_lt_1 xx(2)) + qed + + then obtain B where "B \ unit_disc" "is_real (to_complex B)" + "\x\unit_disc. \y\unit_disc. \ x \ \ y \ Re (to_complex x) \ Re (to_complex B) \ + Re (to_complex B) \ Re (to_complex y)" + by blast + + show "\ b \ unit_disc. point_between_sets \ b \" + proof (rule_tac x="B" in bexI) + show "B \ unit_disc" + by fact + next + show "point_between_sets \ B \" + proof ((rule ballI)+, rule impI) + fix x y + let ?x = "to_complex x" and ?y = "to_complex y" and ?B = "to_complex B" + assume "x \ unit_disc" "y \ unit_disc" "\ x \ \ y" + + hence "Re ?x \ Re ?B \ Re ?B \ Re ?y" + using \\x\unit_disc. \y\unit_disc. \ x \ \ y \ Re (to_complex x) \ Re ?B \ + Re (to_complex B) \ Re (to_complex y)\ + by auto + moreover + have "is_real ?x" "Re ?x \ 0" + using \noneg + using \x \ unit_disc\ \\ x \ \ y\ + by auto + moreover + have "is_real ?y" "Re ?y > 0" + using \pos + using \y \ unit_disc\ \\ x \ \ y\ + by auto + moreover + have "cor (Re ?x) = ?x" + using complex_of_real_Re \is_real ?x\ by blast + hence "x = of_complex (cor (Re ?x))" + using \x \ unit_disc\ + by (metis inf_notin_unit_disc of_complex_to_complex) + moreover + have "cor (Re ?y) = ?y" + using complex_of_real_Re \is_real ?y\ by blast + hence "y = of_complex (cor (Re ?y))" + using \y \ unit_disc\ + by (metis inf_notin_unit_disc of_complex_to_complex) + moreover + have "cor (Re ?B) = ?B" + using complex_of_real_Re \is_real (to_complex B)\ by blast + hence "B = of_complex (cor (Re ?B))" + using \B \ unit_disc\ + by (metis inf_notin_unit_disc of_complex_to_complex) + ultimately + show "poincare_between x B y" + using \is_real (to_complex B)\ \x \ unit_disc\ \y \ unit_disc\ \B \ unit_disc\ + using poincare_between_x_axis_uvw[of "Re (to_complex x)" "Re (to_complex B)" "Re (to_complex y)"] + by (smt Re_complex_of_real arg_0_iff poincare_between_nonstrict(1) rcis_cmod_arg rcis_zero_arg unit_disc_iff_cmod_lt_1) + qed + qed + qed + qed + thus ?thesis + using False \\ X0\ \\ Y0\ * \Y0 \ unit_disc\ \X0 \ unit_disc\ + by auto + qed + qed +qed + + +(* ------------------------------------------------------------------ *) +subsection\Limiting parallels axiom\ +(* ------------------------------------------------------------------ *) + +text \Auxiliary definitions\ + +definition poincare_on_line where + "poincare_on_line p a b \ poincare_collinear {p, a, b}" + +definition poincare_on_ray where + "poincare_on_ray p a b \ poincare_between a p b \ poincare_between a b p" + +definition poincare_in_angle where + "poincare_in_angle p a b c \ + b \ a \ b \ c \ p \ b \ (\ x \ unit_disc. poincare_between a x c \ x \ a \ x \ c \ poincare_on_ray p b x)" + +definition poincare_ray_meets_line where + "poincare_ray_meets_line a b c d \ (\ x \ unit_disc. poincare_on_ray x a b \ poincare_on_line x c d)" + +text \All points on ray are collinear\ +lemma poincare_on_ray_poincare_collinear: + assumes "p \ unit_disc" and "a \ unit_disc" and "b \ unit_disc" and "poincare_on_ray p a b" + shows "poincare_collinear {p, a, b}" + using assms poincare_between_poincare_collinear + unfolding poincare_on_ray_def + by (metis insert_commute) + +text \H-isometries preserve all defined auxiliary relations\ + +lemma unit_disc_fix_preserves_poincare_on_line [simp]: + assumes "unit_disc_fix M" and "p \ unit_disc" "a \ unit_disc" "b \ unit_disc" + shows "poincare_on_line (moebius_pt M p) (moebius_pt M a) (moebius_pt M b) \ poincare_on_line p a b" + using assms + unfolding poincare_on_line_def + by auto + +lemma unit_disc_fix_preserves_poincare_on_ray [simp]: + assumes "unit_disc_fix M" "p \ unit_disc" "a \ unit_disc" "b \ unit_disc" + shows "poincare_on_ray (moebius_pt M p) (moebius_pt M a) (moebius_pt M b) \ poincare_on_ray p a b" + using assms + unfolding poincare_on_ray_def + by auto + +lemma unit_disc_fix_preserves_poincare_in_angle [simp]: + assumes "unit_disc_fix M" "p \ unit_disc" "a \ unit_disc" "b \ unit_disc" "c \ unit_disc" + shows "poincare_in_angle (moebius_pt M p) (moebius_pt M a) (moebius_pt M b) (moebius_pt M c) \ poincare_in_angle p a b c" (is "?lhs \ ?rhs") +proof + assume "?lhs" + then obtain Mx where *: "Mx \ unit_disc" + "poincare_between (moebius_pt M a) Mx (moebius_pt M c)" + "Mx \ moebius_pt M a" "Mx \ moebius_pt M c" "poincare_on_ray (moebius_pt M p) (moebius_pt M b) Mx" + "moebius_pt M b \ moebius_pt M a" "moebius_pt M b \ moebius_pt M c" "moebius_pt M p \ moebius_pt M b" + unfolding poincare_in_angle_def + by auto + obtain x where "Mx = moebius_pt M x" "x \ unit_disc" + by (metis "*"(1) assms(1) image_iff unit_disc_fix_iff) + thus ?rhs + using * assms + unfolding poincare_in_angle_def + by auto +next + assume ?rhs + then obtain x where *: "x \ unit_disc" + "poincare_between a x c" + "x \ a" "x \ c" "poincare_on_ray p b x" + "b \ a" "b \ c" "p \ b" + unfolding poincare_in_angle_def + by auto + thus ?lhs + using assms + unfolding poincare_in_angle_def + by auto (rule_tac x="moebius_pt M x" in bexI, auto) +qed + +lemma unit_disc_fix_preserves_poincare_ray_meets_line [simp]: + assumes "unit_disc_fix M" "a \ unit_disc" "b \ unit_disc" "c \ unit_disc" "d \ unit_disc" + shows "poincare_ray_meets_line (moebius_pt M a) (moebius_pt M b) (moebius_pt M c) (moebius_pt M d) \ poincare_ray_meets_line a b c d" (is "?lhs \ ?rhs") +proof + assume ?lhs + then obtain Mx where *: "Mx \ unit_disc" "poincare_on_ray Mx (moebius_pt M a) (moebius_pt M b)" + "poincare_on_line Mx (moebius_pt M c) (moebius_pt M d)" + unfolding poincare_ray_meets_line_def + by auto + obtain x where "Mx = moebius_pt M x" "x \ unit_disc" + by (metis "*"(1) assms(1) image_iff unit_disc_fix_iff) + thus ?rhs + using assms * + unfolding poincare_ray_meets_line_def poincare_on_line_def + by auto +next + assume ?rhs + then obtain x where *: "x \ unit_disc" "poincare_on_ray x a b" + "poincare_on_line x c d" + unfolding poincare_ray_meets_line_def + by auto + thus ?lhs + using assms * + unfolding poincare_ray_meets_line_def poincare_on_line_def + by auto (rule_tac x="moebius_pt M x" in bexI, auto) +qed + +text \H-lines that intersect on the absolute do not meet (they do not share a common h-point)\ +lemma tangent_not_meet: + assumes "x1 \ unit_disc" and "x2 \ unit_disc" and "x1 \ x2" and "\ poincare_collinear {0\<^sub>h, x1, x2}" + assumes "i \ ideal_points (poincare_line x1 x2)" "a \ unit_disc" "a \ 0\<^sub>h" "poincare_collinear {0\<^sub>h, a, i}" + shows "\ poincare_ray_meets_line 0\<^sub>h a x1 x2" +proof (rule ccontr) + assume "\ ?thesis" + then obtain x where "x \ unit_disc" "poincare_on_ray x 0\<^sub>h a" "poincare_collinear {x, x1, x2}" + unfolding poincare_ray_meets_line_def poincare_on_line_def + by auto + + have "poincare_collinear {0\<^sub>h, a, x}" + using `poincare_on_ray x 0\<^sub>h a` `x \ unit_disc` `a \ unit_disc` + by (meson poincare_between_poincare_collinear poincare_between_rev poincare_on_ray_def poincare_on_ray_poincare_collinear zero_in_unit_disc) + + have "x \ 0\<^sub>h" + using `\ poincare_collinear {0\<^sub>h, x1, x2}` `poincare_collinear {x, x1, x2}` + unfolding poincare_collinear_def + by (auto simp add: assms(2) assms(3) poincare_between_rev) + + let ?l1 = "poincare_line 0\<^sub>h a" + let ?l2 = "poincare_line x1 x2" + + have "i \ circline_set unit_circle" + using `i \ ideal_points (poincare_line x1 x2)` + using assms(3) ideal_points_on_unit_circle is_poincare_line_poincare_line by blast + + have "i \ circline_set ?l1" + using `poincare_collinear {0\<^sub>h, a, i}` + unfolding poincare_collinear_def + using \a \ unit_disc\ \a \ 0\<^sub>h\ + by (metis insert_subset unique_poincare_line zero_in_unit_disc) + + moreover + + have "x \ circline_set ?l1" + using `a \ unit_disc` `a \ 0\<^sub>h` `poincare_collinear {0\<^sub>h, a, x}` `x \ unit_disc` + by (metis poincare_collinear3_between poincare_between_poincare_line_uvz poincare_between_poincare_line_uzv poincare_line_sym zero_in_unit_disc) + + moreover + + have "inversion x \ circline_set ?l1" + using `poincare_collinear {0\<^sub>h, a, x}` + using poincare_line_inversion_full[of "0\<^sub>h" a x] `a \ unit_disc` `a \ 0\<^sub>h` `x \ unit_disc` + by (metis poincare_collinear3_between is_poincare_line_inverse_point is_poincare_line_poincare_line poincare_between_poincare_line_uvz poincare_between_poincare_line_uzv poincare_line_sym zero_in_unit_disc) + + moreover + + have "x \ circline_set ?l2" + using `poincare_collinear {x, x1, x2}` `x1 \ x2` `x1 \ unit_disc` `x2 \ unit_disc` `x \ unit_disc` + by (metis insert_commute inversion_noteq_unit_disc poincare_between_poincare_line_uvz poincare_between_poincare_line_uzv poincare_collinear3_iff poincare_line_sym_general) + + moreover + + hence "inversion x \ circline_set ?l2" + using `x1 \ x2` `x1 \ unit_disc` `x2 \ unit_disc` `x \ unit_disc` + using poincare_line_inversion_full[of x1 x2 x] + unfolding circline_set_def + by auto + + moreover + + have "i \ circline_set ?l2" + using `x1 \ x2` `x1 \ unit_disc` `x2 \ unit_disc` + using `i \ ideal_points ?l2` + by (simp add: ideal_points_on_circline) + + moreover + + have "x \ inversion x" + using `x \ unit_disc` + using inversion_noteq_unit_disc by fastforce + + moreover + + have "x \ i" + using `x \ unit_disc` + using \i \ circline_set unit_circle\ circline_set_def inversion_noteq_unit_disc + by fastforce+ + + moreover + + have "inversion x \ i" + using \i \ circline_set unit_circle\ \x \ i\ circline_set_def inversion_unit_circle + by fastforce + + ultimately + + have "?l1 = ?l2" + using unique_circline_set[of x "inversion x" i] + by blast + + hence "0\<^sub>h \ circline_set ?l2" + by (metis \a \ 0\<^sub>h\ poincare_line_circline_set(1)) + + thus False + using `\ poincare_collinear {0\<^sub>h, x1, x2}` + unfolding poincare_collinear_def + using \poincare_collinear {x, x1, x2}\ \x1 \ x2\ `x1 \ unit_disc` `x2 \ unit_disc` poincare_collinear_def unique_poincare_line + by auto +qed + +lemma limiting_parallels: + assumes "a \ unit_disc" and "x1 \ unit_disc" and "x2 \ unit_disc" and "\ poincare_on_line a x1 x2" + shows "\a1\unit_disc. \a2\unit_disc. + \ poincare_on_line a a1 a2 \ + \ poincare_ray_meets_line a a1 x1 x2 \ \ poincare_ray_meets_line a a2 x1 x2 \ + (\a'\unit_disc. poincare_in_angle a' a1 a a2 \ poincare_ray_meets_line a a' x1 x2)" (is "?P a x1 x2") +proof- + have "\ poincare_collinear {a, x1, x2}" + using `\ poincare_on_line a x1 x2` + unfolding poincare_on_line_def + by simp + + have "\ x1 x2. x1 \ unit_disc \ x2 \ unit_disc \ \ poincare_collinear {a, x1, x2} \ ?P a x1 x2" (is "?Q a") + proof (rule wlog_zero[OF `a \ unit_disc`]) + fix a u + assume *: "u \ unit_disc" "cmod a < 1" + hence uf: "unit_disc_fix (blaschke a)" + by simp + assume **: "?Q (moebius_pt (blaschke a) u)" + show "?Q u" + proof safe + fix x1 x2 + let ?M = "moebius_pt (blaschke a)" + assume xx: "x1 \ unit_disc" "x2 \ unit_disc" "\ poincare_collinear {u, x1, x2}" + hence MM: "?M x1 \ unit_disc \ ?M x2\ unit_disc \ \ poincare_collinear {?M u, ?M x1, ?M x2}" + using * + by auto + show "?P u x1 x2" (is "\a1\unit_disc. \a2\unit_disc. ?P' a1 a2 u x1 x2") + proof- + obtain Ma1 Ma2 where MM: "Ma1 \ unit_disc" "Ma2 \ unit_disc" "?P' Ma1 Ma2 (?M u) (?M x1) (?M x2)" + using **[rule_format, OF MM] + by blast + hence MM': "\a'\unit_disc. poincare_in_angle a' Ma1 (?M u) Ma2 \ poincare_ray_meets_line (?M u) a' (?M x1) (?M x2)" + by auto + obtain a1 a2 where a: "a1 \ unit_disc" "a2 \ unit_disc" "?M a1 = Ma1" "?M a2 = Ma2" + using uf + by (metis \Ma1 \ unit_disc\ \Ma2 \ unit_disc\ image_iff unit_disc_fix_iff) + + have "\a'\unit_disc. poincare_in_angle a' a1 u a2 \ poincare_ray_meets_line u a' x1 x2" + proof safe + fix a' + assume "a' \ unit_disc" "poincare_in_angle a' a1 u a2" + thus "poincare_ray_meets_line u a' x1 x2" + using MM(1-2) MM'[rule_format, of "?M a'"] * uf a xx + by (meson unit_disc_fix_discI unit_disc_fix_preserves_poincare_in_angle unit_disc_fix_preserves_poincare_ray_meets_line) + qed + + hence "?P' a1 a2 u x1 x2" + using MM * uf xx a + by auto + + thus ?thesis + using `a1 \ unit_disc` `a2 \ unit_disc` + by blast + qed + qed + next + show "?Q 0\<^sub>h" + proof safe + fix x1 x2 + assume "x1 \ unit_disc" "x2 \ unit_disc" + assume "\ poincare_collinear {0\<^sub>h, x1, x2}" + show "?P 0\<^sub>h x1 x2" + proof- + let ?lx = "poincare_line x1 x2" + + have "x1 \ x2" + using `x1 \ unit_disc` `x2 \ unit_disc``\ poincare_collinear {0\<^sub>h, x1, x2}` + using poincare_collinear3_between + by auto + + have lx: "is_poincare_line ?lx" + using is_poincare_line_poincare_line[OF `x1 \ x2`] + by simp + + obtain i1 i2 where "ideal_points ?lx = {i1, i2}" + by (meson \x1 \ x2\ is_poincare_line_poincare_line obtain_ideal_points) + + let ?li = "poincare_line i1 i2" + let ?i1 = "to_complex i1" + let ?i2 = "to_complex i2" + + have "i1 \ unit_circle_set" "i2 \ unit_circle_set" + using lx \ideal_points ?lx = {i1, i2}\ + unfolding unit_circle_set_def + by (metis ideal_points_on_unit_circle insertI1, metis ideal_points_on_unit_circle insertI1 insertI2) + + have "i1 \ i2" + using \ideal_points ?lx = {i1, i2}\ \x1 \ unit_disc\ \x1 \ x2\ \x2 \ unit_disc\ ideal_points_different(1) + by blast + + let ?a1 = "of_complex (?i1 / 2)" + let ?a2 = "of_complex (?i2 / 2)" + let ?la = "poincare_line ?a1 ?a2" + + have "?a1 \ unit_disc" "?a2 \ unit_disc" + using `i1 \ unit_circle_set` `i2 \ unit_circle_set` + unfolding unit_circle_set_def unit_disc_def disc_def circline_set_def + by auto (transfer, transfer, case_tac i1, case_tac i2, simp add: vec_cnj_def)+ + + have "?a1 \ 0\<^sub>h" "?a2 \ 0\<^sub>h" + using `i1 \ unit_circle_set` `i2 \ unit_circle_set` + unfolding unit_circle_set_def + by auto + + have "?a1 \ ?a2" + using `i1 \ i2` + by (metis \i1 \ unit_circle_set\ \i2 \ unit_circle_set\ circline_set_def divide_cancel_right inversion_infty inversion_unit_circle mem_Collect_eq of_complex_to_complex of_complex_zero to_complex_of_complex unit_circle_set_def zero_neq_numeral) + + have "poincare_collinear {0\<^sub>h, ?a1, i1}" + unfolding poincare_collinear_def + using `?a1 \ 0\<^sub>h`[symmetric] is_poincare_line_poincare_line[of "0\<^sub>h" ?a1] + unfolding circline_set_def + apply (rule_tac x="poincare_line 0\<^sub>h ?a1" in exI, auto) + apply (transfer, transfer, auto simp add: vec_cnj_def) + done + + have "poincare_collinear {0\<^sub>h, ?a2, i2}" + unfolding poincare_collinear_def + using `?a2 \ 0\<^sub>h`[symmetric] is_poincare_line_poincare_line[of "0\<^sub>h" ?a2] + unfolding circline_set_def + apply (rule_tac x="poincare_line 0\<^sub>h ?a2" in exI, auto) + apply (transfer, transfer, auto simp add: vec_cnj_def) + done + + have "\ poincare_ray_meets_line 0\<^sub>h ?a1 x1 x2" + using tangent_not_meet[of x1 x2 i1 ?a1] + using `x1 \ unit_disc` `x2 \ unit_disc` `?a1 \ unit_disc` `x1 \ x2` `\ poincare_collinear {0\<^sub>h, x1, x2}` + using `ideal_points ?lx = {i1, i2}` `?a1 \ 0\<^sub>h` `poincare_collinear {0\<^sub>h, ?a1, i1}` + by simp + + moreover + + have "\ poincare_ray_meets_line 0\<^sub>h ?a2 x1 x2" + using tangent_not_meet[of x1 x2 i2 ?a2] + using `x1 \ unit_disc` `x2 \ unit_disc` `?a2 \ unit_disc` `x1 \ x2` `\ poincare_collinear {0\<^sub>h, x1, x2}` + using `ideal_points ?lx = {i1, i2}` `?a2 \ 0\<^sub>h` `poincare_collinear {0\<^sub>h, ?a2, i2}` + by simp + + moreover + + have "\a' \ unit_disc. poincare_in_angle a' ?a1 0\<^sub>h ?a2 \ poincare_ray_meets_line 0\<^sub>h a' x1 x2" + unfolding poincare_in_angle_def + proof safe + fix a' a + assume *: "a' \ unit_disc" "a \ unit_disc" "poincare_on_ray a' 0\<^sub>h a" "a' \ 0\<^sub>h" + "poincare_between ?a1 a ?a2" "a \ ?a1" "a \ ?a2" + show "poincare_ray_meets_line 0\<^sub>h a' x1 x2" + proof- + have "\ a' a1 a2 x1 x2 i1 i2. + a' \ unit_disc \ x1 \ unit_disc \ x2 \ unit_disc \ x1 \ x2 \ + \ poincare_collinear {0\<^sub>h, x1, x2} \ ideal_points (poincare_line x1 x2) = {i1, i2} \ + a1 = of_complex (to_complex i1 / 2) \ a2 = of_complex (to_complex i2 / 2) \ + i1 \ i2 \ a1 \ a2 \ poincare_collinear {0\<^sub>h, a1, i1} \ poincare_collinear {0\<^sub>h, a2, i2} \ + a1 \ unit_disc \ a2 \ unit_disc \ i1 \ unit_circle_set \ i2 \ unit_circle_set \ + poincare_on_ray a' 0\<^sub>h a \ a' \ 0\<^sub>h \ poincare_between a1 a a2 \ a \ a1 \ a \ a2 \ + poincare_ray_meets_line 0\<^sub>h a' x1 x2" (is "\ a' a1 a2 x1 x2 i1 i2. ?R 0\<^sub>h a' a1 a2 x1 x2 i1 i2 a") + proof (rule wlog_rotation_to_positive_x_axis[OF `a \ unit_disc`]) + let ?R' = "\ a zero. \ a' a1 a2 x1 x2 i1 i2. ?R zero a' a1 a2 x1 x2 i1 i2 a" + fix xa + assume xa: "is_real xa" "0 < Re xa" "Re xa < 1" + let ?a = "of_complex xa" + show "?R' ?a 0\<^sub>h" + proof safe + fix a' a1 a2 x1 x2 i1 i2 + let ?i1 = "to_complex i1" and ?i2 = "to_complex i2" + let ?a1 = "of_complex (?i1 / 2)" and ?a2 = "of_complex (?i2 / 2)" + let ?la = "poincare_line ?a1 ?a2" and ?lx = "poincare_line x1 x2" and ?li = "poincare_line i1 i2" + assume "a' \ unit_disc" "x1 \ unit_disc" "x2 \ unit_disc" "x1 \ x2" + assume "\ poincare_collinear {0\<^sub>h, x1, x2}" "ideal_points ?lx = {i1, i2}" + assume "poincare_on_ray a' 0\<^sub>h ?a" "a' \ 0\<^sub>h" + assume "poincare_between ?a1 ?a ?a2" "?a \ ?a1" "?a \ ?a2" + assume "i1 \ i2" "?a1 \ ?a2" "poincare_collinear {0\<^sub>h, ?a1, i1}" "poincare_collinear {0\<^sub>h, ?a2, i2}" + assume "?a1 \ unit_disc" "?a2 \ unit_disc" + assume "i1 \ unit_circle_set" "i2 \ unit_circle_set" + show "poincare_ray_meets_line 0\<^sub>h a' x1 x2" + proof- + have "?lx = ?li" + using \ideal_points ?lx = {i1, i2}\ \x1 \ x2\ ideal_points_line_unique + by auto + + have lx: "is_poincare_line ?lx" + using is_poincare_line_poincare_line[OF `x1 \ x2`] + by simp + + have "x1 \ circline_set ?lx" "x2 \ circline_set ?lx" + using lx \x1 \ x2\ + by auto + + have "?lx \ x_axis" + using `\ poincare_collinear {0\<^sub>h, x1, x2}` `x1 \ circline_set ?lx` `x2 \ circline_set ?lx` lx + unfolding poincare_collinear_def + by auto + + have "0\<^sub>h \ circline_set ?lx" + using `\ poincare_collinear {0\<^sub>h, x1, x2}` lx `x1 \ circline_set ?lx` `x2 \ circline_set ?lx` + unfolding poincare_collinear_def + by auto + + have "xa \ 0" "?a \ 0\<^sub>h" + using xa + by auto + hence "0\<^sub>h \ ?a" + by metis + + have "?a \ positive_x_axis" + using xa + unfolding positive_x_axis_def + by simp + + have "?a \ unit_disc" + using xa + by (auto simp add: cmod_eq_Re) + + have "?a \ circline_set ?la" + using `poincare_between ?a1 ?a ?a2` + using \?a1 \ ?a2\ \?a \ unit_disc\ \?a1 \ unit_disc\ \?a2 \ unit_disc\ poincare_between_poincare_line_uzv + by blast + + have "?a1 \ circline_set ?la" "?a2 \ circline_set ?la" + by (auto simp add: \?a1 \ ?a2\) + + have la: "is_poincare_line ?la" + using is_poincare_line_poincare_line[OF `?a1 \ ?a2`] + by simp + + have inv: "inversion i1 = i1" "inversion i2 = i2" + using `i1 \ unit_circle_set` `i2 \ unit_circle_set` + by (auto simp add: circline_set_def unit_circle_set_def) + + have "i1 \ \\<^sub>h" "i2 \ \\<^sub>h" + using inv + by auto + + have "?a1 \ circline_set x_axis \ ?a2 \ circline_set x_axis" + proof (rule ccontr) + assume "\ ?thesis" + hence "?a1 \ circline_set x_axis \ ?a2 \ circline_set x_axis" + by auto + hence "?la = x_axis" + proof + assume "?a1 \ circline_set x_axis" + hence "{?a, ?a1} \ circline_set ?la \ circline_set x_axis" + using `?a \ circline_set ?la` `?a1 \ circline_set ?la``?a \ positive_x_axis` + using circline_set_x_axis_I xa(1) + by blast + thus "?la = x_axis" + using unique_is_poincare_line[of ?a ?a1 ?la x_axis] + using `?a1 \ unit_disc` `?a \ unit_disc` la `?a \ ?a1` + by auto + next + assume "?a2 \ circline_set x_axis" + hence "{?a, ?a2} \ circline_set ?la \ circline_set x_axis" + using `?a \ circline_set ?la` `?a2 \ circline_set ?la` `?a \ positive_x_axis` + using circline_set_x_axis_I xa(1) + by blast + thus "?la = x_axis" + using unique_is_poincare_line[of ?a ?a2 ?la x_axis] + using `?a2 \ unit_disc` `?a \ unit_disc` la `?a \ ?a2` + by auto + qed + + hence "i1 \ circline_set x_axis \ i2 \ circline_set x_axis" + using `?a1 \ circline_set ?la` `?a2 \ circline_set ?la` + by (metis \i1 \ \\<^sub>h\ \i2 \ \\<^sub>h\ \of_complex (to_complex i1 / 2) \ unit_disc\ \of_complex (to_complex i2 / 2) \ unit_disc\ \poincare_collinear {0\<^sub>h, of_complex (to_complex i1 / 2), i1}\ \poincare_collinear {0\<^sub>h, of_complex (to_complex i2 / 2), i2}\ divide_eq_0_iff inf_not_of_complex inv(1) inv(2) inversion_noteq_unit_disc of_complex_to_complex of_complex_zero_iff poincare_collinear3_poincare_lines_equal_general poincare_line_0_real_is_x_axis poincare_line_circline_set(2) zero_in_unit_disc zero_neq_numeral) + + thus False + using `?lx \ x_axis` unique_is_poincare_line_general[of i1 i2 ?li x_axis] `i1 \ i2` inv `?lx = ?li` + by auto + qed + + hence "?la \ x_axis" + using \?a1 \ ?a2\ poincare_line_circline_set(1) + by fastforce + + have "intersects_x_axis_positive ?la" + using intersects_x_axis_positive_iff[of ?la] `?la \ x_axis` `?a \ circline_set ?la` la + using `?a \ unit_disc` `?a \ positive_x_axis` + by auto + + have "intersects_x_axis ?lx" + proof- + have "arg (to_complex ?a1) * arg (to_complex ?a2) < 0" + using `poincare_between ?a1 ?a ?a2` `?a1 \ unit_disc` `?a2 \ unit_disc` + using poincare_between_x_axis_intersection[of ?a1 ?a2 "of_complex xa"] + using `?a1 \ ?a2` `?a \ unit_disc` `?a1 \ circline_set x_axis \ ?a2 \ circline_set x_axis` `?a \ positive_x_axis` + using `?a \ circline_set ?la` + unfolding positive_x_axis_def + by simp + + moreover + + have "\ x y x' y' :: real. \sgn x' = sgn x; sgn y' = sgn y\ \ x*y < 0 \ x'*y' < 0" + by (metis sgn_less sgn_mult) + + ultimately + + have "Im (to_complex ?a1) * Im (to_complex ?a2) < 0" + using arg_Im_sgn[of "to_complex ?a1"] arg_Im_sgn[of "to_complex ?a2"] + using `?a1 \ unit_disc` `?a2 \ unit_disc` `?a1 \ circline_set x_axis \ ?a2 \ circline_set x_axis` + using inf_or_of_complex[of ?a1] inf_or_of_complex[of ?a2] circline_set_x_axis + by (metis circline_set_x_axis_I to_complex_of_complex) + + thus ?thesis + using ideal_points_intersects_x_axis[of ?lx i1 i2] + using `ideal_points ?lx = {i1, i2}` lx `?lx \ x_axis` + by simp + qed + + have "intersects_x_axis_positive ?lx" + proof- + have "cmod ?i1 = 1" "cmod ?i2 = 1" + using \i1 \ unit_circle_set\ \i2 \ unit_circle_set\ + unfolding unit_circle_set_def + by auto + + let ?a1' = "?i1 / 2" and ?a2' = "?i2 / 2" + let ?Aa1 = "\ * (?a1' * cnj ?a2' - ?a2' * cnj ?a1')" and + ?Ba1 = "\ * (?a2' * cor ((cmod ?a1')\<^sup>2 + 1) - ?a1' * cor ((cmod ?a2')\<^sup>2 + 1))" + + have "?Aa1 \ 0 \ ?Ba1 \ 0" + using `cmod (to_complex i1) = 1` `cmod (to_complex i2) = 1` `?a1 \ ?a2` + by (auto simp add: power_divide complex_mult_cnj_cmod) + + have "is_real ?Aa1" + by simp + + have "?a1 \ inversion ?a2" + using \?a1 \ unit_disc\ \?a2 \ unit_disc\ inversion_noteq_unit_disc by fastforce + + hence "Re ?Ba1 / Re ?Aa1 < -1" + using `intersects_x_axis_positive ?la` `?a1 \ ?a2` + using intersects_x_axis_positive_mk_circline[of ?Aa1 ?Ba1] `?Aa1 \ 0 \ ?Ba1 \ 0` `is_real ?Aa1` + using poincare_line_non_homogenous[of ?a1 ?a2] + by (simp add: Let_def) + + moreover + + let ?i1' = "to_complex i1" and ?i2' = "to_complex i2" + let ?Ai1 = "\ * (?i1' * cnj ?i2' - ?i2' * cnj ?i1')" and + ?Bi1 = "\ * (?i2' * cor ((cmod ?i1')\<^sup>2 + 1) - ?i1' * cor ((cmod ?i2')\<^sup>2 + 1))" + + have "?Ai1 \ 0 \ ?Bi1 \ 0" + using `cmod (to_complex i1) = 1` `cmod (to_complex i2) = 1` `?a1 \ ?a2` + by (auto simp add: power_divide complex_mult_cnj_cmod) + + have "is_real ?Ai1" + by simp + + have "sgn (Re ?Bi1 / Re ?Ai1) = sgn (Re ?Ba1 / Re ?Aa1)" + proof- + have "Re ?Bi1 / Re ?Ai1 = (Im ?i1 * 2 - Im ?i2 * 2) / + (Im ?i2 * (Re ?i1 * 2) - Im ?i1 * (Re ?i2 * 2))" + using `cmod ?i1 = 1` `cmod ?i2 = 1` + by (auto simp add: complex_mult_cnj_cmod field_simps) + also have "... = (Im ?i1 - Im ?i2) / + (Im ?i2 * (Re ?i1) - Im ?i1 * (Re ?i2))" (is "... = ?expr") + apply (subst left_diff_distrib[symmetric]) + apply (subst semiring_normalization_rules(18))+ + apply (subst left_diff_distrib[symmetric]) + by (metis mult.commute mult_divide_mult_cancel_left_if zero_neq_numeral) + finally have 1: "Re ?Bi1 / Re ?Ai1 = (Im ?i1 - Im ?i2) / (Im ?i2 * (Re ?i1) - Im ?i1 * (Re ?i2))" + . + + + have "Re ?Ba1 / Re ?Aa1 = (Im ?i1 * 20 - Im ?i2 * 20) / + (Im ?i2 * (Re ?i1 * 16) - Im ?i1 * (Re ?i2 * 16))" + using `cmod (to_complex i1) = 1` `cmod (to_complex i2) = 1` + by (auto simp add: complex_mult_cnj_cmod field_simps) + also have "... = (20 / 16) * ((Im ?i1 - Im ?i2) / + (Im ?i2 * (Re ?i1) - Im ?i1 * (Re ?i2)))" + apply (subst left_diff_distrib[symmetric])+ + apply (subst semiring_normalization_rules(18))+ + apply (subst left_diff_distrib[symmetric])+ + by (metis (no_types, hide_lams) field_class.field_divide_inverse mult.commute times_divide_times_eq) + finally have 2: "Re ?Ba1 / Re ?Aa1 = (5 / 4) * ((Im ?i1 - Im ?i2) / (Im ?i2 * (Re ?i1) - Im ?i1 * (Re ?i2)))" + by simp + + have "?expr \ 0" + using `Re ?Ba1 / Re ?Aa1 < -1` + apply (subst (asm) 2) + by linarith + thus ?thesis + apply (subst 1, subst 2) + apply (simp only: sgn_mult) + by simp + qed + + + moreover + + have "i1 \ inversion i2" + by (simp add: \i1 \ i2\ inv(2)) + + have "(Re ?Bi1 / Re ?Ai1)\<^sup>2 > 1" + proof- + have "?Ai1 = 0 \ (Re ?Bi1)\<^sup>2 > (Re ?Ai1)\<^sup>2" + using `intersects_x_axis ?lx` + using `i1 \ i2` `i1 \ \\<^sub>h` `i2 \ \\<^sub>h` `i1 \ inversion i2` + using intersects_x_axis_mk_circline[of ?Ai1 ?Bi1] `?Ai1 \ 0 \ ?Bi1 \ 0` `is_real ?Ai1` + using poincare_line_non_homogenous[of i1 i2] `?lx = ?li` + by metis + + moreover + have "?Ai1 \ 0" + proof (rule ccontr) + assume "\ ?thesis" + hence "0\<^sub>h \ circline_set ?li" + unfolding circline_set_def + apply simp + apply (transfer, transfer, case_tac i1, case_tac i2) + by (auto simp add: vec_cnj_def field_simps) + thus False + using `0\<^sub>h \ circline_set ?lx` `?lx = ?li` + by simp + qed + + ultimately + + have "(Re ?Bi1)\<^sup>2 > (Re ?Ai1)\<^sup>2" + by auto + + moreover + + have "Re ?Ai1 \ 0" + using `is_real ?Ai1` `?Ai1 \ 0` + by (simp add: complex_eq_iff) + + ultimately + + show ?thesis + by (simp add: power_divide) + qed + + moreover + + { + fix x1 x2 :: real + assume "sgn x1 = sgn x2" "x1 < -1" "x2\<^sup>2 > 1" + hence "x2 < -1" + by (smt one_power2 real_sqrt_abs real_sqrt_less_iff sgn_neg sgn_pos) + } + + ultimately + + have "Re ?Bi1 / Re ?Ai1 < -1" + by metis + + thus ?thesis + using `i1 \ i2` `i1 \ \\<^sub>h` `i2 \ \\<^sub>h` `i1 \ inversion i2` + using intersects_x_axis_positive_mk_circline[of ?Ai1 ?Bi1] `?Ai1 \ 0 \ ?Bi1 \ 0` `is_real ?Ai1` + using poincare_line_non_homogenous[of i1 i2] `?lx = ?li` + by (simp add: Let_def) + qed + + then obtain x where x: "x \ unit_disc" "x \ circline_set ?lx \ positive_x_axis" + using intersects_x_axis_positive_iff[OF lx `?lx \ x_axis`] + by auto + + have "poincare_on_ray x 0\<^sub>h a' \ poincare_collinear {x1, x2, x}" + proof + show "poincare_collinear {x1, x2, x}" + using x lx `x1 \ circline_set ?lx` `x2 \ circline_set ?lx` + unfolding poincare_collinear_def + by auto + next + show "poincare_on_ray x 0\<^sub>h a'" + unfolding poincare_on_ray_def + proof- + have "a' \ circline_set x_axis" + using `poincare_on_ray a' 0\<^sub>h ?a` xa `0\<^sub>h \ ?a` `xa \ 0` `a' \ unit_disc` + unfolding poincare_on_ray_def + using poincare_line_0_real_is_x_axis[of "of_complex xa"] + using poincare_between_poincare_line_uvz[of "0\<^sub>h" "of_complex xa" a'] + using poincare_between_poincare_line_uzv[of "0\<^sub>h" "of_complex xa" a'] + by (auto simp add: cmod_eq_Re) + + then obtain xa' where xa': "a' = of_complex xa'" "is_real xa'" + using `a' \ unit_disc` + using circline_set_def on_circline_x_axis + by auto + + hence "-1 < Re xa'" "Re xa' < 1" "xa' \ 0" + using `a' \ unit_disc` `a' \ 0\<^sub>h` + by (auto simp add: cmod_eq_Re) + + hence "Re xa' > 0" "Re xa' < 1" "is_real xa'" + using `poincare_on_ray a' 0\<^sub>h (of_complex xa)` + using poincare_between_x_axis_0uv[of "Re xa'" "Re xa"] + using poincare_between_x_axis_0uv[of "Re xa" "Re xa'"] + using circline_set_positive_x_axis_I[of "Re xa'"] + using xa xa' complex_of_real_Re + unfolding poincare_on_ray_def + by (smt of_real_0, linarith, blast) + + moreover + + obtain xx where "is_real xx" "Re xx > 0" "Re xx < 1" "x = of_complex xx" + using x + unfolding positive_x_axis_def + using circline_set_def cmod_eq_Re on_circline_x_axis + by auto + + ultimately + + show "poincare_between 0\<^sub>h x a' \ poincare_between 0\<^sub>h a' x" + using `a' = of_complex xa'` + by (smt \a' \ unit_disc\ arg_0_iff poincare_between_0uv poincare_between_def to_complex_of_complex x(1)) + qed + + qed + + thus ?thesis + using `x \ unit_disc` + unfolding poincare_ray_meets_line_def poincare_on_line_def + by (metis insert_commute) + qed + qed + next + show "a \ 0\<^sub>h" + proof (rule ccontr) + assume "\ ?thesis" + then obtain k where "k<0" "to_complex ?a1 = cor k * to_complex ?a2" + using poincare_between_u0v[OF `?a1 \ unit_disc` `?a2 \ unit_disc` `?a1 \ 0\<^sub>h` `?a2 \ 0\<^sub>h`] + using `poincare_between ?a1 a ?a2` + by auto + hence "to_complex i1 = cor k * to_complex i2" "k < 0" + by auto + hence "0\<^sub>h \ circline_set (poincare_line x1 x2)" + using ideal_points_proportional[of "poincare_line x1 x2" i1 i2 k] `ideal_points (poincare_line x1 x2) = {i1, i2}` + using is_poincare_line_poincare_line[OF `x1 \ x2`] + by simp + thus False + using `\ poincare_collinear {0\<^sub>h, x1, x2}` + using is_poincare_line_poincare_line[OF `x1 \ x2`] + unfolding poincare_collinear_def + by (meson \x1 \ x2\ empty_subsetI insert_subset poincare_line_circline_set(1) poincare_line_circline_set(2)) + qed + next + fix \ u + let ?R' = "\ a zero. \ a' a1 a2 x1 x2 i1 i2. ?R zero a' a1 a2 x1 x2 i1 i2 a" + let ?M = "moebius_pt (moebius_rotation \)" + assume *: "u \ unit_disc" "u \ 0\<^sub>h" and **: "?R' (?M u) 0\<^sub>h" + have uf: "unit_disc_fix (moebius_rotation \)" + by simp + have "?M 0\<^sub>h = 0\<^sub>h" + by auto + hence **: "?R' (?M u) (?M 0\<^sub>h)" + using ** + by simp + show "?R' u 0\<^sub>h" + proof (rule allI)+ + fix a' a1 a2 x1 x2 i1 i2 + have i1: "i1 \ unit_circle_set \ moebius_pt (moebius_rotation \) (of_complex (to_complex i1 / 2)) = of_complex (to_complex (moebius_pt (moebius_rotation \) i1) / 2)" + using unit_circle_set_def by force + + have i2: "i2 \ unit_circle_set \ moebius_pt (moebius_rotation \) (of_complex (to_complex i2 / 2)) = of_complex (to_complex (moebius_pt (moebius_rotation \) i2) / 2)" + using unit_circle_set_def by force + + show "?R 0\<^sub>h a' a1 a2 x1 x2 i1 i2 u" + using **[rule_format, of "?M a'" "?M x1" "?M x2" "?M i1" "?M i2" "?M a1" "?M a2"] uf * + apply (auto simp del: moebius_pt_moebius_rotation_zero moebius_pt_moebius_rotation) + using i1 i2 + by simp + qed + qed + thus ?thesis + using `a' \ unit_disc` `x1 \ unit_disc` `x2 \ unit_disc` `x1 \ x2` + using `\ poincare_collinear {0\<^sub>h, x1, x2}` `ideal_points ?lx = {i1, i2}` `i1 \ i2` + using `?a1 \ ?a2` `poincare_collinear {0\<^sub>h, ?a1, i1}` `poincare_collinear {0\<^sub>h, ?a2, i2}` + using `?a1 \ unit_disc` `?a2 \ unit_disc` `i1 \ unit_circle_set` `i2 \ unit_circle_set` + using `poincare_on_ray a' 0\<^sub>h a` `a' \ 0\<^sub>h` `poincare_between ?a1 a ?a2` `a \ ?a1` `a \ ?a2` + by blast + qed + qed + + moreover + + have "\ poincare_on_line 0\<^sub>h ?a1 ?a2" + proof + assume *: "poincare_on_line 0\<^sub>h ?a1 ?a2" + hence "poincare_collinear {0\<^sub>h, ?a1, ?a2}" + unfolding poincare_on_line_def + by simp + hence "poincare_line 0\<^sub>h ?a1 = poincare_line 0\<^sub>h ?a2" + using poincare_collinear3_poincare_lines_equal_general[of "0\<^sub>h" ?a1 ?a2] + using \?a1 \ unit_disc\ \?a1 \ 0\<^sub>h\ \?a2 \ unit_disc\ \?a2 \ 0\<^sub>h\ + by (metis inversion_noteq_unit_disc zero_in_unit_disc) + + have "i1 \ circline_set (poincare_line 0\<^sub>h ?a1)" + using `poincare_collinear {0\<^sub>h, ?a1, i1}` + using poincare_collinear3_poincare_line_general[of i1 "0\<^sub>h" ?a1] + using \?a1 \ unit_disc\ `?a1 \ 0\<^sub>h` + by (metis insert_commute inversion_noteq_unit_disc zero_in_unit_disc) + moreover + have "i2 \ circline_set (poincare_line 0\<^sub>h ?a1)" + using `poincare_collinear {0\<^sub>h, ?a2, i2}` + using poincare_collinear3_poincare_line_general[of i2 "0\<^sub>h" ?a2] + using \?a2 \ unit_disc\ `?a2 \ 0\<^sub>h` \poincare_line 0\<^sub>h ?a1 = poincare_line 0\<^sub>h ?a2\ + by (metis insert_commute inversion_noteq_unit_disc zero_in_unit_disc) + + ultimately + + have "poincare_collinear {0\<^sub>h, i1, i2}" + using \?a1 \ unit_disc\ \?a1 \ 0\<^sub>h\ \poincare_collinear {0\<^sub>h, ?a1, i1}\ + by (smt insert_subset poincare_collinear_def unique_poincare_line zero_in_unit_disc) + hence "0\<^sub>h \ circline_set (poincare_line i1 i2)" + using poincare_collinear3_poincare_line_general[of "0\<^sub>h" i1 i2] + using \i1 \ i2\ \i2 \ unit_circle_set\ unit_circle_set_def + by force + + moreover + + have "?lx = ?li" + using \ideal_points ?lx = {i1, i2}\ \x1 \ x2\ ideal_points_line_unique + by auto + + ultimately + + show False + using \\ poincare_collinear {0\<^sub>h, x1, x2}\ + using \x1 \ x2\ poincare_line_poincare_collinear3_general + by auto + qed + + ultimately + + show ?thesis + using `?a1 \ unit_disc` `?a2 \ unit_disc` + by blast + qed + qed + qed + thus ?thesis + using `x1 \ unit_disc` `x2 \ unit_disc` `\ poincare_collinear {a, x1, x2}` + by blast +qed + +subsection\Interpretation of locales\ + +global_interpretation PoincareTarskiAbsolute: TarskiAbsolute where cong = p_congruent and betw = p_between + defines p_on_line = PoincareTarskiAbsolute.on_line and + p_on_ray = PoincareTarskiAbsolute.on_ray and + p_in_angle = PoincareTarskiAbsolute.in_angle and + p_ray_meets_line = PoincareTarskiAbsolute.ray_meets_line +proof- + show "TarskiAbsolute p_congruent p_between" + proof + text\ 1. Reflexivity of congruence \ + fix x y + show "p_congruent x y y x" + unfolding p_congruent_def + by transfer (simp add: poincare_distance_sym) + next + text\ 2. Transitivity of congruence \ + fix x y z u v w + show "p_congruent x y z u \ p_congruent x y v w \ p_congruent z u v w" + by (transfer, simp) + next + text\ 3. Identity of congruence \ + fix x y z + show "p_congruent x y z z \ x = y" + unfolding p_congruent_def + by transfer (simp add: poincare_distance_eq_0_iff) + next + text\ 4. Segment construction \ + fix x y a b + show "\ z. p_between x y z \ p_congruent y z a b" + using segment_construction + unfolding p_congruent_def + by transfer (simp, blast) + next + text\ 5. Five segment \ + fix x y z x' y' z' u u' + show "x \ y \ p_between x y z \ p_between x' y' z' \ + p_congruent x y x' y' \ p_congruent y z y' z' \ + p_congruent x u x' u' \ p_congruent y u y' u' \ + p_congruent z u z' u'" + unfolding p_congruent_def + apply transfer + using five_segment_axiom + by meson + next + text\ 6. Identity of betweeness \ + fix x y + show "p_between x y x \ x = y" + by transfer (simp add: poincare_between_sum_distances poincare_distance_eq_0_iff poincare_distance_sym) + next + text\ 7. Pasch \ + fix x y z u v + show "p_between x u z \ p_between y v z \ (\ a. p_between u a y \ p_between x a v)" + apply transfer + using Pasch + by blast + next + text\ 8. Lower dimension \ + show "\ a. \ b. \ c. \ p_between a b c \ \ p_between b c a \ \ p_between c a b" + apply (transfer) + using lower_dimension_axiom + by simp + next + text\ 9. Upper dimension \ + fix x y z u v + show "p_congruent x u x v \ p_congruent y u y v \ p_congruent z u z v \ u \ v \ + p_between x y z \ p_between y z x \ p_between z x y" + unfolding p_congruent_def + by (transfer, simp add: upper_dimension_axiom) + qed +qed + + +interpretation PoincareTarskiHyperbolic: TarskiHyperbolic + where cong = p_congruent and betw = p_between +proof + text\ 10. Euclid negation \ + show "\ a b c d t. p_between a d t \ p_between b d c \ a \ d \ + (\ x y. p_between a b x \ p_between a c y \ \ p_between x t y)" + using negated_euclidean_axiom + by transfer (auto, blast) +next + fix a x1 x2 + assume "\ TarskiAbsolute.on_line p_between a x1 x2" + hence "\ p_on_line a x1 x2" + using TarskiAbsolute.on_line_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms] + using PoincareTarskiAbsolute.on_line_def + by simp + text\ 11. Limiting parallels \ + thus "\a1 a2. + \ TarskiAbsolute.on_line p_between a a1 a2 \ + \ TarskiAbsolute.ray_meets_line p_between a a1 x1 x2 \ + \ TarskiAbsolute.ray_meets_line p_between a a2 x1 x2 \ + (\a'. TarskiAbsolute.in_angle p_between a' a1 a a2 \ TarskiAbsolute.ray_meets_line p_between a a' x1 x2)" + unfolding TarskiAbsolute.in_angle_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms] + unfolding TarskiAbsolute.on_ray_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms] + unfolding TarskiAbsolute.ray_meets_line_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms] + unfolding TarskiAbsolute.on_ray_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms] + unfolding TarskiAbsolute.on_line_def[OF PoincareTarskiAbsolute.TarskiAbsolute_axioms] + unfolding PoincareTarskiAbsolute.on_line_def + apply transfer + proof- + fix a x1 x2 + assume *: "a \ unit_disc" "x1 \ unit_disc" "x2 \ unit_disc" + "\ (poincare_between a x1 x2 \ poincare_between x1 a x2 \ poincare_between x1 x2 a)" + hence "\ poincare_on_line a x1 x2" + using poincare_collinear3_iff[of a x1 x2] + using poincare_between_rev poincare_on_line_def by blast + hence "\a1\unit_disc. + \a2\unit_disc. + \ poincare_on_line a a1 a2 \ + \ poincare_ray_meets_line a a1 x1 x2 \ + \ poincare_ray_meets_line a a2 x1 x2 \ + (\a'\unit_disc. + poincare_in_angle a' a1 a a2 \ + poincare_ray_meets_line a a' x1 x2)" + using limiting_parallels[of a x1 x2] * + by blast + then obtain a1 a2 where **: "a1\unit_disc" "a2\unit_disc" "\ poincare_on_line a a1 a2" + "\ poincare_ray_meets_line a a2 x1 x2" + "\ poincare_ray_meets_line a a1 x1 x2" + "\a'\unit_disc. + poincare_in_angle a' a1 a a2 \ + poincare_ray_meets_line a a' x1 x2" + by blast + have "\ (\x\{z. z \ unit_disc}. + (poincare_between a x a1 \ + poincare_between a a1 x) \ + (poincare_between x x1 x2 \ + poincare_between x1 x x2 \ + poincare_between x1 x2 x))" + using `\ poincare_ray_meets_line a a1 x1 x2` + unfolding poincare_on_line_def poincare_ray_meets_line_def poincare_on_ray_def + using poincare_collinear3_iff[of _ x1 x2] poincare_between_rev *(2, 3) + by auto + moreover + have "\ (\x\{z. z \ unit_disc}. + (poincare_between a x a2 \ + poincare_between a a2 x) \ + (poincare_between x x1 x2 \ + poincare_between x1 x x2 \ + poincare_between x1 x2 x))" + using `\ poincare_ray_meets_line a a2 x1 x2` + unfolding poincare_on_line_def poincare_ray_meets_line_def poincare_on_ray_def + using poincare_collinear3_iff[of _ x1 x2] poincare_between_rev *(2, 3) + by auto + moreover + have "\ (poincare_between a a1 a2 \ poincare_between a1 a a2 \ poincare_between a1 a2 a)" + using `\ poincare_on_line a a1 a2` poincare_collinear3_iff[of a a1 a2] + using *(1) **(1-2) + unfolding poincare_on_line_def + by simp + moreover + have "(\a'\{z. z \ unit_disc}. + a \ a1 \ + a \ a2 \ + a' \ a \ + (\x\{z. z \ unit_disc}. + poincare_between a1 x a2 \ + x \ a1 \ + x \ a2 \ + (poincare_between a a' x \ + poincare_between a x a')) \ + (\x\{z. z \ unit_disc}. + (poincare_between a x a' \ + poincare_between a a' x) \ + (poincare_between x x1 x2 \ + poincare_between x1 x x2 \ + poincare_between x1 x2 x)))" + using **(6) + unfolding poincare_on_line_def poincare_in_angle_def poincare_ray_meets_line_def poincare_on_ray_def + using poincare_collinear3_iff[of _ x1 x2] poincare_between_rev *(2, 3) + by auto + ultimately + show "\a1\{z. z \ unit_disc}. + \a2\{z. z \ unit_disc}. + \ (poincare_between a a1 a2 \ poincare_between a1 a a2 \ poincare_between a1 a2 a) \ + \ (\x\{z. z \ unit_disc}. + (poincare_between a x a1 \ + poincare_between a a1 x) \ + (poincare_between x x1 x2 \ + poincare_between x1 x x2 \ + poincare_between x1 x2 x)) \ + \ (\x\{z. z \ unit_disc}. + (poincare_between a x a2 \ + poincare_between a a2 x) \ + (poincare_between x x1 x2 \ + poincare_between x1 x x2 \ + poincare_between x1 x2 x)) \ + (\a'\{z. z \ unit_disc}. + a \ a1 \ + a \ a2 \ + a' \ a \ + (\x\{z. z \ unit_disc}. + poincare_between a1 x a2 \ + x \ a1 \ + x \ a2 \ + (poincare_between a a' x \ + poincare_between a x a')) \ + (\x\{z. z \ unit_disc}. + (poincare_between a x a' \ + poincare_between a a' x) \ + (poincare_between x x1 x2 \ + poincare_between x1 x x2 \ + poincare_between x1 x2 x)))" + using **(1, 2) + by auto + qed +qed + +interpretation PoincareElementaryTarskiHyperbolic: ElementaryTarskiHyperbolic p_congruent p_between +proof + text\ 12. Continuity \ + fix \ \ + assume "\ a. \ x. \ y. \ x \ \ y \ p_between a x y" + thus "\ b. \ x. \ y. \ x \ \ y \ p_between x b y" + apply transfer + using continuity + by auto +qed + +end diff --git a/thys/Poincare_Disc/ROOT b/thys/Poincare_Disc/ROOT new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/ROOT @@ -0,0 +1,21 @@ +chapter AFP + +session Poincare_Disc (AFP) = HOL + + options [timeout = 1200] + sessions + "Complex_Geometry" + theories + Hyperbolic_Functions + Tarski + Poincare_Lines + Poincare_Lines_Ideal_Points + Poincare_Distance + Poincare_Circles + Poincare_Between + Poincare_Lines_Axis_Intersections + Poincare_Perpendicular + Poincare + Poincare_Tarski + document_files + "root.bib" + "root.tex" diff --git a/thys/Poincare_Disc/Tarski.thy b/thys/Poincare_Disc/Tarski.thy new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/Tarski.thy @@ -0,0 +1,61 @@ +section\Tarski axioms\ + +text \In this section we introduce axioms of Tarski \cite{tarski} trough a series of locales.\ + +theory Tarski +imports Main +begin + +text \The first locale assumes all Tarski axioms except for the Euclid's axiom and the continuity +axiom and corresponds to absolute geometry.\ + +locale TarskiAbsolute = + fixes cong :: "'p \ 'p \ 'p \ 'p \ bool" + fixes betw :: "'p \ 'p \ 'p \ bool" + assumes cong_reflexive: "cong x y y x" + assumes cong_transitive: "cong x y z u \ cong x y v w \ cong z u v w" + assumes cong_identity: "cong x y z z \ x = y" + assumes segment_construction: "\ z. betw x y z \ cong y z a b" + assumes five_segment: "x \ y \ betw x y z \ betw x' y' z' \ cong x y x' y' \ cong y z y' z' \ cong x u x' u' \ cong y u y' u' \ cong z u z' u'" + assumes betw_identity: "betw x y x \ x = y" + assumes Pasch: "betw x u z \ betw y v z \ (\ a. betw u a y \ betw x a v)" + assumes lower_dimension: "\ a. \ b. \ c. \ betw a b c \ \ betw b c a \ \ betw c a b" + assumes upper_dimension: "cong x u x v \ cong y u y v \ cong z u z v \ u \ v \ betw x y z \ betw y z x \ betw z x y" +begin + +text \The following definitions are used to specify axioms in the following locales.\ + +text \Point $p$ is on line $ab$.\ +definition on_line where + "on_line p a b \ betw p a b \ betw a p b \ betw a b p" + +text \Point $p$ is on ray $ab$.\ +definition on_ray where + "on_ray p a b \ betw a p b \ betw a b p" + +text \Point $p$ is inside angle $abc$.\ +definition in_angle where + "in_angle p a b c \ b \ a \ b \ c \ p \ b \ (\ x. betw a x c \ x \ a \ x \ c \ on_ray p b x)" + +text \Ray $r_ar_b$ meets the line $l_al_b$.\ +definition ray_meets_line where + "ray_meets_line ra rb la lb \ (\ x. on_ray x ra rb \ on_line x la lb)" + +end + +text\The second locales adds the negation of Euclid's axiom and limiting parallels and corresponds +to hyperbolic geometry.\ + +locale TarskiHyperbolic = TarskiAbsolute + + assumes euclid_negation: "\ a b c d t. betw a d t \ betw b d c \ a \ d \ (\ x y. betw a b x \ betw a c y \ \ betw x t y)" + assumes limiting_parallels: "\ on_line a x1 x2 \ + (\ a1 a2. \ on_line a a1 a2 \ + \ ray_meets_line a a1 x1 x2 \ + \ ray_meets_line a a2 x1 x2 \ + (\ a'. in_angle a' a1 a a2 \ ray_meets_line a a' x1 x2))" + +text\The third locale adds the continuity axiom and corresponds to elementary hyperbolic geometry.\ +locale ElementaryTarskiHyperbolic = TarskiHyperbolic + + assumes continuity: "\\ a. \ x. \ y. \ x \ \ y \ betw a x y\ \ \ b. \ x. \ y. \ x \ \ y \ betw x b y" + +end diff --git a/thys/Poincare_Disc/document/root.bib b/thys/Poincare_Disc/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Poincare_Disc/document/root.bib @@ -0,0 +1,73 @@ +@book{tarski, + author = {Wolfram Schwabhäuser and Wanda Szmielew and Alfred Tarski}, + title = {{Metamathematische Methoden in der Geometrie}}, + publisher = {Springer-Verlag}, + year = {1983}, + address = {Berlin} +} + +@article{amai-complexplane, + year={2015}, + author = "Mari{\'c}, Filip and Simi{\'c}, Danijela", + doi = "10.1007/s10472-014-9436-4", + issn = "1012-2443", + journal = "Annals of Mathematics and Artificial Intelligence", + keywords = "Interactive theorem proving; Complex plane geometry; Möbius transformations; 68T15; 51B10; 97I80", + number = "3-4", + pages = "271–308", + publisher = "Springer International Publishing", + title = "{Formalizing Complex Plane Geometry}", + url = "http://dx.doi.org/10.1007/s10472-014-9436-4", + volume = "74" +} + +@book{schwerdtfeger, + title={{Geometry of Complex Numbers: Circle Geometry, Moebius Transformation, Non-euclidean Geometry}}, + author={Schwerdtfeger, Hans}, + year={1979}, + publisher={Courier Corporation} +} + +@mastersthesis{makarios, + title = {{A Mechanical Verification of the Independence of Tarski's Euclidean Axiom}}, + author = {Makarios, Timothy James McKenzie}, + school = {Victoria University of Wellington}, + year = {2012}, + note = {Master Thesis} +} + +@Inbook{lobachevsky1840geometrische, +author="Lobatschewsky, Nicolaus", +title="Geometrische Untersuchungen zur Theorie der Parallellinien", +bookTitle="Gau{\ss} und die Anf{\"a}nge der nicht-euklidischen Geometrie", +year="1985", +publisher="Springer Vienna", +address="Vienna", +pages="159--223", +abstract="In der Geometrie fand ich einige Unvollkom-menheiten, welche ich f{\"u}r den Grund halte, warum diese Missenschaft, so lange sie nicht in die Analysis {\"u}bergeht, bis ietzt keinen Schritt vorw{\"a}rts thun konnte aus demienigen Zustande, in welchem sie uns von Guclid {\"u}berkommen ist. Zu den Unvollkommenheiten rechne ich die Dunkelheit in den ersten Begriffen von den geometrischen Gr{\"o}{\ss}en, in der Art und Meise wie man sich die Ausmessung dieser Gr{\"o}{\ss}en vorstellt, und endlich die wichtige L{\"u}cke in der Theorie der Parallelen, welche auszuf{\"u}llen, alle Anstrengungen der Wathematiker bis ietzt vergeblich waren. Die Bem{\"u}hungen Legnedre's haben zu doeser Theorie nichts hinzugef{\"u}gt, indem er gen{\"o}thigt war, den einzigen strengen Gang zu derlassen, sich auf einen Seitenweg zu wenden, und zu H{\"u}lfss{\"a}tzen seine Zuflucht zu nehmen, welche er sich unbegr{\"u}ndeter Weise bemihet als nothwendige Ariome darzustellen.", +isbn="978-3-7091-9511-6", +doi="10.1007/978-3-7091-9511-6_4", +url="https://doi.org/10.1007/978-3-7091-9511-6_4" +} + +@article{coghetto2018klein1, + title={{Klein-Beltrami Model. Part I}}, + author={Coghetto, Roland}, + journal={Formalized Mathematics}, + volume={26}, + number={1}, + pages={21--32}, + year={2018}, + publisher={Sciendo} +} + +@article{coghetto2018klein2, + title={{Klein-Beltrami Model. Part II}}, + author={Coghetto, Roland}, + journal={Formalized Mathematics}, + volume={26}, + number={1}, + pages={33--48}, + year={2018}, + publisher={Sciendo} +} \ No newline at end of file diff --git a/thys/Poincare_Disc/document/root.tex b/thys/Poincare_Disc/document/root.tex new file mode 100755 --- /dev/null +++ b/thys/Poincare_Disc/document/root.tex @@ -0,0 +1,79 @@ +\documentclass[8pt,a4paper]{article} +\usepackage[margin=2cm]{geometry} +\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} + +\usepackage{amsmath} + +\begin{document} + +\title{Poincar\'e Disc Model} +\author{Danijela Simi\'c \and + Filip Mari\'c \and + Pierre Boutry} +\maketitle + +\begin{abstract} + We describe formalization of the Poincar\'e disc model of hyperbolic + geometry within the Isabelle/HOL proof assistant. The model is + defined within the extended complex plane (one dimensional complex + projective space $\mathbb{C}P^1$), formalized in the AFP entry + ``Complex Geometry'' \cite{afp-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). +\end{abstract} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +\clearpage +% generated text of all theories +\input{session} + +% optional bibliography +\clearpage +\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,514 +1,516 @@ AODV Auto2_HOL Auto2_Imperative_HOL 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 Amortized_Complexity AnselmGod Applicative_Lifting Approximation_Algorithms Architectural_Design_Patterns Aristotles_Assertoric_Syllogistic ArrowImpossibilityGS AutoFocus-Stream Automatic_Refinement AxiomaticCategoryTheory BDD BNF_Operations Bell_Numbers_Spivey Berlekamp_Zassenhaus Bernoulli Bertrands_Postulate Bicategory BinarySearchTree Binding_Syntax_Theory Binomial-Heaps Binomial-Queues BNF_CC 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 Chord_Segments Circus Clean ClockSynchInst Closest_Pair_Points CofGroups Coinductive Coinductive_Languages Collections Comparison_Sort_Lower_Bound Compiling-Exceptions-Correctly Completeness Complete_Non_Orders +Complex_Geometry Complx ComponentDependencies ConcurrentGC ConcurrentIMP Concurrent_Ref_Alg Concurrent_Revisions Consensus_Refined Constructive_Cryptography Constructor_Funs Containers CoreC++ Core_DOM Count_Complex_Roots CryptHOL CryptoBasedCompositionalProperties DFS_Framework DPT-SAT-Solver DataRefinementIBP Datatype_Order_Generator Decl_Sem_Fun_PL Decreasing-Diagrams Decreasing-Diagrams-II Deep_Learning Density_Compiler Dependent_SIFUM_Refinement Dependent_SIFUM_Type_Systems Depth-First-Search Derangements Deriving Descartes_Sign_Rule Dict_Construction Differential_Dynamic_Logic Differential_Game_Logic Dijkstra_Shortest_Path Diophantine_Eqns_Lin_Hom Dirichlet_L Dirichlet_Series Discrete_Summation DiscretePricing DiskPaxos DynamicArchitectures Dynamic_Tables E_Transcendental Echelon_Form EdmondsKarp_Maxflow Efficient-Mergesort Elliptic_Curves_Group_Law Encodability_Process_Calculi Epistemic_Logic Ergodic_Theory Error_Function Euler_MacLaurin Euler_Partition Example-Submission Factored_Transition_System_Bounding Farkas FFT FLP FOL-Fitting FOL_Harrison FOL_Seq_Calc1 Falling_Factorial_Sum FeatherweightJava Featherweight_OCL Fermat3_4 FileRefinement FinFun Finger-Trees Finite_Automata_HF First_Order_Terms First_Welfare_Theorem Fishburn_Impossibility Fisher_Yates Flow_Networks Floyd_Warshall Flyspeck-Tame FocusStreamsCaseStudies Formal_SSA Formula_Derivatives Fourier Free-Boolean-Algebra Free-Groups FunWithFunctions FunWithTilings Functional-Automata Functional_Ordered_Resolution_Prover GPU_Kernel_PL Gabow_SCC Game_Based_Crypto Gauss-Jordan-Elim-Fun Gauss_Jordan Gauss_Sums GenClock General-Triangle Generalized_Counting_Sort Generic_Deriving Generic_Join GewirthPGCProof Girth_Chromatic GoedelGod GraphMarkingIBP Graph_Saturation Graph_Theory Green Groebner_Bases Groebner_Macaulay Gromov_Hyperbolicity Group-Ring-Module HOL-CSP HOLCF-Prelude HRB-Slicing Heard_Of HereditarilyFinite Hermite Hidden_Markov_Models Higher_Order_Terms Hoare_Time HotelKeyCards Huffman Hybrid_Logic Hybrid_Multi_Lane_Spatial_Logic Hybrid_Systems_VCs HyperCTL IEEE_Floating_Point IMAP-CRDT IMO2019 IMP2 IMP2_Binary_Heap IP_Addresses Imperative_Insertion_Sort Impossible_Geometry Incompleteness Incredible_Proof_Machine Inductive_Confidentiality InfPathElimination InformationFlowSlicing InformationFlowSlicing_Inter Integration Interval_Arithmetic_Word32 Iptables_Semantics Irrationality_J_Hancl Isabelle_C Isabelle_Meta_Model Jacobson_Basic_Algebra Jinja JinjaThreads JiveDataStoreModel Jordan_Hoelder Jordan_Normal_Form KAD KAT_and_DRA KBPs KD_Tree Key_Agreement_Strong_Adversaries Kleene_Algebra Knot_Theory Knuth_Morris_Pratt Koenigsberg_Friendship Kruskal Kuratowski_Closure_Complement LLL_Basis_Reduction LLL_Factorization LOFT LTL LTL_to_DRA LTL_to_GBA LTL_Master_Theorem Lam-ml-Normalization LambdaAuth LambdaMu Lambda_Free_KBOs Lambda_Free_RPOs Landau_Symbols Laplace_Transform Latin_Square LatticeProperties Lambda_Free_EPO Launchbury Lazy-Lists-II Lazy_Case Lehmer Lifting_Definition_Option LightweightJava LinearQuantifierElim Linear_Inequalities Linear_Programming Linear_Recurrences Liouville_Numbers List-Index List-Infinite List_Interleaving List_Inversions List_Update LocalLexing Localization_Ring Locally-Nameless-Sigma Lowe_Ontological_Argument Lower_Semicontinuous Lp MFMC_Countable MSO_Regex_Equivalence Markov_Models Marriage Mason_Stothers Matrix Matrix_Tensor Matroids Max-Card-Matching Median_Of_Medians_Selection Menger MFOTL_Monitor MiniML Minimal_SSA Minkowskis_Theorem Minsky_Machines Modal_Logics_for_NTS Modular_Assembly_Kit_Security Monad_Memo_DP Monad_Normalisation MonoBoolTranAlgebra MonoidalCategory Monomorphic_Monad MuchAdoAboutTwo Multirelations Multi_Party_Computation Myhill-Nerode Name_Carrying_Type_Inference 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 Open_Induction OpSets Optics Optimal_BST Orbit_Stabiliser Order_Lattice_Props Ordered_Resolution_Prover Ordinal Ordinals_and_Cardinals Ordinary_Differential_Equations PCF PLM Pell POPLmark-deBruijn PSemigroupsConvolution Pairing_Heap Paraconsistency Parity_Game Partial_Function_MR Partial_Order_Reduction Password_Authentication_Protocol Perfect-Number-Thm Perron_Frobenius Pi_Calculus Pi_Transcendental Planarity_Certificates Polynomial_Factorization Polynomial_Interpolation Polynomials Poincare_Bendixson +Poincare_Disc Pop_Refinement Posix-Lexing Possibilistic_Noninterference 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 Projective_Geometry Program-Conflict-Analysis 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 Randomised_BSTs Random_Graph_Subgraph_Threshold Randomised_Social_Choice Rank_Nullity_Theorem Real_Impl Recursion-Theory-I Refine_Imperative_HOL Refine_Monadic RefinementReactive Regex_Equivalence Regular-Sets Regular_Algebras Relation_Algebra Rep_Fin_Groups Residuated_Lattices Resolution_FOL Rewriting_Z Ribbon_Proofs Robbins-Conjecture Root_Balanced_Tree Routing Roy_Floyd_Warshall Safe_OCL SATSolverVerification SDS_Impossibility SIFPL SIFUM_Type_Systems SPARCv8 Secondary_Sylow Security_Protocol_Refinement Selection_Heap_Sort SenSocialChoice Separata Separation_Algebra Separation_Logic_Imperative_HOL SequentInvertibility Shivers-CFA ShortestPath Show Sigma_Commit_Crypto Signature_Groebner Simpl Simple_Firewall Simplex Skew_Heap Skip_Lists Slicing Smooth_Manifolds Sort_Encodings Source_Coding_Theorem Special_Function_Bounds Splay_Tree Sqrt_Babylonian Stable_Matching Statecharts 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 SumSquares SuperCalc Surprise_Paradox Symmetric_Polynomials Szpilrajn TESL_Language TLA Tail_Recursive_Functions Tarskis_Geometry Taylor_Models Timed_Automata Topology TortoiseHare Transcendence_Series_Hancl_Rucki Transformer_Semantics Transition_Systems_and_Automata Transitive-Closure Transitive-Closure-II Treaps Tree-Automata Tree_Decomposition Triangle Trie Twelvefold_Way Tycon Types_Tableaus_and_Goedels_God Universal_Turing_Machine UPF UPF_Firewall UpDown_Scheme UTP Valuation VectorSpace Verified-Prover VerifyThis2018 VerifyThis2019 Vickrey_Clarke_Groves VolpanoSmith WHATandWHERE_Security WebAssembly Weight_Balanced_Trees Well_Quasi_Orders Winding_Number_Eval Word_Lib WorkerWrapper XML Zeta_Function Zeta_3_Irrational ZFC_in_HOL pGCL diff --git a/web/entries/Complex_Geometry.html b/web/entries/Complex_Geometry.html new file mode 100644 --- /dev/null +++ b/web/entries/Complex_Geometry.html @@ -0,0 +1,176 @@ + + + + +Complex Geometry - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + +
+

 

+ + + +

 

+

 

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

 

+

 

+		 +
+

 

+

Complex + + Geometry + +

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Title:Complex Geometry
+ Authors: + + Filip Marić (filip /at/ matf /dot/ bg /dot/ ac /dot/ rs) and + Danijela Simić +
Submission date:2019-12-16
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.
BibTeX: + 
@article{Complex_Geometry-AFP,
+  author  = {Filip Marić and Danijela Simić},
+  title   = {Complex Geometry},
+  journal = {Archive of Formal Proofs},
+  month   = dec,
+  year    = 2019,
+  note    = {\url{http://isa-afp.org/entries/Complex_Geometry.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
+
License:BSD License
Used by:Poincare_Disc
+ +

+ + + + + + + + + + + + + + + + +
+ Proof outline
+ Proof document +
+ Browse theories +
+ Download this entry +
Older releases: + None +
+ +
+
+ + + + + + \ No newline at end of file diff --git a/web/entries/Poincare_Disc.html b/web/entries/Poincare_Disc.html new file mode 100644 --- /dev/null +++ b/web/entries/Poincare_Disc.html @@ -0,0 +1,182 @@ + + + + +Poincaré Disc Model - Archive of Formal Proofs + + + + + + + + + + + + + + + + + + + + + +
+

 

+ + + +

 

+

 

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

 

+

 

+		 +
+

 

+

Poincaré + + Disc + + Model + +

+

 

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Title:Poincaré Disc Model
+ Authors: + + Danijela Simić, + Filip Marić (filip /at/ matf /dot/ bg /dot/ ac /dot/ rs) and + Pierre Boutry (boutry /at/ unistra /dot/ fr) +
Submission date:2019-12-16
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 &‌#8450;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).
BibTeX: + 
@article{Poincare_Disc-AFP,
+  author  = {Danijela Simić and Filip Marić and Pierre Boutry},
+  title   = {Poincaré Disc Model},
+  journal = {Archive of Formal Proofs},
+  month   = dec,
+  year    = 2019,
+  note    = {\url{http://isa-afp.org/entries/Poincare_Disc.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
+
License:BSD License
Depends on:Complex_Geometry
+ +

+ + + + + + + + + + + + + + + + +
+ Proof outline
+ Proof document +
+ Browse theories +
+ Download this entry +
Older releases: + None +
+ +
+
+ + + + + + \ No newline at end of file diff --git a/web/entries/SATSolverVerification.html b/web/entries/SATSolverVerification.html --- a/web/entries/SATSolverVerification.html +++ b/web/entries/SATSolverVerification.html @@ -1,260 +1,260 @@ Formal Verification of Modern SAT Solvers - Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

Formal Verification of Modern SAT Solvers

 

Title: Formal Verification of Modern SAT Solvers
Author: - Filip Maric + Filip Marić (filip /at/ matf /dot/ bg /dot/ ac /dot/ rs)
Submission date: 2008-07-23
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.
BibTeX: 
@article{SATSolverVerification-AFP,
-  author  = {Filip Maric},
+  author  = {Filip Marić},
   title   = {Formal Verification of Modern SAT Solvers},
   journal = {Archive of Formal Proofs},
   month   = jul,
   year    = 2008,
   note    = {\url{http://isa-afp.org/entries/SATSolverVerification.html},
             Formal proof development},
   ISSN    = {2150-914x},
 }
License: BSD License

Proof outline
Proof document
Browse theories
Download this entry
Older releases:
\ No newline at end of file diff --git a/web/index.html b/web/index.html --- a/web/index.html +++ b/web/index.html @@ -1,4727 +1,4746 @@ Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

Archive of Formal Proofs

 

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

A development version of the archive is available as well.

 

 

2020
2020-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: Andreas Halkjær From
2019-07-08: A Verified Code Generator from Isabelle/HOL to CakeML
Author: Lars Hupel
2019-07-04: Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic
Authors: Joshua Schneider and Dmitriy Traytel
2019-06-27: Complete Non-Orders and Fixed Points
Authors: Akihisa Yamada and Jérémy Dubut
2019-06-25: Priority Search Trees
Authors: Peter Lammich and Tobias Nipkow
2019-06-25: Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra
Authors: Peter Lammich and Tobias Nipkow
2019-06-21: Linear Inequalities
Authors: Ralph Bottesch, Alban Reynaud and René Thiemann
2019-06-16: Hilbert's Nullstellensatz
Author: Alexander Maletzky
2019-06-15: Gröbner Bases, Macaulay Matrices and Dubé's Degree Bounds
Author: Alexander Maletzky
2019-06-13: Binary Heaps for IMP2
Author: Simon Griebel
2019-06-03: Differential Game Logic
Author: André Platzer
2019-05-30: Multidimensional Binary Search Trees
Author: Martin Rau
2019-05-14: Formalization of Generic Authenticated Data Structures
Authors: Matthias Brun and Dmitriy Traytel
2019-05-09: Multi-Party Computation
Authors: David Aspinall and David Butler
2019-04-26: HOL-CSP Version 2.0
Authors: Safouan Taha, Lina Ye and Burkhart Wolff
2019-04-16: A Compositional and Unified Translation of LTL into ω-Automata
Authors: Benedikt Seidl and Salomon Sickert
2019-04-06: A General Theory of Syntax with Bindings
Authors: Lorenzo Gheri and Andrei Popescu
2019-03-27: The Transcendence of Certain Infinite Series
Authors: Angeliki Koutsoukou-Argyraki and Wenda Li
2019-03-24: Quantum Hoare Logic
Authors: Junyi Liu, Bohua Zhan, Shuling Wang, Shenggang Ying, Tao Liu, Yangjia Li, Mingsheng Ying and Naijun Zhan
2019-03-09: Safe OCL
Author: Denis Nikiforov
2019-02-21: Elementary Facts About the Distribution of Primes
Author: Manuel Eberl
2019-02-14: Kruskal's Algorithm for Minimum Spanning Forest
Authors: Maximilian P.L. Haslbeck, Peter Lammich and Julian Biendarra
2019-02-11: Probabilistic Primality Testing
Authors: Daniel Stüwe and Manuel Eberl
2019-02-08: Universal Turing Machine
Authors: Jian Xu, Xingyuan Zhang, Christian Urban and Sebastiaan J. C. Joosten
2019-02-01: Isabelle/UTP: Mechanised Theory Engineering for Unifying Theories of Programming
Authors: Simon Foster, Frank Zeyda, Yakoub Nemouchi, Pedro Ribeiro and Burkhart Wolff
2019-02-01: The Inversions of a List
Author: Manuel Eberl
2019-01-17: Farkas' Lemma and Motzkin's Transposition Theorem
Authors: Ralph Bottesch, Max W. Haslbeck and René Thiemann
2019-01-15: IMP2 – Simple Program Verification in Isabelle/HOL
Authors: Peter Lammich and Simon Wimmer
2019-01-15: An Algebra for Higher-Order Terms
Author: Lars Hupel
2019-01-07: A Reduction Theorem for Store Buffers
Authors: Ernie Cohen and Norbert Schirmer

 

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

 

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

 

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

 

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

 

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

 

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

 

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

 

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

 

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

 

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

 

2008
2008-12-12: A Bytecode Logic for JML and Types
Authors: Lennart Beringer and Martin Hofmann
2008-11-10: Secure information flow and program logics
Authors: Lennart Beringer and Martin Hofmann
2008-11-09: Some classical results in Social Choice Theory
Author: Peter Gammie
2008-11-07: Fun With Tilings
Authors: Tobias Nipkow and Lawrence C. Paulson
2008-10-15: The Textbook Proof of Huffman's Algorithm
Author: Jasmin Christian Blanchette
2008-09-16: Towards Certified Slicing
Author: Daniel Wasserrab
2008-09-02: A Correctness Proof for the Volpano/Smith Security Typing System
Authors: Gregor Snelting and Daniel Wasserrab
2008-09-01: Arrow and Gibbard-Satterthwaite
Author: Tobias Nipkow
2008-08-26: Fun With Functions
Author: Tobias Nipkow
2008-07-23: Formal Verification of Modern SAT Solvers
Author: - Filip Maric + 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,569 +1,574 @@ 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. 16 Jan 2020 00:00:00 +0000 Verified Approximation Algorithms https://www.isa-afp.org/entries/Approximation_Algorithms.html https://www.isa-afp.org/entries/Approximation_Algorithms.html Robin Eßmann, Tobias Nipkow, Simon Robillard 16 Jan 2020 00:00:00 +0000 We present the first formal verification of approximation algorithms for NP-complete optimization problems: vertex cover, independent set, load balancing, and bin packing. The proofs correct incompletenesses in existing proofs and improve the approximation ratio in one case. Closest Pair of Points Algorithms https://www.isa-afp.org/entries/Closest_Pair_Points.html https://www.isa-afp.org/entries/Closest_Pair_Points.html Martin Rau, Tobias Nipkow 13 Jan 2020 00:00:00 +0000 This entry provides two related verified divide-and-conquer algorithms solving the fundamental <em>Closest Pair of Points</em> problem in Computational Geometry. Functional correctness and the optimal running time of <em>O</em>(<em>n</em> log <em>n</em>) are proved. Executable code is generated which is empirically competitive with handwritten reference implementations. Skip Lists https://www.isa-afp.org/entries/Skip_Lists.html https://www.isa-afp.org/entries/Skip_Lists.html Max W. Haslbeck, Manuel Eberl 09 Jan 2020 00:00:00 +0000 <p> 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. </p> <p> 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. </p> Bicategories https://www.isa-afp.org/entries/Bicategory.html https://www.isa-afp.org/entries/Bicategory.html Eugene W. Stark 06 Jan 2020 00:00:00 +0000 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. The Irrationality of ζ(3) https://www.isa-afp.org/entries/Zeta_3_Irrational.html https://www.isa-afp.org/entries/Zeta_3_Irrational.html Manuel Eberl 27 Dec 2019 00:00:00 +0000 <p>This article provides a formalisation of Beukers's straightforward analytic proof that ζ(3) is irrational. This was first proven by Apéry (which is why this result is also often called ‘Apéry's Theorem’) using a more algebraic approach. This formalisation follows <a href="http://people.math.sc.edu/filaseta/gradcourses/Math785/Math785Notes4.pdf">Filaseta's presentation</a> of Beukers's proof.</p> Formalizing a Seligman-Style Tableau System for Hybrid Logic https://www.isa-afp.org/entries/Hybrid_Logic.html https://www.isa-afp.org/entries/Hybrid_Logic.html Asta Halkjær From 20 Dec 2019 00:00:00 +0000 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 the cited 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 derivable 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 derivable. Similarly, I start from simpler versions of the @-rules and derive the general ones. These restrictions are imposed to rule out some means of nontermination. The Poincaré-Bendixson Theorem https://www.isa-afp.org/entries/Poincare_Bendixson.html https://www.isa-afp.org/entries/Poincare_Bendixson.html Fabian Immler, Yong Kiam Tan 18 Dec 2019 00:00:00 +0000 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. + Poincaré Disc Model + https://www.isa-afp.org/entries/Poincare_Disc.html + https://www.isa-afp.org/entries/Poincare_Disc.html + Danijela Simić, Filip Marić, Pierre Boutry + 16 Dec 2019 00:00:00 +0000 + +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 &‌#8450;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). + + + Complex Geometry + https://www.isa-afp.org/entries/Complex_Geometry.html + https://www.isa-afp.org/entries/Complex_Geometry.html + Filip Marić, Danijela Simić + 16 Dec 2019 00:00:00 +0000 + +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. + + Gauss Sums and the Pólya–Vinogradov Inequality https://www.isa-afp.org/entries/Gauss_Sums.html https://www.isa-afp.org/entries/Gauss_Sums.html Rodrigo Raya, Manuel Eberl 10 Dec 2019 00:00:00 +0000 <p>This article provides a full formalisation of Chapter 8 of Apostol's <em><a href="https://www.springer.com/de/book/9780387901633">Introduction to Analytic Number Theory</a></em>. Subjects that are covered are:</p> <ul> <li>periodic arithmetic functions and their finite Fourier series</li> <li>(generalised) Ramanujan sums</li> <li>Gauss sums and separable characters</li> <li>induced moduli and primitive characters</li> <li>the Pólya&mdash;Vinogradov inequality</li> </ul> An Efficient Generalization of Counting Sort for Large, possibly Infinite Key Ranges https://www.isa-afp.org/entries/Generalized_Counting_Sort.html https://www.isa-afp.org/entries/Generalized_Counting_Sort.html Pasquale Noce 04 Dec 2019 00:00:00 +0000 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. Interval Arithmetic on 32-bit Words https://www.isa-afp.org/entries/Interval_Arithmetic_Word32.html https://www.isa-afp.org/entries/Interval_Arithmetic_Word32.html Brandon Bohrer 27 Nov 2019 00:00:00 +0000 Interval_Arithmetic implements conservative interval arithmetic computations, then uses this interval arithmetic to implement a simple programming language where all terms have 32-bit signed word values, with explicit infinities for terms outside the representable bounds. Our target use case is interpreters for languages that must have a well-understood low-level behavior. We include a formalization of bounded-length strings which are used for the identifiers of our language. Bounded-length identifiers are useful in some applications, for example the <a href="https://www.isa-afp.org/entries/Differential_Dynamic_Logic.html">Differential_Dynamic_Logic</a> article, where a Euclidean space indexed by identifiers demands that identifiers are finitely many. Zermelo Fraenkel Set Theory in Higher-Order Logic https://www.isa-afp.org/entries/ZFC_in_HOL.html https://www.isa-afp.org/entries/ZFC_in_HOL.html Lawrence C. Paulson 24 Oct 2019 00:00:00 +0000 <p>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.</p> <p>There is a type <em>V</em> of sets and a function <em>elts :: V =&gt; V set</em> mapping a set to its elements. Classes simply have type <em>V set</em>, 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.</p> <p>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.</p> <p>The theory provides two type classes with the aim of facilitating developments that combine <em>V</em> with other Isabelle/HOL types: <em>embeddable</em>, the class of types that can be injected into <em>V</em> (including <em>V</em> itself as well as <em>V*V</em>, etc.), and <em>small</em>, the class of types that correspond to some ZF set.</p> Isabelle/C https://www.isa-afp.org/entries/Isabelle_C.html https://www.isa-afp.org/entries/Isabelle_C.html Frédéric Tuong, Burkhart Wolff 22 Oct 2019 00:00:00 +0000 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. VerifyThis 2019 -- Polished Isabelle Solutions https://www.isa-afp.org/entries/VerifyThis2019.html https://www.isa-afp.org/entries/VerifyThis2019.html Peter Lammich, Simon Wimmer 16 Oct 2019 00:00:00 +0000 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. Aristotle's Assertoric Syllogistic https://www.isa-afp.org/entries/Aristotles_Assertoric_Syllogistic.html https://www.isa-afp.org/entries/Aristotles_Assertoric_Syllogistic.html Angeliki Koutsoukou-Argyraki 08 Oct 2019 00:00:00 +0000 We formalise with Isabelle/HOL some basic elements of Aristotle's assertoric syllogistic following the <a href="https://plato.stanford.edu/entries/aristotle-logic/">article from the Stanford Encyclopedia of Philosophy by Robin Smith.</a> To this end, we use a set theoretic formulation (covering both individual and general predication). In particular, we formalise the deductions in the Figures and after that we present Aristotle's metatheoretical observation that all deductions in the Figures can in fact be reduced to either Barbara or Celarent. As the formal proofs prove to be straightforward, the interest of this entry lies in illustrating the functionality of Isabelle and high efficiency of Sledgehammer for simple exercises in philosophy. Sigma Protocols and Commitment Schemes https://www.isa-afp.org/entries/Sigma_Commit_Crypto.html https://www.isa-afp.org/entries/Sigma_Commit_Crypto.html David Butler, Andreas Lochbihler 07 Oct 2019 00:00:00 +0000 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. Clean - An Abstract Imperative Programming Language and its Theory https://www.isa-afp.org/entries/Clean.html https://www.isa-afp.org/entries/Clean.html Frédéric Tuong, Burkhart Wolff 04 Oct 2019 00:00:00 +0000 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. Formalization of Multiway-Join Algorithms https://www.isa-afp.org/entries/Generic_Join.html https://www.isa-afp.org/entries/Generic_Join.html Thibault Dardinier 16 Sep 2019 00:00:00 +0000 Worst-case optimal multiway-join algorithms are recent seminal achievement of the database community. These algorithms compute the natural join of multiple relational databases and improve in the worst case over traditional query plan optimizations of nested binary joins. In 2014, <a href="https://doi.org/10.1145/2590989.2590991">Ngo, Ré, and Rudra</a> gave a unified presentation of different multi-way join algorithms. We formalized and proved correct their "Generic Join" algorithm and extended it to support negative joins. Verification Components for Hybrid Systems https://www.isa-afp.org/entries/Hybrid_Systems_VCs.html https://www.isa-afp.org/entries/Hybrid_Systems_VCs.html Jonathan Julian Huerta y Munive 10 Sep 2019 00:00:00 +0000 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. Fourier Series https://www.isa-afp.org/entries/Fourier.html https://www.isa-afp.org/entries/Fourier.html Lawrence C Paulson 06 Sep 2019 00:00:00 +0000 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 A Case Study in Basic Algebra https://www.isa-afp.org/entries/Jacobson_Basic_Algebra.html https://www.isa-afp.org/entries/Jacobson_Basic_Algebra.html Clemens Ballarin 30 Aug 2019 00:00:00 +0000 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 <i>Basic Algebra</i> 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. Formalisation of an Adaptive State Counting Algorithm https://www.isa-afp.org/entries/Adaptive_State_Counting.html https://www.isa-afp.org/entries/Adaptive_State_Counting.html Robert Sachtleben 16 Aug 2019 00:00:00 +0000 This entry provides a formalisation of a refinement of an adaptive state counting algorithm, used to test for reduction between finite state machines. The algorithm has been originally presented by Hierons in the paper <a href="https://doi.org/10.1109/TC.2004.85">Testing from a Non-Deterministic Finite State Machine Using Adaptive State Counting</a>. Definitions for finite state machines and adaptive test cases are given and many useful theorems are derived from these. The algorithm is formalised using mutually recursive functions, for which it is proven that the generated test suite is sufficient to test for reduction against finite state machines of a certain fault domain. Additionally, the algorithm is specified in a simple WHILE-language and its correctness is shown using Hoare-logic. Laplace Transform https://www.isa-afp.org/entries/Laplace_Transform.html https://www.isa-afp.org/entries/Laplace_Transform.html Fabian Immler 14 Aug 2019 00:00:00 +0000 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. Linear Programming https://www.isa-afp.org/entries/Linear_Programming.html https://www.isa-afp.org/entries/Linear_Programming.html Julian Parsert, Cezary Kaliszyk 06 Aug 2019 00:00:00 +0000 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. Communicating Concurrent Kleene Algebra for Distributed Systems Specification https://www.isa-afp.org/entries/C2KA_DistributedSystems.html https://www.isa-afp.org/entries/C2KA_DistributedSystems.html Maxime Buyse, Jason Jaskolka 06 Aug 2019 00:00:00 +0000 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. Selected Problems from the International Mathematical Olympiad 2019 https://www.isa-afp.org/entries/IMO2019.html https://www.isa-afp.org/entries/IMO2019.html Manuel Eberl 05 Aug 2019 00:00:00 +0000 <p>This entry contains formalisations of the answers to three of the six problem of the International Mathematical Olympiad 2019, namely Q1, Q4, and Q5.</p> <p>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.</p> Stellar Quorum Systems https://www.isa-afp.org/entries/Stellar_Quorums.html https://www.isa-afp.org/entries/Stellar_Quorums.html Giuliano Losa 01 Aug 2019 00:00:00 +0000 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). A Formal Development of a Polychronous Polytimed Coordination Language https://www.isa-afp.org/entries/TESL_Language.html https://www.isa-afp.org/entries/TESL_Language.html Hai Nguyen Van, Frédéric Boulanger, Burkhart Wolff 30 Jul 2019 00:00:00 +0000 The design of complex systems involves different formalisms for modeling their different parts or aspects. The global model of a system may therefore consist of a coordination of concurrent sub-models that use different paradigms. We develop here a theory for a language used to specify the timed coordination of such heterogeneous subsystems by addressing the following issues: <ul><li>the behavior of the sub-systems is observed only at a series of discrete instants,</li><li>events may occur in different sub-systems at unrelated times, leading to polychronous systems, which do not necessarily have a common base clock,</li><li>coordination between subsystems involves causality, so the occurrence of an event may enforce the occurrence of other events, possibly after a certain duration has elapsed or an event has occurred a given number of times,</li><li>the domain of time (discrete, rational, continuous...) may be different in the subsystems, leading to polytimed systems,</li><li>the time frames of different sub-systems may be related (for instance, time in a GPS satellite and in a GPS receiver on Earth are related although they are not the same).</li></ul> Firstly, a denotational semantics of the language is defined. Then, in order to be able to incrementally check the behavior of systems, an operational semantics is given, with proofs of progress, soundness and completeness with regard to the denotational semantics. These proofs are made according to a setup that can scale up when new operators are added to the language. In order for specifications to be composed in a clean way, the language should be invariant by stuttering (i.e., adding observation instants at which nothing happens). The proof of this invariance is also given. Szpilrajn Extension Theorem https://www.isa-afp.org/entries/Szpilrajn.html https://www.isa-afp.org/entries/Szpilrajn.html Peter Zeller 27 Jul 2019 00:00:00 +0000 We formalize the Szpilrajn extension theorem, also known as order-extension principal: Every strict partial order can be extended to a strict linear order. - - A Sequent Calculus for First-Order Logic - https://www.isa-afp.org/entries/FOL_Seq_Calc1.html - https://www.isa-afp.org/entries/FOL_Seq_Calc1.html - Andreas Halkjær From - 18 Jul 2019 00:00:00 +0000 - -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. - - - A Verified Code Generator from Isabelle/HOL to CakeML - https://www.isa-afp.org/entries/CakeML_Codegen.html - https://www.isa-afp.org/entries/CakeML_Codegen.html - Lars Hupel - 08 Jul 2019 00:00:00 +0000 - -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. - diff --git a/web/statistics.html b/web/statistics.html --- a/web/statistics.html +++ b/web/statistics.html @@ -1,309 +1,309 @@ Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

Statistics

 

Statistics

- - - - + + + +
Number of Articles:513
Number of Authors:339
Number of lemmas:~139,800
Lines of Code:~2,426,200
Number of Articles:515
Number of Authors:340
Number of lemmas:~141,000
Lines of Code:~2,451,100

Most used AFP articles:

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

Growth in number of articles:

Growth in lines of code:

Growth in number of authors:

Size of articles:
\ No newline at end of file diff --git a/web/topics.html b/web/topics.html --- a/web/topics.html +++ b/web/topics.html @@ -1,831 +1,833 @@ Archive of Formal Proofs

 

 

 

Home
About
Submission
Updating Entries
Using Entries
Search
Statistics
Index
Download

 

 

 

Index by Topic

 

Computer Science

Automata and Formal Languages

Partial_Order_Reduction   C2KA_DistributedSystems   Posix-Lexing   LocalLexing   KBPs   Regular-Sets   Regex_Equivalence   MSO_Regex_Equivalence   Formula_Derivatives   Myhill-Nerode   Universal_Turing_Machine   CYK   Presburger-Automata   Functional-Automata   Statecharts   Stuttering_Equivalence   Coinductive_Languages   Tree-Automata   Kleene_Algebra   KAT_and_DRA   KAD   Regular_Algebras   Markov_Models   Probabilistic_System_Zoo   CAVA_Automata   LTL   LTL_to_GBA   CAVA_LTL_Modelchecker   Probabilistic_Timed_Automata   Finite_Automata_HF   LTL_to_DRA   Timed_Automata   Stochastic_Matrices   Buchi_Complementation   Transition_Systems_and_Automata   Factored_Transition_System_Bounding   LTL_Master_Theorem   MFOTL_Monitor   Adaptive_State_Counting  

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   Deep_Learning   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   Graph: DFS_Framework   Prpu_Maxflow   Floyd_Warshall   Roy_Floyd_Warshall   Dijkstra_Shortest_Path   EdmondsKarp_Maxflow   Depth-First-Search   GraphMarkingIBP   Transitive-Closure   Transitive-Closure-II   Gabow_SCC   Kruskal   Prim_Dijkstra_Simple   Distributed: DiskPaxos   GenClock   ClockSynchInst   Heard_Of   Consensus_Refined   Abortable_Linearizable_Modules   IMAP-CRDT   CRDT   OpSets   Stellar_Quorums   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   Optimization: Simplex  

Concurrency

FLP   Concurrent_Ref_Alg   Concurrent_Revisions   Store_Buffer_Reduction   TESL_Language   Process Calculi: Noninterference_Generic_Unwinding   AODV   AWN   CCS   Pi_Calculus   Psi_Calculi   Encodability_Process_Calculi   Circus   Noninterference_Sequential_Composition   Noninterference_Concurrent_Composition   Modal_Logics_for_NTS   HOL-CSP  

Data Structures

Generic_Deriving   Random_BSTs   Randomised_BSTs   List_Interleaving   Refine_Imperative_HOL   Amortized_Complexity   Dynamic_Tables   AVL-Trees   BDD   BinarySearchTree   Splay_Tree   Root_Balanced_Tree   Skew_Heap   Pairing_Heap   Priority_Queue_Braun   Binomial-Queues   Binomial-Heaps   Finger-Trees   Trie   FinFun   Collections   Containers   FileRefinement   Datatype_Order_Generator   Deriving   List-Index   List-Infinite   Matrix   Matrix_Tensor   Huffman   Lazy-Lists-II   IEEE_Floating_Point   Native_Word   XML   ROBDD   IMAP-CRDT   Word_Lib   CRDT   KD_Tree   Taylor_Models   Treaps   Skip_Lists   Weight_Balanced_Trees   OpSets   Optimal_BST   Core_DOM   Auto2_Imperative_HOL   IMP2_Binary_Heap   Priority_Search_Trees   Interval_Arithmetic_Word32  

Functional Programming

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

Games

Parity_Game  

Hardware

SPARCv8  

Networks

UPF_Firewall   IP_Addresses   Simple_Firewall   Iptables_Semantics   Routing   LOFT  

Programming Languages

Clean   Decl_Sem_Fun_PL   Language Definitions: CakeML   WebAssembly   pGCL   GPU_Kernel_PL   LightweightJava   CoreC++   FeatherweightJava   Jinja   JinjaThreads   Locally-Nameless-Sigma   AutoFocus-Stream   FocusStreamsCaseStudies   Isabelle_Meta_Model   Simpl   Complx   Safe_OCL   Isabelle_C   Lambda Calculi: Higher_Order_Terms   Launchbury   PCF   POPLmark-deBruijn   Lam-ml-Normalization   LambdaMu   Binding_Syntax_Theory   LambdaAuth   Type Systems: Name_Carrying_Type_Inference   MiniML   Possibilistic_Noninterference   SIFUM_Type_Systems   Dependent_SIFUM_Type_Systems   Strong_Security   WHATandWHERE_Security   VolpanoSmith   Logics: ConcurrentIMP   Refine_Monadic   Automatic_Refinement   MonoBoolTranAlgebra   Simpl   Separation_Algebra   Separation_Logic_Imperative_HOL   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   Static Analysis: RIPEMD-160-SPARK   Program-Conflict-Analysis   Shivers-CFA   Slicing   HRB-Slicing   InfPathElimination   Abs_Int_ITP2012   Transformations: Call_Arity   Refine_Imperative_HOL   WorkerWrapper   Monad_Memo_DP   Formal_SSA   Minimal_SSA   Misc: JiveDataStoreModel   Pop_Refinement   Case_Labeling  

Security

Multi_Party_Computation   Noninterference_Generic_Unwinding   Noninterference_Ipurge_Unwinding   UPF   UPF_Firewall   CISC-Kernel   Noninterference_CSP   Key_Agreement_Strong_Adversaries   Security_Protocol_Refinement   Inductive_Confidentiality   Possibilistic_Noninterference   SIFUM_Type_Systems   Dependent_SIFUM_Type_Systems   Dependent_SIFUM_Refinement   Strong_Security   WHATandWHERE_Security   VolpanoSmith   SIFPL   HotelKeyCards   InformationFlowSlicing   InformationFlowSlicing_Inter   CryptoBasedCompositionalProperties   Probabilistic_Noninterference   HyperCTL   Bounded_Deducibility_Security   Network_Security_Policy_Verification   Noninterference_Inductive_Unwinding   Password_Authentication_Protocol   Noninterference_Sequential_Composition   Noninterference_Concurrent_Composition   SPARCv8   Modular_Assembly_Kit_Security   LambdaAuth   Cryptography: Game_Based_Crypto   Sigma_Commit_Crypto   CryptHOL   Constructive_Cryptography   RSAPSS   Elliptic_Curves_Group_Law  

Semantics

Launchbury   Clean   Transformer_Semantics   HOL-CSP   QHLProver   TESL_Language   Isabelle_C  

System Description Languages

Circus   ComponentDependencies   Promela   Featherweight_OCL   DynamicArchitectures   Architectural_Design_Patterns   TESL_Language  

Logic

Propositional_Proof_Systems   MSO_Regex_Equivalence   Formula_Derivatives   Universal_Turing_Machine   Boolean_Expression_Checkers   Presburger-Automata   Verified-Prover   Completeness   Ordinal   Ordinals_and_Cardinals   FOL-Fitting   Epistemic_Logic   SequentInvertibility   LinearQuantifierElim   Nat-Interval-Logic   Recursion-Theory-I   Free-Boolean-Algebra   Sort_Encodings   LTL   HereditarilyFinite   Incompleteness   HyperCTL   Abstract_Completeness   PropResPI   SuperCalc   Incredible_Proof_Machine   Resolution_FOL   Surprise_Paradox   Allen_Calculus   Modal_Logics_for_NTS   Paraconsistency   FOL_Harrison   Abstract_Soundness   Differential_Dynamic_Logic   LambdaMu   Hybrid_Multi_Lane_Spatial_Logic   Ordered_Resolution_Prover   Minsky_Machines   Functional_Ordered_Resolution_Prover   Binding_Syntax_Theory   MFOTL_Monitor   FOL_Seq_Calc1   Hybrid_Logic  

Philosophy

GoedelGod   Types_Tableaus_and_Goedels_God   GewirthPGCProof   Lowe_Ontological_Argument   AnselmGod   PLM   Aristotles_Assertoric_Syllogistic  

Rewriting

CakeML_Codegen   Monad_Normalisation   Lambda_Free_RPOs   Lambda_Free_KBOs   Lambda_Free_EPO   Nested_Multisets_Ordinals   Abstract-Rewriting   First_Order_Terms   Decreasing-Diagrams   Decreasing-Diagrams-II   Rewriting_Z   Graph_Saturation  

Mathematics

Order

LatticeProperties   Stone_Algebras   Allen_Calculus   Order_Lattice_Props   Complete_Non_Orders   Szpilrajn  

Algebra

Optics   Subresultants   Buildings   Algebraic_VCs   C2KA_DistributedSystems   Multirelations   Residuated_Lattices   PseudoHoops   Impossible_Geometry   Gauss-Jordan-Elim-Fun   Matrix_Tensor   Kleene_Algebra   KAT_and_DRA   KAD   Regular_Algebras   Free-Groups   CofGroups   Group-Ring-Module   Robbins-Conjecture   Valuation   Rank_Nullity_Theorem   Polynomials   Relation_Algebra   PSemigroupsConvolution   Secondary_Sylow   Jordan_Hoelder   Cayley_Hamilton   VectorSpace   Echelon_Form   QR_Decomposition   Hermite   Rep_Fin_Groups   Jordan_Normal_Form   Algebraic_Numbers   Polynomial_Interpolation   Polynomial_Factorization   Perron_Frobenius   Stochastic_Matrices   Groebner_Bases   Nullstellensatz   Mason_Stothers   Berlekamp_Zassenhaus   Stone_Relation_Algebras   Stone_Kleene_Relation_Algebras   Orbit_Stabiliser   Dirichlet_L   Symmetric_Polynomials   Taylor_Models   LLL_Basis_Reduction   LLL_Factorization   Localization_Ring   Quaternions   Octonions   Aggregation_Algebras   Signature_Groebner   Quantales   Transformer_Semantics   Farkas   Groebner_Macaulay   Linear_Inequalities   Linear_Programming   Jacobson_Basic_Algebra   Hybrid_Systems_VCs  

Analysis

Fourier   E_Transcendental   Liouville_Numbers   Descartes_Sign_Rule   Euler_MacLaurin   Real_Impl   Lower_Semicontinuous   Affine_Arithmetic   Laplace_Transform   Cauchy   Integration   Ordinary_Differential_Equations   Polynomials   Sqrt_Babylonian   Sturm_Sequences   Sturm_Tarski   Special_Function_Bounds   Landau_Symbols   Error_Function   Akra_Bazzi   Zeta_Function   Linear_Recurrences   Cartan_FP   Stirling_Formula   Lp   Bernoulli   Winding_Number_Eval   Count_Complex_Roots   Taylor_Models   Green   Irrationality_J_Hancl   Budan_Fourier   Smooth_Manifolds   Transcendence_Series_Hancl_Rucki   Hybrid_Systems_VCs   Poincare_Bendixson  

Probability Theory

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

Number Theory

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

Economics

DiscretePricing   ArrowImpossibilityGS   SenSocialChoice   Vickrey_Clarke_Groves   First_Welfare_Theorem   Randomised_Social_Choice   SDS_Impossibility   Stable_Matching   Fishburn_Impossibility   Neumann_Morgenstern_Utility  

Geometry

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

Topology

Topology   Knot_Theory   Kuratowski_Closure_Complement   Smooth_Manifolds  

Graph Theory

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

Combinatorics

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

Category Theory

Category3   MonoidalCategory   Category   Category2   AxiomaticCategoryTheory   Bicategory  

Physics

No_FTL_observers  

Set Theory

ZFC_in_HOL  

Misc

FunWithFunctions   FunWithTilings   IMO2019  

Tools

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