/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.norm_num
import Mathlib.data.int.range
import Mathlib.PostPort

universes u_1 l

namespace Mathlib

/-!
# `ring`

Evaluate expressions in the language of commutative (semi)rings.
Based on <http://www.cs.ru.nl/~freek/courses/tt-2014/read/10.1.1.61.3041.pdf> .
-/

namespace tactic

namespace ring

/-- The normal form that `ring` uses is mediated by the function `horner a x n b := a * x ^ n + b`.
The reason we use a definition rather than the (more readable) expression on the right is because
this expression contains a number of typeclass arguments in different positions, while `horner`
contains only one `comm_semiring` instance at the top level. See also `horner_expr` for a
description of normal form. -/
def horner {α : Type u_1} [comm_semiring α] (a : α) (x : α) (n : ℕ) (b : α) : α := a * x ^ n + b

/-- This cache contains data required by the `ring` tactic during execution. -/
/-- The monad that `ring` works in. This is a reader monad containing a mutable cache (using `ref`
for mutability), as well as the list of atoms-up-to-defeq encountered thus far, used for atom
sorting. -/
/-- Get the `ring` data from the monad. -/
/-- Get an already encountered atom by its index. -/
/-- Get the index corresponding to an atomic expression, if it has already been encountered, or
put it in the list of atoms and return the new index, otherwise. -/
/-- Lift a tactic into the `ring_m` monad. -/
/-- Run a `ring_m` tactic in the tactic monad. This version of `ring_m.run` uses an external
atoms ref, so that subexpressions can be named across multiple `ring_m` calls. -/
/-- Run a `ring_m` tactic in the tactic monad. -/
/-- Lift an instance cache tactic (probably from `norm_num`) to the `ring_m` monad. This version
is abstract over the instance cache in question (either the ring `α`, or `ℕ` for exponents). -/
/-- Lift an instance cache tactic (probably from `norm_num`) to the `ring_m` monad. This uses
the instance cache corresponding to the ring `α`. -/
/-- Lift an instance cache tactic (probably from `norm_num`) to the `ring_m` monad. This uses
the instance cache corresponding to `ℕ`, which is used for computations in the exponent. -/
/-- Apply a theorem that expects a `comm_semiring` instance. This is a special case of
`ic_lift mk_app`, but it comes up often because `horner` and all its theorems have this assumption;
it also does not require the tactic monad which improves access speed a bit. -/
/-- Every expression in the language of commutative semirings can be viewed as a sum of monomials,
where each monomial is a product of powers of atoms. We fix a global order on atoms (up to
definitional equality), and then separate the terms according to their smallest atom. So the top
level expression is `a * x^n + b` where `x` is the smallest atom and `n > 0` is a numeral, and
`n` is maximal (so `a` contains at least one monomial not containing an `x`), and `b` contains no
monomials with an `x` (hence all atoms in `b` are larger than `x`).

If there is no `x` satisfying these constraints, then the expression must be a numeral. Even though
we are working over rings, we allow rational constants when these can be interpreted in the ring,
so we can solve problems like `x / 3 = 1 / 3 * x` even though these are not technically in the
language of rings.

These constraints ensure that there is a unique normal form for each ring expression, and so the
algorithm is simply to calculate the normal form of each side and compare for equality.

To allow us to efficiently pattern match on normal forms, we maintain this inductive type that
holds a normalized expression together with its structure. All the `expr`s in this type could be
removed without loss of information, and conversely the `horner_expr` structure and the `ℕ` and
`ℚ` values can be recovered from the top level `expr`, but we keep both in order to keep proof
 producing normalization functions efficient. -/
/-- Get the expression corresponding to a `horner_expr`. This can be calculated recursively from
the structure, but we cache the exprs in all subterms so that this function can be computed in
constant time. -/
/-- Is this expr the constant `0`? -/
/-- Construct a `xadd` node, generating the cached expr using the input cache. -/
/-- Pretty printer for `horner_expr`. -/
/-- Pretty printer for `horner_expr`. -/
/-- Reflexivity conversion for a `horner_expr`. -/
theorem zero_horner {α : Type u_1} [comm_semiring α] (x : α) (n : ℕ) (b : α) : horner 0 x n b = b :=
  sorry

theorem horner_horner {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n₁ : ℕ) (n₂ : ℕ) (b : α)
    (n' : ℕ) (h : n₁ + n₂ = n') : horner (horner a₁ x n₁ 0) x n₂ b = horner a₁ x n' b :=
  sorry

/-- Evaluate `horner a n x b` where `a` and `b` are already in normal form. -/
theorem const_add_horner {α : Type u_1} [comm_semiring α] (k : α) (a : α) (x : α) (n : ℕ) (b : α)
    (b' : α) (h : k + b = b') : k + horner a x n b = horner a x n b' :=
  sorry

theorem horner_add_const {α : Type u_1} [comm_semiring α] (a : α) (x : α) (n : ℕ) (b : α) (k : α)
    (b' : α) (h : b + k = b') : horner a x n b + k = horner a x n b' :=
  sorry

theorem horner_add_horner_lt {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n₁ : ℕ) (b₁ : α)
    (a₂ : α) (n₂ : ℕ) (b₂ : α) (k : ℕ) (a' : α) (b' : α) (h₁ : n₁ + k = n₂)
    (h₂ : a₁ + horner a₂ x k 0 = a') (h₃ : b₁ + b₂ = b') :
    horner a₁ x n₁ b₁ + horner a₂ x n₂ b₂ = horner a' x n₁ b' :=
  sorry

theorem horner_add_horner_gt {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n₁ : ℕ) (b₁ : α)
    (a₂ : α) (n₂ : ℕ) (b₂ : α) (k : ℕ) (a' : α) (b' : α) (h₁ : n₂ + k = n₁)
    (h₂ : horner a₁ x k 0 + a₂ = a') (h₃ : b₁ + b₂ = b') :
    horner a₁ x n₁ b₁ + horner a₂ x n₂ b₂ = horner a' x n₂ b' :=
  sorry

theorem horner_add_horner_eq {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n : ℕ) (b₁ : α)
    (a₂ : α) (b₂ : α) (a' : α) (b' : α) (t : α) (h₁ : a₁ + a₂ = a') (h₂ : b₁ + b₂ = b')
    (h₃ : horner a' x n b' = t) : horner a₁ x n b₁ + horner a₂ x n b₂ = t :=
  sorry

/-- Evaluate `a + b` where `a` and `b` are already in normal form. -/
theorem horner_neg {α : Type u_1} [comm_ring α] (a : α) (x : α) (n : ℕ) (b : α) (a' : α) (b' : α)
    (h₁ : -a = a') (h₂ : -b = b') : -horner a x n b = horner a' x n b' :=
  sorry

/-- Evaluate `-a` where `a` is already in normal form. -/
theorem horner_const_mul {α : Type u_1} [comm_semiring α] (c : α) (a : α) (x : α) (n : ℕ) (b : α)
    (a' : α) (b' : α) (h₁ : c * a = a') (h₂ : c * b = b') : c * horner a x n b = horner a' x n b' :=
  sorry

theorem horner_mul_const {α : Type u_1} [comm_semiring α] (a : α) (x : α) (n : ℕ) (b : α) (c : α)
    (a' : α) (b' : α) (h₁ : a * c = a') (h₂ : b * c = b') : horner a x n b * c = horner a' x n b' :=
  sorry

/-- Evaluate `k * a` where `k` is a rational numeral and `a` is in normal form. -/
theorem horner_mul_horner_zero {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n₁ : ℕ) (b₁ : α)
    (a₂ : α) (n₂ : ℕ) (aa : α) (t : α) (h₁ : horner a₁ x n₁ b₁ * a₂ = aa)
    (h₂ : horner aa x n₂ 0 = t) : horner a₁ x n₁ b₁ * horner a₂ x n₂ 0 = t :=
  sorry

theorem horner_mul_horner {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n₁ : ℕ) (b₁ : α)
    (a₂ : α) (n₂ : ℕ) (b₂ : α) (aa : α) (haa : α) (ab : α) (bb : α) (t : α)
    (h₁ : horner a₁ x n₁ b₁ * a₂ = aa) (h₂ : horner aa x n₂ 0 = haa) (h₃ : a₁ * b₂ = ab)
    (h₄ : b₁ * b₂ = bb) (H : haa + horner ab x n₁ bb = t) :
    horner a₁ x n₁ b₁ * horner a₂ x n₂ b₂ = t :=
  sorry

/-- Evaluate `a * b` where `a` and `b` are in normal form. -/
theorem horner_pow {α : Type u_1} [comm_semiring α] (a : α) (x : α) (n : ℕ) (m : ℕ) (n' : ℕ)
    (a' : α) (h₁ : n * m = n') (h₂ : a ^ m = a') : horner a x n 0 ^ m = horner a' x n' 0 :=
  sorry

theorem pow_succ {α : Type u_1} [comm_semiring α] (a : α) (n : ℕ) (b : α) (c : α) (h₁ : a ^ n = b)
    (h₂ : b * a = c) : a ^ (n + 1) = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n + 1) = c)) (Eq.symm h₂)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n + 1) = b * a)) (Eq.symm h₁)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n + 1) = a ^ n * a)) (pow_succ' a n)))
        (Eq.refl (a ^ n * a))))

/-- Evaluate `a ^ n` where `a` is in normal form and `n` is a natural numeral. -/
theorem horner_atom {α : Type u_1} [comm_semiring α] (x : α) : x = horner 1 x 1 0 := sorry

/-- Evaluate `a` where `a` is an atom. -/
theorem subst_into_pow {α : Type u_1} [monoid α] (l : α) (r : ℕ) (tl : α) (tr : ℕ) (t : α)
    (prl : l = tl) (prr : r = tr) (prt : tl ^ tr = t) : l ^ r = t :=
  eq.mpr (id (Eq._oldrec (Eq.refl (l ^ r = t)) prl))
    (eq.mpr (id (Eq._oldrec (Eq.refl (tl ^ r = t)) prr))
      (eq.mpr (id (Eq._oldrec (Eq.refl (tl ^ tr = t)) prt)) (Eq.refl t)))

