/-- These are lemmas i found myself proving in the course of producing full_proof, i am aware that
    there is heavy redundency -/

lemma lt_irrfl : ∀ n : ℕ, ¬ n < n :=
begin
 intro n,
 induction n with n hn,
 { intro hz, cases hz with r hr, },
 { intro h,
   apply hn,
   exact nat.lt_of_succ_lt_succ h, },
end

lemma add_succ_commute : ∀ m n : ℕ, nat.add m (nat.succ n) = nat.succ (nat.add m n) :=
begin
 intros m n,
 exact rfl,
end

lemma add_succ_commute' : ∀ m n : ℕ, nat.add (nat.succ m) n = nat.succ (nat.add m n) :=
begin
 intros m n,
 exact nat.succ_add m n,
end

-- i think this one could be tidied up
lemma lt_succ_add : ∀ m n : ℕ, m < nat.succ (nat.add m n) :=
begin
 intros m n,
 apply nat.lt_succ_of_le,
 induction n with n hn,
 { have h : nat.add m 0 = m,
   { exact nat.add_zero m, },
   apply nat.le_of_eq,
   rw h, },
 { calc
    m     ≤ nat.add m n : by exact hn
      ... ≤ nat.succ (nat.add m n) : by exact nat.le_of_lt (nat.lt_succ_of_le (nat.le_of_eq rfl))
      ... = nat.add m (nat.succ n) : by { symmetry, exact add_succ_commute m n },
 },
end

lemma succ_add_nlt : ∀ m n : ℕ, ¬ nat.succ (nat.add m n) < m :=
begin
 intros m n h,
 have h' := lt_succ_add m n,
 have h'' := lt_irrfl m,
 apply h'',
 exact nat.lt_trans h' h,
end

