-- Chapter 5 Tactics

#print "=================================="
#print "Section 5.1"
#print " "

/- In this chapter, we describe an alternative approach to constructing proofs, using tactics.
   A proof term is a representation of a mathematical proof; tactics are commands, or
   instructions, that describe how to build such a proof. Informally, we might begin a
   mathematical proof by saying "to prove the forward direction, unfold the definition, apply
   the previous lemma, and simplify." Just as these are instructions that tell the reader how
   to find the relevant proof, tactics are instructions that tell Lean how to construct a proof
   term. They naturally support an incremental style of writing proofs, in which users decompose
   a proof and work on goals one step at a time. -/

/- We will describe proofs that consist of sequences of tactics as "tactic-style" proofs,
   to contrast with the ways of writing proof terms we have seen so far, which we will call
   "term-style" proofs. Each style has its own advantages and disadvantages. For example,
   tactic-style proofs can be harder to read, because they require the reader to predict or
   guess the results of each instruction. But they can also be shorter and easier to write.
   Moreover, tactics offer a gateway to using Lean's automation, since automated procedures
   are themselves tactics. -/

#print "==================================="
#print "Section 5.1. Entering Tactic Mode"
#print " "

namespace Sec_5_1
  theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
  begin
    apply and.intro, exact hp,
    apply and.intro, exact hq, exact hp
  end

  -- You can see the resulting proof term with the #print command:
  #print test

  /- You can write a tactic script incrementally. If you run Lean on an incomplete tactic
     proof bracketed by begin and end, the system reports all the unsolved goals that remain.
     If you are running Lean with its Emacs interface, you can see this information by putting
     your cursor on the end symbol, which should be underlined. In the Emacs interface, there
     is another extremely useful trick: if you put your cursor on a line of a tactic proof and
     press `C-c C-g`, Lean will show you the goal that remains at the end of the line. -/

end Sec_5_1

#print "==================================="
#print "Section 5.2. Basic Tactics"
#print " "

/- In addition to `apply` and `exact`, another useful tactic is `intro`, which
   introduces a hypothesis. Here's an example of an identity from propositional
   logic that we proved Section 3.6, now proved using tactics. -/