theorem unfold_sub {α : Type u_1} [add_group α] (a : α) (b : α) (c : α) (h : a + -b = c) :
    a - b = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b = c)) (sub_eq_add_neg a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -b = c)) h)) (Eq.refl c))

theorem unfold_div {α : Type u_1} [division_ring α] (a : α) (b : α) (c : α) (h : a * (b⁻¹) = c) :
    a / b = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b = c)) (div_eq_mul_inv a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b⁻¹) = c)) h)) (Eq.refl c))

/-- Evaluate a ring expression `e` recursively to normal form, together with a proof of
equality. -/
/-- Evaluate a ring expression `e` recursively to normal form, together with a proof of
equality. -/
theorem horner_def' {α : Type u_1} [comm_semiring α] (a : α) (x : α) (n : ℕ) (b : α) :
    horner a x n b = x ^ n * a + b :=
  sorry

theorem mul_assoc_rev {α : Type u_1} [semigroup α] (a : α) (b : α) (c : α) :
    a * (b * c) = a * b * c :=
  sorry

theorem pow_add_rev {α : Type u_1} [monoid α] (a : α) (m : ℕ) (n : ℕ) :
    a ^ m * a ^ n = a ^ (m + n) :=
  sorry

theorem pow_add_rev_right {α : Type u_1} [monoid α] (a : α) (b : α) (m : ℕ) (n : ℕ) :
    b * a ^ m * a ^ n = b * a ^ (m + n) :=
  sorry

theorem add_neg_eq_sub {α : Type u_1} [add_group α] (a : α) (b : α) : a + -b = a - b :=
  Eq.symm (sub_eq_add_neg a b)

/-- If `ring` fails to close the goal, it falls back on normalizing the expression to a "pretty"
form so that you can see why it failed. This setting adjusts the resulting form:

  * `raw` is the form that `ring` actually uses internally, with iterated applications of `horner`.
    Not very readable but useful if you don't want any postprocessing.
    This results in terms like `horner (horner (horner 3 y 1 0) x 2 1) x 1 (horner 1 y 1 0)`.
  * `horner` maintains the Horner form structure, but it unfolds the `horner` definition itself,
    and tries to otherwise minimize parentheses.
    This results in terms like `(3 * x ^ 2 * y + 1) * x + y`.
  * `SOP` means sum of products form, expanding everything to monomials.
    This results in terms like `3 * x ^ 3 * y + x + y`. -/
inductive normalize_mode where
| raw : normalize_mode
| SOP : normalize_mode
| horner : normalize_mode

protected instance normalize_mode.inhabited : Inhabited normalize_mode :=
  { default := normalize_mode.horner }

/-- A `ring`-based normalization simplifier that rewrites ring expressions into the specified mode.

  * `raw` is the form that `ring` actually uses internally, with iterated applications of `horner`.
    Not very readable but useful if you don't want any postprocessing.
    This results in terms like `horner (horner (horner 3 y 1 0) x 2 1) x 1 (horner 1 y 1 0)`.
  * `horner` maintains the Horner form structure, but it unfolds the `horner` definition itself,
    and tries to otherwise minimize parentheses.
    This results in terms like `(3 * x ^ 2 * y + 1) * x + y`.
  * `SOP` means sum of products form, expanding everything to monomials.
    This results in terms like `3 * x ^ 3 * y + x + y`. -/
end ring

namespace interactive

/-- Tactic for solving equations in the language of *commutative* (semi)rings.
  This version of `ring` fails if the target is not an equality
  that is provable by the axioms of commutative (semi)rings. -/
/-- Parser for `ring`'s `mode` argument, which can only be the "keywords" `raw`, `horner` or `SOP`.
(Because these are not actually keywords we use a name parser and postprocess the result.) -/
/-- Tactic for solving equations in the language of *commutative* (semi)rings.
Attempts to prove the goal outright if there is no `at`
specifier and the target is an equality, but if this
fails it falls back to rewriting all ring expressions
into a normal form. When writing a normal form,
`ring SOP` will use sum-of-products form instead of horner form.
`ring!` will use a more aggressive reducibility setting to identify atoms.