-- again, could be tidied up
lemma succ_add_minus_is_succ : ∀ m n : ℕ, nat.succ (nat.add m n) - m = nat.succ n :=
begin
 intros m n,
 induction n with n hn,
 { have h : nat.add m 0 = m,
   { exact nat.add_zero m, },
   have h' : 1 = nat.succ (m - m),
   { rw nat.sub_self m, },
   calc
    nat.succ (nat.add m 0) - m     = nat.succ m - m : by rw h
                               ... = nat.succ (m - m) : by exact nat.succ_sub (nat.le_of_eq rfl)
                               ... = 1 : by { symmetry, exact h' },
 },
 {
   calc
    nat.succ (nat.add m (nat.succ n)) - m
        = nat.succ (nat.succ (nat.add m n)) - m : by rw add_succ_commute
    ... = nat.succ (nat.succ (nat.add m n) - m) : by exact nat.succ_sub
                                                     (nat.le_of_lt (lt_succ_add m n))
    ... = nat.succ (nat.succ n)                 : by rw hn,
 },
end

lemma lt_decidable : ∀ m n : ℕ, n < m ∨ ¬ n < m :=
begin
 intros m n,
 have h : n ≤ m ∨ m ≤ n,
 { exact nat.le_total, },
 { cases h,
   have h' : n = m ∨ n < m,
   { exact nat.eq_or_lt_of_le h, },
   cases h',
   { right,
     rw h',
     exact lt_irrfl m, },
   { left,
     exact h', },
 { right,
   have h' : m = n ∨ m < n,
   { exact nat.eq_or_lt_of_le h, },
   cases h',
   { rw h',
     exact lt_irrfl n, },
   { intro h'',
     apply lt_irrfl m,
     exact nat.lt_trans h' h'', },},},
end


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

/-

# A harder question about lattices

I learnt this fact when preparing sheet 2.

With sets we have `A ∪ (B ∩ C) = (A ∪ B) ∩ (A ∪ C)`, and `A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C)`.
In sheet 2 we saw an explicit example (the lattice of subspaces of a 2-d vector space)
of a lattice where neither `A ⊓ (B ⊔ C) = (A ⊔ B) ⊓ (A ⊔ C)` nor `A ⊓ (B ⊔ C) = (A ⊓ B) ⊔ (A ⊓ C)`
held. But it turns out that in a general lattice, one equality holds if and only if the
other one does! This was quite surprising to me.

The challenge is to prove it in Lean. My strategy would be to prove it on paper first
and then formalise the proof. If you're not in to puzzles like this, then feel free to skip
this question.

-/

example (L : Type) [lattice L] :
  (∀ a b c : L, a ⊔ (b ⊓ c) = (a ⊔ b) ⊓ (a ⊔ c)) ↔ (∀ a b c : L, a ⊓ (b ⊔ c) = (a ⊓ b) ⊔ (a ⊓ c)) :=
begin
  sorry,
end


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

/-

## Orderings and lattices

In the last section we saw how subsets of a type worked, and we saw that
things like `⊆` and `∪` and `∩` made sense for subsets, and they satisfied
theorems such as `A ∩ B ⊆ B`. But it turns out that there is a more general
abstraction called a *lattice* which captures these kinds of ideas, and I'd
like to explain this concept in this section. Note that the word "lattice"
unfortunately means several things in mathematics; this is the use of the
word in the context of partial orders. So let me start by talking about
partial orders.

## Partial orders

A partial order (or a partially ordered type) is a type `X` equipped with
a concept of `≤` satisying some axioms. More precisely `X` is equipped
with a true-false statement `a ≤ b` for each `a b : X`, satisfying
the following axioms:

`le_refl a : a ≤ a`
`le_antisymm : a ≤ b → b ≤ a → a = b`
`le_trans : a ≤ b → b ≤ c → a ≤ c`

Examples of partial orders include the natural numbers and the real numbers. However
these examples are not quite representative, because a partial order does *not* have
the axiom that for all `a b : X` we have either `a ≤ b` or `b ≤ a`. A perhaps more
representative example of a partial order is the type `set X` of subsets of a type `X`,
with `a ≤ b` defined to mean `a ⊆ b`. For two general subsets `a` and `b` of `X`,
both `a ⊆ b` and `b ⊆ a` might be false.

-/

-- Let `X` be a partial order.
variables (X : Type) [partial_order X]

-- You can prove transitivity directly using the axiom
example (a b c : X) (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c :=
begin
  exact le_trans hab hbc
end

-- or you can use the `transitivity` tactic
example (a b c : X) (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c :=
begin
  transitivity b,
  { exact hab, },
  { exact hbc, },
end

-- Let a,b,c,d be arbitrary elements of `X`
variables (a b c d : X)

-- See if you can prove these basic facts about partial orders.
example : a ≤ a :=
begin
  sorry
end

example (hab : a ≤ b) (hbc : b ≤ c) (hcd : c ≤ d) : a ≤ d :=
begin
  sorry
end

example (hab : a ≤ b) (hbc : b ≤ c) (hca : c ≤ a) : a = b :=
begin
  sorry
end


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que la función identidad no está acotada
-- superiormente.
-- ----------------------------------------------------------------------

import .Funcion_no_acotada_superiormente

example : ¬ fn_has_ub (λ x, x) :=
begin
  apply no_has_ub,
  intro a,
  use a + 1,
  linarith,
end

-- Prueba
-- ------

-- ⊢ ¬fn_has_ub (λ (x : ℝ), x)
--    >> apply no_has_ub,
-- ⊢ ∀ (a : ℝ), ∃ (x : ℝ), x > a
--    >> intro a,
-- a : ℝ
-- ⊢ ∃ (x : ℝ), x > a
--    >> use a + 1,
-- ⊢ a + 1 > a
--    >> linarith,
-- no goals


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro p,
  intro q,
  exact q p,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  by_cases h : P,
  intro j,
  exact h,
  intro g,
  exfalso,
  exact g h,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  by_cases h : P,
  intro j,
  exact h,
  intro g,
  exfalso,
  exact g h,
  intro p,
  intro q,
  exact q p,
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro poq,
  cases poq with p q,
  right,
  exact p,
  left,
  exact q,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro peq,
  cases peq with p q,
  split,
  exact q,
  exact p,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro h,
  intro p,
  cases h with notp q,
  exfalso,
  exact notp p,
  exact q,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro poq,
  intro notp,
  cases poq with p q,
  exfalso,
  exact notp p,
  exact q,
end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro piq,
  intro nq,
  intro p,
  have q : Q := piq p,
  exact nq q,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro nqinp,
  intro p,
  by_contradiction hboom,
  have np := nqinp hboom,
  exact np p,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  intro piq,
  intro nq,
  by_contradiction hboom,
  have q := piq hboom,
  exact nq q,
  intro nqinp,
  intro p,
  by_contradiction hboom,
  have np := nqinp hboom,
  exact np p,
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro n_ponq,
  have r: P∨¬P,
  by_cases p:P,
  left,
  exact p,
  right,
  exact p,
  exact n_ponq r,
end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro piq_i_p,
  intro np,
  have piq : (P → Q),
  intro p,
  exfalso,
  exact np p,
  exact np(piq_i_p(piq)),
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro poq,
  by_contradiction npenq,
  cases npenq with np nq,
  cases poq with p q,
  exact np p,
  exact nq q,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro peq,
  by_contradiction nponq,
  cases peq with p q,
  cases nponq with np nq,
  exact np p,
  exact nq q,
end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro n_poq,
  split,
  intro p,
  have poq : (P∨Q),
  left,
  exact p,
  exact n_poq poq,
  intro q,
  have poq : (P∨Q),
  right,
  exact q,
  exact n_poq poq,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro npenq,
  cases npenq with np nq,
  by_contradiction poq,
  cases poq with p q,
  exact np p,
  exact nq q,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
sorry,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro nqonp,
  by_contradiction peq,
  cases nqonp with nq np,
  cases peq with p q,
  exact nq q,
  cases peq with p q,
  exact np p,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  sorry,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  sorry,
end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro pe_qor,
  cases pe_qor with p qor,
  cases qor with q r,
  left,
  split,
  exact p,
  exact q,
  right,
  split,
  exact p,
  exact r,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro peq_o_pe_qor,
  cases peq_o_pe_qor with peq per,
  cases peq with p q,
  split,
  exact p,
  left,
  exact q,
  split,
  cases per with p r,
  exact p,
  cases per with p r,
  right,
  exact r,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro po_qer,
  cases po_qer with p qer,
  split,
  left,
  exact p,
  left,
  exact p,
  cases qer with q r,
  split,
  right,
  exact q,
  right,
  exact r,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro poq_e_por,
  cases poq_e_por with poq por,
  cases poq with p q,
  left,
  exact p,
  cases por with p r,
  left,
  exact p,
  right,
  split,
  exact q,
  exact r,
end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro peq_i_r,
  intro p,
  intro q,
  have peq : P∧Q,
  split,
  exact p,
  exact q,
  exact peq_i_r peq,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro piqir,
  intro peq,
  cases peq with p q,
  have qir := piqir p,
  exact qir q,
end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro p,
  exact p,
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro p,
  left,
  exact p,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro q,
  right,
  exact q,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro peq,
  cases peq with p q,
  exact p,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro peq,
  cases peq with p q,
  exact q,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro pep,
  cases pep with p1 p2,
  exact p1,
  intro p,
  split,
  exact p,
  exact p,
end

theorem disj_idemp :
  (P∨P) ↔ P  :=
begin
  split,
  intro pop,
  cases pop with p1 p2,
  exact p1,
  exact p2,
  intro p,
  left,
  exact p,
end

end propositional

----------------------------------------------------------------

section predicate

variable U : Type
variables P Q : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intro none_P,
  intro x,
  intro P,
  apply none_P,
  existsi x,
  exact P,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro all_nP,
  intro some_P,
  cases some_P with x P,
  have nP := all_nP x,
  exact nP P,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  sorry,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro some_dont_P, --exists x such that not P of x
  intro all_P,  --for all x, P of x
  cases some_dont_P with x nPx,
  have Px := all_P x,
  exact nPx Px,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  sorry,
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  sorry,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intro some_P,
  intro all_nP,
  cases some_P with x Px,
  have nPx := all_nP x,
  exact nPx Px,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro all_P,
  intro some_nP,
  cases some_nP with x nPx,
  have Px := all_P x,
  exact nPx Px,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intro none_nP,
  by_contradiction n_all_P,
  apply n_all_P,
  intro x,
  by_contradiction n_P,
  apply none_nP,
  existsi x,
  exact n_P,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro n_all_nP,
  by_contradiction none_P,
  apply n_all_nP,
  intro x,
  intro p,
  apply none_P,
  existsi x,
  exact p,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  intro all_P,
  intro some_nP,
  cases some_nP with x nP,
  apply nP,
  exact all_P x,
  intro none_nP,
  by_contradiction n_all_P,
  apply none_nP,
  sorry,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  sorry,
end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro some_P_e_Q,
  cases some_P_e_Q with x P_e_Q,
  cases P_e_Q with P Q,
  split,
  existsi x,
  exact P,
  existsi x,
  exact Q,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro some_PoQ,
  cases some_PoQ with x P_o_Q,
  cases P_o_Q with P Q,
  left,
  existsi x,
  exact P,
  right,
  existsi x,
  exact Q,

end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro someP_or_someQ,
  cases someP_or_someQ with some_P some_Q,
  cases some_P with x Px,
  existsi x,
  left,
  exact Px,
  cases some_Q with x Qx,
  existsi x,
  right,
  exact Qx,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro allP_e_allQ,
  split,
  intro x,
  have P_e_Q := allP_e_allQ x,
  cases P_e_Q with P Q,
  exact P,
  intro x,
  have P_e_Q := allP_e_allQ x,
  cases P_e_Q with P Q,
  exact Q,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro allP_e_allQ,
  cases allP_e_allQ with allP allQ,
  intro x,
  split,
  exact allP x,
  exact allQ x,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro allP_or_allQ,
  intro x,
  cases allP_or_allQ with allP allQ,
  left,
  exact allP x,
  right,
  exact allQ x,
end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

---------------------------------------------- -/

end predicate


import tactic

def fib : ℕ -> ℤ
| 0 := 0
| 1 := 1
| (x+2) := fib (x) + fib (x+1)

lemma fib_rule (n : ℕ) : fib(n + 2) = fib(n) + fib(n + 1) := rfl

theorem strong_induction {P : ℕ → Prop} {H : ∀ n : ℕ, (∀ m : ℕ, m < n → P m) → P n} (n : ℕ) : P n := sorry, -- this is already proven

lemma fib_rule' (n : ℕ) (h : 0 < n) : fib (n + 1) = fib n + fib (n - 1) := sorry

theorem fib_add (m n : ℕ) (hm : 0 < m) : fib(m + n) = fib(n + 1) * fib(m) + fib(n) * fib(m - 1) :=
begin
  apply strong_induction n,
  -- use `intros` instead of `intro`
  intros k h,
  -- using by_cases instead of cases for... my eyes
  cases k,
  { simp [fib], },
  { cases k,
    { -- see how `fib_rule'` takes arguments, so i supply them? in `fib_rule' m hm`
      simp [fib, fib_rule' m hm],
    },
    { simp only [nat.succ_eq_add_one, add_assoc],
      norm_num,
      -- we "massage" things into the right form, then expand everything
      rw [← add_assoc, fib, nat.succ_eq_add_one, add_assoc m k 1],
      rw [h k _, h (k + 1) _],
      rw [fib_rule (k + 1), fib_rule k],
      -- and then ring gets rid of everything
      ring,
      exact nat.lt_succ_self _,
      exact lt_trans (nat.lt_succ_self _) (nat.lt_succ_self _),
    },
  },
end

example (m n : ℕ) (hm : m > 0) (h : m ∣ n): fib(m) ∣ fib(n) :=
begin
  rcases h with ⟨k, rfl⟩,
  induction k with k hk,
  { simp only [fib, mul_zero, dvd_zero], },
  { rw [nat.succ_eq_add_one, mul_add, add_comm, mul_one, fib_add m _ hm],
    simp only [dvd_add, dvd_mul_left, dvd_mul_of_dvd_left hk], },
end


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll

! This file was ported from Lean 3 source module data.fin.tuple.bubble_sort_induction
! leanprover-community/mathlib commit 50832daea47b195a48b5b33b1c8b2162c48c3afc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fin.Tuple.Sort
import Mathbin.Data.Fintype.Perm
import Mathbin.Order.WellFounded

/-!
# "Bubble sort" induction

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

We implement the following induction principle `tuple.bubble_sort_induction`
on tuples with values in a linear order `α`.

Let `f : fin n → α` and let `P` be a predicate on `fin n → α`. Then we can show that
`f ∘ sort f` satisfies `P` if `f` satisfies `P`, and whenever some `g : fin n → α`
satisfies `P` and `g i > g j` for some `i < j`, then `g ∘ swap i j` also satisfies `P`.

We deduce it from a stronger variant `tuple.bubble_sort_induction'`, which
requires the assumption only for `g` that are permutations of `f`.

The latter is proved by well-founded induction via `well_founded.induction_bot'`
with respect to the lexicographic ordering on the finite set of all permutations of `f`.
-/

namespace Tuple

#print Tuple.bubble_sort_induction' /-
/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P`
if `f` satsifies `P` and `P` is preserved on permutations of `f` when swapping two
antitone values. -/
theorem bubble_sort_induction' {n : ℕ} {α : Type _} [LinearOrder α] {f : Fin n → α}
    {P : (Fin n → α) → Prop} (hf : P f)
    (h :
      ∀ (σ : Equiv.Perm (Fin n)) (i j : Fin n),
        i < j → (f ∘ σ) j < (f ∘ σ) i → P (f ∘ σ) → P (f ∘ σ ∘ Equiv.swap i j)) :
    P (f ∘ sort f) :=
  by
  letI := @Preorder.lift _ (Lex (Fin n → α)) _ fun σ : Equiv.Perm (Fin n) => toLex (f ∘ σ)
  refine'
    @WellFounded.induction_bot' _ _ _ (@Finite.Preorder.wellFounded_lt (Equiv.Perm (Fin n)) _ _)
      (Equiv.refl _) (sort f) P (fun σ => f ∘ σ) (fun σ hσ hfσ => _) hf
  obtain ⟨i, j, hij₁, hij₂⟩ := antitone_pair_of_not_sorted' hσ
  exact ⟨σ * Equiv.swap i j, Pi.lex_desc hij₁ hij₂, h σ i j hij₁ hij₂ hfσ⟩
#align tuple.bubble_sort_induction' Tuple.bubble_sort_induction'
-/

#print Tuple.bubble_sort_induction /-
/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P`
if `f` satsifies `P` and `P` is preserved when swapping two antitone values. -/
theorem bubble_sort_induction {n : ℕ} {α : Type _} [LinearOrder α] {f : Fin n → α}
    {P : (Fin n → α) → Prop} (hf : P f)
    (h : ∀ (g : Fin n → α) (i j : Fin n), i < j → g j < g i → P g → P (g ∘ Equiv.swap i j)) :
    P (f ∘ sort f) :=
  bubble_sort_induction' hf fun σ => h _
#align tuple.bubble_sort_induction Tuple.bubble_sort_induction
-/

end Tuple


/-
Copyright (c) 2020 The Xena project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Kevin Buzzard
Thanks: Imperial College London, leanprover-community

The complex numbers, modelled as R^2 in the obvious way.
-/
import complex.basic -- tutorial level
/-!

# Level 1: I

I find it unbelievable that we have written quite a lot of code about the complex numbers
and we've still never defined i, or j, or I, or $$\sqrt{-1}$$, or whatever it's called.
Why don't you supply the definition, and make the basic API?

All the proofs below are sorried. You can try them in tactic mode
by replacing `sorry` with `begin end` and then starting to write
tactics in the `begin end` block.
-/

namespace complex

/-- complex.I is the square root of -1 above the imaginary axis -/
def I : ℂ := ⟨0, 1⟩

/-

 Easy lemmas, tagged with `simp` so Lean can prove things about `I` by equating
 real and imaginary parts.

-/

/-- re(I) = 0 -/
@[simp] lemma I_re : re(I) = 0 :=
begin
  refl,
end

/-- im(I) = 1 -/
@[simp] lemma I_im : im(I) = 1 :=
begin
  refl,
end

/-- I*I = -1 -/
@[simp] lemma I_mul_I : I * I = -1 :=
begin
  ext;
  simp,
end

/-
  Bonus level. Hint: don't forget ext_iff. It's defined
  in complex.basic and its type is below.

  ext_iff : ∀ {z w : ℂ}, z = w ↔ z.re = w.re ∧ z.im = w.im
-/
/-- I is non-zero -/
lemma I_ne_zero : (I : ℂ) ≠ 0 :=
begin
  intro h,
  rw ext_iff at h,
  rw I_im at h,
  rw zero_im at h,
  cases h,
  simp at h_right,
  contradiction,
end

end complex


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.normed_space.ray
import topology.local_extr

/-!
# (Local) maximums in a normed space

In this file we prove the following lemma, see `is_max_filter.norm_add_same_ray`. If `f : α → E` is
a function such that `norm ∘ f` has a maximum along a filter `l` at a point `c` and `y` is a vector
on the same ray as `f c`, then the function `λ x, ‖f x + y‖` has a maximul along `l` at `c`.

Then we specialize it to the case `y = f c` and to different special cases of `is_max_filter`:
`is_max_on`, `is_local_max_on`, and `is_local_max`.

## Tags

local maximum, normed space
-/

variables {α X E : Type*} [seminormed_add_comm_group E] [normed_space ℝ E] [topological_space X]

section

variables {f : α → E} {l : filter α} {s : set α} {c : α} {y : E}

/-- If `f : α → E` is a function such that `norm ∘ f` has a maximum along a filter `l` at a point
`c` and `y` is a vector on the same ray as `f c`, then the function `λ x, ‖f x + y‖` has a maximul
along `l` at `c`. -/
lemma is_max_filter.norm_add_same_ray (h : is_max_filter (norm ∘ f) l c) (hy : same_ray ℝ (f c) y) :
  is_max_filter (λ x, ‖f x + y‖) l c :=
h.mono $ λ x hx,
calc ‖f x + y‖ ≤ ‖f x‖ + ‖y‖ : norm_add_le _ _
           ... ≤ ‖f c‖ + ‖y‖ : add_le_add_right hx _
           ... = ‖f c + y‖   : hy.norm_add.symm

/-- If `f : α → E` is a function such that `norm ∘ f` has a maximum along a filter `l` at a point
`c`, then the function `λ x, ‖f x + f c‖` has a maximul along `l` at `c`. -/
lemma is_max_filter.norm_add_self (h : is_max_filter (norm ∘ f) l c) :
  is_max_filter (λ x, ‖f x + f c‖) l c :=
h.norm_add_same_ray same_ray.rfl

/-- If `f : α → E` is a function such that `norm ∘ f` has a maximum on a set `s` at a point `c` and
`y` is a vector on the same ray as `f c`, then the function `λ x, ‖f x + y‖` has a maximul on `s` at
`c`. -/
lemma is_max_on.norm_add_same_ray (h : is_max_on (norm ∘ f) s c) (hy : same_ray ℝ (f c) y) :
  is_max_on (λ x, ‖f x + y‖) s c :=
h.norm_add_same_ray hy

/-- If `f : α → E` is a function such that `norm ∘ f` has a maximum on a set `s` at a point `c`,
then the function `λ x, ‖f x + f c‖` has a maximul on `s` at `c`. -/
lemma is_max_on.norm_add_self (h : is_max_on (norm ∘ f) s c) : is_max_on (λ x, ‖f x + f c‖) s c :=
h.norm_add_self

end

variables {f : X → E} {s : set X} {c : X} {y : E}

/-- If `f : α → E` is a function such that `norm ∘ f` has a local maximum on a set `s` at a point
`c` and `y` is a vector on the same ray as `f c`, then the function `λ x, ‖f x + y‖` has a local
maximul on `s` at `c`. -/
lemma is_local_max_on.norm_add_same_ray (h : is_local_max_on (norm ∘ f) s c)
  (hy : same_ray ℝ (f c) y) : is_local_max_on (λ x, ‖f x + y‖) s c :=
h.norm_add_same_ray hy

/-- If `f : α → E` is a function such that `norm ∘ f` has a local maximum on a set `s` at a point
`c`, then the function `λ x, ‖f x + f c‖` has a local maximul on `s` at `c`. -/
lemma is_local_max_on.norm_add_self (h : is_local_max_on (norm ∘ f) s c) :
  is_local_max_on (λ x, ‖f x + f c‖) s c :=
h.norm_add_self

/-- If `f : α → E` is a function such that `norm ∘ f` has a local maximum at a point `c` and `y` is
a vector on the same ray as `f c`, then the function `λ x, ‖f x + y‖` has a local maximul at `c`. -/
lemma is_local_max.norm_add_same_ray (h : is_local_max (norm ∘ f) c)
  (hy : same_ray ℝ (f c) y) : is_local_max (λ x, ‖f x + y‖) c :=
h.norm_add_same_ray hy

/-- If `f : α → E` is a function such that `norm ∘ f` has a local maximum at a point `c`, then the
function `λ x, ‖f x + f c‖` has a local maximul at `c`. -/
lemma is_local_max.norm_add_self (h : is_local_max (norm ∘ f) c) :
  is_local_max (λ x, ‖f x + f c‖) c :=
h.norm_add_self


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import analysis.special_functions.exp_deriv
import analysis.special_functions.trigonometric.basic
import data.set.intervals.monotone

/-!
# Differentiability of trigonometric functions

## Main statements

The differentiability of the usual trigonometric functions is proved, and their derivatives are
computed.

## Tags

sin, cos, tan, angle
-/

noncomputable theory
open_locale classical topological_space filter
open set filter

namespace complex

/-- The complex sine function is everywhere strictly differentiable, with the derivative `cos x`. -/
lemma has_strict_deriv_at_sin (x : ℂ) : has_strict_deriv_at sin (cos x) x :=
begin
  simp only [cos, div_eq_mul_inv],
  convert ((((has_strict_deriv_at_id x).neg.mul_const I).cexp.sub
    ((has_strict_deriv_at_id x).mul_const I).cexp).mul_const I).mul_const (2:ℂ)⁻¹,
  simp only [function.comp, id],
  rw [sub_mul, mul_assoc, mul_assoc, I_mul_I, neg_one_mul, neg_neg, mul_one, one_mul, mul_assoc,
      I_mul_I, mul_neg_one, sub_neg_eq_add, add_comm]
end

/-- The complex sine function is everywhere differentiable, with the derivative `cos x`. -/
lemma has_deriv_at_sin (x : ℂ) : has_deriv_at sin (cos x) x :=
(has_strict_deriv_at_sin x).has_deriv_at

lemma cont_diff_sin {n} : cont_diff ℂ n sin :=
(((cont_diff_neg.mul cont_diff_const).cexp.sub
  (cont_diff_id.mul cont_diff_const).cexp).mul cont_diff_const).div_const

lemma differentiable_sin : differentiable ℂ sin :=
λx, (has_deriv_at_sin x).differentiable_at

lemma differentiable_at_sin {x : ℂ} : differentiable_at ℂ sin x :=
differentiable_sin x

@[simp] lemma deriv_sin : deriv sin = cos :=
funext $ λ x, (has_deriv_at_sin x).deriv

/-- The complex cosine function is everywhere strictly differentiable, with the derivative
`-sin x`. -/
lemma has_strict_deriv_at_cos (x : ℂ) : has_strict_deriv_at cos (-sin x) x :=
begin
  simp only [sin, div_eq_mul_inv, neg_mul_eq_neg_mul],
  convert (((has_strict_deriv_at_id x).mul_const I).cexp.add
    ((has_strict_deriv_at_id x).neg.mul_const I).cexp).mul_const (2:ℂ)⁻¹,
  simp only [function.comp, id],
  ring
end

/-- The complex cosine function is everywhere differentiable, with the derivative `-sin x`. -/
lemma has_deriv_at_cos (x : ℂ) : has_deriv_at cos (-sin x) x :=
(has_strict_deriv_at_cos x).has_deriv_at

lemma cont_diff_cos {n} : cont_diff ℂ n cos :=
((cont_diff_id.mul cont_diff_const).cexp.add
  (cont_diff_neg.mul cont_diff_const).cexp).div_const

lemma differentiable_cos : differentiable ℂ cos :=
λx, (has_deriv_at_cos x).differentiable_at

lemma differentiable_at_cos {x : ℂ} : differentiable_at ℂ cos x :=
differentiable_cos x

lemma deriv_cos {x : ℂ} : deriv cos x = -sin x :=
(has_deriv_at_cos x).deriv

@[simp] lemma deriv_cos' : deriv cos = (λ x, -sin x) :=
funext $ λ x, deriv_cos

/-- The complex hyperbolic sine function is everywhere strictly differentiable, with the derivative
`cosh x`. -/
lemma has_strict_deriv_at_sinh (x : ℂ) : has_strict_deriv_at sinh (cosh x) x :=
begin
  simp only [cosh, div_eq_mul_inv],
  convert ((has_strict_deriv_at_exp x).sub (has_strict_deriv_at_id x).neg.cexp).mul_const (2:ℂ)⁻¹,
  rw [id, mul_neg_one, sub_eq_add_neg, neg_neg]
end

/-- The complex hyperbolic sine function is everywhere differentiable, with the derivative
`cosh x`. -/
lemma has_deriv_at_sinh (x : ℂ) : has_deriv_at sinh (cosh x) x :=
(has_strict_deriv_at_sinh x).has_deriv_at

lemma cont_diff_sinh {n} : cont_diff ℂ n sinh :=
(cont_diff_exp.sub cont_diff_neg.cexp).div_const

lemma differentiable_sinh : differentiable ℂ sinh :=
λx, (has_deriv_at_sinh x).differentiable_at

lemma differentiable_at_sinh {x : ℂ} : differentiable_at ℂ sinh x :=
differentiable_sinh x

@[simp] lemma deriv_sinh : deriv sinh = cosh :=
funext $ λ x, (has_deriv_at_sinh x).deriv

/-- The complex hyperbolic cosine function is everywhere strictly differentiable, with the
derivative `sinh x`. -/
lemma has_strict_deriv_at_cosh (x : ℂ) : has_strict_deriv_at cosh (sinh x) x :=
begin
  simp only [sinh, div_eq_mul_inv],
  convert ((has_strict_deriv_at_exp x).add (has_strict_deriv_at_id x).neg.cexp).mul_const (2:ℂ)⁻¹,
  rw [id, mul_neg_one, sub_eq_add_neg]
end

/-- The complex hyperbolic cosine function is everywhere differentiable, with the derivative
`sinh x`. -/
lemma has_deriv_at_cosh (x : ℂ) : has_deriv_at cosh (sinh x) x :=
(has_strict_deriv_at_cosh x).has_deriv_at

lemma cont_diff_cosh {n} : cont_diff ℂ n cosh :=
(cont_diff_exp.add cont_diff_neg.cexp).div_const

lemma differentiable_cosh : differentiable ℂ cosh :=
λx, (has_deriv_at_cosh x).differentiable_at

lemma differentiable_at_cosh {x : ℂ} : differentiable_at ℂ cosh x :=
differentiable_cosh x

@[simp] lemma deriv_cosh : deriv cosh = sinh :=
funext $ λ x, (has_deriv_at_cosh x).deriv

end complex

section
/-! ### Simp lemmas for derivatives of `λ x, complex.cos (f x)` etc., `f : ℂ → ℂ` -/

variables {f : ℂ → ℂ} {f' x : ℂ} {s : set ℂ}

/-! #### `complex.cos` -/

lemma has_strict_deriv_at.ccos (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, complex.cos (f x)) (- complex.sin (f x) * f') x :=
(complex.has_strict_deriv_at_cos (f x)).comp x hf

lemma has_deriv_at.ccos (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, complex.cos (f x)) (- complex.sin (f x) * f') x :=
(complex.has_deriv_at_cos (f x)).comp x hf

lemma has_deriv_within_at.ccos (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, complex.cos (f x)) (- complex.sin (f x) * f') s x :=
(complex.has_deriv_at_cos (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_ccos (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  deriv_within (λx, complex.cos (f x)) s x = - complex.sin (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.ccos.deriv_within hxs

@[simp] lemma deriv_ccos (hc : differentiable_at ℂ f x) :
  deriv (λx, complex.cos (f x)) x = - complex.sin (f x) * (deriv f x) :=
hc.has_deriv_at.ccos.deriv

/-! #### `complex.sin` -/

lemma has_strict_deriv_at.csin (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, complex.sin (f x)) (complex.cos (f x) * f') x :=
(complex.has_strict_deriv_at_sin (f x)).comp x hf

lemma has_deriv_at.csin (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, complex.sin (f x)) (complex.cos (f x) * f') x :=
(complex.has_deriv_at_sin (f x)).comp x hf

lemma has_deriv_within_at.csin (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, complex.sin (f x)) (complex.cos (f x) * f') s x :=
(complex.has_deriv_at_sin (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_csin (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  deriv_within (λx, complex.sin (f x)) s x = complex.cos (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.csin.deriv_within hxs

@[simp] lemma deriv_csin (hc : differentiable_at ℂ f x) :
  deriv (λx, complex.sin (f x)) x = complex.cos (f x) * (deriv f x) :=
hc.has_deriv_at.csin.deriv

/-! #### `complex.cosh` -/

lemma has_strict_deriv_at.ccosh (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, complex.cosh (f x)) (complex.sinh (f x) * f') x :=
(complex.has_strict_deriv_at_cosh (f x)).comp x hf

lemma has_deriv_at.ccosh (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, complex.cosh (f x)) (complex.sinh (f x) * f') x :=
(complex.has_deriv_at_cosh (f x)).comp x hf

lemma has_deriv_within_at.ccosh (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, complex.cosh (f x)) (complex.sinh (f x) * f') s x :=
(complex.has_deriv_at_cosh (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_ccosh (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  deriv_within (λx, complex.cosh (f x)) s x = complex.sinh (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.ccosh.deriv_within hxs

@[simp] lemma deriv_ccosh (hc : differentiable_at ℂ f x) :
  deriv (λx, complex.cosh (f x)) x = complex.sinh (f x) * (deriv f x) :=
hc.has_deriv_at.ccosh.deriv

/-! #### `complex.sinh` -/

lemma has_strict_deriv_at.csinh (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, complex.sinh (f x)) (complex.cosh (f x) * f') x :=
(complex.has_strict_deriv_at_sinh (f x)).comp x hf

lemma has_deriv_at.csinh (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, complex.sinh (f x)) (complex.cosh (f x) * f') x :=
(complex.has_deriv_at_sinh (f x)).comp x hf

lemma has_deriv_within_at.csinh (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, complex.sinh (f x)) (complex.cosh (f x) * f') s x :=
(complex.has_deriv_at_sinh (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_csinh (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  deriv_within (λx, complex.sinh (f x)) s x = complex.cosh (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.csinh.deriv_within hxs

@[simp] lemma deriv_csinh (hc : differentiable_at ℂ f x) :
  deriv (λx, complex.sinh (f x)) x = complex.cosh (f x) * (deriv f x) :=
hc.has_deriv_at.csinh.deriv

end

section
/-! ### Simp lemmas for derivatives of `λ x, complex.cos (f x)` etc., `f : E → ℂ` -/

variables {E : Type*} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {f' : E →L[ℂ] ℂ}
  {x : E} {s : set E}

/-! #### `complex.cos` -/

lemma has_strict_fderiv_at.ccos (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, complex.cos (f x)) (- complex.sin (f x) • f') x :=
(complex.has_strict_deriv_at_cos (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.ccos (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, complex.cos (f x)) (- complex.sin (f x) • f') x :=
(complex.has_deriv_at_cos (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.ccos (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, complex.cos (f x)) (- complex.sin (f x) • f') s x :=
(complex.has_deriv_at_cos (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.ccos (hf : differentiable_within_at ℂ f s x) :
  differentiable_within_at ℂ (λ x, complex.cos (f x)) s x :=
hf.has_fderiv_within_at.ccos.differentiable_within_at

@[simp] lemma differentiable_at.ccos (hc : differentiable_at ℂ f x) :
  differentiable_at ℂ (λx, complex.cos (f x)) x :=
hc.has_fderiv_at.ccos.differentiable_at

lemma differentiable_on.ccos (hc : differentiable_on ℂ f s) :
  differentiable_on ℂ (λx, complex.cos (f x)) s :=
λx h, (hc x h).ccos

@[simp] lemma differentiable.ccos (hc : differentiable ℂ f) :
  differentiable ℂ (λx, complex.cos (f x)) :=
λx, (hc x).ccos

lemma fderiv_within_ccos (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  fderiv_within ℂ (λx, complex.cos (f x)) s x = - complex.sin (f x) • (fderiv_within ℂ f s x) :=
hf.has_fderiv_within_at.ccos.fderiv_within hxs

@[simp] lemma fderiv_ccos (hc : differentiable_at ℂ f x) :
  fderiv ℂ (λx, complex.cos (f x)) x = - complex.sin (f x) • (fderiv ℂ f x) :=
hc.has_fderiv_at.ccos.fderiv

lemma cont_diff.ccos {n} (h : cont_diff ℂ n f) :
  cont_diff ℂ n (λ x, complex.cos (f x)) :=
complex.cont_diff_cos.comp h

lemma cont_diff_at.ccos {n} (hf : cont_diff_at ℂ n f x) :
  cont_diff_at ℂ n (λ x, complex.cos (f x)) x :=
complex.cont_diff_cos.cont_diff_at.comp x hf

lemma cont_diff_on.ccos {n} (hf : cont_diff_on ℂ n f s) :
  cont_diff_on ℂ n (λ x, complex.cos (f x)) s :=
complex.cont_diff_cos.comp_cont_diff_on  hf

lemma cont_diff_within_at.ccos {n} (hf : cont_diff_within_at ℂ n f s x) :
  cont_diff_within_at ℂ n (λ x, complex.cos (f x)) s x :=
complex.cont_diff_cos.cont_diff_at.comp_cont_diff_within_at x hf

/-! #### `complex.sin` -/

lemma has_strict_fderiv_at.csin (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, complex.sin (f x)) (complex.cos (f x) • f') x :=
(complex.has_strict_deriv_at_sin (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.csin (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, complex.sin (f x)) (complex.cos (f x) • f') x :=
(complex.has_deriv_at_sin (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.csin (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, complex.sin (f x)) (complex.cos (f x) • f') s x :=
(complex.has_deriv_at_sin (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.csin (hf : differentiable_within_at ℂ f s x) :
  differentiable_within_at ℂ (λ x, complex.sin (f x)) s x :=
hf.has_fderiv_within_at.csin.differentiable_within_at

@[simp] lemma differentiable_at.csin (hc : differentiable_at ℂ f x) :
  differentiable_at ℂ (λx, complex.sin (f x)) x :=
hc.has_fderiv_at.csin.differentiable_at

lemma differentiable_on.csin (hc : differentiable_on ℂ f s) :
  differentiable_on ℂ (λx, complex.sin (f x)) s :=
λx h, (hc x h).csin

@[simp] lemma differentiable.csin (hc : differentiable ℂ f) :
  differentiable ℂ (λx, complex.sin (f x)) :=
λx, (hc x).csin

lemma fderiv_within_csin (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  fderiv_within ℂ (λx, complex.sin (f x)) s x = complex.cos (f x) • (fderiv_within ℂ f s x) :=
hf.has_fderiv_within_at.csin.fderiv_within hxs

@[simp] lemma fderiv_csin (hc : differentiable_at ℂ f x) :
  fderiv ℂ (λx, complex.sin (f x)) x = complex.cos (f x) • (fderiv ℂ f x) :=
hc.has_fderiv_at.csin.fderiv

lemma cont_diff.csin {n} (h : cont_diff ℂ n f) :
  cont_diff ℂ n (λ x, complex.sin (f x)) :=
complex.cont_diff_sin.comp h

lemma cont_diff_at.csin {n} (hf : cont_diff_at ℂ n f x) :
  cont_diff_at ℂ n (λ x, complex.sin (f x)) x :=
complex.cont_diff_sin.cont_diff_at.comp x hf

lemma cont_diff_on.csin {n} (hf : cont_diff_on ℂ n f s) :
  cont_diff_on ℂ n (λ x, complex.sin (f x)) s :=
complex.cont_diff_sin.comp_cont_diff_on  hf

lemma cont_diff_within_at.csin {n} (hf : cont_diff_within_at ℂ n f s x) :
  cont_diff_within_at ℂ n (λ x, complex.sin (f x)) s x :=
complex.cont_diff_sin.cont_diff_at.comp_cont_diff_within_at x hf

/-! #### `complex.cosh` -/

lemma has_strict_fderiv_at.ccosh (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, complex.cosh (f x)) (complex.sinh (f x) • f') x :=
(complex.has_strict_deriv_at_cosh (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.ccosh (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, complex.cosh (f x)) (complex.sinh (f x) • f') x :=
(complex.has_deriv_at_cosh (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.ccosh (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, complex.cosh (f x)) (complex.sinh (f x) • f') s x :=
(complex.has_deriv_at_cosh (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.ccosh (hf : differentiable_within_at ℂ f s x) :
  differentiable_within_at ℂ (λ x, complex.cosh (f x)) s x :=
hf.has_fderiv_within_at.ccosh.differentiable_within_at

@[simp] lemma differentiable_at.ccosh (hc : differentiable_at ℂ f x) :
  differentiable_at ℂ (λx, complex.cosh (f x)) x :=
hc.has_fderiv_at.ccosh.differentiable_at

lemma differentiable_on.ccosh (hc : differentiable_on ℂ f s) :
  differentiable_on ℂ (λx, complex.cosh (f x)) s :=
λx h, (hc x h).ccosh

@[simp] lemma differentiable.ccosh (hc : differentiable ℂ f) :
  differentiable ℂ (λx, complex.cosh (f x)) :=
λx, (hc x).ccosh

lemma fderiv_within_ccosh (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  fderiv_within ℂ (λx, complex.cosh (f x)) s x = complex.sinh (f x) • (fderiv_within ℂ f s x) :=
hf.has_fderiv_within_at.ccosh.fderiv_within hxs

@[simp] lemma fderiv_ccosh (hc : differentiable_at ℂ f x) :
  fderiv ℂ (λx, complex.cosh (f x)) x = complex.sinh (f x) • (fderiv ℂ f x) :=
hc.has_fderiv_at.ccosh.fderiv

lemma cont_diff.ccosh {n} (h : cont_diff ℂ n f) :
  cont_diff ℂ n (λ x, complex.cosh (f x)) :=
complex.cont_diff_cosh.comp h

lemma cont_diff_at.ccosh {n} (hf : cont_diff_at ℂ n f x) :
  cont_diff_at ℂ n (λ x, complex.cosh (f x)) x :=
complex.cont_diff_cosh.cont_diff_at.comp x hf

lemma cont_diff_on.ccosh {n} (hf : cont_diff_on ℂ n f s) :
  cont_diff_on ℂ n (λ x, complex.cosh (f x)) s :=
complex.cont_diff_cosh.comp_cont_diff_on  hf

lemma cont_diff_within_at.ccosh {n} (hf : cont_diff_within_at ℂ n f s x) :
  cont_diff_within_at ℂ n (λ x, complex.cosh (f x)) s x :=
complex.cont_diff_cosh.cont_diff_at.comp_cont_diff_within_at x hf

/-! #### `complex.sinh` -/

lemma has_strict_fderiv_at.csinh (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, complex.sinh (f x)) (complex.cosh (f x) • f') x :=
(complex.has_strict_deriv_at_sinh (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.csinh (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, complex.sinh (f x)) (complex.cosh (f x) • f') x :=
(complex.has_deriv_at_sinh (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.csinh (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, complex.sinh (f x)) (complex.cosh (f x) • f') s x :=
(complex.has_deriv_at_sinh (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.csinh (hf : differentiable_within_at ℂ f s x) :
  differentiable_within_at ℂ (λ x, complex.sinh (f x)) s x :=
hf.has_fderiv_within_at.csinh.differentiable_within_at

@[simp] lemma differentiable_at.csinh (hc : differentiable_at ℂ f x) :
  differentiable_at ℂ (λx, complex.sinh (f x)) x :=
hc.has_fderiv_at.csinh.differentiable_at

lemma differentiable_on.csinh (hc : differentiable_on ℂ f s) :
  differentiable_on ℂ (λx, complex.sinh (f x)) s :=
λx h, (hc x h).csinh

@[simp] lemma differentiable.csinh (hc : differentiable ℂ f) :
  differentiable ℂ (λx, complex.sinh (f x)) :=
λx, (hc x).csinh

lemma fderiv_within_csinh (hf : differentiable_within_at ℂ f s x)
  (hxs : unique_diff_within_at ℂ s x) :
  fderiv_within ℂ (λx, complex.sinh (f x)) s x = complex.cosh (f x) • (fderiv_within ℂ f s x) :=
hf.has_fderiv_within_at.csinh.fderiv_within hxs

@[simp] lemma fderiv_csinh (hc : differentiable_at ℂ f x) :
  fderiv ℂ (λx, complex.sinh (f x)) x = complex.cosh (f x) • (fderiv ℂ f x) :=
hc.has_fderiv_at.csinh.fderiv

lemma cont_diff.csinh {n} (h : cont_diff ℂ n f) :
  cont_diff ℂ n (λ x, complex.sinh (f x)) :=
complex.cont_diff_sinh.comp h

lemma cont_diff_at.csinh {n} (hf : cont_diff_at ℂ n f x) :
  cont_diff_at ℂ n (λ x, complex.sinh (f x)) x :=
complex.cont_diff_sinh.cont_diff_at.comp x hf

lemma cont_diff_on.csinh {n} (hf : cont_diff_on ℂ n f s) :
  cont_diff_on ℂ n (λ x, complex.sinh (f x)) s :=
complex.cont_diff_sinh.comp_cont_diff_on  hf

lemma cont_diff_within_at.csinh {n} (hf : cont_diff_within_at ℂ n f s x) :
  cont_diff_within_at ℂ n (λ x, complex.sinh (f x)) s x :=
complex.cont_diff_sinh.cont_diff_at.comp_cont_diff_within_at x hf

end

namespace real

variables {x y z : ℝ}

lemma has_strict_deriv_at_sin (x : ℝ) : has_strict_deriv_at sin (cos x) x :=
(complex.has_strict_deriv_at_sin x).real_of_complex

lemma has_deriv_at_sin (x : ℝ) : has_deriv_at sin (cos x) x :=
(has_strict_deriv_at_sin x).has_deriv_at

lemma cont_diff_sin {n} : cont_diff ℝ n sin :=
complex.cont_diff_sin.real_of_complex

lemma differentiable_sin : differentiable ℝ sin :=
λx, (has_deriv_at_sin x).differentiable_at

lemma differentiable_at_sin : differentiable_at ℝ sin x :=
differentiable_sin x

@[simp] lemma deriv_sin : deriv sin = cos :=
funext $ λ x, (has_deriv_at_sin x).deriv

lemma has_strict_deriv_at_cos (x : ℝ) : has_strict_deriv_at cos (-sin x) x :=
(complex.has_strict_deriv_at_cos x).real_of_complex

lemma has_deriv_at_cos (x : ℝ) : has_deriv_at cos (-sin x) x :=
(complex.has_deriv_at_cos x).real_of_complex

lemma cont_diff_cos {n} : cont_diff ℝ n cos :=
complex.cont_diff_cos.real_of_complex

lemma differentiable_cos : differentiable ℝ cos :=
λx, (has_deriv_at_cos x).differentiable_at

lemma differentiable_at_cos : differentiable_at ℝ cos x :=
differentiable_cos x

lemma deriv_cos : deriv cos x = - sin x :=
(has_deriv_at_cos x).deriv

@[simp] lemma deriv_cos' : deriv cos = (λ x, - sin x) :=
funext $ λ _, deriv_cos

lemma has_strict_deriv_at_sinh (x : ℝ) : has_strict_deriv_at sinh (cosh x) x :=
(complex.has_strict_deriv_at_sinh x).real_of_complex

lemma has_deriv_at_sinh (x : ℝ) : has_deriv_at sinh (cosh x) x :=
(complex.has_deriv_at_sinh x).real_of_complex

lemma cont_diff_sinh {n} : cont_diff ℝ n sinh :=
complex.cont_diff_sinh.real_of_complex

lemma differentiable_sinh : differentiable ℝ sinh :=
λx, (has_deriv_at_sinh x).differentiable_at

lemma differentiable_at_sinh : differentiable_at ℝ sinh x :=
differentiable_sinh x

@[simp] lemma deriv_sinh : deriv sinh = cosh :=
funext $ λ x, (has_deriv_at_sinh x).deriv

lemma has_strict_deriv_at_cosh (x : ℝ) : has_strict_deriv_at cosh (sinh x) x :=
(complex.has_strict_deriv_at_cosh x).real_of_complex

lemma has_deriv_at_cosh (x : ℝ) : has_deriv_at cosh (sinh x) x :=
(complex.has_deriv_at_cosh x).real_of_complex

lemma cont_diff_cosh {n} : cont_diff ℝ n cosh :=
complex.cont_diff_cosh.real_of_complex

lemma differentiable_cosh : differentiable ℝ cosh :=
λx, (has_deriv_at_cosh x).differentiable_at

lemma differentiable_at_cosh : differentiable_at ℝ cosh x :=
differentiable_cosh x

@[simp] lemma deriv_cosh : deriv cosh = sinh :=
funext $ λ x, (has_deriv_at_cosh x).deriv

/-- `sinh` is strictly monotone. -/
lemma sinh_strict_mono : strict_mono sinh :=
strict_mono_of_deriv_pos $ by { rw real.deriv_sinh, exact cosh_pos }

/-- `sinh` is injective, `∀ a b, sinh a = sinh b → a = b`. -/
lemma sinh_injective : function.injective sinh := sinh_strict_mono.injective

@[simp] lemma sinh_inj : sinh x = sinh y ↔ x = y := sinh_injective.eq_iff
@[simp] lemma sinh_le_sinh : sinh x ≤ sinh y ↔ x ≤ y := sinh_strict_mono.le_iff_le
@[simp] lemma sinh_lt_sinh : sinh x < sinh y ↔ x < y := sinh_strict_mono.lt_iff_lt

@[simp] lemma sinh_pos_iff : 0 < sinh x ↔ 0 < x :=
by simpa only [sinh_zero] using @sinh_lt_sinh 0 x

@[simp] lemma sinh_nonpos_iff : sinh x ≤ 0 ↔ x ≤ 0 :=
by simpa only [sinh_zero] using @sinh_le_sinh x 0

@[simp] lemma sinh_neg_iff : sinh x < 0 ↔ x < 0 :=
by simpa only [sinh_zero] using @sinh_lt_sinh x 0

@[simp] lemma sinh_nonneg_iff : 0 ≤ sinh x ↔ 0 ≤ x :=
by simpa only [sinh_zero] using @sinh_le_sinh 0 x

lemma cosh_strict_mono_on : strict_mono_on cosh (Ici 0) :=
(convex_Ici _).strict_mono_on_of_deriv_pos continuous_cosh.continuous_on $ λ x hx,
  by { rw [interior_Ici, mem_Ioi] at hx, rwa [deriv_cosh, sinh_pos_iff] }

@[simp] lemma cosh_le_cosh : cosh x ≤ cosh y ↔ |x| ≤ |y| :=
cosh_abs x ▸ cosh_abs y ▸ cosh_strict_mono_on.le_iff_le (_root_.abs_nonneg x) (_root_.abs_nonneg y)

@[simp] lemma cosh_lt_cosh : cosh x < cosh y ↔ |x| < |y| :=
lt_iff_lt_of_le_iff_le cosh_le_cosh

@[simp] lemma one_le_cosh (x : ℝ) : 1 ≤ cosh x :=
cosh_zero ▸ cosh_le_cosh.2 (by simp only [_root_.abs_zero, _root_.abs_nonneg])

@[simp] lemma one_lt_cosh : 1 < cosh x ↔ x ≠ 0 :=
cosh_zero ▸ cosh_lt_cosh.trans (by simp only [_root_.abs_zero, abs_pos])

lemma sinh_sub_id_strict_mono : strict_mono (λ x, sinh x - x) :=
begin
  refine strict_mono_of_odd_strict_mono_on_nonneg (λ x, by simp) _,
  refine (convex_Ici _).strict_mono_on_of_deriv_pos _ (λ x hx, _),
  { exact (continuous_sinh.sub continuous_id).continuous_on },
  { rw [interior_Ici, mem_Ioi] at hx,
    rw [deriv_sub, deriv_sinh, deriv_id'', sub_pos, one_lt_cosh],
    exacts [hx.ne', differentiable_at_sinh, differentiable_at_id] }
end

@[simp] lemma self_le_sinh_iff : x ≤ sinh x ↔ 0 ≤ x :=
calc x ≤ sinh x ↔ sinh 0 - 0 ≤ sinh x - x : by simp
... ↔ 0 ≤ x : sinh_sub_id_strict_mono.le_iff_le

@[simp] lemma sinh_le_self_iff : sinh x ≤ x ↔ x ≤ 0 :=
calc sinh x ≤ x ↔ sinh x - x ≤ sinh 0 - 0 : by simp
... ↔ x ≤ 0 : sinh_sub_id_strict_mono.le_iff_le

@[simp] lemma self_lt_sinh_iff : x < sinh x ↔ 0 < x :=
lt_iff_lt_of_le_iff_le sinh_le_self_iff

@[simp] lemma sinh_lt_self_iff : sinh x < x ↔ x < 0 :=
lt_iff_lt_of_le_iff_le self_le_sinh_iff

end real

section
/-! ### Simp lemmas for derivatives of `λ x, real.cos (f x)` etc., `f : ℝ → ℝ` -/

variables {f : ℝ → ℝ} {f' x : ℝ} {s : set ℝ}

/-! #### `real.cos` -/

lemma has_strict_deriv_at.cos (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, real.cos (f x)) (- real.sin (f x) * f') x :=
(real.has_strict_deriv_at_cos (f x)).comp x hf

lemma has_deriv_at.cos (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, real.cos (f x)) (- real.sin (f x) * f') x :=
(real.has_deriv_at_cos (f x)).comp x hf

lemma has_deriv_within_at.cos (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, real.cos (f x)) (- real.sin (f x) * f') s x :=
(real.has_deriv_at_cos (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_cos (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, real.cos (f x)) s x = - real.sin (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.cos.deriv_within hxs

@[simp] lemma deriv_cos (hc : differentiable_at ℝ f x) :
  deriv (λx, real.cos (f x)) x = - real.sin (f x) * (deriv f x) :=
hc.has_deriv_at.cos.deriv

/-! #### `real.sin` -/

lemma has_strict_deriv_at.sin (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, real.sin (f x)) (real.cos (f x) * f') x :=
(real.has_strict_deriv_at_sin (f x)).comp x hf

lemma has_deriv_at.sin (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, real.sin (f x)) (real.cos (f x) * f') x :=
(real.has_deriv_at_sin (f x)).comp x hf

lemma has_deriv_within_at.sin (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, real.sin (f x)) (real.cos (f x) * f') s x :=
(real.has_deriv_at_sin (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_sin (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, real.sin (f x)) s x = real.cos (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.sin.deriv_within hxs

@[simp] lemma deriv_sin (hc : differentiable_at ℝ f x) :
  deriv (λx, real.sin (f x)) x = real.cos (f x) * (deriv f x) :=
hc.has_deriv_at.sin.deriv

/-! #### `real.cosh` -/

lemma has_strict_deriv_at.cosh (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, real.cosh (f x)) (real.sinh (f x) * f') x :=
(real.has_strict_deriv_at_cosh (f x)).comp x hf

lemma has_deriv_at.cosh (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, real.cosh (f x)) (real.sinh (f x) * f') x :=
(real.has_deriv_at_cosh (f x)).comp x hf

lemma has_deriv_within_at.cosh (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, real.cosh (f x)) (real.sinh (f x) * f') s x :=
(real.has_deriv_at_cosh (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_cosh (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, real.cosh (f x)) s x = real.sinh (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.cosh.deriv_within hxs

@[simp] lemma deriv_cosh (hc : differentiable_at ℝ f x) :
  deriv (λx, real.cosh (f x)) x = real.sinh (f x) * (deriv f x) :=
hc.has_deriv_at.cosh.deriv

/-! #### `real.sinh` -/

lemma has_strict_deriv_at.sinh (hf : has_strict_deriv_at f f' x) :
  has_strict_deriv_at (λ x, real.sinh (f x)) (real.cosh (f x) * f') x :=
(real.has_strict_deriv_at_sinh (f x)).comp x hf

lemma has_deriv_at.sinh (hf : has_deriv_at f f' x) :
  has_deriv_at (λ x, real.sinh (f x)) (real.cosh (f x) * f') x :=
(real.has_deriv_at_sinh (f x)).comp x hf

lemma has_deriv_within_at.sinh (hf : has_deriv_within_at f f' s x) :
  has_deriv_within_at (λ x, real.sinh (f x)) (real.cosh (f x) * f') s x :=
(real.has_deriv_at_sinh (f x)).comp_has_deriv_within_at x hf

lemma deriv_within_sinh (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, real.sinh (f x)) s x = real.cosh (f x) * (deriv_within f s x) :=
hf.has_deriv_within_at.sinh.deriv_within hxs

@[simp] lemma deriv_sinh (hc : differentiable_at ℝ f x) :
  deriv (λx, real.sinh (f x)) x = real.cosh (f x) * (deriv f x) :=
hc.has_deriv_at.sinh.deriv

end

section

/-! ### Simp lemmas for derivatives of `λ x, real.cos (f x)` etc., `f : E → ℝ` -/

variables {E : Type*} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {f' : E →L[ℝ] ℝ}
  {x : E} {s : set E}

/-! #### `real.cos` -/

lemma has_strict_fderiv_at.cos (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, real.cos (f x)) (- real.sin (f x) • f') x :=
(real.has_strict_deriv_at_cos (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.cos (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, real.cos (f x)) (- real.sin (f x) • f') x :=
(real.has_deriv_at_cos (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.cos (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, real.cos (f x)) (- real.sin (f x) • f') s x :=
(real.has_deriv_at_cos (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.cos (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ x, real.cos (f x)) s x :=
hf.has_fderiv_within_at.cos.differentiable_within_at

@[simp] lemma differentiable_at.cos (hc : differentiable_at ℝ f x) :
  differentiable_at ℝ (λx, real.cos (f x)) x :=
hc.has_fderiv_at.cos.differentiable_at

lemma differentiable_on.cos (hc : differentiable_on ℝ f s) :
  differentiable_on ℝ (λx, real.cos (f x)) s :=
λx h, (hc x h).cos

@[simp] lemma differentiable.cos (hc : differentiable ℝ f) :
  differentiable ℝ (λx, real.cos (f x)) :=
λx, (hc x).cos

lemma fderiv_within_cos (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, real.cos (f x)) s x = - real.sin (f x) • (fderiv_within ℝ f s x) :=
hf.has_fderiv_within_at.cos.fderiv_within hxs

@[simp] lemma fderiv_cos (hc : differentiable_at ℝ f x) :
  fderiv ℝ (λx, real.cos (f x)) x = - real.sin (f x) • (fderiv ℝ f x) :=
hc.has_fderiv_at.cos.fderiv

lemma cont_diff.cos {n} (h : cont_diff ℝ n f) :
  cont_diff ℝ n (λ x, real.cos (f x)) :=
real.cont_diff_cos.comp h

lemma cont_diff_at.cos {n} (hf : cont_diff_at ℝ n f x) :
  cont_diff_at ℝ n (λ x, real.cos (f x)) x :=
real.cont_diff_cos.cont_diff_at.comp x hf

lemma cont_diff_on.cos {n} (hf : cont_diff_on ℝ n f s) :
  cont_diff_on ℝ n (λ x, real.cos (f x)) s :=
real.cont_diff_cos.comp_cont_diff_on  hf

lemma cont_diff_within_at.cos {n} (hf : cont_diff_within_at ℝ n f s x) :
  cont_diff_within_at ℝ n (λ x, real.cos (f x)) s x :=
real.cont_diff_cos.cont_diff_at.comp_cont_diff_within_at x hf

/-! #### `real.sin` -/

lemma has_strict_fderiv_at.sin (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, real.sin (f x)) (real.cos (f x) • f') x :=
(real.has_strict_deriv_at_sin (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.sin (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, real.sin (f x)) (real.cos (f x) • f') x :=
(real.has_deriv_at_sin (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.sin (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, real.sin (f x)) (real.cos (f x) • f') s x :=
(real.has_deriv_at_sin (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.sin (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ x, real.sin (f x)) s x :=
hf.has_fderiv_within_at.sin.differentiable_within_at

@[simp] lemma differentiable_at.sin (hc : differentiable_at ℝ f x) :
  differentiable_at ℝ (λx, real.sin (f x)) x :=
hc.has_fderiv_at.sin.differentiable_at

lemma differentiable_on.sin (hc : differentiable_on ℝ f s) :
  differentiable_on ℝ (λx, real.sin (f x)) s :=
λx h, (hc x h).sin

@[simp] lemma differentiable.sin (hc : differentiable ℝ f) :
  differentiable ℝ (λx, real.sin (f x)) :=
λx, (hc x).sin

lemma fderiv_within_sin (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, real.sin (f x)) s x = real.cos (f x) • (fderiv_within ℝ f s x) :=
hf.has_fderiv_within_at.sin.fderiv_within hxs

@[simp] lemma fderiv_sin (hc : differentiable_at ℝ f x) :
  fderiv ℝ (λx, real.sin (f x)) x = real.cos (f x) • (fderiv ℝ f x) :=
hc.has_fderiv_at.sin.fderiv

lemma cont_diff.sin {n} (h : cont_diff ℝ n f) :
  cont_diff ℝ n (λ x, real.sin (f x)) :=
real.cont_diff_sin.comp h

lemma cont_diff_at.sin {n} (hf : cont_diff_at ℝ n f x) :
  cont_diff_at ℝ n (λ x, real.sin (f x)) x :=
real.cont_diff_sin.cont_diff_at.comp x hf

lemma cont_diff_on.sin {n} (hf : cont_diff_on ℝ n f s) :
  cont_diff_on ℝ n (λ x, real.sin (f x)) s :=
real.cont_diff_sin.comp_cont_diff_on  hf

lemma cont_diff_within_at.sin {n} (hf : cont_diff_within_at ℝ n f s x) :
  cont_diff_within_at ℝ n (λ x, real.sin (f x)) s x :=
real.cont_diff_sin.cont_diff_at.comp_cont_diff_within_at x hf

/-! #### `real.cosh` -/

lemma has_strict_fderiv_at.cosh (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, real.cosh (f x)) (real.sinh (f x) • f') x :=
(real.has_strict_deriv_at_cosh (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.cosh (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, real.cosh (f x)) (real.sinh (f x) • f') x :=
(real.has_deriv_at_cosh (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.cosh (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, real.cosh (f x)) (real.sinh (f x) • f') s x :=
(real.has_deriv_at_cosh (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.cosh (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ x, real.cosh (f x)) s x :=
hf.has_fderiv_within_at.cosh.differentiable_within_at

@[simp] lemma differentiable_at.cosh (hc : differentiable_at ℝ f x) :
  differentiable_at ℝ (λx, real.cosh (f x)) x :=
hc.has_fderiv_at.cosh.differentiable_at

lemma differentiable_on.cosh (hc : differentiable_on ℝ f s) :
  differentiable_on ℝ (λx, real.cosh (f x)) s :=
λx h, (hc x h).cosh

@[simp] lemma differentiable.cosh (hc : differentiable ℝ f) :
  differentiable ℝ (λx, real.cosh (f x)) :=
λx, (hc x).cosh

lemma fderiv_within_cosh (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, real.cosh (f x)) s x = real.sinh (f x) • (fderiv_within ℝ f s x) :=
hf.has_fderiv_within_at.cosh.fderiv_within hxs

@[simp] lemma fderiv_cosh (hc : differentiable_at ℝ f x) :
  fderiv ℝ (λx, real.cosh (f x)) x = real.sinh (f x) • (fderiv ℝ f x) :=
hc.has_fderiv_at.cosh.fderiv

lemma cont_diff.cosh {n} (h : cont_diff ℝ n f) :
  cont_diff ℝ n (λ x, real.cosh (f x)) :=
real.cont_diff_cosh.comp h

lemma cont_diff_at.cosh {n} (hf : cont_diff_at ℝ n f x) :
  cont_diff_at ℝ n (λ x, real.cosh (f x)) x :=
real.cont_diff_cosh.cont_diff_at.comp x hf

lemma cont_diff_on.cosh {n} (hf : cont_diff_on ℝ n f s) :
  cont_diff_on ℝ n (λ x, real.cosh (f x)) s :=
real.cont_diff_cosh.comp_cont_diff_on  hf

lemma cont_diff_within_at.cosh {n} (hf : cont_diff_within_at ℝ n f s x) :
  cont_diff_within_at ℝ n (λ x, real.cosh (f x)) s x :=
real.cont_diff_cosh.cont_diff_at.comp_cont_diff_within_at x hf

/-! #### `real.sinh` -/

lemma has_strict_fderiv_at.sinh (hf : has_strict_fderiv_at f f' x) :
  has_strict_fderiv_at (λ x, real.sinh (f x)) (real.cosh (f x) • f') x :=
(real.has_strict_deriv_at_sinh (f x)).comp_has_strict_fderiv_at x hf

lemma has_fderiv_at.sinh (hf : has_fderiv_at f f' x) :
  has_fderiv_at (λ x, real.sinh (f x)) (real.cosh (f x) • f') x :=
(real.has_deriv_at_sinh (f x)).comp_has_fderiv_at x hf

lemma has_fderiv_within_at.sinh (hf : has_fderiv_within_at f f' s x) :
  has_fderiv_within_at (λ x, real.sinh (f x)) (real.cosh (f x) • f') s x :=
(real.has_deriv_at_sinh (f x)).comp_has_fderiv_within_at x hf

lemma differentiable_within_at.sinh (hf : differentiable_within_at ℝ f s x) :
  differentiable_within_at ℝ (λ x, real.sinh (f x)) s x :=
hf.has_fderiv_within_at.sinh.differentiable_within_at

@[simp] lemma differentiable_at.sinh (hc : differentiable_at ℝ f x) :
  differentiable_at ℝ (λx, real.sinh (f x)) x :=
hc.has_fderiv_at.sinh.differentiable_at

lemma differentiable_on.sinh (hc : differentiable_on ℝ f s) :
  differentiable_on ℝ (λx, real.sinh (f x)) s :=
λx h, (hc x h).sinh

@[simp] lemma differentiable.sinh (hc : differentiable ℝ f) :
  differentiable ℝ (λx, real.sinh (f x)) :=
λx, (hc x).sinh

lemma fderiv_within_sinh (hf : differentiable_within_at ℝ f s x)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, real.sinh (f x)) s x = real.cosh (f x) • (fderiv_within ℝ f s x) :=
hf.has_fderiv_within_at.sinh.fderiv_within hxs

@[simp] lemma fderiv_sinh (hc : differentiable_at ℝ f x) :
  fderiv ℝ (λx, real.sinh (f x)) x = real.cosh (f x) • (fderiv ℝ f x) :=
hc.has_fderiv_at.sinh.fderiv

lemma cont_diff.sinh {n} (h : cont_diff ℝ n f) :
  cont_diff ℝ n (λ x, real.sinh (f x)) :=
real.cont_diff_sinh.comp h

lemma cont_diff_at.sinh {n} (hf : cont_diff_at ℝ n f x) :
  cont_diff_at ℝ n (λ x, real.sinh (f x)) x :=
real.cont_diff_sinh.cont_diff_at.comp x hf

lemma cont_diff_on.sinh {n} (hf : cont_diff_on ℝ n f s) :
  cont_diff_on ℝ n (λ x, real.sinh (f x)) s :=
real.cont_diff_sinh.comp_cont_diff_on  hf

lemma cont_diff_within_at.sinh {n} (hf : cont_diff_within_at ℝ n f s x) :
  cont_diff_within_at ℝ n (λ x, real.sinh (f x)) s x :=
real.cont_diff_sinh.cont_diff_at.comp_cont_diff_within_at x hf

end


import tactic
import data.set.basic
import data.real.basic
import algebra.order.floor
import data.real.irrational
import data.set.basic
import data.real.basic
import data.rat.basic
import .greg_lemmas

-- TO DO
--O prove union part

-- definition of a Beatty seq
def B : ℝ → set ℤ  := λ r, { n | ∃ m : ℤ , (m ≥ 1 ) ∧ ((n : ℤ ) = int.floor ((m : ℝ)  * r) ) }

lemma mem_b_iff {q : ℝ} {k : ℤ }  : (k ∈ (B q)) ↔ ∃ m : ℤ   , (m ≥ 1 ) ∧ (k : ℤ )  = int.floor ((m : ℝ) * q ) :=
begin
  split,
  intro hk,
  rw set.mem_def at hk,
  exact hk,
  intro h,
  rw set.mem_def,
  assumption,
end

-- good examples of easy lemmas in lean
lemma self_div_self_sub_one_neq_one (q : ℝ ) (hq : q > 1) : q/(q-1) ≠ 1 :=
begin
  by_contra hc,
  have hc' : (q - 1) * (q / (q - 1)) = (q - 1 ) * 1 := congr_arg (has_mul.mul (q - 1)) hc,
  rw [← mul_div_assoc, mul_one, mul_comm, mul_div_assoc, div_self, mul_one] at hc',
  repeat {linarith,},
end

lemma self_div_self_sub_one_neq_zero (q : ℝ ) (hq : q > 1) : q/(q-1) ≠ 0 :=
begin
  by_contra hc,
  have hc' : (q - 1) * (q / (q - 1)) = (q - 1 ) * 0 := congr_arg (has_mul.mul (q - 1)) hc,
  rw mul_zero at hc',
  rw ← mul_div_assoc at hc',
  rw mul_comm at hc',
  rw mul_div_assoc at hc',
  rw div_self at hc',
  rw mul_one at hc',
  linarith,
  linarith,
end

lemma irrat_mul_sub_irrat (a b : ℤ) (q : ℝ) (hsub : (a : ℝ)  - ↑b ≠ 0) (hq : irrational q) :
  irrational (q *(↑a - ↑b)) :=
begin
  have hsub' : a - b ≠ 0,
  {
    norm_cast at *,
  },
  norm_cast,
  rw irrational_mul_int_iff,
  exact ⟨hsub', hq⟩,
end

lemma irrat_div_irrat_sub_one_irrat (q : ℝ) (hq : irrational q) (h_q_gt_one : q > 1) :
  irrational (q / (q - 1)) :=
begin
  rw irrational_iff_ne_rational,
  by_contra hc, push_neg at hc,
  rcases hc with ⟨a, b, hf⟩,
  change (q / (q - 1)) = ↑a / ↑b at hf,

  have hf1 : (q - 1) * (q / (q - 1)) = (q - 1) * (↑a / ↑b) := congr_arg (has_mul.mul (q - 1)) hf,
  rw mul_div at hf1,
  rw mul_comm (q - 1) q at hf1,
  rw ← mul_div at hf1,
  rw div_self at hf1,
  rw mul_one at hf1,

  have hf2 : q * ↑b  = ((q - 1) * (↑a / ↑b)) * ↑b  := congr_fun (congr_arg has_mul.mul hf1) ↑b,
  rw mul_assoc at hf2,
  rw div_mul at hf2,
  rw div_self at hf2,
  rw div_one at hf2,
  rw sub_mul at hf2,
  rw one_mul at hf2,
  have hf3 : ↑a = q * ↑a - q * ↑b  := by linarith,
  rw ← mul_sub at hf3,
  have h_a_neq_b : (a : ℝ)  - ↑b ≠ 0 , {
    by_contra hc,
    have hr : (a : ℝ)  / ↑b = 1,
    {
      rw sub_eq_zero at hc,
      have hdiv: (b : ℝ) / ↑b = ↑a / ↑b := congr_fun (congr_arg has_div.div (eq.symm hc)) ↑b,
      rw div_self at hdiv,
      exact hdiv.symm,
      by_contra hc,
      rw hc at hf,
      rw div_zero at hf,
      apply self_div_self_sub_one_neq_zero q h_q_gt_one,
      exact hf,
    },
    rw hr at hf,
    apply self_div_self_sub_one_neq_one q h_q_gt_one,
    exact hf,
  },
  have h_irrational : irrational (q * (↑a - ↑b)) := irrat_mul_sub_irrat a b q h_a_neq_b hq,
  rw ← hf3 at h_irrational,
  have h_rational : ¬ (irrational ↑a) := int.not_irrational a,
  exact hq (false.rec (q ∈ set.range coe) (h_rational h_irrational)),
  tactic.swap,
  linarith,
  by_contra hc,
  rw hc at hf,
  rw div_zero at hf,
  apply self_div_self_sub_one_neq_zero q h_q_gt_one,
  exact hf,
end

lemma mul_sum_reciprocals (q p a : ℝ) : a / p + a / q = a* (1 / p + 1 / q) :=
begin
 rw mul_add,
 repeat {rw ← mul_div_assoc, rw mul_one},
end

lemma add_one_mul_sum_reciprocals (q p : ℝ) (x : ℤ) : (↑x  + 1) / p + (↑x  + 1) / q = (↑x  + 1)* (1 / p + 1 / q) :=
begin
 rw mul_add,
 repeat {rw ← mul_div_assoc, rw mul_one},
end

lemma sum_reciprocals_eq_one (q : ℝ) (hq : q > 1) : 1/ (q/(q-1)) + 1 / q = 1 :=
begin
 ring_nf,
 simp,
 rw mul_sub,
 simp,
 rwa inv_mul_cancel,
 linarith,
end

lemma floor_ge_one (m : ℤ ) (hm : m ≥ 1 ) (q : ℝ) (hq : q > 1) : ⌊↑m * q⌋ ≥ 1 :=
begin
 sorry,
end

lemma h_p_gt_one (q : ℝ) :  ( q/(q-1) > 1)  :=
begin
 sorry,
end

def Zpos := {z : ℤ | z > 0 }

-- proof I am basing off assumes an equivalent definition to B p U B q = Zpos
lemma rephrase_union (q p : ℝ) :  (∀ x ∈ Zpos, (∃ (m n : ℤ), (x = ⌊↑m * q⌋ ∨ x = ⌊↑n * p⌋)))
  ↔ (∀ x ∈ Zpos, (∃ (k l : ℤ), (x < ⌊↑k * q⌋ ∨ x + 1 > ⌊↑(k + 1) * q⌋) ∨ (x < ⌊↑l * q⌋ ∨ x + 1 > ⌊↑(l + 1) * q⌋))) :=
begin
  split, {
    intros hx x,
    intro hx',
    specialize hx x,
    specialize hx hx',
    rcases hx with ⟨m, n, hmn⟩,
    cases hmn, {
      have hmn' : ⌊↑m * q⌋ = x := eq.symm hmn, clear hmn,
      rw int.floor_eq_iff at hmn',
      cases hmn' with hle hlt,
      sorry,
    }, {
      have hmn' : ⌊↑n * p⌋ = x := eq.symm hmn, clear hmn,
      rw int.floor_eq_iff at hmn',
      cases hmn' with hle hlt,
      sorry,
    },

  }, {
    intros hx x hx',
    specialize hx x hx',
    rcases hx with ⟨k, l, hkl⟩,
    sorry,
  }
end

-- proof of rephrased union condition, in progress
lemma anti_collisions (q p : ℝ) (k l : ℤ) (h_irrat : irrational q ∧ irrational p ) (hpq : 1/p + 1/q = 1) (x : ℤ) (hx : x > 0)  :
  (∃ (k l : ℤ), (x < ⌊↑k * q⌋ ∨ x + 1 > ⌊↑(k + 1) * q⌋) ∨ (x < ⌊↑l * p⌋ ∨ x + 1 > ⌊↑(l + 1) * p⌋)) :=
begin
  by_contra hc, push_neg at hc,
  specialize hc k l,
  rcases hc with ⟨ ⟨hq1, hq2⟩, ⟨hp1, hp2⟩ ⟩,
  sorry,
end

lemma beatty_theorem_forward_union' ( q : ℝ ) (hq : irrational q) (h_q_gt_one : q > 1) (h_inter : (B q) ∩ (B ( q/(q-1))) = ∅) :
(B q) ∪ (B ( q/(q-1))) = {n : ℤ | n ≥ 1 } :=
begin
  have h_p_gt_one := h_p_gt_one q,
  set p := (q/(q-1)),
  ext,
  split, {
    intro hx,
    repeat {rw set.mem_union at hx},
    cases hx with hxq hxp,
    {
      rw mem_b_iff at hxq,
      cases hxq with m hm,
      cases hm with hm hx',
      change x ≥ 1,
      have hge := floor_ge_one m hm q h_q_gt_one,
      rwa ← hx' at hge,
    }, {
      rw mem_b_iff at hxp,
      cases hxp with m hm,
      cases hm with hm hx',
      change x ≥ 1,
      have hge := floor_ge_one m hm p h_p_gt_one,
      rwa ← hx' at hge,
    },
  }, {
    intro hx,
    have hx' : x ≥ 1 := set.mem_def.mp hx, clear hx,
    rw set.mem_union,
    repeat {rw mem_b_iff},
    apply or_iff_not_imp_left.mpr,
    intro h,
    push_neg at h,
    have h0 := h,

  },

end

lemma beatty_theorem_forward_inter ( q : ℝ ) (hq : irrational q) (h_q_gt_one : q > 1) :
(((B q) ∩ (B (q/(q-1)))) = ∅) :=
begin
  -- let p be defined as
  set p := (q/(q-1)),
  -- by contradiction
  by_contra h,
  -- rewrite to unfold definitions
  change B q ∩ B p ≠ ∅ at h,
  rw ← set.nonempty_iff_ne_empty at h,
  rw set.nonempty_def at h,
  -- introduce variables from existence
  rcases h with ⟨x, hxq, hxp⟩,
  rw mem_b_iff at *,

  cases hxq with m hm,
  cases hxp with l hl,

  have hm2 := int.floor_eq_iff.mp (hm.2).symm,
  cases hm2 with hm_le hm_gt,

  --inequality can't be true because of irrationality
  have hm_neq : ↑x ≠ ↑m * q,
  {
    -- use irrationality
    have h_m_neq_zero : m ≠ 0 := by linarith,
    have h_m_neq_zero' : (m : ℚ)  ≠ 0 := int.cast_ne_zero.mpr h_m_neq_zero,
    have h_rhs : irrational (↑(m : ℚ) * q) := irrational.rat_mul hq h_m_neq_zero',
    exact (irrational.ne_int h_rhs x).symm,
  },
  -- manipulate inequalities
  have hm_lt : ↑x < ↑m * q := ne.lt_of_le hm_neq hm_le,
  have hq_pos : q > 0 := by linarith,
  have hm_lt2 : ↑x/q < ↑m := (div_lt_iff hq_pos).mpr hm_lt,
  have hl_gt2 : ↑m  < (↑x + 1)/q  := (lt_div_iff hq_pos).mpr hm_gt,

  have hl2 := int.floor_eq_iff.mp (hl.2).symm,
  cases hl2 with hl_le hl_gt,
  have hl_neq : ↑x ≠ ↑l * p,
  {
    -- use irrationality
    have hp : irrational p,
    {
      change irrational (q/(q-1)),
      exact irrat_div_irrat_sub_one_irrat q hq h_q_gt_one,
    },
    have h_l_neq_zero : l ≠ 0 := by linarith,
    have h_l_neq_zero' : (l : ℚ)  ≠ 0 := int.cast_ne_zero.mpr h_l_neq_zero,
    have h_rhs : irrational (↑(l : ℚ) * p) := irrational.rat_mul hp h_l_neq_zero',
    exact (irrational.ne_int h_rhs x).symm,
  },
  have hl_lt : ↑x < ↑l * p := ne.lt_of_le hl_neq hl_le,
  have hp_pos : p > 0 := p_is_positive q h_q_gt_one,
  have hl_lt2 : ↑x/p < ↑l := (div_lt_iff hp_pos).mpr hl_lt,
  have hl_gt2 : ↑l  < (↑x + 1)/p  := (lt_div_iff hp_pos).mpr hl_gt,

  have h_lt : ↑x/p + ↑x/q < ↑m + ↑l := by linarith,
  have h_gt : ↑m + ↑l  < (↑x + 1)/p + (↑x + 1)/q  := by linarith,

  have hqp : 1/p + 1/q = 1 := sum_reciprocals_eq_one q h_q_gt_one,

  have hs0 : (↑x + 1) / p + (↑x + 1) / q = (↑x + 1) * (1 / p + 1 / q) := add_one_mul_sum_reciprocals q p x,
  rw hs0 at h_gt,
  rw hqp at h_gt,
  rw mul_one at h_gt,

  have hs1 : ↑x  / p + ↑x / q = ↑x  * (1 / p + 1 / q) := mul_sum_reciprocals q p (x : ℝ),
  rw hs1 at h_lt,
  rw hqp at h_lt,
  rw mul_one at h_lt,

  norm_cast at *,
  linarith,
end

-- Forward direction:
-- complementary beatty sequences partition ℕ

theorem beatty_theorem_forward ( q : ℝ ) (hq : irrational q) (h_q_gt_one : q > 1) :
 ((B q) ∪ (B ( q/(q-1))) = {n : ℤ | n ≥ 1 }) ∧ (((B q) ∩ (B (q/(q-1)))) = ∅) :=
begin
  exact ⟨ beatty_theorem_forward_union' q hq h_q_gt_one, beatty_theorem_forward_inter q hq h_q_gt_one⟩,
end

-- Converse direction
-- if two beatty sequence B p, B q partition ℕ, then 1/p + 1/ q = 1

-- In progress...

-- Upensky's theorem
-- https://mathweb.ucsd.edu/~fan/ron/papers/63_01_uspensky.pdf

-- if a set S of positive real numbers has the property that the beatty sequences formed by these numbers
-- partition the positive natural numbers, then |S| < 3

def P : finset ℝ → Prop := λ S,  ((⋃ (r : S) , B r) = {n : ℤ | n > 1 }) ∧ ((⋂ (r : S) , B r) = ∅)

lemma p_is_true (S : finset ℝ ) : P S ↔ ((⋃ (r : S) , B r) = {n : ℤ | n > 1 }) ∧ ((⋂ (r : S) , B r) = ∅) :=
begin
  refl,
end

theorem upensky (S : finset ℝ ) (hS : P S) : ∀ s ∈ (P⁻¹'({true})), finset.card s < 3 :=
begin
  by_contra hc, push_neg at hc,
  cases hc with S hn,
  cases hn,
  rewrite set.mem_preimage at hn_left,
  rw p_is_true at hn_left,
  dsimp at hn_left,
  sorry,

end

-- lemma beatty_theorem_forward_union'' ( q : ℝ ) (hq : irrational q) (h_q_gt_one : q > 1) (h_inter : (B q) ∩ (B ( q/(q-1))) = ∅) :
-- (B q) ∪ (B ( q/(q-1))) = {n : ℤ | n ≥ 1 } :=
-- begin
--   have h_p_gt_one := h_p_gt_one q,
--   set p := (q/(q-1)),
--   ext,
--   split, {
--     intro hx,
--     repeat {rw set.mem_union at hx},
--     cases hx with hxq hxp,
--     {
--       rw mem_b_iff at hxq,
--       cases hxq with m hm,
--       cases hm with hm hx',
--       change x ≥ 1,
--       have hge := floor_ge_one m hm q h_q_gt_one,
--       rwa ← hx' at hge,
--     }, {
--       rw mem_b_iff at hxp,
--       cases hxp with m hm,
--       cases hm with hm hx',
--       change x ≥ 1,
--       have hge := floor_ge_one m hm p h_p_gt_one,
--       rwa ← hx' at hge,
--     },
--   }, {
--     intro hx,
--     have hx' : x ≥ 1 := set.mem_def.mp hx, clear hx,
--     rw set.mem_union,
--     repeat {rw mem_b_iff},
--     sorry,

--   },

-- end


/-
Copyright (c) 2022 Praneeth Kolichala. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Praneeth Kolichala

! This file was ported from Lean 3 source module data.nat.bits
! leanprover-community/mathlib commit d012cd09a9b256d870751284dd6a29882b0be105
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Init.Data.Nat.Bitwise
import Mathlib.Init.Data.List.Basic
import Mathlib.Data.Nat.Basic

/-!
# Additional properties of binary recursion on `Nat`

This file documents additional properties of binary recursion,
which allows us to more easily work with operations which do depend
on the number of leading zeros in the binary representation of `n`.
For example, we can more easily work with `Nat.bits` and `Nat.size`.

See also: `Nat.bitwise`, `Nat.pow` (for various lemmas about `size` and `shiftl`/`shiftr`),
and `Nat.digits`.
-/

-- As this file is all about `bit0` and `bit1`,
-- we turn off the deprecated linter for the whole file.
set_option linter.deprecated false

namespace Nat

universe u

variable {n : ℕ}

/-! ### `boddDiv2_eq` and `bodd` -/

@[simp]
theorem boddDiv2_eq (n : ℕ) : boddDiv2 n = (bodd n, div2 n) := by
  unfold bodd div2; cases boddDiv2 n; rfl
#align nat.bodd_div2_eq Nat.boddDiv2_eq

@[simp]
theorem bodd_bit0 (n) : bodd (bit0 n) = false :=
  bodd_bit false n
#align nat.bodd_bit0 Nat.bodd_bit0

@[simp]
theorem bodd_bit1 (n) : bodd (bit1 n) = true :=
  bodd_bit true n
#align nat.bodd_bit1 Nat.bodd_bit1

@[simp]
theorem div2_bit0 (n) : div2 (bit0 n) = n :=
  div2_bit false n
#align nat.div2_bit0 Nat.div2_bit0

@[simp]
theorem div2_bit1 (n) : div2 (bit1 n) = n :=
  div2_bit true n
#align nat.div2_bit1 Nat.div2_bit1

/-! ### `bit0` and `bit1` -/

-- There is no need to prove `bit0_eq_zero : bit0 n = 0 ↔ n = 0`
-- as this is true for any `[Semiring R] [NoZeroDivisors R] [CharZero R]`
-- However the lemmas `bit0_eq_bit0`, `bit1_eq_bit1`, `bit1_eq_one`, `one_eq_bit1`
-- need `[Ring R] [NoZeroDivisors R] [CharZero R]` in general,
-- so we prove `ℕ` specialized versions here.
@[simp]

@[simp]
theorem bit1_eq_bit1 {m n : ℕ} : bit1 m = bit1 n ↔ m = n :=
  ⟨Nat.bit1_inj, fun h => by subst h; rfl⟩
#align nat.bit1_eq_bit1 Nat.bit1_eq_bit1

@[simp]
theorem bit1_eq_one {n : ℕ} : bit1 n = 1 ↔ n = 0 :=
  ⟨@Nat.bit1_inj n 0, fun h => by subst h; rfl⟩
#align nat.bit1_eq_one Nat.bit1_eq_one

@[simp]
theorem one_eq_bit1 {n : ℕ} : 1 = bit1 n ↔ n = 0 :=
  ⟨fun h => (@Nat.bit1_inj 0 n h).symm, fun h => by subst h; rfl⟩
#align nat.one_eq_bit1 Nat.one_eq_bit1

theorem bit_add : ∀ (b : Bool) (n m : ℕ), bit b (n + m) = bit false n + bit b m
  | true => bit1_add
  | false => bit0_add
#align nat.bit_add Nat.bit_add

theorem bit_add' : ∀ (b : Bool) (n m : ℕ), bit b (n + m) = bit b n + bit false m
  | true => bit1_add'
  | false => bit0_add
#align nat.bit_add' Nat.bit_add'

theorem bit_ne_zero (b) {n} (h : n ≠ 0) : bit b n ≠ 0 := by
  cases b <;> [exact Nat.bit0_ne_zero h, exact Nat.bit1_ne_zero _]
#align nat.bit_ne_zero Nat.bit_ne_zero

theorem bit0_mod_two : bit0 n % 2 = 0 := by
  rw [Nat.mod_two_of_bodd]
  simp
#align nat.bit0_mod_two Nat.bit0_mod_two

theorem bit1_mod_two : bit1 n % 2 = 1 := by
  rw [Nat.mod_two_of_bodd]
  simp
#align nat.bit1_mod_two Nat.bit1_mod_two

theorem pos_of_bit0_pos {n : ℕ} (h : 0 < bit0 n) : 0 < n := by
  cases n
  · cases h
  · apply succ_pos
#align nat.pos_of_bit0_pos Nat.pos_of_bit0_pos

@[simp]
theorem bitCasesOn_bit {C : ℕ → Sort u} (H : ∀ b n, C (bit b n)) (b : Bool) (n : ℕ) :
    bitCasesOn (bit b n) H = H b n :=
  eq_of_heq <| (eq_rec_heq _ _).trans <| by rw [bodd_bit, div2_bit]
#align nat.bit_cases_on_bit Nat.bitCasesOn_bit

@[simp]
theorem bitCasesOn_bit0 {C : ℕ → Sort u} (H : ∀ b n, C (bit b n)) (n : ℕ) :
    bitCasesOn (bit0 n) H = H false n :=
  bitCasesOn_bit H false n
#align nat.bit_cases_on_bit0 Nat.bitCasesOn_bit0

@[simp]
theorem bitCasesOn_bit1 {C : ℕ → Sort u} (H : ∀ b n, C (bit b n)) (n : ℕ) :
    bitCasesOn (bit1 n) H = H true n :=
  bitCasesOn_bit H true n
#align nat.bit_cases_on_bit1 Nat.bitCasesOn_bit1

theorem bit_cases_on_injective {C : ℕ → Sort u} :
    Function.Injective fun H : ∀ b n, C (bit b n) => fun n => bitCasesOn n H := by
  intro H₁ H₂ h
  ext (b n)
  simpa only [bitCasesOn_bit] using congr_fun h (bit b n)
#align nat.bit_cases_on_injective Nat.bit_cases_on_injective

@[simp]
theorem bit_cases_on_inj {C : ℕ → Sort u} (H₁ H₂ : ∀ b n, C (bit b n)) :
    ((fun n => bitCasesOn n H₁) = fun n => bitCasesOn n H₂) ↔ H₁ = H₂ :=
  bit_cases_on_injective.eq_iff
#align nat.bit_cases_on_inj Nat.bit_cases_on_inj

protected theorem bit0_eq_zero {n : ℕ} : bit0 n = 0 ↔ n = 0 :=
  ⟨Nat.eq_zero_of_add_eq_zero_left, fun h => by simp [h]⟩
#align nat.bit0_eq_zero Nat.bit0_eq_zero

theorem bit_eq_zero_iff {n : ℕ} {b : Bool} : bit b n = 0 ↔ n = 0 ∧ b = false := by
  constructor
  · cases b <;> simp [Nat.bit, Nat.bit0_eq_zero, Nat.bit1_ne_zero]
  · rintro ⟨rfl, rfl⟩
    rfl
#align nat.bit_eq_zero_iff Nat.bit_eq_zero_iff

/--
The same as `binaryRec_eq`,
but that one unfortunately requires `f` to be the identity when appending `false` to `0`.
Here, we allow you to explicitly say that that case is not happening,
i.e. supplying `n = 0 → b = true`. -/
theorem binaryRec_eq' {C : ℕ → Sort _} {z : C 0} {f : ∀ b n, C n → C (bit b n)} (b n)
    (h : f false 0 z = z ∨ (n = 0 → b = true)) :
    binaryRec z f (bit b n) = f b n (binaryRec z f n) := by
  rw [binaryRec]
  split_ifs with h'
  · rcases bit_eq_zero_iff.mp h' with ⟨rfl, rfl⟩
    rw [binaryRec_zero]
    simp only [imp_false, or_false_iff, eq_self_iff_true, not_true] at h
    exact h.symm
  · dsimp only []
    -- Porting note: this line was `generalize_proofs e`:
    generalize @id (C (bit b n) = C (bit (bodd (bit b n)) (div2 (bit b n))))
      (Eq.symm (bit_decomp (bit b n)) ▸ Eq.refl (C (bit b n))) = e
    revert e
    rw [bodd_bit, div2_bit]
    intros
    rfl
#align nat.binary_rec_eq' Nat.binaryRec_eq'

/-- The same as `binaryRec`, but the induction step can assume that if `n=0`,
  the bit being appended is `true`-/
@[elab_as_elim]
def binaryRec' {C : ℕ → Sort _} (z : C 0) (f : ∀ b n, (n = 0 → b = true) → C n → C (bit b n)) :
    ∀ n, C n :=
  binaryRec z fun b n ih =>
    if h : n = 0 → b = true then f b n h ih
    else by
      convert z
      rw [bit_eq_zero_iff]
      simpa using h
#align nat.binary_rec' Nat.binaryRec'

/-- The same as `binaryRec`, but special casing both 0 and 1 as base cases -/
@[elab_as_elim]
def binaryRecFromOne {C : ℕ → Sort _} (z₀ : C 0) (z₁ : C 1) (f : ∀ b n, n ≠ 0 → C n → C (bit b n)) :
    ∀ n, C n :=
  binaryRec' z₀ fun b n h ih =>
    if h' : n = 0 then by
      rw [h', h h']
      exact z₁
    else f b n h' ih
#align nat.binary_rec_from_one Nat.binaryRecFromOne

@[simp]
theorem zero_bits : bits 0 = [] := by simp [Nat.bits]
#align nat.zero_bits Nat.zero_bits

@[simp]
theorem bits_append_bit (n : ℕ) (b : Bool) (hn : n = 0 → b = true) :
    (bit b n).bits = b :: n.bits := by
  rw [Nat.bits, binaryRec_eq']
  simpa
#align nat.bits_append_bit Nat.bits_append_bit

@[simp]
theorem bit0_bits (n : ℕ) (hn : n ≠ 0) : (bit0 n).bits = false :: n.bits :=
  bits_append_bit n false fun hn' => absurd hn' hn
#align nat.bit0_bits Nat.bit0_bits

@[simp]
theorem bit1_bits (n : ℕ) : (bit1 n).bits = true :: n.bits :=
  bits_append_bit n true fun _ => rfl
#align nat.bit1_bits Nat.bit1_bits

@[simp]
theorem one_bits : Nat.bits 1 = [true] := by
  convert bit1_bits 0
#align nat.one_bits Nat.one_bits

-- TODO Find somewhere this can live.
-- example : bits 3423 = [true, true, true, true, true, false, true, false, true, false, true, true]
-- := by norm_num

theorem bodd_eq_bits_head (n : ℕ) : n.bodd = n.bits.headI := by
  induction' n using Nat.binaryRec' with b n h _; · simp
  simp [bodd_bit, bits_append_bit _ _ h]
#align nat.bodd_eq_bits_head Nat.bodd_eq_bits_head

theorem div2_bits_eq_tail (n : ℕ) : n.div2.bits = n.bits.tail := by
  induction' n using Nat.binaryRec' with b n h _; · simp
  simp [div2_bit, bits_append_bit _ _ h]
#align nat.div2_bits_eq_tail Nat.div2_bits_eq_tail

end Nat


import data.sym2 -- allows us to use unordered pairs

/-
We begin by defining a graph as a triple:
- vertices;
- edges;
- and an endpoint map taking each edge to the unordered pair of its endpoints.
-/

structure graph :=
  (vertices : Type)
  (edges : Type)
  (endpoints : edges → sym2 vertices)

/-
Now we can define adjacency.
-/

def are_adjacent (G : graph) (a b : G.vertices) : Prop := ∃ e : G.edges, G.endpoints(e) = ⟦(a,b)⟧

/-
We now define a morphism of graphs to be a triple:
- a map on vertices;
- a map on edges;
- and a compatability condition between the two maps.
-/

structure morphism (G : graph) (H : graph) :=
  (vertex_map : G.vertices → H.vertices)
  (edge_map : G.edges → H.edges)
  (compatability : H.endpoints ∘ edge_map = sym2.map vertex_map ∘ G.endpoints)

/-
We want a convenient infix notation for a morphism.
-/

infix `↦` :50 := morphism

/-
We want to define composition of morphisms, so your first task is to prove that the
compatability condition needed holds when we do the `obvious' thing ... you will want
to use the result sym2.map_comp.
-/

/- Lemma :
For all graphs $G$, $H$ and $K$ and for all morphisms $α : G → H$ and $β : H → K$, we have
$ε_K ∘ β_e ∘ α_e = sym2 (β_v ∘ α_v) ∘ ε_G$.
-/
lemma compatability {G H K : graph} (α : G ↦ H) (β : H ↦ K) : K.endpoints ∘ β.edge_map ∘ α.edge_map = sym2.map (β.vertex_map ∘ α.vertex_map) ∘ G.endpoints :=
begin
  sorry,

end


-- Las funciones inyectivas tienen inversa por la izquierda
-- ========================================================

import tactic

open classical function

local attribute [instance] prop_decidable

variables {X Y : Type}

-- ----------------------------------------------------
-- Ej. 1. Definir la función
--    inversa :: (X → Y) → X → (Y → X)
-- tal que (inversa f d) es la función que a cada
-- y ∈ Y le asigna
-- + alguno de los elementos x tales que f(x) = y, si
--   existen dichos elementos y
-- + d, en caso contrario.
-- ----------------------------------------------------

noncomputable def inversa (f : X → Y) (d : X) : Y → X :=
λ y, if h : ∃ x, f x = y then some h else d

-- Notación:
variable (f : X → Y)
variable (d : X)
variable (y : Y)

-- ----------------------------------------------------
-- Ej. 2. Demostrar que si
--    ∃ x, f x = y
-- entonces,
--    f ((inversa f d) y) = y
-- ----------------------------------------------------

-- 1ª demostración
example
  (h : ∃ x, f x = y)
  : f ((inversa f d) y) = y :=
calc f ((inversa f d) y)
         = f (some h)  : congr rfl (dif_pos h)
     ... = y           : some_spec h

-- 2ª demostración
lemma inversa_cuando_existe
  (h : ∃ x, f x = y)
  : f ((inversa f d) y) = y :=
have h1 : (inversa f d) y = some h,
  from dif_pos h,
have h2 : f (some h) = y,
  from some_spec h,
show f (inversa f d y) = y,
  from eq.subst (eq.symm h1) h2

-- ----------------------------------------------------
-- Ej. 3. Demostrar que si f es inyectiva, entonces
-- (inversa f d) es inversa de f por la izquierda.
-- ----------------------------------------------------

-- 1ª demostración
example
  (h : injective f)
  : left_inverse (inversa f d) f :=
begin
  intro x,
  apply h,
  rw inversa_cuando_existe f d,
  use x,
end

-- 2ª demostración
lemma inversa_es_inversa_por_la_izquierda
  (h : injective f)
  : left_inverse (inversa f d) f :=
let g := (inversa f d) in
assume x,
have h1 : ∃ x', f x' = f x,
  from exists.intro x rfl,
have h2 : f (g (f x)) = f x,
  from inversa_cuando_existe f d (f x) h1,
show g (f x) = x,
  from h h2

-- ----------------------------------------------------
-- Ej. 4. Demostrar que si f es inyectiva, entonces
-- f tiene inversa por la izquierda.
-- ----------------------------------------------------

-- 1ª demostración
example
  (d : X)
  (h : injective f)
  : has_left_inverse f :=
begin
  unfold has_left_inverse,
  use (inversa f d),
  exact (inversa_es_inversa_por_la_izquierda f d h),
end

-- 2ª demostración
example
  (d : X)
  (h : injective f)
  : has_left_inverse f :=
have h1 : left_inverse (inversa f d) f,
  from inversa_es_inversa_por_la_izquierda f d h,
have h2 : ∃ g, left_inverse g f,
  from exists.intro (inversa f d) h1,
show has_left_inverse f,
  from h2

-- 3ª demostración
example
  (d : X)
  (h : injective f)
  : has_left_inverse f :=
have h1 : left_inverse (inversa f d) f,
  from inversa_es_inversa_por_la_izquierda f d h,
show has_left_inverse f,
  from exists.intro (inversa f d) h1


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro h,
  intro hnp,
  contradiction,

end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro nnp,
  by_contradiction hboom,
  contradiction,

end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  {
    intro h,
    by_contradiction hboom,
    contradiction,
  },
  {
    intro h,
    intro hnp,
    contradiction,
  }
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro hpq,
  cases hpq with hp hq,
  {
    right,
    assumption

  },
  {
    left,
    assumption,
  }

end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro h,
  split,
  {
    cases h,
    assumption
  },
  {
    cases h,
    assumption
  }
end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro h,
  intro hp,
  cases h with hnp hq,
  {
    contradiction,
  },
  {
    assumption,
  }
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro h,
  intro hnp,
  cases h with hp hq,
  {
    contradiction,
  },
  {
    assumption,
  }
end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro h,
  intro hq,
  by_cases r : P,
  {
    have hq: Q := h r,
    contradiction,
  },
  {
    assumption,
  }
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro h,
  intro p,
  by_cases r : Q,
  {
    assumption,
  },
  {
    have hnp:¬P := h r,
    contradiction,
  }
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  {
    intro h,
    intro hnq,
    by_contradiction hboom,
    have hq:Q := h hboom,
    contradiction,
  },
  {
    intro h,
    intro hp,
    by_cases r: Q,
    {
      assumption,
    },
    {
      have hnp:¬P := h r,
      contradiction,
    }
  }
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro h,
  by_cases x:P,
  {
    apply h,
    left,
    assumption
  },
  {
    apply h,
    right,
    assumption,
  }

end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro h,
  intro np,
  apply np,
  apply h,
  intro p,
  contradiction,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro hpq,
  intro npq,
  cases npq with np nq,
  cases hpq with hp hq,
  {
    contradiction,
  },
  {
    contradiction,
  }
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro hpq,
  intro norpq,
  cases hpq with p q,
  cases norpq with np nq,
  {
    contradiction,
  },
  {
    contradiction,
  }
end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro nhpq,
  split,
  {
    intro np,
    apply nhpq,
    left,
    assumption
  },
  {
    intro nq,
    apply nhpq,
    right,
    assumption,

  }
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro cnpq,
  intro porq,
  cases cnpq with np nq,
  cases porq with hp hq,
  {
    contradiction,
  },
  {
    contradiction,
  }
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro nepq,
  by_cases h:P,
  {
    left,
    intro q,
    apply nepq,
    split,
    {
      assumption,
    },
    {
      assumption,
    }
  },
  {
    right,
    assumption,
  }
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro nopq,
  intro peq,
  cases peq with p q,
  cases nopq with nq np,
  {
    contradiction,
  },
  {
    contradiction,
  }
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  {
    intro npeq,
    by_cases h:P,
    {
      left,
      intro q,
      apply npeq,
      split,
      {
        assumption,
      },
      {
        assumption,
      }
    },
    {
      right,
      assumption,
    },

  },
  {
    intro norpq,
    intro peq,
    cases peq with p q,
    cases norpq with np nq,
    {
      contradiction,
    },
    {
      contradiction,
    }
  }

end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  {
    intro nopq,
    split,
    {
      intro p,
      apply nopq,
      left,
      assumption,
    },
    {
      intro q,
      apply nopq,
      right,
      assumption,
    },
  },
  {
    intro nepq,
    intro pouq,
    cases nepq with np nq,
    cases pouq with p q,
    {
      contradiction,
    },
    {
      contradiction,
    }
  }
end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro peqor,
  cases peqor with p qr,
  cases qr with q r,
  {
    left,
    split,
    {
      assumption
    },
    {
      assumption,
    },
  },
  {
    right,
    split,
    {
      assumption,
    },
    {
      assumption,
    }
  }
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro peqoper,
  split,
  {
    cases peqoper with peq per,
    {
      cases peq with p q,
      assumption,
    },
    {
      cases per with p r,
      assumption,
    },
  },
  {
    cases peqoper with peq per,
    {
      cases peq with p q,
      left,
      assumption,
    },
    {
      cases per with p r,
      right,
      assumption,

    }
  }
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro poqer,
  split,
  {
    cases poqer with p qer,
    {
      left,
      assumption,
    },
    {
      cases qer with q r,
      right,
      assumption,
    },
  },
  {
    cases poqer with p qer,
    {
      left,
      assumption,
    },
    {
      cases qer with q r,
      right,
      assumption,
    }
  }
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro hpoqepor,
  cases hpoqepor with hpoq por,
  cases hpoq with p q,
  {
    left,
    assumption,
  },
  {
    cases por with p r,
    {
      left,
      assumption,
    },
    {
      right,
      split,
      {
        assumption,
      },
      {
        assumption,
      },
    }
  }

end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro peq_tor,
  intro p,
  intro q,
  apply peq_tor,
  split,
  {
    assumption,
  },
  {
    assumption,
  }

end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro p_to_q_to_r,
  intro peq,
  cases peq with p q,
  apply p_to_q_to_r,
  {
    assumption,
  },
  {
    assumption,
  },

end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro p,
  assumption,
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro p,
  left,
  assumption,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro q,
  right,
  assumption,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro peq,
  cases peq with p q,
  assumption,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro peq,
  cases peq with p q,
  assumption,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  {
    intro pep,
    cases pep with p p',
    {
      assumption,
    },
  },
  {
    intro p,
    split,
    {
      assumption,
    },
    {
      assumption,
    },
  }
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  {
    intro pop,
    cases pop with p p',
    {
      assumption
    },
    {
      assumption,
    },
  },
  {
    intro p,
    left,
    assumption,
  }
end

end propositional

----------------------------------------------------------------

section predicate

variable U : Type
variables P Q : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intro epx,
  intro x,
  by_contradiction hboom,
  apply epx,
  existsi x,
  assumption,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro napx,
  intro nepx,
  cases nepx with t ht,
  exact(napx t) ht,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  rw contrapositive_law,
  rw doubleneg_law,
  intro epx,
  intro x,
  by_contradiction nPx,
  apply epx,
  existsi x,
  exact nPx,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro epx,
  intro apx,
  cases epx with x npx,
  apply npx,
  apply apx,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  {
  rw contrapositive_law,
  rw doubleneg_law,
  intro epx,
  intro x,
  by_contradiction nPx,
  apply epx,
  existsi x,
  exact nPx,
  },
  {
    intro epx,
    intro apx,
    cases epx with x npx,
    apply npx,
    apply apx,
  }
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  {
    intro epx,
  intro x,
  by_contradiction hboom,
  apply epx,
  existsi x,
  assumption,
  },
  {
    intro napx,
  intro nepx,
  cases nepx with t ht,
  exact(napx t) ht,
  }
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intro epx,
  intro apx,
  cases epx with x Px,
  exact(apx x) Px,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro apx,
  intro nepx,
  cases nepx with x npx,
  apply npx,
  apply apx,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intro nepx,
  intro x,
  by_contradiction hboom,
  apply nepx,
  existsi x,
  exact hboom,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  rw contrapositive_law,
  rw doubleneg_law,
  intro nepx,
  intro x,
  by_contradiction pboom,
  apply nepx,
  existsi x,
  exact pboom,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  {
    intro apx,
  intro nepx,
  cases nepx with x npx,
  apply npx,
  apply apx,
  },
  {
    intro nepx,
  intro x,
  by_contradiction hboom,
  apply nepx,
  existsi x,
  exact hboom,
  }
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  {
    intro epx,
    intro apx,
    cases epx with x Px,
    exact(apx x) Px,
  },
  {
    rw contrapositive_law,
    rw doubleneg_law,
    intro nepx,
    intro x,
    by_contradiction pboom,
    apply nepx,
    existsi x,
    exact pboom,
  }
end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro epq,
  split,
  {
    sorry,
  }
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  sorry,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  sorry,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  sorry,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  sorry,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  sorry,
end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

---------------------------------------------- -/

end predicate