namespace Sec_5_2

  example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  begin
    apply iff.intro,
      intro h,
      apply or.elim (and.right h),
        intro hq,
        apply or.inl,
        apply and.intro (and.left h) hq,
        intro hr,
        apply or.inr,
        apply and.intro (and.left h) hr,
      intro h,
      apply or.elim h,
        intro hpq,
        apply and.intro hpq.left (or.inl hpq.right),
      intro hpr,
      apply and.intro hpr.left (or.inr hpr.right)
  end

  -- The intro command can more generally be used to introduce a variable of any type:

  example (α : Type) : α → α :=
  begin
    intro a, exact a
  end

  example (α : Type) : ∀ x : α, x = x :=
  begin
    intro x, exact eq.refl x
  end

  -- `intro` has a plural form, `intros`, that takes a list of names.

  example : ∀ a b c : ℕ, a = b → a = c → b = c :=
  begin
    intros a b c h₁ h₂,
    exact eq.trans (eq.symm h₁) h₂
  end

  /- The `assumption` tactic looks through the assumptions in context of the current goal,
     and if there is one matching the conclusion, it applies it. -/

  variable α : Type
  variables x y z w : α

  example (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w :=
  begin
    apply eq.trans h₁,
    apply eq.trans h₂,
    assumption
  end

  -- The `assumption` tactic will unify metavariables in the conclusion if necessary:

  example (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w :=
  begin
    apply eq.trans, assumption,
    apply eq.trans, assumption,
    assumption
  end

  -- We could use `intros` to introduce the variables and hypotheses automatically:

  example : ∀ a b c : ℕ, a = b → a = c → b = c :=
  begin
    intros,
    apply eq.trans,
    apply eq.symm,
    assumption,
    assumption
  end

  /- `reflexivity`, `symmetry`, `transitivity`
     Using reflexivity, for example, is more general than `apply eq.refl`,
     because it works for any relation that has been tagged with the `refl` attribute.
     (Attributes will be discussed in Section 6.4.)
     `reflexivity` is abbreviated `refl`. -/

  example  (y : ℕ) : (λ x : ℕ, 0) y = 0 := begin refl end

  example (x : ℕ) : x ≤ x := begin refl end

  example : ∀ a b c : ℕ, a = b → a = c → b = c :=
  begin
    intros, transitivity, symmetry, assumption, assumption
  end

  -- Instead of typing `assumption` twice, we can use the `repeat` combinator:
  example : ∀ a b c : ℕ, a = b → a = c → b = c :=
  begin
    intros, transitivity, symmetry, repeat { assumption }
  end

  -- the curly braces introduce a new tactic block; equivalent to a nested `begin ... end` pair.

  -- A variant of `apply` called `fapply` is more aggressive in creating new subgoals for args.
  example : ∃ a : ℕ,  a = a :=
  begin
    fapply exists.intro, -- Creates two goals:  (1) provide a natural number a,
    exact 0,             --                     (2) prove the nat you provided satisfies a = a.
    apply rfl            -- Goal (2) depends on (1); solving the first goal instantiates a
  end                    -- metavariable in the second.

  -- The `revert` tactic is sort of inverse to `intro`, as this silly example illustrates.
  example (x : ℕ) : x = x :=
  begin           -- goal is now `x : ℕ ⊢ x = x`
     revert x,    -- goal is now `∀ (x : ℕ), x = x`
     intro y,     -- goal is now `y : ℕ ⊢ y = y`
     reflexivity
   end
  -- This example is silly because we can simply use `reflexivity` from the start:
  example (x : ℕ) : x = x :=  begin reflexivity end

  -- `revert` can move a hypothesis into the goal, yielding an implication.
  -- Here's another silly example:
  example (x y : ℕ) (h : x = y) : y = x :=
  begin       -- goal: `x y : ℕ, h : x = y ⊢ y = x`
    revert h, -- goal: `x y : ℕ ⊢ x = y → y = x`
    intro h₁, -- goal: `x y : ℕ, h₁ : x = y ⊢ y = x`
    symmetry, -- goal: `x y : ℕ, h₁ : x = y ⊢ x = y`
    exact h₁  -- (or we could use `assumption`)
  end

  /- But revert is clever in that it reverts not only an element of the context, but
     also all subsequent elements of the context that depend on it.
     You can also revert multiple elements of the context at once:   -/

  example (x y : ℕ) (h : x = y) : y = x :=
  begin         -- goal: `x y : ℕ, h : x = y ⊢ y = x`
    revert x y, -- goal: `⊢ ∀ (x y : ℕ), x = y → y = x`
    intros,     -- goal: `x y : ℕ, h : x = y ⊢ y = x`
    symmetry,   -- goal: `x y : ℕ, h₁ : x = y ⊢ x = y`
    exact h
  end

  /- You can only `revert` an element of the local context; that is, a local variable
     or hypothesis. But you can replace an arbitrary expression in the goal by a
     fresh variable using the `generalize` tactic. -/
  example : 3 = 3 :=
  begin                      -- goal:   `⊢ 3 = 3`
    generalize : 3 = x,      -- goal:   `x : ℕ ⊢ x = x`
    revert x,                -- goal:   `⊢ ∀ (x : ℕ), x = x
    intro y,                 -- goal:   `y : ℕ ⊢ y = y
    reflexivity
  end
end Sec_5_2

#print "==================================="
#print "Section 5.3. More Tactics"
#print " "

namespace Sec_5_3
  /- Some additional tactics are useful for constructing and destructing propositions and data.
     E.g., when applied to the goal p ∨ q, the tactics `left` and `right` are equivalent to
     `apply or.inl` and `apply or.inr`, respectively.
     Conversely, the `cases` tactic can be used to decompose a disjunction. -/

  example (p q : Prop) : p ∨ q → q ∨ p :=
  begin
    intro h,             -- goal:  p q : Prop, h : p ∨ q ⊢ q ∨ p
    cases h with hp hq,  -- two goals:  p q : Prop, hp : p ⊢ q ∨ p  (and sim for q ⊢ q ∨ p)
    -- case hp : p
    right, exact hp,
    -- case hq : q
    left, exact hq
  end

  -- `cases` can also be used to decompose a conjunction.
  example (p q : Prop) : p ∧ q → q ∧ p :=
  begin
    intro h,
    cases h with hp hq,
    constructor, exact hq, exact hp -- could have used: `apply and.intro hq hp`
  end

  -- Here's a demo of these tactics using an example from earlier.
  example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  begin
    apply iff.intro,
    intro h,
      cases h with hp hqr,
      cases hqr with hq hr,
        left, constructor, exact hp, exact hq,
        right, constructor, exact hp, exact hr,
    intro h,
      cases h with hpq hpr,
      cases hpq with hp hq,
        constructor, exact hp, left, exact hq,
      cases hpr with hp hr,
      constructor, exact hp, right, exact hr
  end

  /- `cases` decomposes any element of an inductively defined type;
    `constructor` applies the first constructor of an inductively defined type;
     `left` and `right` are used with inductively defined types with exactly two constructors.
  -/

  -- We can use `cases` and `constructor` with an existential quantifier.
  example (p q : ℕ → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x :=
  begin
    intro h,
    cases h with x px,
    constructor, left, exact px
  end
  /- Here, `constructor` leaves the first component of the existential assertion (i.e., `x`)
     implicit. It is represented by a metavariable, which we must instantiate. The instantiated
     value is determined by the tactic `exact px`, since `px` has type `p x`. -/

  /- To specify a witness to the exists quantifier explicitly, use the `existsi` tactic: -/
  example (p q : ℕ → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x :=
  begin
    intro h,
    cases h with x px,
    existsi x, left, exact px
  end

  -- Another example:
  example (p q : ℕ → Prop) : (∃ x, p x ∧ q x) → (∃ x, q x ∧ p x) :=
  begin
    intro h,
    cases h with x hpq,
    cases hpq with hpx hqx,
    existsi x,
    split; assumption  -- `;` tells Lean to apply `assumption` to both goals of the conj
  end

  /- These tactics can be used on data just as well as propositions. -/

  -- Here they're used to define functions that swap components of product and sum types:
  universes u v
  def swap_pair {α : Type u} {β : Type v} : α × β → β × α :=
  begin
    intro h,
    cases h with ha hb,
    constructor; assumption
  end

  def swap_sum {α : Type u} {β : Type v} : α ⊕ β → β ⊕ α :=
  begin
    intro h,
    cases h with ha hb,
    right, exact ha, left, exact hb
  end

  -- `cases` will do case distinctions on a natural number:
  open nat
  example (P : ℕ → Prop) (h₀ : P 0) (h₁ : ∀ n, P (succ n)) (m : ℕ) : P m :=
  begin
    cases m with m', exact h₀, exact h₁ m'
  end

  -- `contradiction` searches for a contradiction among the current hypotheses:
  example (p q : Prop) : p ∧ ¬ p → q :=
  begin
    intro h,
    cases h with hp hnp,
    contradiction
  end

end Sec_5_3

#print "==================================="
#print "Section 5.4. Structuring Tactic Proofs"
#print " "

namespace Sec_5_4
  /- it is possible to mix term-style and tactic-style proofs, and pass between the two freely.
     `apply` and `exact` expect arbitrary terms, e.g., using `have`, `show`, etc.
     Conversely, arbitrary terms can use tactic mode by inserting `begin...end`.-/
  example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
  begin
    intro h,
    exact
      have hp : p, from h.left,
      have hqr : q ∨ r, from h.right,
      show p ∧ q ∨ p ∧ r,
      begin
        cases hqr with hq hr,
        left, split; assumption,   -- alternatively `exact or.inl ⟨hp, hq⟩`
        right, split; assumption   -- alternatively `exact or.inr ⟨hp, hr⟩`
      end
  end
  -- Here's a more natural example.
  example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  begin
    apply iff.intro,
      intro h,
      cases h.right with hq hr,
        exact or.inl ⟨h.left, hq⟩,
        exact or.inr ⟨h.left, hr⟩,
      intro h,
      cases h with hpq hpr,
        exact ⟨hpq.left, or.inl hpq.right⟩,
        exact ⟨hpr.left, or.inr hpr.right⟩
  end

  /- There is also a `show` tactic, which is analogous to the `show` keyword in a proof term.
     The `show` tactic declares the type of the goal that is about to be solved, while
     remaining in tactic mode. And, in tactic mode `from` is an alternative name for `exact`.  -/
  example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  begin
    apply iff.intro,
      intro h,
      cases h.right with hq hr,
        show p ∧ q ∨ p ∧ r,
          from or.inl ⟨h.left, hq⟩,  -- alternatively, { left, split, exact h.left, assumption },
        show p ∧ q ∨ p ∧ r,
          from or.inr ⟨h.left, hr⟩,
      intro h,
      cases h with hpq hpr,
        show p ∧ (q ∨ r),
          from ⟨hpq.left, or.inl hpq.right⟩,
        show p ∧ (q ∨ r),
          from ⟨hpr.left, or.inr hpr.right⟩
  end

  -- `show` can be used to rewrite a goal to something definitionally equivalent.
  example (n : ℕ) : n+1 = nat.succ n := -- could just do `begin reflexivity end`
  begin
    show nat.succ n = nat.succ n, reflexivity
  end

  /- When there are multiple goals, `show` can be used to select which goal to work on.
     Thus, both of these proofs work:    -/
  example (p q : Prop) : p ∧ q → q ∧ p :=
  begin
    intro h, cases h with hp hq, split,
    show q, from hq,
    show p, from hp
  end
  example (p q : Prop) : p ∧ q → q ∧ p :=
  begin
    intro h, cases h with hp hq, split,
    show p, from hp,
    show q, from hq
  end

  -- the `have` tactic introduces a new subgoal, just as when writing proof terms:
  example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
  begin
    intro h,
    cases h with hp hqr,
    show (p ∧ q) ∨ (p ∧ r),
    cases hqr with hq hr,
      have hpq : p ∧ q, from and.intro hp hq, left, exact hpq,
      have hpr : p ∧ r, from and.intro hp hr, right, exact hpr
  end

  -- With both `show` and `have` you can omit `from` and stay in tactic mode;
  -- you can also omit the hypothesis label and refer to the given term as `this`.
  example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
  begin
    intro h,
    cases h with hp hqr,
    show (p ∧ q) ∨ (p ∧ r),
    cases hqr with hq hr,
      have : p ∧ q,              -- no label for `p ∧ q`
        exact ⟨hp, hq⟩,
      exact or.inl this,  -- refer to `p ∧ q` as `this`
      have : p ∧ r,
        exact ⟨hp, hr⟩,
      exact or.inr this
  end

  -- alternatively, you can use `:=` instead of `from`
  example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
  begin
    intro h,
    have hp : p := h.left,
    have hqr : q ∨ r := h.right,
    cases hqr with hq hr,
      exact or.inl ⟨hp, hq⟩,
      exact or.inr ⟨hp, hr⟩
  end

  -- the `let` tactic is similar to `have` but introduces local definitions instead
  -- auxiliary facts. It is the tactic analogue of a `let` in a proof term.
  example : ∃ x, x + 2 = 8 :=
  begin
    let a := 6,
    existsi a,
    reflexivity
  end

  -- You can nest `begin...end` blocks within other `begin...end` blocks.
  -- Within a `begin...end` block, nested `begin...end` blocks can be abbrev with curly braces:
  example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  begin
    apply iff.intro,
    { intro h,
      cases h.right with hq hr,
      { exact or.inl ⟨h.left, hq⟩ },
      { exact or.inr ⟨h.left, hr⟩ }
    },
    { intro h,
      cases h with hpq hpr,
      { exact ⟨hpq.left, or.inl hpq.right⟩ },
      { exact ⟨hpr.left, or.inr hpr.right⟩ }
    }
  end

  -- Combining these various mechanisms makes for nicely structured tactic proofs:
  example (p q : Prop) : p ∧ q ↔ q ∧ p :=
  begin
    apply iff.intro,
    { intro h,
      exact ⟨h.right, h.left⟩
    },
    { intro h,
      exact ⟨h.right, h.left⟩
    }
  end

end Sec_5_4

#print "==================================="
#print "Section 5.5. Tactic Combinators"
#print " "
/- Tactic combinators are operations that form new tactics from old ones. A sequencing combinator
   is already implicit in the comma that appear in a `begin...end` block. -/

namespace Sec_5_5
  example (p q : Prop) (hp : p) : p ∨ q :=
  by { left, assumption }

  -- Here `{ left, assumption }` is functionally equiv to a single tactic which first
  -- applies `left` and then applies `assumption`.

  -- `t₁; t₂` says "apply t₁ to the current goal and then apply `t₂` to *all* resulting subgoals:
  example (p q : Prop) (hp : p) (hq : q) : p ∧ q :=
  by split; assumption

  -- The orelse combinator, denoted <|>, applies one tactic, and then backtracks and
  -- applies another if the first one failed:
  example (p q : Prop) (hp : p) : p ∨ q :=
  by { left, assumption } <|> { right, assumption} -- first one succeeds

  example (p q : Prop) (hq : q) : p ∨ q :=
  by { left, assumption } <|> { right, assumption} -- first one fails, but second succeeds

end Sec_5_5

#print "==================================="
#print "Section 5.6. Rewriting"
#print " "
  /- The rewrite tactic provide a basic mechanism for applying substitutions to goals and
     hypotheses, providing a convenient and efficient way of working with equality. -/

namespace Sec_5_6
  variables (f : ℕ → ℕ) (k : ℕ)

  example (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 :=
  begin
    rw h₂, -- replace k with 0
    rw h₁  -- replace f 0 with 0
  end

end Sec_5_6

#print "==================================="
#print "Section 5.7. Using the Simplifier"
#print " "
  /- Whereas `rewrite` is designed as a surgical tool for manipulating a goal,
     the simplifier offers a more powerful form of automation. A number of identities
     in Lean's library have been tagged with the `[simp]` attribute, and the simp tactic
     uses them to iteratively rewrite subterms in an expression. -/

namespace Sec_5_7

end Sec_5_7

#print "==================================="
#print "Section 5.8. Exercises"
#print " "

namespace Sec_5_8

  -- Ex 1. Go back to the exercises in Chapter 3 and Chapter 4 and redo as many as
  --       you can now with tactic proofs, using also `rw` and `simp` as appropriate.

  -- Ex 2. Use tactic combinators to obtain a one line proof of the following:
  example (p q r : Prop) (hp : p) : (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
  by exact ⟨or.inl hp, or.inr (or.inl hp), or.inr (or.inr hp)⟩

end Sec_5_8


import ..lectures.love05_inductive_predicates_demo

/-! # LoVe Homework 11: Logical Foundations of Mathematics

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (6 points): Even Numbers as a Subtype

Usually, the most convenient way to represent even natural numbers is to use the
larger type `ℕ`, which also includes the odd natural numbers. If we want to
quantify only over even numbers `n`, we can add an assumption `even n` to our
lemma statement.

An alternative is to encode evenness in the type, using a subtype. We will
explore this approach.

1.1 (1 point). Define the type `evℕ` of even natural numbers, using the `even`
predicate introduced in the lecture 5 demo. -/

#print even

def evℕ : Type :=
sorry

/-! 1.2 (1 point). Prove the following lemma about the `even` predicate. You will
need it to answer question 1.3. -/

lemma even.add {m n : ℕ} (hm : even m) (hn : even n) :
  even (m + n) :=
sorry

/-! 1.3 (1 point). Define zero and addition of even numbers by filling in the
`sorry` placeholders. -/

def evℕ.zero : evℕ :=
sorry

def evℕ.add (m n : evℕ) : evℕ :=
sorry

/-! 1.4 (3 points). Prove that addition of even numbers is commutative and
associative, and has 0 as an identity element. -/

lemma evℕ.add_comm (m n : evℕ) :
  evℕ.add m n = evℕ.add n m :=
sorry

lemma evℕ.add_assoc (l m n : evℕ) :
  evℕ.add (evℕ.add l m) n = evℕ.add l (evℕ.add m n) :=
sorry

lemma evℕ.add_iden_left (n : evℕ) :
  evℕ.add evℕ.zero n = n :=
sorry

lemma evℕ.add_iden_right (n : evℕ) :
  evℕ.add n evℕ.zero = n :=
sorry

/- ## Question 2 (6 points): Multisets as a Quotient Type
A multiset (or bag) is a collection of elements that allows for multiple
(but finitely many) occurrences of its elements. For example, the multiset
`{2, 7}` is equal to the multiset `{7, 2}` but different from `{2, 7, 7}`.
Finite multisets can be defined as a quotient over lists. We start with the
type `list α` of finite lists and consider only the number of occurrences of
elements in the lists, ignoring the order in which elements occur. Following
this scheme, `[2, 7, 7]`, `[7, 2, 7]`, and `[7, 7, 2]` would be three equally
valid representations of the multiset `{2, 7, 7}`.
The `list.count` function returns the number of occurrences of an element in a
list. Since it uses equality on elements of type `α`, it requires `α` to belong
to the `decidable_eq` type class. For this reason, the definitions and lemmas
below all take `[decidable_eq α]` as type class argument.

2.1 (1 point). Provide the missing proof below. -/

@[instance] def multiset.rel (α : Type) [decidable_eq α] : setoid (list α) :=
{ r     := λas bs, ∀x, list.count x as = list.count x bs,
  iseqv :=
    sorry }

/- 2.2 (1 point). Define the type of multisets as the quotient over the
relation `multiset.rel`. -/

def multiset (α : Type) [decidable_eq α] : Type :=
sorry

/- 2.3 (2 points). Now we have a type `multiset α` but no operations on it.
Basic operations on multisets include the empty multiset (`∅`), the singleton
multiset (`{x} `for any element `x`), and the sum of two multisets (`A ⊎ B` for
any multisets `A` and `B`). The sum should be defined so that the multiplicities
of elements are added; thus, `{2} ⊎ {2, 2} = {2, 2, 2}`.
Fill in the `sorry` placeholders below to implement the multiset union operation.
operations. -/

def multiset.empty {α : Type} [decidable_eq α] : multiset α :=
⟦[]⟧

def multiset.singleton {α : Type} [decidable_eq α] (a : α) : multiset α :=
⟦[a]⟧

def multiset.union {α : Type} [decidable_eq α] :
  multiset α → multiset α → multiset α :=
quotient.lift₂
  sorry
  sorry

/- 2.4 (2 points). Prove that `multiset.union` is commutative and associative. -/

lemma multiset.union_comm {α : Type} [decidable_eq α] (A B : multiset α) :
  multiset.union A B = multiset.union B A :=
sorry

lemma multiset.union_assoc {α : Type} [decidable_eq α] (A B C : multiset α) :
  multiset.union (multiset.union A B) C =
  multiset.union A (multiset.union B C) :=
sorry

/-! ## Question 3 (2 points + 1 bonus point): Hilbert Choice

3.1 (1 bonus point). Prove the following lemma. -/

lemma exists_minimal_arg.aux (f : ℕ → ℕ) :
  ∀x m, f m = x → ∃n, ∀i, f n ≤ f i
| x m eq :=
  begin
    cases' classical.em (∃n, f n < x),
    sorry, sorry
  end

/-! Now this interesting lemma falls off: -/

lemma exists_minimal_arg (f : ℕ → ℕ) :
  ∃n : ℕ, ∀i : ℕ, f n ≤ f i :=
exists_minimal_arg.aux f _ 0 (by refl)

/-! 3.2 (1 point). Use what you learned in the lecture to define the following
function, which returns the (or an) index of the minimal element in `f`'s
image. -/

noncomputable def minimal_arg (f : ℕ → ℕ) : ℕ :=
sorry

/-! 3.3 (1 point). Prove the following characteristic lemma about your
definition. -/

lemma minimal_arg_spec (f : ℕ → ℕ) :
  ∀i : ℕ, f (minimal_arg f) ≤ f i :=
sorry

end LoVe


import data.real.basic

/- Good work!
Correctness 90/90
Style 10/10
-/

/-
EXERCISE 1.

Prove the following without using automation, i.e. only with basic tactics
such as `intros`, `apply`, `split`, `cases`, `left`, `right`, and `use`.
-/

section

variables {α β : Type} (p q : α → Prop) (r : α → β → Prop)

-- Exercise 1a. [10pts]
example : (∀ x, p x) ∧ (∀ x, q x) → ∀ x, p x ∧ q x :=
begin
  intro h,
  intro x,
  split,
  apply h.left,
  apply h.right,
end

-- Exercise 1b. [10pts]
example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
begin
  intros h x,
  cases h,
  {
    left, -- changes goal to just LHS
    apply h,
  },
  {
    right,
    apply h,
  }
end

-- Exercise 1c. [10pts]
example : (∃ x, ∀ y, r x y) → ∀ y, ∃ x, r x y :=
begin
  intros h y,
  cases h with x,
  use x,
  apply h_h,
end

end

/-
EXERCISE 2.

Suppose two pairs of real numbers {a, b} and {c, d} have the same sum
and product. The following theorem shows that either a = c and b = d,
or a = d and b = c. Fill in the details. You can use `ring`, `ring_nf`
and `linarith` freely.
-/

-- Exercise 2. [20pts]
theorem sum_product_magic (a b c d : ℝ)
    (sumeq : a + b = c + d) (prodeq : a * b = c * d) :
  (a = c ∧ b = d) ∨ (a = d ∧ b = c) :=
begin
  have : (a - c) * (a - d) = 0,
  { ring_nf,
    nth_rewrite 1 mul_comm,
    rw ← prodeq,
    rw ← neg_add',
    rw ← sumeq,
    ring_nf,
},
  have := eq_zero_or_eq_zero_of_mul_eq_zero this,
  cases this with h h,
  { left,
    split;
    linarith,},
  { right,
    split;
    linarith,}
    --Nicely done!
end

/-
EXERCISE 3.

The predicate `approaches_at f b a` should be read "f(x) approaches b as x
approaches a", and the predicate `continuous f` says that f is continuous.

Prove the following two theorems.

Note that bounded quantification such as `∀ ε > 0, ..` really means `∀ ε, ε > 0 → ..`
and `∃ δ > 0, ..` really means `∃ δ, δ > 0 ∧ ..`.
-/

def approaches_at (f : ℝ → ℝ) (b : ℝ) (a : ℝ) :=
∀ ε > 0, ∃ δ > 0, ∀ x, abs (x - a) < δ → abs (f x - b) < ε

-- Exercise 3a. [10pts]
theorem approaches_at_add_right  {f : ℝ → ℝ} {a b c: ℝ}
    (hf : approaches_at f b a) :
  approaches_at (λ x, f x + c) (b + c) a :=
begin
  intros ε he,
  unfold approaches_at at hf,
  unfold approaches_at,
  cases (hf ε he) with δ hf,
  cases hf with hd hf,
  use δ,
  split,
  exact hd,
  intros x hxaδ,
  ring_nf,
  exact (hf x hxaδ),
end

-- Exercise 3b. [10pts]
theorem approaches_at_comp {f g : ℝ → ℝ} {a b c : ℝ}
  (hf : approaches_at f b a) (hg : approaches_at g c b) :
    approaches_at (g ∘ f) c a :=
begin
  unfold approaches_at at hf hg,
  unfold approaches_at,
  intros ε he,
  cases (hg ε he) with dg hg,
  cases hg with hdg hg,
  cases (hf dg hdg) with δ hf,
  cases hf with hd hf,
  use δ,
  split,
  exact hd,
  intros x hxaδ,
  dsimp,
  exact (hg (f x) (hf x hxaδ)),
end

def continuous (f : ℝ → ℝ) := ∀ x, approaches_at f (f x) x

-- Exercise 3c. [10pts]
theorem continuous_add_right {f : ℝ → ℝ} (ctsf : continuous f) (r : ℝ) :
  continuous (λ x, f x + r) :=
begin
  unfold continuous,
  intros x,
  unfold continuous at ctsf,
  apply approaches_at_add_right,
  dsimp,
  exact ctsf x,
end

-- Since `f x - r` is the same as `f x + (- r)`, the following is an instance
-- of the previous theorem.
theorem continuous_sub {f : ℝ → ℝ} (ctsf : continuous f) (r : ℝ) :
  continuous (λ x, f x - r) :=
continuous_add_right ctsf (-r)

/-
EXERCISE 4.

In class, I will prove the intermediate value theorem in the form `ivt`.
Use that version to prove the more general one that comes after.
-/

/- We'll do this in class! You don't have to prove it,
   and you can leave the `sorry` and apply the theorem
   as a black box. -/
theorem ivt {f : ℝ → ℝ} {a b : ℝ} (aleb : a ≤ b)
    (ctsf : continuous f) (hfa : f a < 0) (hfb : 0 < f b) :
  ∃ x, a ≤ x ∧ x ≤ b ∧ f x = 0 :=
sorry

-- Use `ivt` to prove `ivt'` below.

-- Exercise 4. [20pts]
theorem ivt' {f : ℝ → ℝ} {a b c : ℝ} (aleb : a ≤ b)
    (ctsf : continuous f) (hfa : f a < c) (hfb : c < f b) :
  ∃ x, a ≤ x ∧ x ≤ b ∧ f x = c :=
begin
  let g := λ x, f x - c,
  have : ∃ x, a ≤ x ∧ x ≤ b ∧ g x = 0,
  { dsimp [g],
    apply ivt aleb,
    apply continuous_sub ctsf,
    linarith,
    linarith,},
  dsimp [g] at this,
  cases this with x this,
  use x,
  rw sub_eq_zero at this,
  exact this,
end


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module order.circular
! leanprover-community/mathlib commit a2d2e18906e2b62627646b5d5be856e6a642062f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Basic
import Mathlib.Tactic.Set

/-!
# Circular order hierarchy

This file defines circular preorders, circular partial orders and circular orders.

## Hierarchy

* A ternary "betweenness" relation `btw : α → α → α → Prop` forms a `CircularOrder` if it is
  - reflexive: `btw a a a`
  - cyclic: `btw a b c → btw b c a`
  - antisymmetric: `btw a b c → btw c b a → a = b ∨ b = c ∨ c = a`
  - total: `btw a b c ∨ btw c b a`
  along with a strict betweenness relation `sbtw : α → α → α → Prop` which respects
  `sbtw a b c ↔ btw a b c ∧ ¬ btw c b a`, analogously to how `<` and `≤` are related, and is
  - transitive: `sbtw a b c → sbtw b d c → sbtw a d c`.
* A `CircularPartialOrder` drops totality.
* A `CircularPreorder` further drops antisymmetry.

The intuition is that a circular order is a circle and `btw a b c` means that going around
clockwise from `a` you reach `b` before `c` (`b` is between `a` and `c` is meaningless on an
unoriented circle). A circular partial order is several, potentially intersecting, circles. A
circular preorder is like a circular partial order, but several points can coexist.

Note that the relations between `CircularPreorder`, `CircularPartialOrder` and `CircularOrder`
are subtler than between `Preorder`, `PartialOrder`, `LinearOrder`. In particular, one cannot
simply extend the `btw` of a `CircularPartialOrder` to make it a `CircularOrder`.

One can translate from usual orders to circular ones by "closing the necklace at infinity". See
`LE.toBtw` and `LT.toSBtw`. Going the other way involves "cutting the necklace" or
"rolling the necklace open".

## Examples

Some concrete circular orders one encounters in the wild are `ZMod n` for `0 < n`, `Circle`,
`Real.Angle`...

## Main definitions

* `Set.cIcc`: Closed-closed circular interval.
* `Set.cIoo`: Open-open circular interval.

## Notes

There's an unsolved diamond on `OrderDual α` here. The instances `LE α → Btw αᵒᵈ` and
`LT α → SBtw αᵒᵈ` can each be inferred in two ways:
* `LE α` → `Btw α` → `Btw αᵒᵈ` vs
  `LE α` → `LE αᵒᵈ` → `Btw αᵒᵈ`
* `LT α` → `SBtw α` → `SBtw αᵒᵈ` vs
  `LT α` → `LT αᵒᵈ` → `SBtw αᵒᵈ`
The fields are propeq, but not defeq. It is temporarily fixed by turning the circularizing instances
into definitions.

## TODO

Antisymmetry is quite weak in the sense that there's no way to discriminate which two points are
equal. This prevents defining closed-open intervals `cIco` and `cIoc` in the neat `=`-less way. We
currently haven't defined them at all.

What is the correct generality of "rolling the necklace" open? At least, this works for `α × β` and
`β × α` where `α` is a circular order and `β` is a linear order.

What's next is to define circular groups and provide instances for `ZMod n`, the usual circle group
`Circle`, `Real.Angle`, and `RootsOfUnity M`. What conditions do we need on `M` for this last one
to work?

We should have circular order homomorphisms. The typical example is
`days_to_month : days_of_the_year →c months_of_the_year` which relates the circular order of days
and the circular order of months. Is `α →c β` a good notation?

## References

* https://en.wikipedia.org/wiki/Cyclic_order
* https://en.wikipedia.org/wiki/Partial_cyclic_order

## Tags

circular order, cyclic order, circularly ordered set, cyclically ordered set
-/

/-- Syntax typeclass for a betweenness relation. -/
class Btw (α : Type _) where
  /-- Betweenness for circular orders. `btw a b c` states that `b` is between `a` and `c` (in that
  order). -/
  btw : α → α → α → Prop
#align has_btw Btw

export Btw (btw)

/-- Syntax typeclass for a strict betweenness relation. -/
class SBtw (α : Type _) where
  /-- Strict betweenness for circular orders. `sbtw a b c` states that `b` is strictly between `a`
  and `c` (in that order). -/
  sbtw : α → α → α → Prop
#align has_sbtw SBtw

export SBtw (sbtw)

/-- A circular preorder is the analogue of a preorder where you can loop around. `≤` and `<` are
replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive and cyclic. `sbtw` is transitive.
-/
class CircularPreorder (α : Type _) extends Btw α, SBtw α where
  /-- `a` is between `a` and `a`. -/
  btw_refl (a : α) : btw a a a
  /-- If `b` is between `a` and `c`, then `c` is between `b` and `a`.
  This is motivated by imagining three points on a circle. -/
  btw_cyclic_left {a b c : α} : btw a b c → btw b c a
  sbtw := fun a b c => btw a b c ∧ ¬btw c b a
  /-- Strict betweenness is given by betweenness in one direction and non-betweenness in the other.

  I.e., if `b` is between `a` and `c` but not between `c` and `a`, then we say `b` is strictly
  between `a` and `c`. -/
  sbtw_iff_btw_not_btw {a b c : α} : sbtw a b c ↔ btw a b c ∧ ¬btw c b a := by intros; rfl
  /-- For any fixed `c`, `fun a b ↦ sbtw a b c` is a transitive relation.

  I.e., given `a` `b` `d` `c` in that "order", if we have `b` strictly between `a` and `c`, and `d`
  strictly between `b` and `c`, then `d` is strictly between `a` and `c`. -/
  sbtw_trans_left {a b c d : α} : sbtw a b c → sbtw b d c → sbtw a d c
#align circular_preorder CircularPreorder

export CircularPreorder (btw_refl btw_cyclic_left sbtw_trans_left)

/-- A circular partial order is the analogue of a partial order where you can loop around. `≤` and
`<` are replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive, cyclic and
antisymmetric. `sbtw` is transitive. -/
class CircularPartialOrder (α : Type _) extends CircularPreorder α where
  /-- If `b` is between `a` and `c` and also between `c` and `a`, then at least one pair of points
  among `a`, `b`, `c` are identical. -/
  btw_antisymm {a b c : α} : btw a b c → btw c b a → a = b ∨ b = c ∨ c = a
#align circular_partial_order CircularPartialOrder

export CircularPartialOrder (btw_antisymm)

/-- A circular order is the analogue of a linear order where you can loop around. `≤` and `<` are
replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive, cyclic, antisymmetric and total.
`sbtw` is transitive. -/
class CircularOrder (α : Type _) extends CircularPartialOrder α where
  /-- For any triple of points, the second is between the other two one way or another. -/
  btw_total : ∀ a b c : α, btw a b c ∨ btw c b a
#align circular_order CircularOrder

export CircularOrder (btw_total)

/-! ### Circular preorders -/

section CircularPreorder

variable {α : Type _} [CircularPreorder α]

theorem btw_rfl {a : α} : btw a a a :=
  btw_refl _
#align btw_rfl btw_rfl

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_cyclic_left        ← has_btw.btw.cyclic_left
theorem Btw.btw.cyclic_left {a b c : α} (h : btw a b c) : btw b c a :=
  btw_cyclic_left h
#align has_btw.btw.cyclic_left Btw.btw.cyclic_left

theorem btw_cyclic_right {a b c : α} (h : btw a b c) : btw c a b :=
  h.cyclic_left.cyclic_left
#align btw_cyclic_right btw_cyclic_right

alias btw_cyclic_right ← Btw.btw.cyclic_right
#align has_btw.btw.cyclic_right Btw.btw.cyclic_right

/-- The order of the `↔` has been chosen so that `rw btw_cyclic` cycles to the right while
`rw ←btw_cyclic` cycles to the left (thus following the prepended arrow). -/
theorem btw_cyclic {a b c : α} : btw a b c ↔ btw c a b :=
  ⟨btw_cyclic_right, btw_cyclic_left⟩
#align btw_cyclic btw_cyclic

theorem sbtw_iff_btw_not_btw {a b c : α} : sbtw a b c ↔ btw a b c ∧ ¬btw c b a :=
  CircularPreorder.sbtw_iff_btw_not_btw
#align sbtw_iff_btw_not_btw sbtw_iff_btw_not_btw

theorem btw_of_sbtw {a b c : α} (h : sbtw a b c) : btw a b c :=
  (sbtw_iff_btw_not_btw.1 h).1
#align btw_of_sbtw btw_of_sbtw

alias btw_of_sbtw ← SBtw.sbtw.btw
#align has_sbtw.sbtw.btw SBtw.sbtw.btw

theorem not_btw_of_sbtw {a b c : α} (h : sbtw a b c) : ¬btw c b a :=
  (sbtw_iff_btw_not_btw.1 h).2
#align not_btw_of_sbtw not_btw_of_sbtw

alias not_btw_of_sbtw ← SBtw.sbtw.not_btw
#align has_sbtw.sbtw.not_btw SBtw.sbtw.not_btw

theorem not_sbtw_of_btw {a b c : α} (h : btw a b c) : ¬sbtw c b a := fun h' => h'.not_btw h
#align not_sbtw_of_btw not_sbtw_of_btw

alias not_sbtw_of_btw ← Btw.btw.not_sbtw
#align has_btw.btw.not_sbtw Btw.btw.not_sbtw

theorem sbtw_of_btw_not_btw {a b c : α} (habc : btw a b c) (hcba : ¬btw c b a) : sbtw a b c :=
  sbtw_iff_btw_not_btw.2 ⟨habc, hcba⟩
#align sbtw_of_btw_not_btw sbtw_of_btw_not_btw

alias sbtw_of_btw_not_btw ← Btw.btw.sbtw_of_not_btw
#align has_btw.btw.sbtw_of_not_btw Btw.btw.sbtw_of_not_btw

theorem sbtw_cyclic_left {a b c : α} (h : sbtw a b c) : sbtw b c a :=
  h.btw.cyclic_left.sbtw_of_not_btw fun h' => h.not_btw h'.cyclic_left
#align sbtw_cyclic_left sbtw_cyclic_left

alias sbtw_cyclic_left ← SBtw.sbtw.cyclic_left
#align has_sbtw.sbtw.cyclic_left SBtw.sbtw.cyclic_left

theorem sbtw_cyclic_right {a b c : α} (h : sbtw a b c) : sbtw c a b :=
  h.cyclic_left.cyclic_left
#align sbtw_cyclic_right sbtw_cyclic_right

alias sbtw_cyclic_right ← SBtw.sbtw.cyclic_right
#align has_sbtw.sbtw.cyclic_right SBtw.sbtw.cyclic_right

/-- The order of the `↔` has been chosen so that `rw sbtw_cyclic` cycles to the right while
`rw ←sbtw_cyclic` cycles to the left (thus following the prepended arrow). -/
theorem sbtw_cyclic {a b c : α} : sbtw a b c ↔ sbtw c a b :=
  ⟨sbtw_cyclic_right, sbtw_cyclic_left⟩
#align sbtw_cyclic sbtw_cyclic

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_trans_left        ← has_btw.btw.trans_left
theorem SBtw.sbtw.trans_left {a b c d : α} (h : sbtw a b c) : sbtw b d c → sbtw a d c :=
  sbtw_trans_left h
#align has_sbtw.sbtw.trans_left SBtw.sbtw.trans_left

theorem sbtw_trans_right {a b c d : α} (hbc : sbtw a b c) (hcd : sbtw a c d) : sbtw a b d :=
  (hbc.cyclic_left.trans_left hcd.cyclic_left).cyclic_right
#align sbtw_trans_right sbtw_trans_right

alias sbtw_trans_right ← SBtw.sbtw.trans_right
#align has_sbtw.sbtw.trans_right SBtw.sbtw.trans_right

theorem sbtw_asymm {a b c : α} (h : sbtw a b c) : ¬sbtw c b a :=
  h.btw.not_sbtw
#align sbtw_asymm sbtw_asymm

alias sbtw_asymm ← SBtw.sbtw.not_sbtw
#align has_sbtw.sbtw.not_sbtw SBtw.sbtw.not_sbtw

theorem sbtw_irrefl_left_right {a b : α} : ¬sbtw a b a := fun h => h.not_btw h.btw
#align sbtw_irrefl_left_right sbtw_irrefl_left_right

theorem sbtw_irrefl_left {a b : α} : ¬sbtw a a b := fun h => sbtw_irrefl_left_right h.cyclic_left
#align sbtw_irrefl_left sbtw_irrefl_left

theorem sbtw_irrefl_right {a b : α} : ¬sbtw a b b := fun h => sbtw_irrefl_left_right h.cyclic_right
#align sbtw_irrefl_right sbtw_irrefl_right

theorem sbtw_irrefl (a : α) : ¬sbtw a a a :=
  sbtw_irrefl_left_right
#align sbtw_irrefl sbtw_irrefl

end CircularPreorder

/-! ### Circular partial orders -/

section CircularPartialOrder

variable {α : Type _} [CircularPartialOrder α]

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_antisymm        ← has_btw.btw.antisymm
theorem Btw.btw.antisymm {a b c : α} (h : btw a b c) : btw c b a → a = b ∨ b = c ∨ c = a :=
  btw_antisymm h
#align has_btw.btw.antisymm Btw.btw.antisymm

end CircularPartialOrder

/-! ### Circular orders -/

section CircularOrder

variable {α : Type _} [CircularOrder α]

theorem btw_refl_left_right (a b : α) : btw a b a :=
  (or_self_iff _).1 (btw_total a b a)
#align btw_refl_left_right btw_refl_left_right

theorem btw_rfl_left_right {a b : α} : btw a b a :=
  btw_refl_left_right _ _
#align btw_rfl_left_right btw_rfl_left_right

theorem btw_refl_left (a b : α) : btw a a b :=
  btw_rfl_left_right.cyclic_right
#align btw_refl_left btw_refl_left

theorem btw_rfl_left {a b : α} : btw a a b :=
  btw_refl_left _ _
#align btw_rfl_left btw_rfl_left

theorem btw_refl_right (a b : α) : btw a b b :=
  btw_rfl_left_right.cyclic_left
#align btw_refl_right btw_refl_right

theorem btw_rfl_right {a b : α} : btw a b b :=
  btw_refl_right _ _
#align btw_rfl_right btw_rfl_right

theorem sbtw_iff_not_btw {a b c : α} : sbtw a b c ↔ ¬btw c b a := by
  rw [sbtw_iff_btw_not_btw]
  exact and_iff_right_of_imp (btw_total _ _ _).resolve_left
#align sbtw_iff_not_btw sbtw_iff_not_btw

theorem btw_iff_not_sbtw {a b c : α} : btw a b c ↔ ¬sbtw c b a :=
  iff_not_comm.1 sbtw_iff_not_btw
#align btw_iff_not_sbtw btw_iff_not_sbtw

end CircularOrder

/-! ### Circular intervals -/

namespace Set

section CircularPreorder

variable {α : Type _} [CircularPreorder α]

/-- Closed-closed circular interval -/
def cIcc (a b : α) : Set α :=
  { x | btw a x b }
#align set.cIcc Set.cIcc

/-- Open-open circular interval -/
def cIoo (a b : α) : Set α :=
  { x | sbtw a x b }
#align set.cIoo Set.cIoo

@[simp]
theorem mem_cIcc {a b x : α} : x ∈ cIcc a b ↔ btw a x b :=
  Iff.rfl
#align set.mem_cIcc Set.mem_cIcc

@[simp]
theorem mem_cIoo {a b x : α} : x ∈ cIoo a b ↔ sbtw a x b :=
  Iff.rfl
#align set.mem_cIoo Set.mem_cIoo

end CircularPreorder

section CircularOrder

variable {α : Type _} [CircularOrder α]

theorem left_mem_cIcc (a b : α) : a ∈ cIcc a b :=
  btw_rfl_left
#align set.left_mem_cIcc Set.left_mem_cIcc

theorem right_mem_cIcc (a b : α) : b ∈ cIcc a b :=
  btw_rfl_right
#align set.right_mem_cIcc Set.right_mem_cIcc

theorem compl_cIcc {a b : α} : cIcc a bᶜ = cIoo b a := by
  ext
  rw [Set.mem_cIoo, sbtw_iff_not_btw]
  rfl
#align set.compl_cIcc Set.compl_cIcc

theorem compl_cIoo {a b : α} : cIoo a bᶜ = cIcc b a := by
  ext
  rw [Set.mem_cIcc, btw_iff_not_sbtw]
  rfl
#align set.compl_cIoo Set.compl_cIoo

end CircularOrder

end Set

/-! ### Circularizing instances -/

/-- The betweenness relation obtained from "looping around" `≤`.
See note [reducible non-instances]. -/
@[reducible]
def LE.toBtw (α : Type _) [LE α] : Btw α where
  btw a b c := a ≤ b ∧ b ≤ c ∨ b ≤ c ∧ c ≤ a ∨ c ≤ a ∧ a ≤ b
#align has_le.to_has_btw LE.toBtw

/-- The strict betweenness relation obtained from "looping around" `<`.
See note [reducible non-instances]. -/
@[reducible]
def LT.toSBtw (α : Type _) [LT α] : SBtw α where
  sbtw a b c := a < b ∧ b < c ∨ b < c ∧ c < a ∨ c < a ∧ a < b
#align has_lt.to_has_sbtw LT.toSBtw

/-- The circular preorder obtained from "looping around" a preorder.
See note [reducible non-instances]. -/
@[reducible]
def Preorder.toCircularPreorder (α : Type _) [Preorder α] : CircularPreorder α where
  btw a b c := a ≤ b ∧ b ≤ c ∨ b ≤ c ∧ c ≤ a ∨ c ≤ a ∧ a ≤ b
  sbtw a b c := a < b ∧ b < c ∨ b < c ∧ c < a ∨ c < a ∧ a < b
  btw_refl a := Or.inl ⟨le_rfl, le_rfl⟩
  btw_cyclic_left {a b c} h := by
    dsimp
    rwa [← or_assoc, or_comm]
  sbtw_trans_left {a b c d} := by
    rintro (⟨hab, hbc⟩ | ⟨hbc, hca⟩ | ⟨hca, hab⟩) (⟨hbd, hdc⟩ | ⟨hdc, hcb⟩ | ⟨hcb, hbd⟩)
    · exact Or.inl ⟨hab.trans hbd, hdc⟩
    · exact (hbc.not_lt hcb).elim
    · exact (hbc.not_lt hcb).elim
    · exact Or.inr (Or.inl ⟨hdc, hca⟩)
    · exact Or.inr (Or.inl ⟨hdc, hca⟩)
    · exact (hbc.not_lt hcb).elim
    · exact Or.inr (Or.inl ⟨hdc, hca⟩)
    · exact Or.inr (Or.inl ⟨hdc, hca⟩)
    · exact Or.inr (Or.inr ⟨hca, hab.trans hbd⟩)
  sbtw_iff_btw_not_btw {a b c} := by
    simp_rw [lt_iff_le_not_le]
    have := le_trans a b c
    have := le_trans b c a
    have := le_trans c a b
    tauto
#align preorder.to_circular_preorder Preorder.toCircularPreorder

/-- The circular partial order obtained from "looping around" a partial order.
See note [reducible non-instances]. -/
@[reducible]
def PartialOrder.toCircularPartialOrder (α : Type _) [PartialOrder α] : CircularPartialOrder α :=
  { Preorder.toCircularPreorder α with
    btw_antisymm := fun {a b c} => by
      rintro (⟨hab, hbc⟩ | ⟨hbc, hca⟩ | ⟨hca, hab⟩) (⟨hcb, hba⟩ | ⟨hba, hac⟩ | ⟨hac, hcb⟩)
      · exact Or.inl (hab.antisymm hba)
      · exact Or.inl (hab.antisymm hba)
      · exact Or.inr (Or.inl <| hbc.antisymm hcb)
      · exact Or.inr (Or.inl <| hbc.antisymm hcb)
      · exact Or.inr (Or.inr <| hca.antisymm hac)
      · exact Or.inr (Or.inl <| hbc.antisymm hcb)
      · exact Or.inl (hab.antisymm hba)
      · exact Or.inl (hab.antisymm hba)
      · exact Or.inr (Or.inr <| hca.antisymm hac) }
#align partial_order.to_circular_partial_order PartialOrder.toCircularPartialOrder

/-- The circular order obtained from "looping around" a linear order.
See note [reducible non-instances]. -/
@[reducible]
def LinearOrder.toCircularOrder (α : Type _) [LinearOrder α] : CircularOrder α :=
  { PartialOrder.toCircularPartialOrder α with
    btw_total := fun a b c => by
      cases' le_total a b with hab hba <;> cases' le_total b c with hbc hcb <;>
        cases' le_total c a with hca hac
      · exact Or.inl (Or.inl ⟨hab, hbc⟩)
      · exact Or.inl (Or.inl ⟨hab, hbc⟩)
      · exact Or.inl (Or.inr <| Or.inr ⟨hca, hab⟩)
      · exact Or.inr (Or.inr <| Or.inr ⟨hac, hcb⟩)
      · exact Or.inl (Or.inr <| Or.inl ⟨hbc, hca⟩)
      · exact Or.inr (Or.inr <| Or.inl ⟨hba, hac⟩)
      · exact Or.inr (Or.inl ⟨hcb, hba⟩)
      · exact Or.inr (Or.inr <| Or.inl ⟨hba, hac⟩) }
#align linear_order.to_circular_order LinearOrder.toCircularOrder

/-! ### Dual constructions -/

namespace OrderDual

instance btw (α : Type _) [Btw α] : Btw αᵒᵈ :=
  ⟨fun a b c : α => Btw.btw c b a⟩

instance sbtw (α : Type _) [SBtw α] : SBtw αᵒᵈ :=
  ⟨fun a b c : α => SBtw.sbtw c b a⟩

instance circularPreorder (α : Type _) [CircularPreorder α] : CircularPreorder αᵒᵈ :=
  { OrderDual.btw α,
    OrderDual.sbtw α with
    btw_refl := fun _ => @btw_refl α _ _
    btw_cyclic_left := fun {_ _ _} => @btw_cyclic_right α _ _ _ _
    sbtw_trans_left := fun {_ _ _ _} habc hbdc => hbdc.trans_right habc
    sbtw_iff_btw_not_btw := fun {a b c} => @sbtw_iff_btw_not_btw α _ c b a }

instance circularPartialOrder (α : Type _) [CircularPartialOrder α] : CircularPartialOrder αᵒᵈ :=
  { OrderDual.circularPreorder α with
    btw_antisymm := fun {_ _ _} habc hcba => @btw_antisymm α _ _ _ _ hcba habc }

instance (α : Type _) [CircularOrder α] : CircularOrder αᵒᵈ :=
  { OrderDual.circularPartialOrder α with
    btw_total := fun {a b c} => @btw_total α _ c b a }

end OrderDual


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-

# More on functions

Another question on the IUM problem sheet on functions
is "If `f : X → Y` and `g : Y → Z` and `g ∘ f` is injective, is it true that `g` is injective?"
This is not true. A counterexample could be made by letting `X` and `Z` have one element,
and letting `Y` have two elements; `f` and `g` are then not hard to write down. Let's
see how to do this in Lean by making inductive types `X`, `Y` and `Z` and functions
`f` and `g` which give an explicit counterexample.

-/

-- Let X be {a}
inductive X : Type
| a : X

-- in fact the term of type X is called `X.a`.

-- Let Y be {b,c}
inductive Y : Type
| b : Y
| c : Y

inductive Z : Type
| d : Z

-- Define f by f(X.a)=Y.b
def f : X → Y
| X.a := Y.b

-- define g by g(Y.b)=g(Y.c)=Z.d
def g : Y → Z
| Y.b := Z.d
| Y.c := Z.d

-- examples of how these things work
example (z : Z) : z = Z.d :=
begin
  cases z,
  refl,
end

example : Y.b ≠ Y.c :=
begin
  intro h, -- x ≠ y is definitionally equal to (x = y) → false
  cases h, -- there are no cases when they're equal!
end

open function

lemma gf_injective : injective (g ∘ f) :=
begin
  sorry,
end

-- This is a question on the IUM function problem sheet
example : ¬ (∀ X Y Z : Type, ∀ (f : X → Y) (g : Y → Z), injective (g ∘ f) → injective g) :=
begin
  sorry,
end

-- This is another one
example : ¬ (∀ X Y Z : Type, ∀ (f : X → Y) (g : Y → Z), surjective (g ∘ f) → surjective f) :=
begin
  sorry,
end


/-
Copyright (c) 2020 Google LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Wong
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.basic
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Palindromes

This module defines *palindromes*, lists which are equal to their reverse.

The main result is the `palindrome` inductive type, and its associated `palindrome.rec_on` induction
principle. Also provided are conversions to and from other equivalent definitions.

## References

* [Pierre Castéran, *On palindromes*][casteran]

[casteran]: https://www.labri.fr/perso/casteran/CoqArt/inductive-prop-chap/palindrome.html

## Tags

palindrome, reverse, induction
-/

/--
`palindrome l` asserts that `l` is a palindrome. This is defined inductively:

* The empty list is a palindrome;
* A list with one element is a palindrome;
* Adding the same element to both ends of a palindrome results in a bigger palindrome.
-/
inductive palindrome {α : Type u_1} : List α → Prop
where
| nil : palindrome []
| singleton : ∀ (x : α), palindrome [x]
| cons_concat : ∀ (x : α) {l : List α}, palindrome l → palindrome (x :: (l ++ [x]))

namespace palindrome

theorem reverse_eq {α : Type u_1} {l : List α} (p : palindrome l) : list.reverse l = l := sorry

theorem of_reverse_eq {α : Type u_1} {l : List α} : list.reverse l = l → palindrome l := sorry

theorem iff_reverse_eq {α : Type u_1} {l : List α} : palindrome l ↔ list.reverse l = l :=
  { mp := reverse_eq, mpr := of_reverse_eq }

theorem append_reverse {α : Type u_1} (l : List α) : palindrome (l ++ list.reverse l) := sorry

protected instance decidable {α : Type u_1} [DecidableEq α] (l : List α) : Decidable (palindrome l) :=
  decidable_of_iff' (list.reverse l = l) iff_reverse_eq


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.finset.sort
! leanprover-community/mathlib commit 509de852e1de55e1efa8eacfa11df0823f26f226
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.RelIso.Set
import Mathlib.Data.Fintype.Lattice
import Mathlib.Data.Multiset.Sort
import Mathlib.Data.List.NodupEquivFin

/-!
# Construct a sorted list from a finset.
-/

namespace Finset

open Multiset Nat

variable {α β : Type _}

/-! ### sort -/

section sort

variable (r : α → α → Prop) [DecidableRel r] [IsTrans α r] [IsAntisymm α r] [IsTotal α r]

/-- `sort s` constructs a sorted list from the unordered set `s`.
  (Uses merge sort algorithm.) -/
def sort (s : Finset α) : List α :=
  Multiset.sort r s.1
#align finset.sort Finset.sort

@[simp]
theorem sort_sorted (s : Finset α) : List.Sorted r (sort r s) :=
  Multiset.sort_sorted _ _
#align finset.sort_sorted Finset.sort_sorted

@[simp]
theorem sort_eq (s : Finset α) : ↑(sort r s) = s.1 :=
  Multiset.sort_eq _ _
#align finset.sort_eq Finset.sort_eq

@[simp]
theorem sort_nodup (s : Finset α) : (sort r s).Nodup :=
  (by rw [sort_eq]; exact s.2 : @Multiset.Nodup α (sort r s))
#align finset.sort_nodup Finset.sort_nodup

@[simp]
theorem sort_toFinset [DecidableEq α] (s : Finset α) : (sort r s).toFinset = s :=
  List.toFinset_eq (sort_nodup r s) ▸ eq_of_veq (sort_eq r s)
#align finset.sort_to_finset Finset.sort_toFinset

@[simp]
theorem mem_sort {s : Finset α} {a : α} : a ∈ sort r s ↔ a ∈ s :=
  Multiset.mem_sort _
#align finset.mem_sort Finset.mem_sort

@[simp]
theorem length_sort {s : Finset α} : (sort r s).length = s.card :=
  Multiset.length_sort _
#align finset.length_sort Finset.length_sort

@[simp]
theorem sort_empty : sort r ∅ = [] :=
  Multiset.sort_zero r
#align finset.sort_empty Finset.sort_empty

@[simp]
theorem sort_singleton (a : α) : sort r {a} = [a] :=
  Multiset.sort_singleton r a
#align finset.sort_singleton Finset.sort_singleton

theorem sort_perm_toList (s : Finset α) : sort r s ~ s.toList := by
  rw [← Multiset.coe_eq_coe]
  simp only [coe_toList, sort_eq]
#align finset.sort_perm_to_list Finset.sort_perm_toList

end sort

section SortLinearOrder

variable [LinearOrder α]

theorem sort_sorted_lt (s : Finset α) : List.Sorted (· < ·) (sort (· ≤ ·) s) :=
  (sort_sorted _ _).lt_of_le (sort_nodup _ _)
#align finset.sort_sorted_lt Finset.sort_sorted_lt

theorem sorted_zero_eq_min'_aux (s : Finset α) (h : 0 < (s.sort (· ≤ ·)).length) (H : s.Nonempty) :
    (s.sort (· ≤ ·)).nthLe 0 h = s.min' H := by
  let l := s.sort (· ≤ ·)
  apply le_antisymm
  · have : s.min' H ∈ l := (Finset.mem_sort (α := α) (· ≤ ·)).mpr (s.min'_mem H)
    obtain ⟨i, hi⟩ : ∃ i, l.get i = s.min' H := List.mem_iff_get.1 this
    rw [← hi]
    exact (s.sort_sorted (· ≤ ·)).rel_nthLe_of_le _ _ (Nat.zero_le i)
  · have : l.get ⟨0, h⟩ ∈ s := (Finset.mem_sort (α := α) (· ≤ ·)).1 (List.get_mem l 0 h)
    exact s.min'_le _ this
#align finset.sorted_zero_eq_min'_aux Finset.sorted_zero_eq_min'_aux

theorem sorted_zero_eq_min' {s : Finset α} {h : 0 < (s.sort (· ≤ ·)).length} :
    (s.sort (· ≤ ·)).nthLe 0 h = s.min' (card_pos.1 <| by rwa [length_sort] at h) :=
  sorted_zero_eq_min'_aux _ _ _
#align finset.sorted_zero_eq_min' Finset.sorted_zero_eq_min'

theorem min'_eq_sorted_zero {s : Finset α} {h : s.Nonempty} :
    s.min' h = (s.sort (· ≤ ·)).nthLe 0 (by rw [length_sort]; exact card_pos.2 h) :=
  (sorted_zero_eq_min'_aux _ _ _).symm
#align finset.min'_eq_sorted_zero Finset.min'_eq_sorted_zero

theorem sorted_last_eq_max'_aux (s : Finset α)
    (h : (s.sort (· ≤ ·)).length - 1 < (s.sort (· ≤ ·)).length) (H : s.Nonempty) :
    (s.sort (· ≤ ·)).nthLe ((s.sort (· ≤ ·)).length - 1) h = s.max' H := by
  let l := s.sort (· ≤ ·)
  apply le_antisymm
  · have : l.get ⟨(s.sort (· ≤ ·)).length - 1, h⟩ ∈ s :=
      (Finset.mem_sort (α := α) (· ≤ ·)).1 (List.get_mem l _ h)
    exact s.le_max' _ this
  · have : s.max' H ∈ l := (Finset.mem_sort (α := α) (· ≤ ·)).mpr (s.max'_mem H)
    obtain ⟨i, hi⟩ : ∃ i, l.get i = s.max' H := List.mem_iff_get.1 this
    rw [← hi]
    exact (s.sort_sorted (· ≤ ·)).rel_nthLe_of_le _ _ (Nat.le_pred_of_lt i.prop)
#align finset.sorted_last_eq_max'_aux Finset.sorted_last_eq_max'_aux

theorem sorted_last_eq_max' {s : Finset α}
    {h : (s.sort (· ≤ ·)).length - 1 < (s.sort (· ≤ ·)).length} :
    (s.sort (· ≤ ·)).nthLe ((s.sort (· ≤ ·)).length - 1) h =
      s.max' (by rw [length_sort] at h; exact card_pos.1 (lt_of_le_of_lt bot_le h)) :=
  sorted_last_eq_max'_aux _ _ _
#align finset.sorted_last_eq_max' Finset.sorted_last_eq_max'

theorem max'_eq_sorted_last {s : Finset α} {h : s.Nonempty} :
    s.max' h =
      (s.sort (· ≤ ·)).nthLe ((s.sort (· ≤ ·)).length - 1)
        (by simpa using Nat.sub_lt (card_pos.mpr h) zero_lt_one) :=
  (sorted_last_eq_max'_aux _ _ _).symm
#align finset.max'_eq_sorted_last Finset.max'_eq_sorted_last

/-- Given a finset `s` of cardinality `k` in a linear order `α`, the map `orderIsoOfFin s h`
is the increasing bijection between `Fin k` and `s` as an `OrderIso`. Here, `h` is a proof that
the cardinality of `s` is `k`. We use this instead of an iso `Fin s.card ≃o s` to avoid
casting issues in further uses of this function. -/
def orderIsoOfFin (s : Finset α) {k : ℕ} (h : s.card = k) : Fin k ≃o s :=
  OrderIso.trans (Fin.cast ((length_sort (α := α) (· ≤ ·)).trans h).symm) <|
    (s.sort_sorted_lt.getIso _).trans <| OrderIso.setCongr _ _ <| Set.ext fun _ => mem_sort _
#align finset.order_iso_of_fin Finset.orderIsoOfFin

/-- Given a finset `s` of cardinality `k` in a linear order `α`, the map `orderEmbOfFin s h` is
the increasing bijection between `Fin k` and `s` as an order embedding into `α`. Here, `h` is a
proof that the cardinality of `s` is `k`. We use this instead of an embedding `Fin s.card ↪o α` to
avoid casting issues in further uses of this function. -/
def orderEmbOfFin (s : Finset α) {k : ℕ} (h : s.card = k) : Fin k ↪o α :=
  (orderIsoOfFin s h).toOrderEmbedding.trans (OrderEmbedding.subtype _)
#align finset.order_emb_of_fin Finset.orderEmbOfFin

@[simp]
theorem coe_orderIsoOfFin_apply (s : Finset α) {k : ℕ} (h : s.card = k) (i : Fin k) :
    ↑(orderIsoOfFin s h i) = orderEmbOfFin s h i :=
  rfl
#align finset.coe_order_iso_of_fin_apply Finset.coe_orderIsoOfFin_apply

theorem orderIsoOfFin_symm_apply (s : Finset α) {k : ℕ} (h : s.card = k) (x : s) :
    ↑((s.orderIsoOfFin h).symm x) = (s.sort (· ≤ ·)).indexOf ↑x :=
  rfl
#align finset.order_iso_of_fin_symm_apply Finset.orderIsoOfFin_symm_apply

theorem orderEmbOfFin_apply (s : Finset α) {k : ℕ} (h : s.card = k) (i : Fin k) :
    s.orderEmbOfFin h i =
      (s.sort (· ≤ ·)).nthLe i (by rw [length_sort, h]; exact i.2) :=
  rfl
#align finset.order_emb_of_fin_apply Finset.orderEmbOfFin_apply

@[simp]
theorem orderEmbOfFin_mem (s : Finset α) {k : ℕ} (h : s.card = k) (i : Fin k) :
    s.orderEmbOfFin h i ∈ s :=
  (s.orderIsoOfFin h i).2
#align finset.order_emb_of_fin_mem Finset.orderEmbOfFin_mem

@[simp]
theorem range_orderEmbOfFin (s : Finset α) {k : ℕ} (h : s.card = k) :
    Set.range (s.orderEmbOfFin h) = s := by
  simp only [orderEmbOfFin, Set.range_comp ((↑) : _ → α) (s.orderIsoOfFin h),
  RelEmbedding.coe_trans, Set.image_univ, Finset.orderEmbOfFin, RelIso.range_eq,
    OrderEmbedding.subtype_apply, OrderIso.coe_toOrderEmbedding, eq_self_iff_true,
    Subtype.range_coe_subtype, Finset.setOf_mem, Finset.coe_inj]
#align finset.range_order_emb_of_fin Finset.range_orderEmbOfFin

/-- The bijection `orderEmbOfFin s h` sends `0` to the minimum of `s`. -/
theorem orderEmbOfFin_zero {s : Finset α} {k : ℕ} (h : s.card = k) (hz : 0 < k) :
    orderEmbOfFin s h ⟨0, hz⟩ = s.min' (card_pos.mp (h.symm ▸ hz)) := by
  simp only [orderEmbOfFin_apply, Fin.val_mk, sorted_zero_eq_min']
#align finset.order_emb_of_fin_zero Finset.orderEmbOfFin_zero

/-- The bijection `orderEmbOfFin s h` sends `k-1` to the maximum of `s`. -/
theorem orderEmbOfFin_last {s : Finset α} {k : ℕ} (h : s.card = k) (hz : 0 < k) :
    orderEmbOfFin s h ⟨k - 1, Nat.sub_lt hz (Nat.succ_pos 0)⟩ =
      s.max' (card_pos.mp (h.symm ▸ hz)) := by
  simp [orderEmbOfFin_apply, max'_eq_sorted_last, h]
#align finset.order_emb_of_fin_last Finset.orderEmbOfFin_last

/-- `orderEmbOfFin {a} h` sends any argument to `a`. -/
@[simp]
theorem orderEmbOfFin_singleton (a : α) (i : Fin 1) :
    orderEmbOfFin {a} (card_singleton a) i = a := by
  rw [Subsingleton.elim i ⟨0, zero_lt_one⟩, orderEmbOfFin_zero _ zero_lt_one, min'_singleton]
#align finset.order_emb_of_fin_singleton Finset.orderEmbOfFin_singleton

/-- Any increasing map `f` from `Fin k` to a finset of cardinality `k` has to coincide with
the increasing bijection `orderEmbOfFin s h`. -/
theorem orderEmbOfFin_unique {s : Finset α} {k : ℕ} (h : s.card = k) {f : Fin k → α}
    (hfs : ∀ x, f x ∈ s) (hmono : StrictMono f) : f = s.orderEmbOfFin h := by
  apply Fin.strictMono_unique hmono (s.orderEmbOfFin h).strictMono
  rw [range_orderEmbOfFin, ← Set.image_univ, ← coe_univ, ← coe_image, coe_inj]
  refine' eq_of_subset_of_card_le (fun x hx => _) _
  · rcases mem_image.1 hx with ⟨x, _, rfl⟩
    exact hfs x
  · rw [h, card_image_of_injective _ hmono.injective, card_univ, Fintype.card_fin]
#align finset.order_emb_of_fin_unique Finset.orderEmbOfFin_unique

/-- An order embedding `f` from `Fin k` to a finset of cardinality `k` has to coincide with
the increasing bijection `orderEmbOfFin s h`. -/

/-- Two parametrizations `orderEmbOfFin` of the same set take the same value on `i` and `j` if
and only if `i = j`. Since they can be defined on a priori not defeq types `Fin k` and `Fin l`
(although necessarily `k = l`), the conclusion is rather written `(i : ℕ) = (j : ℕ)`. -/
@[simp]
theorem orderEmbOfFin_eq_orderEmbOfFin_iff {k l : ℕ} {s : Finset α} {i : Fin k} {j : Fin l}
    {h : s.card = k} {h' : s.card = l} :
    s.orderEmbOfFin h i = s.orderEmbOfFin h' j ↔ (i : ℕ) = (j : ℕ) := by
  substs k l
  exact (s.orderEmbOfFin rfl).eq_iff_eq.trans Fin.ext_iff
#align
  finset.order_emb_of_fin_eq_order_emb_of_fin_iff Finset.orderEmbOfFin_eq_orderEmbOfFin_iff

/-- Given a finset `s` of size at least `k` in a linear order `α`, the map `orderEmbOfCardLe`
is an order embedding from `Fin k` to `α` whose image is contained in `s`. Specifically, it maps
`Fin k` to an initial segment of `s`. -/
def orderEmbOfCardLe (s : Finset α) {k : ℕ} (h : k ≤ s.card) : Fin k ↪o α :=
  (Fin.castLe h).trans (s.orderEmbOfFin rfl)
#align finset.order_emb_of_card_le Finset.orderEmbOfCardLe

theorem orderEmbOfCardLe_mem (s : Finset α) {k : ℕ} (h : k ≤ s.card) (a) :
    orderEmbOfCardLe s h a ∈ s := by
  simp only [orderEmbOfCardLe, RelEmbedding.coe_trans, Finset.orderEmbOfFin_mem,
    Function.comp_apply]
#align finset.order_emb_of_card_le_mem Finset.orderEmbOfCardLe_mem

end SortLinearOrder

unsafe instance [Repr α] : Repr (Finset α) :=
  ⟨fun s _ => repr s.1⟩

end Finset


/-
Copyright (c) 2019 Rohan Mitta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rohan Mitta, Kevin Buzzard, Alistair Tucker, Johannes Hölzl, Yury Kudryashov
-/
import analysis.specific_limits
import data.setoid.basic
import dynamics.fixed_points.topology

/-!
# Contracting maps

A Lipschitz continuous self-map with Lipschitz constant `K < 1` is called a *contracting map*.
In this file we prove the Banach fixed point theorem, some explicit estimates on the rate
of convergence, and some properties of the map sending a contracting map to its fixed point.

## Main definitions

* `contracting_with K f` : a Lipschitz continuous self-map with `K < 1`;
* `efixed_point` : given a contracting map `f` on a complete emetric space and a point `x`
  such that `edist x (f x) < ∞`, `efixed_point f hf x hx` is the unique fixed point of `f`
  in `emetric.ball x ∞`;
* `fixed_point` : the unique fixed point of a contracting map on a complete nonempty metric space.

## Tags

contracting map, fixed point, Banach fixed point theorem
-/

open_locale nnreal topological_space classical ennreal
open filter function

variables {α : Type*}

/-- A map is said to be `contracting_with K`, if `K < 1` and `f` is `lipschitz_with K`. -/
def contracting_with [emetric_space α] (K : ℝ≥0) (f : α → α) :=
(K < 1) ∧ lipschitz_with K f

namespace contracting_with

variables [emetric_space α] [cs : complete_space α] {K : ℝ≥0} {f : α → α}

open emetric set

lemma to_lipschitz_with (hf : contracting_with K f) : lipschitz_with K f := hf.2

lemma one_sub_K_pos' (hf : contracting_with K f) : (0:ℝ≥0∞) < 1 - K := by simp [hf.1]

lemma one_sub_K_ne_zero (hf : contracting_with K f) : (1:ℝ≥0∞) - K ≠ 0 :=
ne_of_gt hf.one_sub_K_pos'

lemma one_sub_K_ne_top : (1:ℝ≥0∞) - K ≠ ⊤ :=
by { norm_cast, exact ennreal.coe_ne_top }

lemma edist_inequality (hf : contracting_with K f) {x y} (h : edist x y < ⊤) :
  edist x y ≤ (edist x (f x) + edist y (f y)) / (1 - K) :=
suffices edist x y ≤ edist x (f x) + edist y (f y) + K * edist x y,
  by rwa [ennreal.le_div_iff_mul_le (or.inl hf.one_sub_K_ne_zero) (or.inl one_sub_K_ne_top),
    mul_comm, ennreal.sub_mul (λ _ _, ne_of_lt h), one_mul, ennreal.sub_le_iff_le_add],
calc edist x y ≤ edist x (f x) + edist (f x) (f y) + edist (f y) y : edist_triangle4 _ _ _ _
  ... = edist x (f x) + edist y (f y) + edist (f x) (f y) : by rw [edist_comm y, add_right_comm]
  ... ≤ edist x (f x) + edist y (f y) + K * edist x y : add_le_add (le_refl _) (hf.2 _ _)

lemma edist_le_of_fixed_point (hf : contracting_with K f) {x y}
  (h : edist x y < ⊤) (hy : is_fixed_pt f y) :
  edist x y ≤ (edist x (f x)) / (1 - K) :=
by simpa only [hy.eq, edist_self, add_zero] using hf.edist_inequality h

lemma eq_or_edist_eq_top_of_fixed_points (hf : contracting_with K f) {x y}
  (hx : is_fixed_pt f x) (hy : is_fixed_pt f y) :
  x = y ∨ edist x y = ⊤ :=
begin
  cases eq_or_lt_of_le (le_top : edist x y ≤ ⊤), from or.inr h,
  refine or.inl (edist_le_zero.1 _),
  simpa only [hx.eq, edist_self, add_zero, ennreal.zero_div]
    using hf.edist_le_of_fixed_point h hy
end

/-- If a map `f` is `contracting_with K`, and `s` is a forward-invariant set, then
restriction of `f` to `s` is `contracting_with K` as well. -/
lemma restrict (hf : contracting_with K f) {s : set α} (hs : maps_to f s s) :
  contracting_with K (hs.restrict f s s) :=
⟨hf.1, λ x y, hf.2 x y⟩

include cs

/-- Banach fixed-point theorem, contraction mapping theorem, `emetric_space` version.
A contracting map on a complete metric space has a fixed point.
We include more conclusions in this theorem to avoid proving them again later.

The main API for this theorem are the functions `efixed_point` and `fixed_point`,
and lemmas about these functions. -/
theorem exists_fixed_point (hf : contracting_with K f) (x : α) (hx : edist x (f x) < ⊤) :
  ∃ y, is_fixed_pt f y ∧ tendsto (λ n, f^[n] x) at_top (𝓝 y) ∧
    ∀ n:ℕ, edist (f^[n] x) y ≤ (edist x (f x)) * K^n / (1 - K) :=
have cauchy_seq (λ n, f^[n] x),
from cauchy_seq_of_edist_le_geometric K (edist x (f x)) (ennreal.coe_lt_one_iff.2 hf.1)
  (ne_of_lt hx) (hf.to_lipschitz_with.edist_iterate_succ_le_geometric x),
let ⟨y, hy⟩ := cauchy_seq_tendsto_of_complete this in
⟨y, is_fixed_pt_of_tendsto_iterate hy hf.2.continuous.continuous_at, hy,
  edist_le_of_edist_le_geometric_of_tendsto K (edist x (f x))
    (hf.to_lipschitz_with.edist_iterate_succ_le_geometric x) hy⟩

variable (f) -- avoid `efixed_point _` in pretty printer

/-- Let `x` be a point of a complete emetric space. Suppose that `f` is a contracting map,
and `edist x (f x) < ∞`. Then `efixed_point` is the unique fixed point of `f`
in `emetric.ball x ∞`. -/
noncomputable def efixed_point (hf : contracting_with K f) (x : α) (hx : edist x (f x) < ⊤) :
  α :=
classical.some $ hf.exists_fixed_point x hx

variables {f}

lemma efixed_point_is_fixed_pt (hf : contracting_with K f) {x : α} (hx : edist x (f x) < ⊤) :
  is_fixed_pt f (efixed_point f hf x hx) :=
(classical.some_spec $ hf.exists_fixed_point x hx).1

lemma tendsto_iterate_efixed_point (hf : contracting_with K f) {x : α} (hx : edist x (f x) < ⊤) :
  tendsto (λn, f^[n] x) at_top (𝓝 $ efixed_point f hf x hx) :=
(classical.some_spec $ hf.exists_fixed_point x hx).2.1

lemma apriori_edist_iterate_efixed_point_le (hf : contracting_with K f)
  {x : α} (hx : edist x (f x) < ⊤) (n : ℕ) :
  edist (f^[n] x) (efixed_point f hf x hx) ≤ (edist x (f x)) * K^n / (1 - K) :=
(classical.some_spec $ hf.exists_fixed_point x hx).2.2 n

lemma edist_efixed_point_le (hf : contracting_with K f) {x : α} (hx : edist x (f x) < ⊤) :
  edist x (efixed_point f hf x hx) ≤ (edist x (f x)) / (1 - K) :=
by { convert hf.apriori_edist_iterate_efixed_point_le hx 0, simp only [pow_zero, mul_one] }

lemma edist_efixed_point_lt_top (hf : contracting_with K f) {x : α} (hx : edist x (f x) < ⊤) :
  edist x (efixed_point f hf x hx) < ⊤ :=
lt_of_le_of_lt (hf.edist_efixed_point_le hx) (ennreal.mul_lt_top hx $
  ennreal.lt_top_iff_ne_top.2 $ ennreal.inv_ne_top.2 hf.one_sub_K_ne_zero)

lemma efixed_point_eq_of_edist_lt_top (hf : contracting_with K f) {x : α} (hx : edist x (f x) < ⊤)
  {y : α} (hy : edist y (f y) < ⊤) (h : edist x y < ⊤) :
  efixed_point f hf x hx = efixed_point f hf y hy :=
begin
  refine (hf.eq_or_edist_eq_top_of_fixed_points _ _).elim id (λ h', false.elim (ne_of_lt _ h'));
    try { apply efixed_point_is_fixed_pt },
  change edist_lt_top_setoid.rel _ _,
  transitivity x, by { symmetry, exact hf.edist_efixed_point_lt_top hx },
  transitivity y,
  exacts [h, hf.edist_efixed_point_lt_top hy]
end

omit cs

/-- Banach fixed-point theorem for maps contracting on a complete subset. -/
theorem exists_fixed_point' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) :
  ∃ y ∈ s, is_fixed_pt f y ∧ tendsto (λ n, f^[n] x) at_top (𝓝 y) ∧
    ∀ n:ℕ, edist (f^[n] x) y ≤ (edist x (f x)) * K^n / (1 - K) :=
begin
  haveI := hsc.complete_space_coe,
  rcases hf.exists_fixed_point ⟨x, hxs⟩ hx with ⟨y, hfy, h_tendsto, hle⟩,
  refine ⟨y, y.2, subtype.ext_iff_val.1 hfy, _, λ n, _⟩,
  { convert (continuous_subtype_coe.tendsto _).comp h_tendsto, ext n,
    simp only [(∘), maps_to.iterate_restrict, maps_to.coe_restrict_apply, subtype.coe_mk] },
  { convert hle n,
    rw [maps_to.iterate_restrict, eq_comm, maps_to.coe_restrict_apply, subtype.coe_mk] }
end

variable (f) -- avoid `efixed_point _` in pretty printer

/-- Let `s` be a complete forward-invariant set of a self-map `f`. If `f` contracts on `s`
and `x ∈ s` satisfies `edist x (f x) < ⊤`, then `efixed_point'` is the unique fixed point
of the restriction of `f` to `s ∩ emetric.ball x ⊤`. -/
noncomputable def efixed_point' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) (x : α) (hxs : x ∈ s) (hx : edist x (f x) < ⊤) :
  α :=
classical.some $ hf.exists_fixed_point' hsc hsf hxs hx

variables {f}

lemma efixed_point_mem' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) :
  efixed_point' f hsc hsf hf x hxs hx ∈ s :=
(classical.some_spec $ hf.exists_fixed_point' hsc hsf hxs hx).fst

lemma efixed_point_is_fixed_pt' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) :
  is_fixed_pt f (efixed_point' f hsc hsf hf x hxs hx) :=
(classical.some_spec $ hf.exists_fixed_point' hsc hsf hxs hx).snd.1

lemma tendsto_iterate_efixed_point' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) :
  tendsto (λn, f^[n] x) at_top (𝓝 $ efixed_point' f hsc hsf hf x hxs hx) :=
(classical.some_spec $ hf.exists_fixed_point' hsc hsf hxs hx).snd.2.1

lemma apriori_edist_iterate_efixed_point_le' {s : set α} (hsc : is_complete s)
  (hsf : maps_to f s s) (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s)
  (hx : edist x (f x) < ⊤) (n : ℕ) :
  edist (f^[n] x) (efixed_point' f hsc hsf hf x hxs hx) ≤ (edist x (f x)) * K^n / (1 - K) :=
(classical.some_spec $ hf.exists_fixed_point' hsc hsf hxs hx).snd.2.2 n

lemma edist_efixed_point_le' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) :
  edist x (efixed_point' f hsc hsf hf x hxs hx) ≤ (edist x (f x)) / (1 - K) :=
by { convert hf.apriori_edist_iterate_efixed_point_le' hsc hsf hxs hx 0,
  rw [pow_zero, mul_one] }

lemma edist_efixed_point_lt_top' {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hf : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤) :
  edist x (efixed_point' f hsc hsf hf x hxs hx) < ⊤ :=
lt_of_le_of_lt (hf.edist_efixed_point_le' hsc hsf hxs hx) (ennreal.mul_lt_top hx $
  ennreal.lt_top_iff_ne_top.2 $ ennreal.inv_ne_top.2 hf.one_sub_K_ne_zero)

/-- If a globally contracting map `f` has two complete forward-invariant sets `s`, `t`,
and `x ∈ s` is at a finite distance from `y ∈ t`, then the `efixed_point'` constructed by `x`
is the same as the `efixed_point'` constructed by `y`.

This lemma takes additional arguments stating that `f` contracts on `s` and `t` because this way
it can be used to prove the desired equality with non-trivial proofs of these facts. -/
lemma efixed_point_eq_of_edist_lt_top' (hf : contracting_with K f)
  {s : set α} (hsc : is_complete s) (hsf : maps_to f s s)
  (hfs : contracting_with K $ hsf.restrict f s s) {x : α} (hxs : x ∈ s) (hx : edist x (f x) < ⊤)
  {t : set α} (htc : is_complete t) (htf : maps_to f t t)
  (hft : contracting_with K $ htf.restrict f t t) {y : α} (hyt : y ∈ t) (hy : edist y (f y) < ⊤)
  (hxy : edist x y < ⊤) :
  efixed_point' f hsc hsf hfs x hxs hx = efixed_point' f htc htf hft y hyt hy :=
begin
  refine (hf.eq_or_edist_eq_top_of_fixed_points _ _).elim id (λ h', false.elim (ne_of_lt _ h'));
    try { apply efixed_point_is_fixed_pt' },
  change edist_lt_top_setoid.rel _ _,
  transitivity x, by { symmetry, apply edist_efixed_point_lt_top' },
  transitivity y,
  exact hxy,
  apply edist_efixed_point_lt_top'
end

end contracting_with

namespace contracting_with

variables [metric_space α] {K : ℝ≥0} {f : α → α} (hf : contracting_with K f)
include hf

lemma one_sub_K_pos (hf : contracting_with K f) : (0:ℝ) < 1 - K := sub_pos.2 hf.1

lemma dist_le_mul (x y : α) : dist (f x) (f y) ≤ K * dist x y :=
hf.to_lipschitz_with.dist_le_mul x y

lemma dist_inequality (x y) : dist x y ≤ (dist x (f x) + dist y (f y)) / (1 - K) :=
suffices dist x y ≤ dist x (f x) + dist y (f y) + K * dist x y,
  by rwa [le_div_iff hf.one_sub_K_pos, mul_comm, sub_mul, one_mul, sub_le_iff_le_add],
calc dist x y ≤ dist x (f x) + dist y (f y) + dist (f x) (f y) : dist_triangle4_right _ _ _ _
          ... ≤ dist x (f x) + dist y (f y) + K * dist x y :
  add_le_add_left (hf.dist_le_mul _ _) _

lemma dist_le_of_fixed_point (x) {y} (hy : is_fixed_pt f y) :
  dist x y ≤ (dist x (f x)) / (1 - K) :=
by simpa only [hy.eq, dist_self, add_zero] using hf.dist_inequality x y

theorem fixed_point_unique' {x y} (hx : is_fixed_pt f x) (hy : is_fixed_pt f y) : x = y :=
(hf.eq_or_edist_eq_top_of_fixed_points hx hy).resolve_right (edist_ne_top _ _)

/-- Let `f` be a contracting map with constant `K`; let `g` be another map uniformly
`C`-close to `f`. If `x` and `y` are their fixed points, then `dist x y ≤ C / (1 - K)`. -/

noncomputable theory

variables [nonempty α] [complete_space α]

variable (f)
/-- The unique fixed point of a contracting map in a nonempty complete metric space. -/
def fixed_point : α :=
efixed_point f hf _ (edist_lt_top (classical.choice ‹nonempty α›) _)
variable {f}

/-- The point provided by `contracting_with.fixed_point` is actually a fixed point. -/
lemma fixed_point_is_fixed_pt : is_fixed_pt f (fixed_point f hf) :=
hf.efixed_point_is_fixed_pt _

lemma fixed_point_unique {x} (hx : is_fixed_pt f x) : x = fixed_point f hf :=
hf.fixed_point_unique' hx hf.fixed_point_is_fixed_pt

lemma dist_fixed_point_le (x) : dist x (fixed_point f hf) ≤ (dist x (f x)) / (1 - K) :=
hf.dist_le_of_fixed_point x hf.fixed_point_is_fixed_pt

/-- Aposteriori estimates on the convergence of iterates to the fixed point. -/
lemma aposteriori_dist_iterate_fixed_point_le (x n) :
  dist (f^[n] x) (fixed_point f hf) ≤ (dist (f^[n] x) (f^[n+1] x)) / (1 - K) :=
by { rw [iterate_succ'], apply hf.dist_fixed_point_le }

lemma apriori_dist_iterate_fixed_point_le (x n) :
  dist (f^[n] x) (fixed_point f hf) ≤ (dist x (f x)) * K^n / (1 - K) :=
le_trans (hf.aposteriori_dist_iterate_fixed_point_le x n) $
  (div_le_div_right hf.one_sub_K_pos).2 $
    hf.to_lipschitz_with.dist_iterate_succ_le_geometric x n

lemma tendsto_iterate_fixed_point (x) :
  tendsto (λn, f^[n] x) at_top (𝓝 $ fixed_point f hf) :=
begin
  convert tendsto_iterate_efixed_point hf (edist_lt_top x _),
  refine (fixed_point_unique _ _).symm,
  apply efixed_point_is_fixed_pt
end

lemma fixed_point_lipschitz_in_map {g : α → α} (hg : contracting_with K g)
  {C} (hfg : ∀ z, dist (f z) (g z) ≤ C) :
  dist (fixed_point f hf) (fixed_point g hg) ≤ C / (1 - K) :=
hf.dist_fixed_point_fixed_point_of_dist_le' g hf.fixed_point_is_fixed_pt
  hg.fixed_point_is_fixed_pt hfg

end contracting_with


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/

prelude
import init.data.nat.lemmas init.meta.well_founded_tactics

universe u

namespace nat

def bodd_div2 : ℕ → bool × ℕ
| 0        := (ff, 0)
| (succ n) :=
    match bodd_div2 n with
    | (ff, m) := (tt, m)
    | (tt, m) := (ff, succ m)
    end

def div2 (n : ℕ) : ℕ := (bodd_div2 n).2

def bodd (n : ℕ) : bool := (bodd_div2 n).1

@[simp] lemma bodd_zero : bodd 0 = ff := rfl
lemma bodd_one : bodd 1 = tt := rfl
lemma bodd_two : bodd 2 = ff := rfl

@[simp] lemma bodd_succ (n : ℕ) : bodd (succ n) = bnot (bodd n) :=
by unfold bodd bodd_div2; cases bodd_div2 n; cases fst; refl

@[simp] lemma bodd_add (m n : ℕ) : bodd (m + n) = bxor (bodd m) (bodd n) :=
begin
    induction n with n IH,
    { simp, cases bodd m; refl },
    { simp [add_succ, IH], cases bodd m; cases bodd n; refl }
end

@[simp] lemma bodd_mul (m n : ℕ) : bodd (m * n) = bodd m && bodd n :=
begin
    induction n with n IH,
    { simp, cases bodd m; refl },
    { simp [mul_succ, IH], cases bodd m; cases bodd n; refl }
end

lemma mod_two_of_bodd (n : ℕ) : n % 2 = cond (bodd n) 1 0 :=
begin
    have := congr_arg bodd (mod_add_div n 2),
    simp [bnot] at this,
    rw [show ∀ b, ff && b = ff, by intros; cases b; refl,
        show ∀ b, bxor b ff = b, by intros; cases b; refl] at this,
    rw [← this],
    cases mod_two_eq_zero_or_one n with h h; rw h; refl
end

@[simp] lemma div2_zero : div2 0 = 0 := rfl
lemma div2_one : div2 1 = 0 := rfl
lemma div2_two : div2 2 = 1 := rfl

@[simp] lemma div2_succ (n : ℕ) : div2 (succ n) = cond (bodd n) (succ (div2 n)) (div2 n) :=
by unfold bodd div2 bodd_div2; cases bodd_div2 n; cases fst; refl

local attribute [simp] nat.add_comm nat.add_assoc nat.add_left_comm nat.mul_comm nat.mul_assoc

theorem bodd_add_div2 : ∀ n, cond (bodd n) 1 0 + 2 * div2 n = n
| 0        := rfl
| (succ n) := begin
    simp,
    refine eq.trans _ (congr_arg succ (bodd_add_div2 n)),
    cases bodd n; simp [cond, bnot],
    { rw [nat.add_comm, nat.zero_add], },
    { rw [succ_mul, nat.add_comm 1, nat.zero_add] }
end

theorem div2_val (n) : div2 n = n / 2 :=
begin
  refine nat.eq_of_mul_eq_mul_left dec_trivial
      (nat.add_left_cancel (eq.trans _ (nat.mod_add_div n 2).symm)),
  rw [mod_two_of_bodd, bodd_add_div2]
end

def bit (b : bool) : ℕ → ℕ := cond b bit1 bit0

lemma bit0_val (n : nat) : bit0 n = 2 * n :=
calc n + n = 0 + n + n : by rw nat.zero_add
       ... = n * 2 : rfl
       ... = 2 * n : nat.mul_comm _ _

lemma bit1_val (n : nat) : bit1 n = 2 * n + 1 := congr_arg succ (bit0_val _)

lemma bit_val (b n) : bit b n = 2 * n + cond b 1 0 :=
by { cases b, apply bit0_val, apply bit1_val }

lemma bit_decomp (n : nat) : bit (bodd n) (div2 n) = n :=
(bit_val _ _).trans $ (nat.add_comm _ _).trans $ bodd_add_div2 _

def bit_cases_on {C : nat → Sort u} (n) (h : ∀ b n, C (bit b n)) : C n :=
by rw [← bit_decomp n]; apply h

lemma bit_zero : bit ff 0 = 0 := rfl

def shiftl' (b : bool) (m : ℕ) : ℕ → ℕ
| 0     := m
| (n+1) := bit b (shiftl' n)

def shiftl : ℕ → ℕ → ℕ := shiftl' ff

@[simp] theorem shiftl_zero (m) : shiftl m 0 = m := rfl
@[simp] theorem shiftl_succ (m n) : shiftl m (n + 1) = bit0 (shiftl m n) := rfl

def shiftr : ℕ → ℕ → ℕ
| m 0     := m
| m (n+1) := div2 (shiftr m n)

def test_bit (m n : ℕ) : bool := bodd (shiftr m n)

def binary_rec {C : nat → Sort u} (z : C 0) (f : ∀ b n, C n → C (bit b n)) : Π n, C n
| n := if n0 : n = 0 then by rw n0; exact z else let n' := div2 n in
    have n' < n, begin
      change div2 n < n, rw div2_val,
      apply (div_lt_iff_lt_mul _ _ (succ_pos 1)).2,
      have := nat.mul_lt_mul_of_pos_left (lt_succ_self 1)
        (lt_of_le_of_ne n.zero_le (ne.symm n0)),
      rwa nat.mul_one at this
    end,
    by rw [← show bit (bodd n) n' = n, from bit_decomp n]; exact
    f (bodd n) n' (binary_rec n')

def size : ℕ → ℕ := binary_rec 0 (λ_ _, succ)

def bits : ℕ → list bool := binary_rec [] (λb _ IH, b :: IH)

def bitwise (f : bool → bool → bool) : ℕ → ℕ → ℕ :=
binary_rec
    (λn, cond (f ff tt) n 0)
    (λa m Ia, binary_rec
      (cond (f tt ff) (bit a m) 0)
      (λb n _, bit (f a b) (Ia n)))

def lor   : ℕ → ℕ → ℕ := bitwise bor
def land  : ℕ → ℕ → ℕ := bitwise band
def ldiff : ℕ → ℕ → ℕ := bitwise (λ a b, a && bnot b)
def lxor  : ℕ → ℕ → ℕ := bitwise bxor

@[simp] lemma binary_rec_zero {C : nat → Sort u} (z : C 0) (f : ∀ b n, C n → C (bit b n)) :
    binary_rec z f 0 = z :=
by {rw [binary_rec], refl}

/- bitwise ops -/

lemma bodd_bit (b n) : bodd (bit b n) = b :=
by rw bit_val; simp; cases b; cases bodd n; refl

lemma div2_bit (b n) : div2 (bit b n) = n :=
by rw [bit_val, div2_val, nat.add_comm, add_mul_div_left, div_eq_of_lt, nat.zero_add];
   cases b; exact dec_trivial

lemma shiftl'_add (b m n) : ∀ k, shiftl' b m (n + k) = shiftl' b (shiftl' b m n) k
| 0     := rfl
| (k+1) := congr_arg (bit b) (shiftl'_add k)

lemma shiftl_add : ∀ m n k, shiftl m (n + k) = shiftl (shiftl m n) k := shiftl'_add _

lemma shiftr_add (m n) : ∀ k, shiftr m (n + k) = shiftr (shiftr m n) k
| 0     := rfl
| (k+1) := congr_arg div2 (shiftr_add k)

lemma shiftl'_sub (b m) : ∀ {n k}, k ≤ n → shiftl' b m (n - k) = shiftr (shiftl' b m n) k
| n     0     h := rfl
| (n+1) (k+1) h := begin
  simp [shiftl'], rw [nat.add_comm, shiftr_add],
  simp [shiftr, div2_bit],
  apply shiftl'_sub (nat.le_of_succ_le_succ h)
end

lemma shiftl_sub : ∀ m {n k}, k ≤ n → shiftl m (n - k) = shiftr (shiftl m n) k := shiftl'_sub _

@[simp] lemma test_bit_zero (b n) : test_bit (bit b n) 0 = b := bodd_bit _ _

lemma test_bit_succ (m b n) : test_bit (bit b n) (succ m) = test_bit n m :=
have bodd (shiftr (shiftr (bit b n) 1) m) = bodd (shiftr n m),
  by dsimp [shiftr]; rw div2_bit,
by rw [← shiftr_add, nat.add_comm] at this; exact this

lemma binary_rec_eq {C : nat → Sort u} {z : C 0} {f : ∀ b n, C n → C (bit b n)}
  (h : f ff 0 z = z) (b n) :
  binary_rec z f (bit b n) = f b n (binary_rec z f n) :=
begin
  rw [binary_rec],
  with_cases { by_cases bit b n = 0 },
  case pos : h' {
    simp [dif_pos h'],
    generalize : binary_rec._main._pack._proof_1 (bit b n) h' = e,
    revert e,
    have bf := bodd_bit b n,
    have n0 := div2_bit b n,
    rw h' at bf n0,
    simp at bf n0,
    rw [← bf, ← n0, binary_rec_zero],
    intros, exact h.symm },
  case neg : h' {
    simp [dif_neg h'],
    generalize : binary_rec._main._pack._proof_2 (bit b n) = e,
    revert e,
    rw [bodd_bit, div2_bit],
    intros, refl}
end

lemma bitwise_bit_aux {f : bool → bool → bool} (h : f ff ff = ff) :
  @binary_rec (λ_, ℕ)
    (cond (f tt ff) (bit ff 0) 0)
    (λ b n _, bit (f ff b) (cond (f ff tt) n 0)) =
  λ (n : ℕ), cond (f ff tt) n 0 :=
begin
  funext n,
  apply bit_cases_on n, intros b n, rw [binary_rec_eq],
  { cases b; try {rw h}; induction fft : f ff tt; simp [cond]; refl },
  { rw [h, show cond (f ff tt) 0 0 = 0, by cases f ff tt; refl,
           show cond (f tt ff) (bit ff 0) 0 = 0, by cases f tt ff; refl]; refl }
end

@[simp] lemma bitwise_zero_left (f : bool → bool → bool) (n) :
  bitwise f 0 n = cond (f ff tt) n 0 :=
by unfold bitwise; rw [binary_rec_zero]

@[simp] lemma bitwise_zero_right (f : bool → bool → bool) (h : f ff ff = ff) (m) :
  bitwise f m 0 = cond (f tt ff) m 0 :=
by unfold bitwise; apply bit_cases_on m; intros;
   rw [binary_rec_eq, binary_rec_zero]; exact bitwise_bit_aux h

@[simp] lemma bitwise_zero (f : bool → bool → bool) :
  bitwise f 0 0 = 0 :=
by rw bitwise_zero_left; cases f ff tt; refl

@[simp] lemma bitwise_bit {f : bool → bool → bool} (h : f ff ff = ff) (a m b n) :
  bitwise f (bit a m) (bit b n) = bit (f a b) (bitwise f m n) :=
begin
  unfold bitwise,
  rw [binary_rec_eq, binary_rec_eq],
  { induction ftf : f tt ff; dsimp [cond],
    rw [show f a ff = ff, by cases a; assumption],
    apply @congr_arg _ _ _ 0 (bit ff), tactic.swap,
    rw [show f a ff = a, by cases a; assumption],
    apply congr_arg (bit a),
    all_goals {
      apply bit_cases_on m, intros a m,
      rw [binary_rec_eq, binary_rec_zero],
      rw [← bitwise_bit_aux h, ftf], refl } },
  { exact bitwise_bit_aux h }
end

theorem bitwise_swap {f : bool → bool → bool} (h : f ff ff = ff) :
  bitwise (function.swap f) = function.swap (bitwise f) :=
begin
  funext m n, revert n,
  dsimp [function.swap],
  apply binary_rec _ (λ a m' IH, _) m; intro n,
  { rw [bitwise_zero_left, bitwise_zero_right], exact h },
  apply bit_cases_on n; intros b n',
  rw [bitwise_bit, bitwise_bit, IH]; exact h
end

@[simp] lemma lor_bit : ∀ (a m b n),
  lor (bit a m) (bit b n) = bit (a || b) (lor m n) := bitwise_bit rfl
@[simp] lemma land_bit : ∀ (a m b n),
  land (bit a m) (bit b n) = bit (a && b) (land m n) := bitwise_bit rfl
@[simp] lemma ldiff_bit : ∀ (a m b n),
  ldiff (bit a m) (bit b n) = bit (a && bnot b) (ldiff m n) := bitwise_bit rfl
@[simp] lemma lxor_bit : ∀ (a m b n),
  lxor (bit a m) (bit b n) = bit (bxor a b) (lxor m n) := bitwise_bit rfl

@[simp] lemma test_bit_bitwise {f : bool → bool → bool} (h : f ff ff = ff) (m n k) :
  test_bit (bitwise f m n) k = f (test_bit m k) (test_bit n k) :=
begin
  revert m n; induction k with k IH; intros m n;
  apply bit_cases_on m; intros a m';
  apply bit_cases_on n; intros b n';
  rw bitwise_bit h,
  { simp [test_bit_zero] },
  { simp [test_bit_succ, IH] }
end

@[simp] lemma test_bit_lor : ∀ (m n k),
  test_bit (lor m n) k = test_bit m k || test_bit n k := test_bit_bitwise rfl
@[simp] lemma test_bit_land : ∀ (m n k),
  test_bit (land m n) k = test_bit m k && test_bit n k := test_bit_bitwise rfl
@[simp]


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic
import data.real.basic
import analysis.calculus.parametric_integral

/-

# Smooth functions

-/

noncomputable def φ₁ : ℝ → ℝ × ℝ :=
λ x, (real.cos x, real.sin x)

-- `cont_diff_on.prod` is a thing etc etc
example : cont_diff_on ℝ ⊤ φ₁ (set.Icc 0 1) :=
begin
  sorry,
end

open real
noncomputable def φ₂ : ℝ → ℝ × ℝ × ℝ :=
λ x, (real.sin x, x^4+37*x^2+1, abs x)

example : cont_diff_on ℝ ⊤ φ₂ (set.Icc 0 1) :=
sorry

-- AFAIK nobody did the below example yet (including me)

/- Let `a≤b` and `c≤d` be reals. Let φ : [a,b] → [c,d] and ψ : [c,d] → [a,b]
  be inverse bijections, and assume φ is smooth and φ' is nonvanishing
  on [a,b]. Then ψ is smooth and ψ' is nonvanishing on [c,d],
  and ψ'(y)*φ'(ψ(y))=1.
-/
example (φ : ℝ → ℝ) (ψ : ℝ → ℝ) (a b c d : ℝ)
  (hab : a ≤ b) (hcd : c ≤ d) (hφ : ∀ x, x ∈ set.Icc a b → φ x ∈ set.Icc c d)
  (hψ : ∀ y, y ∈ set.Icc c d → ψ y ∈ set.Icc a b)
  (left_inv : ∀ x, x ∈ set.Icc a b → ψ (φ x) = x)
  (right_inv : ∀ y, y ∈ set.Icc c d → φ (ψ y) = y)
  (hφdiff : cont_diff_on ℝ ⊤ φ (set.Icc a b))
  (hφregular : ∀ x, x ∈ set.Icc a b → fderiv ℝ φ x ≠ 0) :
  cont_diff_on ℝ ⊤ ψ (set.Icc c d) ∧
  ∀ y, y ∈ set.Icc c d → ∀ z, fderiv ℝ ψ y (fderiv ℝ φ (ψ(y)) z) = z :=
sorry

/-
Heather Macbeth: @Kevin Buzzard This is a toy case of the inverse function theorem,
but you might need to glue together several related results. Some starting points:
docs#cont_diff_at.to_local_inverse, docs#has_strict_fderiv_at.local_inverse_unique

Heather Macbeth: If you want to construct the inverse, and you want to avoid invoking
the inverse function theorem on Banach spaces, you can also route through order theory
for a purely one-dimensional construction. Look at the construction of docs#real.arctan
for a model; it uses docs#strict_mono_on.order_iso
-/


import data.list.sort
import data.list.basic
import data.multiset
import data.set
import tactic.induction
import tactic.ring
import algebra.order.field
import algebra.order.ring
import tactic.linarith
import init.default

set_option trace.simplify.rewrite true

variable {α : Type*}
variable r: α → α → Prop
variables xs ys: list α
variable x: α

/-
This files contains some functions and lemmas that are predefined in __Function Algorithms, Verified!__ and the Isabelle code,
but not in Lean.
-/

def list.to_set : list α → set α -- Source: chapter 10.6 Theorem Proving in Lean.
| []     := ∅
| (h::t) := {h} ∪ list.to_set t

def multiset.to_set: multiset α → set α :=
λ m: multiset α, {x: α | x ∈ m }

lemma member_list_set : x ∈ xs ↔ x ∈ xs.to_set :=
begin
  induction' xs,
  repeat { simp [list.to_set, *], },
end

/-
This definition follows the definition in __Functional Algorithms, Verified!__
instead of using the predefined function sorted in Lean
in order to follow the structure of the proofs.
-/
def sorted' [is_linear_order α r] : list α → Prop
| [] := true
| (h::t) := (∀ y ∈ t.to_set, r h y ) ∧ sorted' t

lemma set_mset_mset: multiset.to_set ↑xs = list.to_set xs :=
begin
  induction' xs,
  { refl},
  { simp [list.to_set,← ih, multiset.to_set, set.insert_def] }
end

lemma mset_append : (↑ (xs ++ ys): multiset α) = ↑ xs + ↑ ys :=
begin
  simp,
end

lemma set_append: (xs ++ ys).to_set = xs.to_set ∪ ys.to_set:=
begin
  simp [← set_mset_mset, multiset.to_set],
  refl,
end

lemma sorted'_append [is_linear_order α r] :
  sorted' r (xs ++ ys) ↔ sorted' r xs ∧ sorted' r ys ∧ (∀ (x ∈ xs), ∀ (y ∈ ys), r x y) :=
begin
  induction' xs fixing *,
  { simp [sorted']},
  simp [sorted', ih, set_append],
  apply iff.intro,
  { intro h,
    apply and.intro,
    { apply and.intro,
      {
        intros,
        exact h.left y (or.inl H), },
      exact h.right.left},
    apply and.intro,
    { exact h.right.right.left},
    apply and.intro,
    { intros,
      have h2: y ∈ ys.to_set, from iff.elim_left (member_list_set ys y) H,
      exact  h.left y (or.inr h2), },
    exact h.right.right.right},
  intro h,
  apply and.intro,
  { intros,
    apply or.elim H,
    { exact h.left.left y },
    intro h1,
    have h2: y ∈ ys, from iff.elim_right (member_list_set ys y) h1,
    exact h.right.right.left y h2 },
  apply and.intro,
  { exact h.left.right},
  apply and.intro,
  { exact h.right.left},
  exact h.right.right.right
end


import data.real.basic

#check sub_self
#check abs_zero

def converges_to (s : ℕ → ℝ) (a : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, abs (s n - a) < ε

theorem converges_to_const (a : ℝ) : converges_to (λ x : ℕ, a) a :=
begin
  intros ε epos,
  dsimp,
  rw sub_self,
  norm_num,
  use 0,
  intros n nge,
  exact epos,
end

example (a : ℝ) : converges_to (λ x : ℕ, a) a :=
begin
  intros ε epos,
  use 0,
  intros n nge,
  dsimp,
  rw sub_self,
  rw abs_zero,
  apply epos,
end


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import combinatorics.set_family.harris_kleitman
import combinatorics.set_family.intersecting

/-!
# Kleitman's bound on the size of intersecting families

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

An intersecting family on `n` elements has size at most `2ⁿ⁻¹`, so we could naïvely think that two
intersecting families could cover all `2ⁿ` sets. But actually that's not case because for example
none of them can contain the empty set. Intersecting families are in some sense correlated.
Kleitman's bound stipulates that `k` intersecting families cover at most `2ⁿ - 2ⁿ⁻ᵏ` sets.

## Main declarations

* `finset.card_bUnion_le_of_intersecting`: Kleitman's theorem.

## References

* [D. J. Kleitman, *Families of non-disjoint subsets*][kleitman1966]
-/

open finset fintype (card)

variables {ι α : Type*} [fintype α] [decidable_eq α] [nonempty α]

/-- **Kleitman's theorem**. An intersecting family on `n` elements contains at most `2ⁿ⁻¹` sets, and
each further intersecting family takes at most half of the sets that are in no previous family. -/
lemma finset.card_bUnion_le_of_intersecting (s : finset ι) (f : ι → finset (finset α))
  (hf : ∀ i ∈ s, (f i : set (finset α)).intersecting) :
  (s.bUnion f).card ≤ 2 ^ card α - 2 ^ (card α - s.card) :=
begin
  obtain hs | hs := le_total (card α) s.card,
  { rw [tsub_eq_zero_of_le hs, pow_zero],
    refine (card_le_of_subset $  bUnion_subset.2 $ λ i hi a ha, mem_compl.2 $ not_mem_singleton.2 $
      (hf _ hi).ne_bot ha).trans_eq _,
    rw [card_compl, fintype.card_finset, card_singleton] },
  induction s using finset.cons_induction with i s hi ih generalizing f,
  { simp },
  classical,
  set f' : ι → finset (finset α) := λ j,
    if hj : j ∈ cons i s hi then (hf j hj).exists_card_eq.some else ∅ with hf',
  have hf₁ : ∀ j, j ∈ cons i s hi →
    f j ⊆ f' j ∧ 2 * (f' j).card = 2 ^ card α ∧ (f' j : set (finset α)).intersecting,
  { rintro j hj,
    simp_rw [hf', dif_pos hj, ←fintype.card_finset],
    exact classical.some_spec (hf j hj).exists_card_eq },
  have hf₂ : ∀ j, j ∈ cons i s hi → is_upper_set (f' j : set (finset α)),
  { refine λ j hj, (hf₁ _ hj).2.2.is_upper_set' ((hf₁ _ hj).2.2.is_max_iff_card_eq.2 _),
    rw fintype.card_finset,
    exact (hf₁ _ hj).2.1 },
  refine (card_le_of_subset $ bUnion_mono $ λ j hj, (hf₁ _ hj).1).trans _,
  nth_rewrite 0 cons_eq_insert i,
  rw bUnion_insert,
  refine (card_mono $ @le_sup_sdiff _ _ _ $ f' i).trans ((card_union_le _ _).trans _),
  rw [union_sdiff_left, sdiff_eq_inter_compl],
  refine le_of_mul_le_mul_left _ (pow_pos zero_lt_two $ card α + 1),
  rw [pow_succ', mul_add, mul_assoc, mul_comm _ 2, mul_assoc],
  refine (add_le_add ((mul_le_mul_left $ pow_pos (zero_lt_two' ℕ) _).2
    (hf₁ _ $ mem_cons_self _ _).2.2.card_le) $ (mul_le_mul_left $ zero_lt_two' ℕ).2 $
    is_upper_set.card_inter_le_finset _ _).trans _,
  { rw coe_bUnion,
    exact is_upper_set_Union₂ (λ i hi, hf₂ _ $ subset_cons _ hi) },
  { rw coe_compl,
    exact (hf₂ _ $ mem_cons_self _ _).compl },
  rw [mul_tsub, card_compl, fintype.card_finset, mul_left_comm, mul_tsub,
    (hf₁ _ $ mem_cons_self _ _).2.1, two_mul, add_tsub_cancel_left, ←mul_tsub, ←mul_two, mul_assoc,
    ←add_mul, mul_comm],
  refine mul_le_mul_left' _ _,
  refine (add_le_add_left (ih ((card_le_of_subset $ subset_cons _).trans hs) _ $ λ i hi,
    (hf₁ _ $ subset_cons _ hi).2.2) _).trans _,
  rw [mul_tsub, two_mul, ←pow_succ, ←add_tsub_assoc_of_le (pow_le_pow' (one_le_two : (1 : ℕ) ≤ 2)
    tsub_le_self), tsub_add_eq_add_tsub hs, card_cons, add_tsub_add_eq_tsub_right],
end


import Mathlib.Data.Nat.Prime

namespace Intro
/-
We can declare variables of type Prop as
-/
variable (p q : Prop)

/-
Terms of type (p : Prop) are _proofs_ of the proposition p.

We state a theorem to declare we want to produce a proof
-/
theorem foo : p := sorry

/-
Of course we cannot fill in this sorry. Not every proposition in
that can be stated in Lean will have a proof. For example,
-/
theorem crazy : ∀ (n : ℕ), Nat.Prime n := sorry

def notGood : Prop := ∀ (n : ℕ), Nat.Prime n

theorem also_crazy : notGood := sorry

end Intro
/-
Under the rules of propositional and higher logics, there are
a handful of ways to make new propositions, called _connectives_,
and a handful to rules to produce new proofs from old ones, _rules
of inference_.

The connectives in propositional logic are
- implication : p → q
- conjunction : p ∧ q
- disjunction : p ∨ q
- negation : ¬ p
- bi-implication : p ↔ q

Each takes an existing set of propositions and constructs a new one.
They can be iterated, eg (p ↔ q) ∨ ¬ p → q. Note that parentheses
are important for the order of application of the connectives.

Each connective comes with rules for providing a proof, introduction
rules, and using as a hypothesis, elimination rules.
-/

/-
Implication

Suppose we have (p q : Prop). What do we need to produce a proof of
p → q? Well, whenever we have a proof of p, we need to construct
a proof of q. In Lean, we can see the difference syntactically.
-/

variable {p q r : Prop}

theorem imp (h : p) : q := sorry

theorem imp' : p → q := sorry

/-
The introduction rule says that give `imp` we can conclude `imp'`.
In Lean, we can give a proof of `imp'` using `imp` and the
tactics `intro` and `exact`.
-/

example : p → q := by
  intro h -- the goal is now q and we have (h : p) in the context
  exact imp h  -- tells Lean that `imp h` is _exactly_ the term we want

/-
The elimination rule says that give `f : p → q` and `h : p` we can
conclude `q`.
-/

example (h : p) (f : p → q) : q := by
  apply f
  exact h

example (h : p) : p := by
  exact h

example : p → p := by
  intro h
  exact h

/-
In Lean, propositional implication is a function type. Application is
elimination. The tactic `apply` allows us to replace a goal `β` with
`α` if we have a term of type `α → β` in the context.
-/

/-
Unlike implication, conjunction is defined separately in Lean. In Lean
core, it is defined as.

structure And (a b : Prop) : Prop where
  /-- `And.intro : a → b → a ∧ b` is the constructor for the And operation. -/
  intro ::
  /-- Extract the left conjunct from a conjunction. `h : a ∧ b` then
  `h.left`, also notated as `h.1`, is a proof of `a`. -/
  left : a
  /-- Extract the right conjunct from a conjunction. `h : a ∧ b` then
  `h.right`, also notated as `h.2`, is a proof of `b`. -/
  right : b

Built into its definition are its introduction `intro` and its two
elimination rules `left` and `right`.

-/

example (u v w : Prop) : (u ∧ v → w) → u → v → w := by
  intro h hp hq
  apply h
  apply And.intro
  · exact hp
  · exact hq

example : (p ∧ q) → p := by
  intro h
  exact h.left

example : (p ∧ q) ∧ r → p ∧ q ∧ r := by
  sorry

example (h : r → p) (h' : r → q) : r → p ∧ q := by
  intro h₃
  apply And.intro
  . exact h h₃
  . exact h' h₃

/-
Disjunction is also its own type.

`Or a b`, or `a ∨ b`, is the disjunction of propositions. There are two
constructors for `Or`, called `Or.inl : a → a ∨ b` and `Or.inr : b → a ∨ b`,
and you can use `match` or `cases` to destruct an `Or` assumption into the
two cases.

inductive Or (a b : Prop) : Prop where
  /-- `Or.inl` is "left injection" into an `Or`. If `h : a` then `Or.inl h : a ∨ b`. -/
  | inl (h : a) : Or a b
  /-- `Or.inr` is "right injection" into an `Or`. If `h : b` then `Or.inr h : a ∨ b`. -/
  | inr (h : b) : Or a b

Disjunction has two introduction rules, intro left or `inl` and intro right or `inr`.
It's elimination rule is derived from the fact it is an inductive type.
-/

example : (p → q) → (q → q ∨ r) := by
  intro _ hq
  exact .inl hq

example : p ∨ q → (p → r) → (q → r) → r := by
  intro h₁ h₂ h₃
  match h₁ with
  | .inl h => exact h₂ h
  | .inr h => exact h₃ h

/-
Negatation relies on `False : Prop`.

`False` is the empty proposition. Thus, it has no introduction rules.
It represents a contradiction. `False` elimination rule
expresses the fact that anything follows from a contradiction.
This rule is sometimes called ex falso (short for ex falso sequitur quodlibet),
or the principle of explosion.

inductive False : Prop

-/

example (f : False) : crazy := by
  cases f
  -- exact f.elim

/-
There is a corresponding type `True : Prop` with a single constructor.
`True.intro`.

By definition in Lean, `¬ p` is _defined as_ `p → False`.
-/

example : (p → q) → ¬ q → ¬ p := sorry

example : ¬ p ∨ ¬ q → ¬ (p ∧ q) := sorry

/-
Finally bi-implication or if-and-only-if looks a bit similar to `And`
under the hood.

If and only if, or logical bi-implication. `a ↔ b` means that `a` implies `b`
and vice versa.

structure Iff (a b : Prop) : Prop where
  /-- If `a → b` and `b → a` then `a` and `b` are equivalent. -/
  intro ::
  /-- Modus ponens for if and only if. If `a ↔ b` and `a`, then `b`. -/
  mp : a → b
  /-- Modus ponens for if and only if, reversed. If `a ↔ b` and `b`, then `a`. -/
  mpr : b → a
-/

example (h : p ↔ q) : (q → r) → p → r := sorry

example : ¬ (p ↔ ¬ p) := sorry