Based on [Proving Equalities in a Commutative Ring Done Right
in Coq](http://www.cs.ru.nl/~freek/courses/tt-2014/read/10.1.1.61.3041.pdf) by Benjamin Grégoire
and Assia Mahboubi.
-/
end Mathlib


import linear_algebra.basic

universes u v w x

variables {R : Type u} [ring R]
variables {M₁ : Type v} [add_comm_group M₁] [module R M₁]
variables {M₂ : Type w} [add_comm_group M₂] [module R M₂]
variables {M₃ : Type x} [add_comm_group M₃] [module R M₃]

open linear_map
open submodule

lemma linear_map.ker_le_range_iff {f : M₁ →ₗ[R] M₂} {g : M₂ →ₗ[R] M₃} :
  g.ker ≤ f.range ↔ f.range.mkq.comp g.ker.subtype = 0 :=
by rw [←range_le_ker_iff, ker_mkq, range_subtype]

/-⟨λ h, ker_eq_top.1 $ eq_top_iff'.2 $ λ x, mem_ker.2 $ by simpa using mem_range.1 (h x.2),
 λ h,
 begin
  rw ←range_le_ker_iff at h,
  rw ker_mkq at h,
  rw range_subtype at h,
  exact h,
 end-
  /-x hx,
 begin
  rw ←submodule.ker_mkq f.range,
  apply mem_ker.2,
  rw ←zero_apply x,
  rw ←h,
  --rw ←submodule.subtype_apply _ ⟨x, hx⟩,
  exact mem_ker.2 (@linear_map.congr _ _ _ _ _ _ _ _
    (comp (mkq (range f)) (submodule.subtype (ker g))) 0 ⟨x, hx⟩ h),-/
 end⟩-/


-- Title: Generation in Optimality Theory with Lexical Insertion is Undecidable
--
-- Author: Cerek Hillen
--
-- Description:
--   Here we show that PCP is reducible to OT. In particular, we show that when
--   there exists a solution to PCP, there exists a solution to OT, and when
--   there does not exist a solution to PCP, there does not exist a solution to
--   OT.
--
--   Because PCP is known to be Turing Complete, this reduction proves that OT
--   is also Turing Complete.

import data.vector

universes u v

--------------------------------------------------------------------------------
--                                   PCP                                      --
--------------------------------------------------------------------------------

-- Defining PCP
structure pcp
  {n : ℕ}
  (Γ : Type)
  (tops : vector (list Γ) n)
  (bottoms : vector (list Γ) n) : Type

namespace pcp
  open vector

  -- Defining the composition of a vector of symbols by a sequence. Used to
  -- define the existence of a solution for PCP.
  def compose
    {Γ : Type}
    {n : ℕ} :
      Π (symbols : vector (list Γ) n), list (fin n) → list Γ
        | symbols list.nil        := list.nil
        | symbols (list.cons i l) :=
          list.append
            (nth symbols i)
            (compose symbols l)

  -- The property of an instance of PCP having a solution. In plain English,
  -- an instance of PCP has a solution iff there exists a sequence of indicies
  -- such that the composition of the indexed tops and bottoms are equal.
  def has_solution
    {n : ℕ}
    {Γ : Type}
    {tops : vector (list Γ) n}
    {bottoms : vector (list Γ) n} :
      pcp Γ tops bottoms → Prop
      | _ := ∃ (seq : list (fin n)), compose tops seq = compose bottoms seq
end pcp

--------------------------------------------------------------------------------
--                             Optimality Theory                              --
--------------------------------------------------------------------------------

namespace ot
  open vector

  -- We define a score to be a vector of natural numbers of length n. Each value
  -- score_i corresponds to the number of violations that occurred in the ith
  -- constraint.
  def score (n : ℕ) := vector ℕ n

  -- We define an ordering on scores such that s₁ ≤ s₂ iff they are equal up to
  -- some index i, wherein s₁[i] ≤ s₂[i].
  --
  -- TODO: This definition isn't going to work, because you can prove it by
  --       using an index larger than n for i.
  def score_lte {n : ℕ} (s1 : score n) (s2 : score n) : Prop :=
    ∃ (i : ℕ), Π (ltin : i < n),
      (nth s1 (fin.mk i ltin)) ≤
      (nth s2 (fin.mk i ltin)) ∧
        ∀ (j : ℕ), Π (ltji : j < i),
          (nth s1 ⟨j, lt.trans ltji ltin⟩) =
          (nth s2 ⟨j, lt.trans ltji ltin⟩)

  -- TODO: Define the rest of OT
end ot

--------------------------------------------------------------------------------
--                                  Proof                                     --
--------------------------------------------------------------------------------

-- Step 1. Reduce from an arbitrary case of PCP to a case of PCP where there
--         exist only two characters.

-- Definition of a binary language
inductive bin
  | a : bin
  | b : bin

def alphabet_width : Type → ℕ := sorry

def map_to_binary
  {n : ℕ}
  {Γ : Type}

  {tops : vector (list Γ) n}
  {bottoms : vector (list Γ) n}

  {new_tops : vector (list bin) (n * alphabet_width Γ)}
  {new_bottoms : vector (list bin) (n * alphabet_width Γ)}:
    pcp Γ tops bottoms → pcp bin new_tops new_bottoms :=
      sorry

-- TODO: Debug it
-- theorem binary_equivalence {n : ℕ}
--                            {Γ : Type}
--                            {tops bottoms : vector (list Γ) n}
--                            (problem : pcp Γ tops bottoms) :
--   problem.has_solution ↔ (map_to_binary problem).has_solution :=
--   begin
--     split,
--     sorry,
--   end

-- Step 2. Provide our mapping from an arbitrary instance of PCP to an arbitrary
--         instance of OT.

-- TODO

-- Step 3. Show that PCP has a solution if and only if our mapped version of OT
--         has a solution.

-- TODO

--------------------------------------------------------------------------------
--                             Misc / Testing                                 --
--------------------------------------------------------------------------------

-- Proving that a simple instance of PCP has a solution.
namespace hidden_has_solution
  inductive Γ
    | a : Γ
    | b : Γ

  open Γ

  def top_l := [[b], [a]]
  def bot_l := [[], [b, a]]

  def tops : vector (list Γ) 2 := ⟨top_l, by refl⟩
  def bottoms : vector (list Γ) 2 := ⟨bot_l, by refl⟩

  theorem simple_pcp (problem : pcp Γ tops bottoms) : problem.has_solution :=
  begin
    existsi [[
      (0 : fin 2),
      (1 : fin 2)
    ]],
    refl,
  end

  #print simple_pcp
end hidden_has_solution

namespace hidden_score
  open ot
  open vector

  def x : score 5 := ⟨[0, 0, 1, 3, 5], by refl⟩
  def y : score 5 := ⟨[0, 0, 2, 1, 7], by refl⟩

  example : (score_lte x y) :=
  begin
    existsi 2,
    intro ltin,

    rw x,
    rw y,

    split,

    {
      repeat {rw nth},
      repeat {rw list.nth_le},

      exact
        nat.less_than_or_equal.step
        (nat.less_than_or_equal.refl 1),
    },

    {
      intros j ltji,

      repeat {rw nth},

      cases j,
      any_goals { cases j },
      any_goals {
        repeat {rw list.nth_le},
      },

      have h : j < 0,
      from nat.le_of_succ_le_succ (nat.le_of_succ_le_succ ltji),

      exfalso,
      exact (nat.not_lt_zero j) h,
    },
  end
end hidden_score

-- NOTE: This example shows that our definition of ordering for score vectors is
--       broken. We can show that x ≤ y, even though in fact x > y. I should
--       change the defn above to be a conjunct, rather than an implication.
--       I.e. (i < n) ∧ ..., not (Π (ltin : i < n), ...
namespace hidden_break_score
  open ot
  open vector

  def x : score 5 := ⟨[0, 0, 2, 3, 5], by refl⟩
  def y : score 5 := ⟨[0, 0, 1, 1, 7], by refl⟩

  example : (score_lte x y) :=
    begin
      existsi 5,
      assume h,

      have h' : 0 < 0,
      sorry,

      exfalso,
      exact (nat.not_lt_zero 0) h',
    end

end hidden_break_score


import algebra.camera.exclusive
import algebra.camera.option

universes u

@[ext] structure auth (α : Type u) :=
(excl : option (exclusive α))
(frag : α)

namespace auth

notation `● `:75 a:75 := auth.mk (some (exclusive.mk a)) 1
notation `◯ `:75 a:75 := auth.mk none a

instance {α : Type u} [ofe α] : ofe (auth α) := {
  eq_at := λ n a b, a.excl =[n] b.excl ∧ a.frag =[n] b.frag,
  eq_at_reflexive := by intros n a; split; refl,
  eq_at_symmetric := λ n a b h, ⟨eq_at_symmetric n h.1, eq_at_symmetric n h.2⟩,
  eq_at_transitive := begin
    rintros n a b c ⟨hab₁, hab₂⟩ ⟨hbc₁, hbc₂⟩,
    split; transitivity; assumption,
  end,
  eq_at_mono' := λ m n hmn a b h, ⟨eq_at_mono hmn h.1, eq_at_mono hmn h.2⟩,
  eq_at_limit' := begin
    intros x y h,
    ext1; rw eq_at_limit; intros n,
    exact (h n).1, exact (h n).2,
  end,
}

lemma excl_eq_at {α : Type u} [unital_camera α] {n : ℕ} {a b : α} :
  ● a =[n] ● b → a =[n] b :=
λ h, exclusive.mk_eq_at (option.eq_at_of_some_eq_at h.1)

@[simp] lemma excl_eq_at_iff {α : Type u} [unital_camera α] {n : ℕ} {a b : α} :
  ● a =[n] ● b ↔ a =[n] b :=
⟨excl_eq_at, λ h, ⟨option.some_eq_at_iff.mpr (exclusive.mk_eq_at_iff.mpr h), eq_at_refl n 1⟩⟩

lemma frag_eq_at {α : Type u} [ofe α] {n : ℕ} {a b : α} :
  ◯ a =[n] ◯ b → a =[n] b :=
λ h, h.2

@[simp] lemma frag_eq_at_iff {α : Type u} [ofe α] {n : ℕ} {a b : α} :
  ◯ a =[n] ◯ b ↔ a =[n] b :=
⟨λ h, h.2, λ h, ⟨eq_at_refl n _, h⟩⟩

instance {α : Type u} [comm_semigroup α] : comm_semigroup (auth α) := {
  mul := λ a b, ⟨a.excl * b.excl, a.frag * b.frag⟩,
  mul_assoc := by intros; ext1; simp only [mul_assoc],
  mul_comm := begin
    intros, ext1,
    change a.excl * b.excl = b.excl * a.excl, rw mul_comm,
    change a.frag * b.frag = b.frag * a.frag, rw mul_comm,
  end,
}

@[simp] lemma mul_excl {α : Type u} [comm_semigroup α] (a b : auth α) :
  (a * b).excl = a.excl * b.excl := rfl

@[simp] lemma mul_frag {α : Type u} [comm_semigroup α] (a b : auth α) :
  (a * b).frag = a.frag * b.frag := rfl

@[simp] lemma mul_mk {α : Type u} [comm_semigroup α]
  (ax bx : option (exclusive α)) (af bf : α) :
  (⟨ax, af⟩ : auth α) * ⟨bx, bf⟩ = ⟨ax * bx, af * bf⟩ := rfl

inductive validn {α : Type u} [camera α] (n : ℕ) : auth α → Prop
| none {b : α} : ✓[n] b → validn (◯ b)
| mk {a b : α} : b ≼[n] a → ✓[n] a → validn ⟨some (exclusive.mk a), b⟩

private lemma validn_nonexpansive {α : Type u} [camera α] {n : ℕ} {xa ya : option (exclusive α)}
  {xf yf : α} : (⟨xa, xf⟩ : auth α) =[n] ⟨ya, yf⟩ → validn n ⟨xa, xf⟩ → validn n ⟨ya, yf⟩ :=
begin
  intros h h',
  obtain (⟨_, h₁⟩ | ⟨z, _, ⟨c, hc⟩, h₃⟩) := h',
  { cases h.1,
    refine validn.none _,
    refine camera.validn_of_eq_at (frag_eq_at h) _,
    assumption, },
  { obtain ⟨h₁, h₂⟩ := h,
    simp only [option.exists_eq_iff_some_eq, exclusive.exists_eq_iff_mk_eq] at h₁,
    obtain ⟨_, rfl, ⟨b', rfl, h₁⟩⟩ := h₁,
    refine validn.mk ⟨c, _⟩ _,
    simp only at h₂,
    refine eq_at_trans z _ h₁,
    refine eq_at_trans (xf * c) _ hc,
    exact camera.mul_eq_at_left (eq_at_symm h₂),
    exact camera.validn_of_eq_at h₁ h₃, },
end

private lemma excl_validn {α : Type u} [camera α] {n : ℕ} {a : auth α} : validn n a → ✓[n] a.excl :=
begin
  rintro (h | h) a (h | h),
  intro h', cases h',
end

private lemma frag_validn {α : Type u} [camera α] {n : ℕ} {a : auth α} : validn n a → ✓[n] a.frag :=
begin
  rintro (h | h),
  assumption,
  exact camera.validn_incln ‹_› ‹_›,
end

def extend {α : Type u} [unital_camera α] {n : ℕ} {a b₁ b₂ : auth α}
  (h₁ : validn n a) (h₂ : a =[n] b₁ * b₂) : auth α × auth α :=
⟨⟨(camera.extend (excl_validn h₁) h₂.1).1, (camera.extend (frag_validn h₁) h₂.2).1⟩,
  ⟨(camera.extend (excl_validn h₁) h₂.1).2, (camera.extend (frag_validn h₁) h₂.2).2⟩⟩

instance {α : Type u} [unital_camera α] : camera (auth α) := {
  validn := ⟨λ a, ⟨λ n, validn n a, begin
    intros m n hmn h,
    cases h,
    exact validn.none (camera.validn_mono hmn ‹_›),
    exact validn.mk (incln_mono hmn ‹_›) (camera.validn_mono hmn ‹_›),
  end⟩, begin
    rintros n ⟨xa, xf⟩ ⟨ya, yf⟩ h m hmn,
    exact ⟨validn_nonexpansive (eq_at_mono hmn h),
      validn_nonexpansive (eq_at_mono hmn (eq_at_symm h))⟩,
  end⟩,
  core := ⟨λ a, some (◯ |a.frag|), begin
    intros n a b h,
    simp only [option.exists_eq_iff_some_eq, exists_eq_left', frag_eq_at_iff],
    exact abs_is_nonexpansive h.2,
  end⟩,
  extend := @extend _ _,
  mul_is_nonexpansive := λ n a b h, ⟨camera.mul_eq_at h.1.1 h.2.1, camera.mul_eq_at h.1.2 h.2.2⟩,
  core_mul_self := begin
    intros a ca h,
    cases h,
    ext1,
    simp only [mul_excl, none_mul],
    simp only [mul_frag, unital_camera.abs_mul_self],
  end,
  core_core := begin
    intros a ca h,
    cases h,
    simp only [nonexpansive_fun.coe_fn_mk, eq_self_iff_true, true_and, unital_camera.abs_abs],
  end,
  core_mono_some := λ a b ca hca h, by simp only [nonexpansive_fun.coe_fn_mk, exists_eq'],
  core_mono := begin
    rintros a b ca hca ⟨c, rfl⟩,
    simp only [nonexpansive_fun.coe_fn_mk, mul_frag] at hca ⊢,
    obtain ⟨d, hd⟩ := unital_camera.abs_mono a.frag (a.frag * c.frag) ⟨c.frag, rfl⟩,
    refine ⟨some (◯ d), _⟩,
    simp only [some_mul_some],
    ext1, refl,
    simp only [nonexpansive_fun.coe_fn_mk, some_mul_some, mul_frag],
    exact hd,
  end,
  validn_mul := begin
    rintros ⟨ax, af⟩ ⟨bx, bf⟩ n h,
    simp only [nonexpansive_fun.coe_fn_mk, sprop.coe_fn_mk, mul_mk] at h ⊢,
    cases ax,
    { cases bx,
      { obtain (⟨_, h⟩ | _) := h,
        exact validn.none (camera.validn_mul_left h), },
      { obtain (_ | ⟨c, _, ⟨d, hd⟩, hc⟩) := h,
        refine validn.none _,
        exact camera.validn_mul_left (camera.validn_mul_left
          (camera.validn_of_eq_at (eq_at_symm hd) hc)), }, },
    { cases bx,
      { obtain (_ | ⟨c, _, ⟨d, hd⟩, hc⟩) := h,
        refine validn.mk ⟨bf * d, _⟩ hc,
        convert hd using 1,
        rw ← mul_assoc,
        refl, },
      { cases h, }, },
  end,
  extend_mul_eq := begin
    intros n a b₁ b₂ h₁ b₂,
    ext1,
    exact camera.extend_mul_eq _ _,
    exact camera.extend_mul_eq _ _,
  end,
  extend_eq_at_left := begin
    intros n a b₁ b₂ h₁ b₂,
    split,
    exact camera.extend_eq_at_left _ _,
    exact camera.extend_eq_at_left _ _,
  end,
  extend_eq_at_right := begin
    intros n a b₁ b₂ h₁ b₂,
    split,
    exact camera.extend_eq_at_right _ _,
    exact camera.extend_eq_at_right _ _,
  end,
  ..auth.ofe,
  ..auth.comm_semigroup,
}

end auth


import tactic

open tactic

/-!

This file contains three tactic-programming exercises of increasing difficulty.

They were (hastily) written to follow the metaprogramming tutorial at
Lean for the Curious Mathematician 2020.

If you're looking for more (better) exercises, we strongly recommend the
exercises by Blanchette et al
for the course Logical Verification at the Vrije Universiteit Amsterdam,
and the corresponding chapter of the course notes:

https://github.com/blanchette/logical_verification_2020/blob/master/lean/love07_metaprogramming_exercise_sheet.lean
https://github.com/blanchette/logical_verification_2020/raw/master/hitchhikers_guide.pdf

-/

-- Preheating...

-- First example from Video 5.

#check list.mfirst (λx, trace `(5))

-- This one already works (serendipity!)
meta def assump' : tactic unit :=
do
  ctxt ← local_context,
  list.mfirst (λx, exact x) ctxt

-- Shorter version (blind guess)
meta def assump : tactic unit := local_context >>= list.mfirst (λx, exact x)

example (A B C : Prop) (ha : A) (hb : B) (hc : C) : C :=
by assump

example (n: ℕ)(hx: n+0=5): n=5 := by assump

/-!

## Exercise 1

Write a `contradiction` tactic.
The tactic should look through the hypotheses in the local context
trying to find two that contradict each other,
i.e. proving `P` and `¬ P` for some proposition `P`.
It should use this contradiction to close the goal.

Bonus: handle `P → false` as well as `¬ P`.

This exercise is to practice manipulating the hypotheses and goal.

Note: this exists as `tactic.interactive.contradiction`.

-/

-- First try: only proves falsity, but also performs modus ponens!
meta def tactic.interactive.contr' : tactic unit :=
do
ctx ← local_context,
list.mfirst
  (λ e, list.mfirst (λx,
  -- Shorter than the next 3 lines: `to_expr ``(%%x %%e) >>= exact`
  do
  apli ← to_expr ``(%%x %%e),
  exact apli
 ) ctx) ctx,
done

-- Even shorter
-- meta def tactic.interactive.contr' : tactic unit :=
-- local_context >>=
-- λ ctx, list.mfirst
-- (λ e, list.mfirst (λx, to_expr ``(%%x %%e) >>= exact ) ctx) ctx

example (P Q R : Prop) (hp : P) (hq : Q) (hr : ¬ R) (hnq : ¬ Q) : false :=
by contr'

example (P Q R : Prop) (hnq : ¬ Q) (hp : P) (hq : Q) (hr : ¬ R) : 0 = 1 :=
by contr'

example (P Q R : Prop) (hp : P) (hq : Q) (hr : ¬ R) (hnq : Q → false) : false :=
by contr'

-- Unexpected!
example (P Q R : Prop) (hp : P) (hq : Q) (hr : ¬ R) (hqr : Q → R) : R :=
by contr'

meta def tactic.interactive.contr : tactic unit :=
do
tgt ← target,
ctx ← local_context,
list.mfirst
  (λ e, list.mfirst (λx, to_expr ``(absurd %%x %%e) >>= exact)
   ctx) ctx,
done

example (P Q R : Prop) (hp : P) (hq : Q) (hr : ¬ R) (hnq : ¬ Q) : false :=
by contr

example (P Q R : Prop) (hp : P) (hq : Q) (hr : ¬ R) (hnq : ¬ Q) : false :=
by contr

example (P Q R : Prop) (hnq : ¬ Q) (hp : P) (hq : Q) (hr : ¬ R) : 0 = 1 :=
by exact false.rec.{0} (0 = 1) (hnq hq)

example (P Q R : Prop) (hp : P) (hq : Q) (hr : ¬ R) (hnq : Q → false) : false :=
by contr

/-!

## Exercise 2

Write a tactic that proves a given `nat`-valued declaration is nonnegative.
The tactic should take the name of a declaration whose return type is `ℕ`
(presumably with some arguments), e.g. `nat.add : ℕ → ℕ → ℕ`
or `list.length : Π α : Type, list α → ℕ`.
It should add a new declaration to the environment which proves all applications
of this function are nonnegative,
e.g. `nat.add_nonneg : ∀ m n : ℕ, 0 ≤ nat.add m n`.

Bonus: create reasonable names for these declarations, and/or take an optional argument
for the new name.

This tactic is not useful by itself, but it's a good way to practice
querying and modifying an environment and working under binders.
It is not a tactic to be used during a proof, but rather as a command.

Hints:
* For looking at declarations in the environment, you will need the `declaration` type,
  as well as the tactics `get_decl` and `add_decl`.
* You will have to manipulate an expression under binders.
  The tactics `mk_local_pis` and `pis`, or their lambda equivalents, will be helpful here.
* `mk_mapp` is a variant of `mk_app` that lets you provide implicit arguments.
-/

meta def add_nonneg_proof (n : name) : tactic unit :=
sorry

-- these test cases should succeed when you're done

-- run_cmd add_nonneg_proof `nat.add
-- run_cmd add_nonneg_proof `list.length

-- #check nat.add_nonneg
-- #check list.length_nonneg

/-!

## Exercise 3 (challenge!)

The mathlib tactic `cancel_denoms` is intended to get rid of division by numerals
in expressions where this makes sense. For example,

-/

example (q : ℚ) (h : q / 3 > 0) : q > 0 :=
begin
  cancel_denoms at h, exact h
end

/-!

But it is not complete. In particular, it doesn't like nested division
or other operators in denominators. These all fail:

-/

example (q : ℚ) (h : q / (3 / 4) > 0) : false :=
begin
  -- cancel_denoms at h,
  sorry
end

example (p q : ℚ) (h : q / 2 / 3 < q) : false :=
begin
  -- cancel_denoms at h,
  sorry
end

example (p q : ℚ) (h : q / 2 < 3 / (4*q)) : false :=
begin
  -- cancel_denoms at h,
  sorry
end

-- this one succeeds but doesn't do what it should
example (p q : ℚ) (h : q / (2*3) < q) : false :=
begin
  -- cancel_denoms at h,
  sorry
end

/-!

Look at the code in `src/tactic/cancel_denoms.lean` and try to fix it.
See if you can solve any or all of these failing test cases.

If you succeed, a pull request to mathlib is strongly encouraged!

-/


inductive Vec (α : Type u) : Nat → Type u
  | nil : Vec α 0
  | cons : α → Vec α n → Vec α (n+1)

def f1 (xs : Vec α n) : Nat :=
  Vec.casesOn xs 0 fun _ _ => 1

def f2 (xs : Vec α n) : Nat :=
  xs.casesOn 0 -- Error insufficient number of arguments

def f3 (x : Nat) : Nat → (Nat → Nat) → Nat :=
  x.casesOn

def f4 (xs : List Nat) : xs ≠ [] → xs.length > 0 :=
  xs.casesOn (by intros; contradiction) (by intros; simp_arith)

def f5 (xs : List Nat) (h : xs ≠ []) : xs.length > 0 :=
  xs.casesOn (by intros; contradiction) (by intros; simp_arith) h

def f6 (x : Nat) :=
  2 * x.casesOn 0 id

example : f6 (x+1) = 2*x := rfl

def f7 (xs : Vec α n) : Nat :=
  xs.casesOn (a := 10) 0 -- Error unused named args

def f8 (xs : List Nat) : xs ≠ [] → xs.length > 0 :=
  @List.casesOn _ (fun xs => xs ≠ [] → xs.length > 0) xs (by dsimp; intros; contradiction) (by dsimp; intros; simp_arith)

def f5' (xs : List Nat) (h : xs ≠ []) : xs.length > 0 :=
  xs.casesOn (fun h => absurd rfl h) (fun _ _ _ => Nat.zero_lt_succ ..) h

example (h₁ : a = b) (h₂ : b = c) : a = c :=
  Eq.rec h₂ h₁.symm

@[elab_as_elim] theorem subst {p : (b : α) → a = b → Prop} (h₁ : a = b) (h₂ : p a rfl) : p b h₁ := by
  cases h₁
  assumption

example (h₁ : a = b) (h₂ : b = c) : a = c :=
  subst h₁.symm h₂

theorem not_or_not : (¬p ∨ ¬q) → ¬(p ∧ q) := λ h ⟨hp, hq⟩ =>
  h.rec (λ h1 => h1 hp) (λ h2 => h2 hq)

structure Point where
  x : Nat

theorem PointExt_lean4 (p : Point) : forall (q : Point) (h1 : Point.x p = Point.x q), p = q :=
  Point.recOn p <|
   fun z1 q => Point.recOn q $
   fun z2 (hA : Point.x (Point.mk z1) = Point.x (Point.mk z2)) => congrArg Point.mk hA

inductive pos_num : Type
  | one  : pos_num
  | bit1 : pos_num → pos_num
  | bit0 : pos_num → pos_num

inductive num : Type
  | zero  : num
  | pos   : pos_num → num

inductive znum : Type
  | zero : znum
  | pos  : pos_num → znum
  | neg  : pos_num → znum

def pos_num.pred' : pos_num → num
  | one    => .zero
  | bit0 n => num.pos (num.casesOn (pred' n) one bit1)
  | bit1 n => num.pos (bit0 n)

protected def znum.bit1 : znum → znum
  | zero    => pos .one
  | pos n => pos (pos_num.bit1 n)
  | neg n => neg (num.casesOn (pos_num.pred' n) .one pos_num.bit1)

example (h : False) : a = c :=
  h.rec

example (h : False) : a = c :=
  h.elim

noncomputable def f : Nat → Nat :=
  Nat.rec 0 (fun x _ => x)

example : ∀ x, x ≥ 0 :=
  Nat.rec (Nat.le_refl 0) (fun _ ih => Nat.le_succ_of_le ih)


constant n : Nat
@[simp] axiom prio_1000 : n = 1000
@[simp 10] axiom prio_10 : n = 10
-- simp should prefer the prio_1000 lemma with the higher priority
example : n = 1000 := by simp


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.tensor_product
import Mathlib.linear_algebra.direct_sum_module
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5

namespace Mathlib

namespace tensor_product

/-- The linear equivalence `(⨁ i₁, M₁ i₁) ⊗ (⨁ i₂, M₂ i₂) ≃ (⨁ i₁, ⨁ i₂, M₁ i₁ ⊗ M₂ i₂)`, i.e.
"tensor product distributes over direct sum". -/
def direct_sum (R : Type u_1) [comm_ring R] (ι₁ : Type u_2) (ι₂ : Type u_3) [DecidableEq ι₁]
    [DecidableEq ι₂] (M₁ : ι₁ → Type u_4) (M₂ : ι₂ → Type u_5) [(i₁ : ι₁) → add_comm_group (M₁ i₁)]
    [(i₂ : ι₂) → add_comm_group (M₂ i₂)] [(i₁ : ι₁) → module R (M₁ i₁)]
    [(i₂ : ι₂) → module R (M₂ i₂)] :
    linear_equiv R
        (tensor_product R (direct_sum ι₁ fun (i₁ : ι₁) => M₁ i₁)
          (direct_sum ι₂ fun (i₂ : ι₂) => M₂ i₂))
        (direct_sum (ι₁ × ι₂)
          fun (i : ι₁ × ι₂) => tensor_product R (M₁ (prod.fst i)) (M₂ (prod.snd i))) :=
  linear_equiv.of_linear
    (lift
      (direct_sum.to_module R ι₁
        (linear_map R (direct_sum ι₂ fun (i₂ : ι₂) => M₂ i₂)
          (direct_sum (ι₁ × ι₂)
            fun (i : ι₁ × ι₂) => tensor_product R (M₁ (prod.fst i)) (M₂ (prod.snd i))))
        fun (i₁ : ι₁) =>
          linear_map.flip
            (direct_sum.to_module R ι₂
              (linear_map R (M₁ i₁)
                (direct_sum (ι₁ × ι₂)
                  fun (i : ι₁ × ι₂) => tensor_product R (M₁ (prod.fst i)) (M₂ (prod.snd i))))
              fun (i₂ : ι₂) =>
                linear_map.flip
                  (curry
                    (direct_sum.lof R (ι₁ × ι₂)
                      (fun (i : ι₁ × ι₂) => tensor_product R (M₁ (prod.fst i)) (M₂ (prod.snd i)))
                      (i₁, i₂))))))
    (direct_sum.to_module R (ι₁ × ι₂)
      (tensor_product R (direct_sum ι₁ fun (i₁ : ι₁) => M₁ i₁)
        (direct_sum ι₂ fun (i₂ : ι₂) => M₂ i₂))
      fun (i : ι₁ × ι₂) =>
        map (direct_sum.lof R ι₁ M₁ (prod.fst i)) (direct_sum.lof R ι₂ M₂ (prod.snd i)))
    sorry sorry

@[simp] theorem direct_sum_lof_tmul_lof (R : Type u_1) [comm_ring R] (ι₁ : Type u_2) (ι₂ : Type u_3)
    [DecidableEq ι₁] [DecidableEq ι₂] (M₁ : ι₁ → Type u_4) (M₂ : ι₂ → Type u_5)
    [(i₁ : ι₁) → add_comm_group (M₁ i₁)] [(i₂ : ι₂) → add_comm_group (M₂ i₂)]
    [(i₁ : ι₁) → module R (M₁ i₁)] [(i₂ : ι₂) → module R (M₂ i₂)] (i₁ : ι₁) (m₁ : M₁ i₁) (i₂ : ι₂)
    (m₂ : M₂ i₂) :
    coe_fn (direct_sum R ι₁ ι₂ M₁ M₂)
          (tmul R (coe_fn (direct_sum.lof R ι₁ M₁ i₁) m₁) (coe_fn (direct_sum.lof R ι₂ M₂ i₂) m₂)) =
        coe_fn
          (direct_sum.lof R (ι₁ × ι₂)
            (fun (i : ι₁ × ι₂) => tensor_product R (M₁ (prod.fst i)) (M₂ (prod.snd i))) (i₁, i₂))
          (tmul R m₁ m₂) :=
  sorry

end Mathlib


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import linear_algebra.affine_space.affine_map
import algebra.invertible

/-!
# Affine equivalences

In this file we define `affine_equiv k P₁ P₂` (notation: `P₁ ≃ᵃ[k] P₂`) to be the type of affine
equivalences between `P₁` and `P₂, i.e., equivalences such that both forward and inverse maps are
affine maps.

We define the following equivalences:

* `affine_equiv.refl k P`: the identity map as an `affine_equiv`;

* `e.symm`: the inverse map of an `affine_equiv` as an `affine_equiv`;

* `e.trans e'`: composition of two `affine_equiv`s; note that the order follows `mathlib`'s
  `category_theory` convention (apply `e`, then `e'`), not the convention used in function
  composition and compositions of bundled morphisms.

## Tags

affine space, affine equivalence
-/

open function set
open_locale affine

/-- An affine equivalence is an equivalence between affine spaces such that both forward
and inverse maps are affine.

We define it using an `equiv` for the map and a `linear_equiv` for the linear part in order
to allow affine equivalences with good definitional equalities. -/
@[nolint has_inhabited_instance]
structure affine_equiv (k P₁ P₂ : Type*) {V₁ V₂ : Type*} [ring k]
  [add_comm_group V₁] [module k V₁] [add_torsor V₁ P₁]
  [add_comm_group V₂] [module k V₂] [add_torsor V₂ P₂] extends P₁ ≃ P₂ :=
(linear : V₁ ≃ₗ[k] V₂)
(map_vadd' : ∀ (p : P₁) (v : V₁), to_equiv (v +ᵥ p) = linear v +ᵥ to_equiv p)

notation P₁ ` ≃ᵃ[`:25 k:25 `] `:0 P₂:0 := affine_equiv k P₁ P₂

variables {k V₁ V₂ V₃ V₄ P₁ P₂ P₃ P₄ : Type*} [ring k]
  [add_comm_group V₁] [module k V₁] [add_torsor V₁ P₁]
  [add_comm_group V₂] [module k V₂] [add_torsor V₂ P₂]
  [add_comm_group V₃] [module k V₃] [add_torsor V₃ P₃]
  [add_comm_group V₄] [module k V₄] [add_torsor V₄ P₄]

namespace affine_equiv

include V₁ V₂

instance : has_coe_to_fun (P₁ ≃ᵃ[k] P₂) (λ _, P₁ → P₂) := ⟨λ e, e.to_fun⟩

instance : has_coe (P₁ ≃ᵃ[k] P₂) (P₁ ≃ P₂) := ⟨affine_equiv.to_equiv⟩

variables (k P₁)

omit V₂

/-- Identity map as an `affine_equiv`. -/
@[refl] def refl : P₁ ≃ᵃ[k] P₁ :=
{ to_equiv := equiv.refl P₁,
  linear := linear_equiv.refl k V₁,
  map_vadd' := λ _ _, rfl }

@[simp] lemma coe_refl : ⇑(refl k P₁) = id := rfl

lemma refl_apply (x : P₁) : refl k P₁ x = x := rfl

@[simp] lemma to_equiv_refl : (refl k P₁).to_equiv = equiv.refl P₁ := rfl

@[simp] lemma linear_refl : (refl k P₁).linear = linear_equiv.refl k V₁ := rfl

variables {k P₁}

include V₂

@[simp] lemma map_vadd (e : P₁ ≃ᵃ[k] P₂) (p : P₁) (v : V₁) : e (v +ᵥ p) = e.linear v +ᵥ e p :=
e.map_vadd' p v

@[simp] lemma coe_to_equiv (e : P₁ ≃ᵃ[k] P₂) : ⇑e.to_equiv = e := rfl

/-- Reinterpret an `affine_equiv` as an `affine_map`. -/
def to_affine_map (e : P₁ ≃ᵃ[k] P₂) : P₁ →ᵃ[k] P₂ := { to_fun := e, .. e }

instance : has_coe (P₁ ≃ᵃ[k] P₂) (P₁ →ᵃ[k] P₂) := ⟨to_affine_map⟩

@[simp] lemma coe_to_affine_map (e : P₁ ≃ᵃ[k] P₂) :
  (e.to_affine_map : P₁ → P₂) = (e : P₁ → P₂) :=
rfl

@[simp] lemma to_affine_map_mk (f : P₁ ≃ P₂) (f' : V₁ ≃ₗ[k] V₂) (h) :
  to_affine_map (mk f f' h) = ⟨f, f', h⟩ :=
rfl

@[norm_cast, simp] lemma coe_coe (e : P₁ ≃ᵃ[k] P₂) : ((e : P₁ →ᵃ[k] P₂) : P₁ → P₂) = e := rfl

@[simp] lemma linear_to_affine_map (e : P₁ ≃ᵃ[k] P₂) : e.to_affine_map.linear = e.linear := rfl

lemma to_affine_map_injective : injective (to_affine_map : (P₁ ≃ᵃ[k] P₂) → (P₁ →ᵃ[k] P₂)) :=
begin
  rintros ⟨e, el, h⟩ ⟨e', el', h'⟩ H,
  simp only [to_affine_map_mk, equiv.coe_inj, linear_equiv.to_linear_map_inj] at H,
  congr,
  exacts [H.1, H.2]
end

@[simp] lemma to_affine_map_inj {e e' : P₁ ≃ᵃ[k] P₂} :
  e.to_affine_map = e'.to_affine_map ↔ e = e' :=
to_affine_map_injective.eq_iff

@[ext] lemma ext {e e' : P₁ ≃ᵃ[k] P₂} (h : ∀ x, e x = e' x) : e = e' :=
to_affine_map_injective $ affine_map.ext h

lemma coe_fn_injective : @injective (P₁ ≃ᵃ[k] P₂) (P₁ → P₂) coe_fn :=
λ e e' H, ext $ congr_fun H

@[simp, norm_cast] lemma coe_fn_inj {e e' : P₁ ≃ᵃ[k] P₂} : (e : P₁ → P₂) = e' ↔ e = e' :=
coe_fn_injective.eq_iff

lemma to_equiv_injective : injective (to_equiv : (P₁ ≃ᵃ[k] P₂) → (P₁ ≃ P₂)) :=
λ e e' H, ext $ equiv.ext_iff.1 H

@[simp] lemma to_equiv_inj {e e' : P₁ ≃ᵃ[k] P₂} : e.to_equiv = e'.to_equiv ↔ e = e' :=
to_equiv_injective.eq_iff

@[simp] lemma coe_mk (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (h) :
  ((⟨e, e', h⟩ : P₁ ≃ᵃ[k] P₂) : P₁ → P₂) = e :=
rfl

/-- Construct an affine equivalence by verifying the relation between the map and its linear part at
one base point. Namely, this function takes a map `e : P₁ → P₂`, a linear equivalence
`e' : V₁ ≃ₗ[k] V₂`, and a point `p` such that for any other point `p'` we have
`e p' = e' (p' -ᵥ p) +ᵥ e p`. -/
def mk' (e : P₁ → P₂) (e' : V₁ ≃ₗ[k] V₂) (p : P₁) (h : ∀ p' : P₁, e p' = e' (p' -ᵥ p) +ᵥ e p) :
  P₁ ≃ᵃ[k] P₂ :=
{ to_fun := e,
  inv_fun := λ q' : P₂, e'.symm (q' -ᵥ e p) +ᵥ p,
  left_inv := λ p', by simp [h p'],
  right_inv := λ q', by simp [h (e'.symm (q' -ᵥ e p) +ᵥ p)],
  linear := e',
  map_vadd' := λ p' v, by { simp [h p', h (v +ᵥ p'), vadd_vsub_assoc, vadd_vadd] } }

@[simp] lemma coe_mk' (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (p h) : ⇑(mk' e e' p h) = e := rfl
@[simp] lemma linear_mk' (e : P₁ ≃ P₂) (e' : V₁ ≃ₗ[k] V₂) (p h) :
  (mk' e e' p h).linear = e' := rfl

/-- Inverse of an affine equivalence as an affine equivalence. -/
@[symm] def symm (e : P₁ ≃ᵃ[k] P₂) : P₂ ≃ᵃ[k] P₁ :=
{ to_equiv := e.to_equiv.symm,
  linear := e.linear.symm,
  map_vadd' := λ v p, e.to_equiv.symm.apply_eq_iff_eq_symm_apply.2 $
    by simpa using (e.to_equiv.apply_symm_apply v).symm }

@[simp] lemma symm_to_equiv (e : P₁ ≃ᵃ[k] P₂) : e.to_equiv.symm = e.symm.to_equiv := rfl

@[simp] lemma symm_linear (e : P₁ ≃ᵃ[k] P₂) : e.linear.symm = e.symm.linear := rfl

protected lemma bijective (e : P₁ ≃ᵃ[k] P₂) : bijective e := e.to_equiv.bijective
protected lemma surjective (e : P₁ ≃ᵃ[k] P₂) : surjective e := e.to_equiv.surjective
protected lemma injective (e : P₁ ≃ᵃ[k] P₂) : injective e := e.to_equiv.injective

@[simp] lemma range_eq (e : P₁ ≃ᵃ[k] P₂) : range e = univ := e.surjective.range_eq

@[simp] lemma apply_symm_apply (e : P₁ ≃ᵃ[k] P₂) (p : P₂) : e (e.symm p) = p :=
e.to_equiv.apply_symm_apply p

@[simp] lemma symm_apply_apply (e : P₁ ≃ᵃ[k] P₂) (p : P₁) : e.symm (e p) = p :=
e.to_equiv.symm_apply_apply p

lemma apply_eq_iff_eq_symm_apply (e : P₁ ≃ᵃ[k] P₂) {p₁ p₂} : e p₁ = p₂ ↔ p₁ = e.symm p₂ :=
e.to_equiv.apply_eq_iff_eq_symm_apply

@[simp] lemma apply_eq_iff_eq (e : P₁ ≃ᵃ[k] P₂) {p₁ p₂ : P₁} : e p₁ = e p₂ ↔ p₁ = p₂ :=
e.to_equiv.apply_eq_iff_eq

omit V₂

@[simp] lemma symm_refl : (refl k P₁).symm = refl k P₁ := rfl

include V₂ V₃

/-- Composition of two `affine_equiv`alences, applied left to right. -/
@[trans] def trans (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) : P₁ ≃ᵃ[k] P₃ :=
{ to_equiv := e.to_equiv.trans e'.to_equiv,
  linear := e.linear.trans e'.linear,
  map_vadd' := λ p v, by simp only [linear_equiv.trans_apply, coe_to_equiv, (∘),
    equiv.coe_trans, map_vadd] }

@[simp] lemma coe_trans (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) : ⇑(e.trans e') = e' ∘ e := rfl

lemma trans_apply (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) (p : P₁) : e.trans e' p = e' (e p) := rfl

include V₄

lemma trans_assoc (e₁ : P₁ ≃ᵃ[k] P₂) (e₂ : P₂ ≃ᵃ[k] P₃) (e₃ : P₃ ≃ᵃ[k] P₄) :
  (e₁.trans e₂).trans e₃ = e₁.trans (e₂.trans e₃) :=
ext $ λ _, rfl

omit V₃ V₄

@[simp] lemma trans_refl (e : P₁ ≃ᵃ[k] P₂) : e.trans (refl k P₂) = e :=
ext $ λ _, rfl

@[simp] lemma refl_trans (e : P₁ ≃ᵃ[k] P₂) : (refl k P₁).trans e = e :=
ext $ λ _, rfl

@[simp] lemma self_trans_symm (e : P₁ ≃ᵃ[k] P₂) : e.trans e.symm = refl k P₁ :=
ext e.symm_apply_apply

@[simp] lemma symm_trans_self (e : P₁ ≃ᵃ[k] P₂) : e.symm.trans e = refl k P₂ :=
ext e.apply_symm_apply

@[simp] lemma apply_line_map (e : P₁ ≃ᵃ[k] P₂) (a b : P₁) (c : k) :
  e (affine_map.line_map a b c) = affine_map.line_map (e a) (e b) c :=
e.to_affine_map.apply_line_map a b c

omit V₂

instance : group (P₁ ≃ᵃ[k] P₁) :=
{ one := refl k P₁,
  mul := λ e e', e'.trans e,
  inv := symm,
  mul_assoc := λ e₁ e₂ e₃, trans_assoc _ _ _,
  one_mul := trans_refl,
  mul_one := refl_trans,
  mul_left_inv := self_trans_symm }

lemma one_def : (1 : P₁ ≃ᵃ[k] P₁) = refl k P₁ := rfl

@[simp] lemma coe_one : ⇑(1 : P₁ ≃ᵃ[k] P₁) = id := rfl

lemma mul_def (e e' : P₁ ≃ᵃ[k] P₁) : e * e' = e'.trans e := rfl

@[simp] lemma coe_mul (e e' : P₁ ≃ᵃ[k] P₁) : ⇑(e * e') = e ∘ e' := rfl

lemma inv_def (e : P₁ ≃ᵃ[k] P₁) : e⁻¹ = e.symm := rfl

variable (k)

/-- The map `v ↦ v +ᵥ b` as an affine equivalence between a module `V` and an affine space `P` with
tangent space `V`. -/
def vadd_const (b : P₁) : V₁ ≃ᵃ[k] P₁ :=
{ to_equiv := equiv.vadd_const b,
  linear := linear_equiv.refl _ _,
  map_vadd' := λ p v, add_vadd _ _ _ }

@[simp] lemma linear_vadd_const (b : P₁) : (vadd_const k b).linear = linear_equiv.refl k V₁ := rfl

@[simp] lemma vadd_const_apply (b : P₁) (v : V₁) : vadd_const k b v = v +ᵥ b := rfl

@[simp] lemma vadd_const_symm_apply (b p : P₁) : (vadd_const k b).symm p = p -ᵥ b := rfl

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub (p : P₁) : P₁ ≃ᵃ[k] V₁ :=
{ to_equiv := equiv.const_vsub p,
  linear := linear_equiv.neg k,
  map_vadd' := λ p' v, by simp [vsub_vadd_eq_vsub_sub, neg_add_eq_sub] }

@[simp] lemma coe_const_vsub (p : P₁) : ⇑(const_vsub k p) = (-ᵥ) p := rfl

@[simp] lemma coe_const_vsub_symm (p : P₁) : ⇑(const_vsub k p).symm = λ v, -v +ᵥ p := rfl

variable (P₁)

/-- The map `p ↦ v +ᵥ p` as an affine automorphism of an affine space. -/
def const_vadd (v : V₁) : P₁ ≃ᵃ[k] P₁ :=
{ to_equiv := equiv.const_vadd P₁ v,
  linear := linear_equiv.refl _ _,
  map_vadd' := λ p w, vadd_comm _ _ _ }

@[simp] lemma linear_const_vadd (v : V₁) : (const_vadd k P₁ v).linear = linear_equiv.refl _ _ := rfl

@[simp] lemma const_vadd_apply (v : V₁) (p : P₁) : const_vadd k P₁ v p = v +ᵥ p := rfl

@[simp] lemma const_vadd_symm_apply (v : V₁) (p : P₁) : (const_vadd k P₁ v).symm p = -v +ᵥ p := rfl

section homothety

omit V₁

variables {R V P : Type*} [comm_ring R] [add_comm_group V] [module R V] [affine_space V P]
include V

/-- Fixing a point in affine space, homothety about this point gives a group homomorphism from (the
centre of) the units of the scalars into the group of affine equivalences. -/
def homothety_units_mul_hom (p : P) : units R →* P ≃ᵃ[R] P :=
{ to_fun   := λ t,
  { to_fun    := affine_map.homothety p (t : R),
    inv_fun   := affine_map.homothety p (↑t⁻¹ : R),
    left_inv  := λ p, by simp [← affine_map.comp_apply, ← affine_map.homothety_mul],
    right_inv := λ p, by simp [← affine_map.comp_apply, ← affine_map.homothety_mul],
    linear    :=
    { inv_fun   := linear_map.lsmul R V (↑t⁻¹ : R),
      left_inv  := λ v, by simp [smul_smul],
      right_inv := λ v, by simp [smul_smul],
      .. linear_map.lsmul R V t, },
    map_vadd' := λ p v, by simp only [vadd_vsub_assoc, smul_add, add_vadd, affine_map.coe_line_map,
      affine_map.homothety_eq_line_map, equiv.coe_fn_mk, linear_equiv.coe_mk,
      linear_map.lsmul_apply, linear_map.to_fun_eq_coe], },
  map_one' := by { ext, simp, },
  map_mul' := λ t₁ t₂, by { ext, simp [← affine_map.comp_apply, ← affine_map.homothety_mul], }, }

@[simp] lemma coe_homothety_units_mul_hom_apply (p : P) (t : units R) :
  (homothety_units_mul_hom p t : P → P) = affine_map.homothety p (t : R) :=
rfl

@[simp] lemma coe_homothety_units_mul_hom_apply_symm (p : P) (t : units R) :
  ((homothety_units_mul_hom p t).symm : P → P) = affine_map.homothety p (↑t⁻¹ : R) :=
rfl

@[simp] lemma coe_homothety_units_mul_hom_eq_homothety_hom_coe (p : P) :
  (coe : (P ≃ᵃ[R] P) → P →ᵃ[R] P) ∘ homothety_units_mul_hom p =
  (affine_map.homothety_hom p) ∘ (coe : units R → R) :=
by { ext, simp, }

end homothety

variable {P₁}
open function

/-- Point reflection in `x` as a permutation. -/
def point_reflection (x : P₁) : P₁ ≃ᵃ[k] P₁ := (const_vsub k x).trans (vadd_const k x)

lemma point_reflection_apply (x y : P₁) : point_reflection k x y = x -ᵥ y +ᵥ x := rfl

@[simp] lemma point_reflection_symm (x : P₁) : (point_reflection k x).symm = point_reflection k x :=
to_equiv_injective $ equiv.point_reflection_symm x

@[simp] lemma to_equiv_point_reflection (x : P₁) :
  (point_reflection k x).to_equiv = equiv.point_reflection x :=
rfl

@[simp] lemma point_reflection_self (x : P₁) : point_reflection k x x = x := vsub_vadd _ _

lemma point_reflection_involutive (x : P₁) : involutive (point_reflection k x : P₁ → P₁) :=
equiv.point_reflection_involutive x

/-- `x` is the only fixed point of `point_reflection x`. This lemma requires
`x + x = y + y ↔ x = y`. There is no typeclass to use here, so we add it as an explicit argument. -/
lemma point_reflection_fixed_iff_of_injective_bit0 {x y : P₁} (h : injective (bit0 : V₁ → V₁)) :
  point_reflection k x y = y ↔ y = x :=
equiv.point_reflection_fixed_iff_of_injective_bit0 h

lemma injective_point_reflection_left_of_injective_bit0 (h : injective (bit0 : V₁ → V₁)) (y : P₁) :
  injective (λ x : P₁, point_reflection k x y) :=
equiv.injective_point_reflection_left_of_injective_bit0 h y

lemma injective_point_reflection_left_of_module [invertible (2:k)]:
  ∀ y, injective (λ x : P₁, point_reflection k x y) :=
injective_point_reflection_left_of_injective_bit0 k $ λ x y h,
  by rwa [bit0, bit0, ← two_smul k x, ← two_smul k y,
    (is_unit_of_invertible (2:k)).smul_left_cancel] at h

lemma point_reflection_fixed_iff_of_module [invertible (2:k)] {x y : P₁} :
  point_reflection k x y = y ↔ y = x :=
((injective_point_reflection_left_of_module k y).eq_iff' (point_reflection_self k y)).trans eq_comm

end affine_equiv

namespace linear_equiv

/-- Interpret a linear equivalence between modules as an affine equivalence. -/
def to_affine_equiv (e : V₁ ≃ₗ[k] V₂) : V₁ ≃ᵃ[k] V₂ :=
{ to_equiv := e.to_equiv,
  linear := e,
  map_vadd' := λ p v, e.map_add v p }

@[simp] lemma coe_to_affine_equiv (e : V₁ ≃ₗ[k] V₂) : ⇑e.to_affine_equiv = e := rfl

end linear_equiv

namespace affine_map

open affine_equiv

include V₁

lemma line_map_vadd (v v' : V₁) (p : P₁) (c : k) :
  line_map v v' c +ᵥ p = line_map (v +ᵥ p) (v' +ᵥ p) c :=
(vadd_const k p).apply_line_map v v' c

lemma line_map_vsub (p₁ p₂ p₃ : P₁) (c : k) :
  line_map p₁ p₂ c -ᵥ p₃ = line_map (p₁ -ᵥ p₃) (p₂ -ᵥ p₃) c :=
(vadd_const k p₃).symm.apply_line_map p₁ p₂ c

lemma vsub_line_map (p₁ p₂ p₃ : P₁) (c : k) :
  p₁ -ᵥ line_map p₂ p₃ c = line_map (p₁ -ᵥ p₂) (p₁ -ᵥ p₃) c :=
(const_vsub k p₁).apply_line_map p₂ p₃ c

lemma vadd_line_map (v : V₁) (p₁ p₂ : P₁) (c : k) :
  v +ᵥ line_map p₁ p₂ c = line_map (v +ᵥ p₁) (v +ᵥ p₂) c :=
(const_vadd k P₁ v).apply_line_map p₁ p₂ c

variables {R' : Type*} [comm_ring R'] [module R' V₁]

lemma homothety_neg_one_apply (c p : P₁) :
  homothety c (-1:R') p = point_reflection R' c p :=
by simp [homothety_apply, point_reflection_apply]

end affine_map


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

universes u v

namespace Mathlib

namespace list

/- pairwise relation (generalized no duplicate) -/

theorem pairwise_iff {α : Type u} (R : α → α → Prop) :
    ∀ (ᾰ : List α),
        pairwise R ᾰ ↔
          ᾰ = [] ∨
            Exists
              fun {a : α} =>
                Exists
                  fun {l : List α} => (∀ (a' : α), a' ∈ l → R a a') ∧ pairwise R l ∧ ᾰ = a :: l :=
  sorry

theorem rel_of_pairwise_cons {α : Type u} {R : α → α → Prop} {a : α} {l : List α}
    (p : pairwise R (a :: l)) {a' : α} : a' ∈ l → R a a' :=
  and.left (iff.mp pairwise_cons p)

theorem pairwise_of_pairwise_cons {α : Type u} {R : α → α → Prop} {a : α} {l : List α}
    (p : pairwise R (a :: l)) : pairwise R l :=
  and.right (iff.mp pairwise_cons p)

theorem pairwise.tail {α : Type u} {R : α → α → Prop} {l : List α} (p : pairwise R l) :
    pairwise R (tail l) :=
  sorry

theorem pairwise.imp_of_mem {α : Type u} {R : α → α → Prop} {S : α → α → Prop} {l : List α}
    (H : ∀ {a b : α}, a ∈ l → b ∈ l → R a b → S a b) (p : pairwise R l) : pairwise S l :=
  sorry

theorem pairwise.imp {α : Type u} {R : α → α → Prop} {S : α → α → Prop}
    (H : ∀ (a b : α), R a b → S a b) {l : List α} : pairwise R l → pairwise S l :=
  pairwise.imp_of_mem fun (a b : α) (_x : a ∈ l) (_x : b ∈ l) => H a b

theorem pairwise.and {α : Type u} {R : α → α → Prop} {S : α → α → Prop} {l : List α} :
    pairwise (fun (a b : α) => R a b ∧ S a b) l ↔ pairwise R l ∧ pairwise S l :=
  sorry

theorem pairwise.imp₂ {α : Type u} {R : α → α → Prop} {S : α → α → Prop} {T : α → α → Prop}
    (H : ∀ (a b : α), R a b → S a b → T a b) {l : List α} (hR : pairwise R l) (hS : pairwise S l) :
    pairwise T l :=
  pairwise.imp (fun (a b : α) => And._oldrec (H a b))
    (iff.mpr pairwise.and { left := hR, right := hS })

theorem pairwise.iff_of_mem {α : Type u} {R : α → α → Prop} {S : α → α → Prop} {l : List α}
    (H : ∀ {a b : α}, a ∈ l → b ∈ l → (R a b ↔ S a b)) : pairwise R l ↔ pairwise S l :=
  { mp := pairwise.imp_of_mem fun (a b : α) (m : a ∈ l) (m' : b ∈ l) => iff.mp (H m m'),
    mpr := pairwise.imp_of_mem fun (a b : α) (m : a ∈ l) (m' : b ∈ l) => iff.mpr (H m m') }

theorem pairwise.iff {α : Type u} {R : α → α → Prop} {S : α → α → Prop}
    (H : ∀ (a b : α), R a b ↔ S a b) {l : List α} : pairwise R l ↔ pairwise S l :=
  pairwise.iff_of_mem fun (a b : α) (_x : a ∈ l) (_x : b ∈ l) => H a b

theorem pairwise_of_forall {α : Type u} {R : α → α → Prop} {l : List α} (H : ∀ (x y : α), R x y) :
    pairwise R l :=
  sorry

theorem pairwise.and_mem {α : Type u} {R : α → α → Prop} {l : List α} :
    pairwise R l ↔ pairwise (fun (x y : α) => x ∈ l ∧ y ∈ l ∧ R x y) l :=
  sorry

theorem pairwise.imp_mem {α : Type u} {R : α → α → Prop} {l : List α} :
    pairwise R l ↔ pairwise (fun (x y : α) => x ∈ l → y ∈ l → R x y) l :=
  sorry

theorem pairwise_of_sublist {α : Type u} {R : α → α → Prop} {l₁ : List α} {l₂ : List α} :
    l₁ <+ l₂ → pairwise R l₂ → pairwise R l₁ :=
  sorry

theorem forall_of_forall_of_pairwise {α : Type u} {R : α → α → Prop} (H : symmetric R) {l : List α}
    (H₁ : ∀ (x : α), x ∈ l → R x x) (H₂ : pairwise R l) (x : α) :
    x ∈ l → ∀ (y : α), y ∈ l → R x y :=
  sorry

theorem forall_of_pairwise {α : Type u} {R : α → α → Prop} (H : symmetric R) {l : List α}
    (hl : pairwise R l) (a : α) : a ∈ l → ∀ (b : α), b ∈ l → a ≠ b → R a b :=
  forall_of_forall_of_pairwise
    (fun (a b : α) (h : a ≠ b → R a b) (hne : b ≠ a) => H (h (ne.symm hne)))
    (fun (_x : α) (_x_1 : _x ∈ l) (h : _x ≠ _x) => false.elim (h rfl))
    (pairwise.imp (fun (_x _x_1 : α) (h : R _x _x_1) (_x : _x ≠ _x_1) => h) hl)

theorem pairwise_singleton {α : Type u} (R : α → α → Prop) (a : α) : pairwise R [a] := sorry

theorem pairwise_pair {α : Type u} {R : α → α → Prop} {a : α} {b : α} : pairwise R [a, b] ↔ R a b :=
  sorry

theorem pairwise_append {α : Type u} {R : α → α → Prop} {l₁ : List α} {l₂ : List α} :
    pairwise R (l₁ ++ l₂) ↔
        pairwise R l₁ ∧ pairwise R l₂ ∧ ∀ (x : α), x ∈ l₁ → ∀ (y : α), y ∈ l₂ → R x y :=
  sorry

theorem pairwise_append_comm {α : Type u} {R : α → α → Prop} (s : symmetric R) {l₁ : List α}
    {l₂ : List α} : pairwise R (l₁ ++ l₂) ↔ pairwise R (l₂ ++ l₁) :=
  sorry

theorem pairwise_middle {α : Type u} {R : α → α → Prop} (s : symmetric R) {a : α} {l₁ : List α}
    {l₂ : List α} : pairwise R (l₁ ++ a :: l₂) ↔ pairwise R (a :: (l₁ ++ l₂)) :=
  sorry

theorem pairwise_map {α : Type u} {β : Type v} {R : α → α → Prop} (f : β → α) {l : List β} :
    pairwise R (map f l) ↔ pairwise (fun (a b : β) => R (f a) (f b)) l :=
  sorry

theorem pairwise_of_pairwise_map {α : Type u} {β : Type v} {R : α → α → Prop} {S : β → β → Prop}
    (f : α → β) (H : ∀ (a b : α), S (f a) (f b) → R a b) {l : List α} (p : pairwise S (map f l)) :
    pairwise R l :=
  pairwise.imp H (iff.mp (pairwise_map f) p)

theorem pairwise_map_of_pairwise {α : Type u} {β : Type v} {R : α → α → Prop} {S : β → β → Prop}
    (f : α → β) (H : ∀ (a b : α), R a b → S (f a) (f b)) {l : List α} (p : pairwise R l) :
    pairwise S (map f l) :=
  iff.mpr (pairwise_map f) (pairwise.imp H p)

theorem pairwise_filter_map {α : Type u} {β : Type v} {R : α → α → Prop} (f : β → Option α)
    {l : List β} :
    pairwise R (filter_map f l) ↔
        pairwise (fun (a a' : β) => ∀ (b : α), b ∈ f a → ∀ (b' : α), b' ∈ f a' → R b b') l :=
  sorry

theorem pairwise_filter_map_of_pairwise {α : Type u} {β : Type v} {R : α → α → Prop}
    {S : β → β → Prop} (f : α → Option β)
    (H : ∀ (a a' : α), R a a' → ∀ (b : β), b ∈ f a → ∀ (b' : β), b' ∈ f a' → S b b') {l : List α}
    (p : pairwise R l) : pairwise S (filter_map f l) :=
  iff.mpr (pairwise_filter_map f) (pairwise.imp H p)

theorem pairwise_filter {α : Type u} {R : α → α → Prop} (p : α → Prop) [decidable_pred p]
    {l : List α} : pairwise R (filter p l) ↔ pairwise (fun (x y : α) => p x → p y → R x y) l :=
  sorry

theorem pairwise_filter_of_pairwise {α : Type u} {R : α → α → Prop} (p : α → Prop)
    [decidable_pred p] {l : List α} : pairwise R l → pairwise R (filter p l) :=
  pairwise_of_sublist (filter_sublist l)

theorem pairwise_pmap {α : Type u} {β : Type v} {R : α → α → Prop} {p : β → Prop}
    {f : (b : β) → p b → α} {l : List β} (h : ∀ (x : β), x ∈ l → p x) :
    pairwise R (pmap f l h) ↔
        pairwise (fun (b₁ b₂ : β) => ∀ (h₁ : p b₁) (h₂ : p b₂), R (f b₁ h₁) (f b₂ h₂)) l :=
  sorry

theorem pairwise.pmap {α : Type u} {β : Type v} {R : α → α → Prop} {l : List α} (hl : pairwise R l)
    {p : α → Prop} {f : (a : α) → p a → β} (h : ∀ (x : α), x ∈ l → p x) {S : β → β → Prop}
    (hS : ∀ {x : α} (hx : p x) {y : α} (hy : p y), R x y → S (f x hx) (f y hy)) :
    pairwise S (pmap f l h) :=
  iff.mpr (pairwise_pmap h)
    (pairwise.imp_of_mem
      (fun (a b : α) (ᾰ : a ∈ l) (ᾰ_1 : b ∈ l) (ᾰ_2 : R a b) (h₁ : p a) (h₂ : p b) => hS h₁ h₂ ᾰ_2)
      hl)

theorem pairwise_join {α : Type u} {R : α → α → Prop} {L : List (List α)} :
    pairwise R (join L) ↔
        (∀ (l : List α), l ∈ L → pairwise R l) ∧
          pairwise (fun (l₁ l₂ : List α) => ∀ (x : α), x ∈ l₁ → ∀ (y : α), y ∈ l₂ → R x y) L :=
  sorry

@[simp] theorem pairwise_reverse {α : Type u} {R : α → α → Prop} {l : List α} :
    pairwise R (reverse l) ↔ pairwise (fun (x y : α) => R y x) l :=
  sorry

theorem pairwise_iff_nth_le {α : Type u} {R : α → α → Prop} {l : List α} :
    pairwise R l ↔
        ∀ (i j : ℕ) (h₁ : j < length l) (h₂ : i < j),
          R (nth_le l i (lt_trans h₂ h₁)) (nth_le l j h₁) :=
  sorry

theorem pairwise_sublists' {α : Type u} {R : α → α → Prop} {l : List α} :
    pairwise R l → pairwise (lex (function.swap R)) (sublists' l) :=
  sorry

theorem pairwise_sublists {α : Type u} {R : α → α → Prop} {l : List α} (H : pairwise R l) :
    pairwise (fun (l₁ l₂ : List α) => lex R (reverse l₁) (reverse l₂)) (sublists l) :=
  sorry

/- pairwise reduct -/

@[simp] theorem pw_filter_nil {α : Type u} {R : α → α → Prop} [DecidableRel R] :
    pw_filter R [] = [] :=
  rfl

@[simp] theorem pw_filter_cons_of_pos {α : Type u} {R : α → α → Prop} [DecidableRel R] {a : α}
    {l : List α} (h : ∀ (b : α), b ∈ pw_filter R l → R a b) :
    pw_filter R (a :: l) = a :: pw_filter R l :=
  if_pos h

@[simp] theorem pw_filter_cons_of_neg {α : Type u} {R : α → α → Prop} [DecidableRel R] {a : α}
    {l : List α} (h : ¬∀ (b : α), b ∈ pw_filter R l → R a b) :
    pw_filter R (a :: l) = pw_filter R l :=
  if_neg h

theorem pw_filter_map {α : Type u} {β : Type v} {R : α → α → Prop} [DecidableRel R] (f : β → α)
    (l : List β) : pw_filter R (map f l) = map f (pw_filter (fun (x y : β) => R (f x) (f y)) l) :=
  sorry

theorem pw_filter_sublist {α : Type u} {R : α → α → Prop} [DecidableRel R] (l : List α) :
    pw_filter R l <+ l :=
  sorry

theorem pw_filter_subset {α : Type u} {R : α → α → Prop} [DecidableRel R] (l : List α) :
    pw_filter R l ⊆ l :=
  sublist.subset (pw_filter_sublist l)

theorem pairwise_pw_filter {α : Type u} {R : α → α → Prop} [DecidableRel R] (l : List α) :
    pairwise R (pw_filter R l) :=
  sorry

theorem pw_filter_eq_self {α : Type u} {R : α → α → Prop} [DecidableRel R] {l : List α} :
    pw_filter R l = l ↔ pairwise R l :=
  sorry

@[simp] theorem pw_filter_idempotent {α : Type u} {R : α → α → Prop} [DecidableRel R] {l : List α} :
    pw_filter R (pw_filter R l) = pw_filter R l :=
  iff.mpr pw_filter_eq_self (pairwise_pw_filter l)

theorem forall_mem_pw_filter {α : Type u} {R : α → α → Prop} [DecidableRel R]
    (neg_trans : ∀ {x y z : α}, R x z → R x y ∨ R y z) (a : α) (l : List α) :
    (∀ (b : α), b ∈ pw_filter R l → R a b) ↔ ∀ (b : α), b ∈ l → R a b :=
  sorry

end Mathlib