/-
Copyright (c) 2017 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.int.gcd
import Mathlib.tactic.abel
import Mathlib.data.list.rotate
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-
# Congruences modulo a natural number

This file defines the equivalence relation `a ≡ b [MOD n]` on the natural numbers,
and proves basic properties about it such as the Chinese Remainder Theorem
`modeq_and_modeq_iff_modeq_mul`.

## Notations

`a ≡ b [MOD n]` is notation for `modeq n a b`, which is defined to mean `a % n = b % n`.

## Tags

modeq, congruence, mod, MOD, modulo
-/

namespace nat

/-- Modular equality. `modeq n a b`, or `a ≡ b [MOD n]`, means
  that `a - b` is a multiple of `n`. -/
def modeq (n : ℕ) (a : ℕ) (b : ℕ) := a % n = b % n

namespace modeq

protected theorem refl {n : ℕ} (a : ℕ) : modeq n a a := rfl

protected theorem symm {n : ℕ} {a : ℕ} {b : ℕ} : modeq n a b → modeq n b a := Eq.symm

protected theorem trans {n : ℕ} {a : ℕ} {b : ℕ} {c : ℕ} : modeq n a b → modeq n b c → modeq n a c :=
  Eq.trans

protected theorem comm {n : ℕ} {a : ℕ} {b : ℕ} : modeq n a b ↔ modeq n b a :=
  { mp := modeq.symm, mpr := modeq.symm }

theorem modeq_zero_iff {n : ℕ} {a : ℕ} : modeq n a 0 ↔ n ∣ a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n a 0 ↔ n ∣ a)) (equations._eqn_1 n a 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a % n = 0 % n ↔ n ∣ a)) (zero_mod n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a % n = 0 ↔ n ∣ a)) (propext (dvd_iff_mod_eq_zero n a))))
        (iff.refl (a % n = 0))))

theorem modeq_iff_dvd {n : ℕ} {a : ℕ} {b : ℕ} : modeq n a b ↔ ↑n ∣ ↑b - ↑a := sorry

theorem modeq_of_dvd {n : ℕ} {a : ℕ} {b : ℕ} : ↑n ∣ ↑b - ↑a → modeq n a b := iff.mpr modeq_iff_dvd

theorem dvd_of_modeq {n : ℕ} {a : ℕ} {b : ℕ} : modeq n a b → ↑n ∣ ↑b - ↑a := iff.mp modeq_iff_dvd

/-- A variant of `modeq_iff_dvd` with `nat` divisibility -/
theorem modeq_iff_dvd' {n : ℕ} {a : ℕ} {b : ℕ} (h : a ≤ b) : modeq n a b ↔ n ∣ b - a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n a b ↔ n ∣ b - a)) (propext modeq_iff_dvd)))
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (↑n ∣ ↑b - ↑a ↔ n ∣ b - a)) (Eq.symm (propext int.coe_nat_dvd))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑n ∣ ↑b - ↑a ↔ ↑n ∣ ↑(b - a))) (int.coe_nat_sub h)))
        (iff.refl (↑n ∣ ↑b - ↑a))))

theorem mod_modeq (a : ℕ) (n : ℕ) : modeq n (a % n) a := mod_mod a n

theorem modeq_of_dvd_of_modeq {n : ℕ} {m : ℕ} {a : ℕ} {b : ℕ} (d : m ∣ n) (h : modeq n a b) :
    modeq m a b :=
  modeq_of_dvd (dvd_trans (iff.mpr int.coe_nat_dvd d) (dvd_of_modeq h))

theorem modeq_mul_left' {n : ℕ} {a : ℕ} {b : ℕ} (c : ℕ) (h : modeq n a b) :
    modeq (c * n) (c * a) (c * b) :=
  sorry

theorem modeq_mul_left {n : ℕ} {a : ℕ} {b : ℕ} (c : ℕ) (h : modeq n a b) :
    modeq n (c * a) (c * b) :=
  modeq_of_dvd_of_modeq (dvd_mul_left n c) (modeq_mul_left' c h)

theorem modeq_mul_right' {n : ℕ} {a : ℕ} {b : ℕ} (c : ℕ) (h : modeq n a b) :
    modeq (n * c) (a * c) (b * c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq (n * c) (a * c) (b * c))) (mul_comm a c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (modeq (n * c) (c * a) (b * c))) (mul_comm b c)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (modeq (n * c) (c * a) (c * b))) (mul_comm n c)))
        (modeq_mul_left' c h)))

theorem modeq_mul_right {n : ℕ} {a : ℕ} {b : ℕ} (c : ℕ) (h : modeq n a b) :
    modeq n (a * c) (b * c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n (a * c) (b * c))) (mul_comm a c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (modeq n (c * a) (b * c))) (mul_comm b c)))
      (modeq_mul_left c h))

theorem modeq_mul {n : ℕ} {a : ℕ} {b : ℕ} {c : ℕ} {d : ℕ} (h₁ : modeq n a b) (h₂ : modeq n c d) :
    modeq n (a * c) (b * d) :=
  modeq.trans (modeq_mul_left a h₂) (modeq_mul_right d h₁)

theorem modeq_pow {n : ℕ} {a : ℕ} {b : ℕ} (m : ℕ) (h : modeq n a b) : modeq n (a ^ m) (b ^ m) :=
  sorry

theorem modeq_add {n : ℕ} {a : ℕ} {b : ℕ} {c : ℕ} {d : ℕ} (h₁ : modeq n a b) (h₂ : modeq n c d) :
    modeq n (a + c) (b + d) :=
  sorry

theorem modeq_add_cancel_left {n : ℕ} {a : ℕ} {b : ℕ} {c : ℕ} {d : ℕ} (h₁ : modeq n a b)
    (h₂ : modeq n (a + c) (b + d)) : modeq n c d :=
  sorry

theorem modeq_add_cancel_right {n : ℕ} {a : ℕ} {b : ℕ} {c : ℕ} {d : ℕ} (h₁ : modeq n c d)
    (h₂ : modeq n (a + c) (b + d)) : modeq n a b :=
  modeq_add_cancel_left h₁
    (eq.mp (Eq._oldrec (Eq.refl (modeq n (c + a) (b + d))) (add_comm b d))
      (eq.mp (Eq._oldrec (Eq.refl (modeq n (a + c) (b + d))) (add_comm a c)) h₂))

theorem modeq_of_modeq_mul_left {n : ℕ} {a : ℕ} {b : ℕ} (m : ℕ) (h : modeq (m * n) a b) :
    modeq n a b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n a b)) (propext modeq_iff_dvd)))
    (dvd.trans (dvd_mul_left ↑n ↑m)
      (eq.mp (Eq._oldrec (Eq.refl (modeq (m * n) a b)) (propext modeq_iff_dvd)) h))

theorem modeq_of_modeq_mul_right {n : ℕ} {a : ℕ} {b : ℕ} (m : ℕ) :
    modeq (n * m) a b → modeq n a b :=
  mul_comm m n ▸ modeq_of_modeq_mul_left m

theorem modeq_one {a : ℕ} {b : ℕ} : modeq 1 a b := modeq_of_dvd (one_dvd (↑b - ↑a))

/-- The natural number less than `lcm n m` congruent to `a` mod `n` and `b` mod `m` -/
def chinese_remainder' {n : ℕ} {m : ℕ} {a : ℕ} {b : ℕ} (h : modeq (gcd n m) a b) :
    Subtype fun (k : ℕ) => modeq n k a ∧ modeq m k b :=
  dite (n = 0) (fun (hn : n = 0) => { val := a, property := sorry })
    fun (hn : ¬n = 0) =>
      dite (m = 0) (fun (hm : m = 0) => { val := b, property := sorry })
        fun (hm : ¬m = 0) => { val := sorry, property := sorry }

/-- The natural number less than `n*m` congruent to `a` mod `n` and `b` mod `m` -/
def chinese_remainder {n : ℕ} {m : ℕ} (co : coprime n m) (a : ℕ) (b : ℕ) :
    Subtype fun (k : ℕ) => modeq n k a ∧ modeq m k b :=
  chinese_remainder' sorry

theorem modeq_and_modeq_iff_modeq_mul {a : ℕ} {b : ℕ} {m : ℕ} {n : ℕ} (hmn : coprime m n) :
    modeq m a b ∧ modeq n a b ↔ modeq (m * n) a b :=
  sorry

theorem coprime_of_mul_modeq_one (b : ℕ) {a : ℕ} {n : ℕ} (h : modeq n (a * b) 1) : coprime a n :=
  sorry

end modeq

@[simp] theorem mod_mul_right_mod (a : ℕ) (b : ℕ) (c : ℕ) : a % (b * c) % b = a % b :=
  modeq.modeq_of_modeq_mul_right c (modeq.mod_modeq a (b * c))

@[simp] theorem mod_mul_left_mod (a : ℕ) (b : ℕ) (c : ℕ) : a % (b * c) % c = a % c :=
  modeq.modeq_of_modeq_mul_left b (modeq.mod_modeq a (b * c))

theorem div_mod_eq_mod_mul_div (a : ℕ) (b : ℕ) (c : ℕ) : a / b % c = a % (b * c) / b := sorry

theorem add_mod_add_ite (a : ℕ) (b : ℕ) (c : ℕ) :
    (a + b) % c + ite (c ≤ a % c + b % c) c 0 = a % c + b % c :=
  sorry

theorem add_mod_of_add_mod_lt {a : ℕ} {b : ℕ} {c : ℕ} (hc : a % c + b % c < c) :
    (a + b) % c = a % c + b % c :=
  sorry

theorem add_mod_add_of_le_add_mod {a : ℕ} {b : ℕ} {c : ℕ} (hc : c ≤ a % c + b % c) :
    (a + b) % c + c = a % c + b % c :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl ((a + b) % c + c = a % c + b % c)) (Eq.symm (add_mod_add_ite a b c))))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl ((a + b) % c + c = (a + b) % c + ite (c ≤ a % c + b % c) c 0))
          (if_pos hc)))
      (Eq.refl ((a + b) % c + c)))

theorem add_div {a : ℕ} {b : ℕ} {c : ℕ} (hc0 : 0 < c) :
    (a + b) / c = a / c + b / c + ite (c ≤ a % c + b % c) 1 0 :=
  sorry

theorem add_div_eq_of_add_mod_lt {a : ℕ} {b : ℕ} {c : ℕ} (hc : a % c + b % c < c) :
    (a + b) / c = a / c + b / c :=
  sorry

protected theorem add_div_of_dvd_right {a : ℕ} {b : ℕ} {c : ℕ} (hca : c ∣ a) :
    (a + b) / c = a / c + b / c :=
  sorry

protected theorem add_div_of_dvd_left {a : ℕ} {b : ℕ} {c : ℕ} (hca : c ∣ b) :
    (a + b) / c = a / c + b / c :=
  sorry

theorem add_div_eq_of_le_mod_add_mod {a : ℕ} {b : ℕ} {c : ℕ} (hc : c ≤ a % c + b % c)
    (hc0 : 0 < c) : (a + b) / c = a / c + b / c + 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl ((a + b) / c = a / c + b / c + 1)) (add_div hc0)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (a / c + b / c + ite (c ≤ a % c + b % c) 1 0 = a / c + b / c + 1))
          (if_pos hc)))
      (Eq.refl (a / c + b / c + 1)))

theorem add_div_le_add_div (a : ℕ) (b : ℕ) (c : ℕ) : a / c + b / c ≤ (a + b) / c := sorry

theorem le_mod_add_mod_of_dvd_add_of_not_dvd {a : ℕ} {b : ℕ} {c : ℕ} (h : c ∣ a + b) (ha : ¬c ∣ a) :
    c ≤ a % c + b % c :=
  sorry

theorem odd_mul_odd {n : ℕ} {m : ℕ} (hn1 : n % bit0 1 = 1) (hm1 : m % bit0 1 = 1) :
    n * m % bit0 1 = 1 :=
  (fun (this : n * m % bit0 1 = 1 * 1 % bit0 1) => this) (modeq.modeq_mul hn1 hm1)

theorem odd_mul_odd_div_two {m : ℕ} {n : ℕ} (hm1 : m % bit0 1 = 1) (hn1 : n % bit0 1 = 1) :
    m * n / bit0 1 = m * (n / bit0 1) + m / bit0 1 :=
  sorry

theorem odd_of_mod_four_eq_one {n : ℕ} (h : n % bit0 (bit0 1) = 1) : n % bit0 1 = 1 :=
  modeq.modeq_of_modeq_mul_left (bit0 1) h

theorem odd_of_mod_four_eq_three {n : ℕ} (h : n % bit0 (bit0 1) = bit1 1) : n % bit0 1 = 1 :=
  modeq.modeq_of_modeq_mul_left (bit0 1) h

end nat

namespace list

theorem nth_rotate {α : Type u_1} {l : List α} {n : ℕ} {m : ℕ} (hml : m < length l) :
    nth (rotate l n) m = nth l ((m + n) % length l) :=
  sorry

theorem rotate_eq_self_iff_eq_repeat {α : Type u_1} [hα : Nonempty α] {l : List α} :
    (∀ (n : ℕ), rotate l n = l) ↔ ∃ (a : α), l = repeat a (length l) :=
  sorry

end Mathlib


#reduce { 2, 4 } ⊆ { n : ℕ | ∃ m, n = 2 * m }

example : { 2, 4 } ⊆ { n : ℕ | ∃ m, n = 2 * m } :=
begin
change ∀ ⦃a : ℕ⦄, a = 4 ∨ a = 2 ∨ false → (∃ (m : ℕ), a = nat.mul 2 m),
intro,
assume h,
cases h with four rest,
apply exists.intro 2,
assumption,

cases rest with two f,
apply exists.intro 1,
assumption,

contradiction,
end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import data.set.function
import logic.equiv.basic

/-!
# Local equivalences

This files defines equivalences between subsets of given types.
An element `e` of `local_equiv α β` is made of two maps `e.to_fun` and `e.inv_fun` respectively
from α to β and from  β to α (just like equivs), which are inverse to each other on the subsets
`e.source` and `e.target` of respectively α and β.

They are designed in particular to define charts on manifolds.

The main functionality is `e.trans f`, which composes the two local equivalences by restricting
the source and target to the maximal set where the composition makes sense.

As for equivs, we register a coercion to functions and use it in our simp normal form: we write
`e x` and `e.symm y` instead of `e.to_fun x` and `e.inv_fun y`.

## Main definitions

`equiv.to_local_equiv`: associating a local equiv to an equiv, with source = target = univ
`local_equiv.symm`    : the inverse of a local equiv
`local_equiv.trans`   : the composition of two local equivs
`local_equiv.refl`    : the identity local equiv
`local_equiv.of_set`  : the identity on a set `s`
`eq_on_source`        : equivalence relation describing the "right" notion of equality for local
                        equivs (see below in implementation notes)

## Implementation notes

There are at least three possible implementations of local equivalences:
* equivs on subtypes
* pairs of functions taking values in `option α` and `option β`, equal to none where the local
equivalence is not defined
* pairs of functions defined everywhere, keeping the source and target as additional data

Each of these implementations has pros and cons.
* When dealing with subtypes, one still need to define additional API for composition and
restriction of domains. Checking that one always belongs to the right subtype makes things very
tedious, and leads quickly to DTT hell (as the subtype `u ∩ v` is not the "same" as `v ∩ u`, for
instance).
* With option-valued functions, the composition is very neat (it is just the usual composition, and
the domain is restricted automatically). These are implemented in `pequiv.lean`. For manifolds,
where one wants to discuss thoroughly the smoothness of the maps, this creates however a lot of
overhead as one would need to extend all classes of smoothness to option-valued maps.
* The local_equiv version as explained above is easier to use for manifolds. The drawback is that
there is extra useless data (the values of `to_fun` and `inv_fun` outside of `source` and `target`).
In particular, the equality notion between local equivs is not "the right one", i.e., coinciding
source and target and equality there. Moreover, there are no local equivs in this sense between
an empty type and a nonempty type. Since empty types are not that useful, and since one almost never
needs to talk about equal local equivs, this is not an issue in practice.
Still, we introduce an equivalence relation `eq_on_source` that captures this right notion of
equality, and show that many properties are invariant under this equivalence relation.

### Local coding conventions

If a lemma deals with the intersection of a set with either source or target of a `local_equiv`,
then it should use `e.source ∩ s` or `e.target ∩ t`, not `s ∩ e.source` or `t ∩ e.target`.

-/

mk_simp_attribute mfld_simps "The simpset `mfld_simps` records several simp lemmas that are
especially useful in manifolds. It is a subset of the whole set of simp lemmas, but it makes it
possible to have quicker proofs (when used with `squeeze_simp` or `simp only`) while retaining
readability.

The typical use case is the following, in a file on manifolds:
If `simp [foo, bar]` is slow, replace it with `squeeze_simp [foo, bar] with mfld_simps` and paste
its output. The list of lemmas should be reasonable (contrary to the output of
`squeeze_simp [foo, bar]` which might contain tens of lemmas), and the outcome should be quick
enough.
"

-- register in the simpset `mfld_simps` several lemmas that are often useful when dealing
-- with manifolds
attribute [mfld_simps] id.def function.comp.left_id set.mem_set_of_eq set.image_eq_empty
set.univ_inter set.preimage_univ set.prod_mk_mem_set_prod_eq and_true set.mem_univ
set.mem_image_of_mem true_and set.mem_inter_eq set.mem_preimage function.comp_app
set.inter_subset_left set.mem_prod set.range_id set.range_prod_map and_self set.mem_range_self
eq_self_iff_true forall_const forall_true_iff set.inter_univ set.preimage_id function.comp.right_id
not_false_iff and_imp set.prod_inter_prod set.univ_prod_univ true_or or_true prod.map_mk
set.preimage_inter heq_iff_eq equiv.sigma_equiv_prod_apply equiv.sigma_equiv_prod_symm_apply
subtype.coe_mk equiv.to_fun_as_coe equiv.inv_fun_as_coe

/-- Common `@[simps]` configuration options used for manifold-related declarations. -/
def mfld_cfg : simps_cfg := {attrs := [`simp, `mfld_simps], fully_applied := ff}

namespace tactic.interactive

/-- A very basic tactic to show that sets showing up in manifolds coincide or are included in
one another. -/
meta def mfld_set_tac : tactic unit := do
  goal ← tactic.target,
  match goal with
  | `(%%e₁ = %%e₂) :=
      `[ext my_y,
        split;
        { assume h_my_y,
          try { simp only [*, -h_my_y] with mfld_simps at h_my_y },
          simp only [*] with mfld_simps }]
  | `(%%e₁ ⊆ %%e₂) :=
      `[assume my_y h_my_y,
        try { simp only [*, -h_my_y] with mfld_simps at h_my_y },
        simp only [*] with mfld_simps]
  | _ := tactic.fail "goal should be an equality or an inclusion"
  end

end tactic.interactive

open function set

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

/-- Local equivalence between subsets `source` and `target` of α and β respectively. The (global)
maps `to_fun : α → β` and `inv_fun : β → α` map `source` to `target` and conversely, and are inverse
to each other there. The values of `to_fun` outside of `source` and of `inv_fun` outside of `target`
are irrelevant. -/
@[nolint has_inhabited_instance]
structure local_equiv (α : Type*) (β : Type*) :=
(to_fun      : α → β)
(inv_fun     : β → α)
(source      : set α)
(target      : set β)
(map_source' : ∀{x}, x ∈ source → to_fun x ∈ target)
(map_target' : ∀{x}, x ∈ target → inv_fun x ∈ source)
(left_inv'   : ∀{x}, x ∈ source → inv_fun (to_fun x) = x)
(right_inv'  : ∀{x}, x ∈ target → to_fun (inv_fun x) = x)

/-- Associating a local_equiv to an equiv-/
def equiv.to_local_equiv (e : α ≃ β) : local_equiv α β :=
{ to_fun      := e,
  inv_fun     := e.symm,
  source      := univ,
  target      := univ,
  map_source' := λx hx, mem_univ _,
  map_target' := λy hy, mem_univ _,
  left_inv'   := λx hx, e.left_inv x,
  right_inv'  := λx hx, e.right_inv x }

namespace local_equiv

variables (e : local_equiv α β) (e' : local_equiv β γ)

/-- The inverse of a local equiv -/
protected def symm : local_equiv β α :=
{ to_fun     := e.inv_fun,
  inv_fun    := e.to_fun,
  source     := e.target,
  target     := e.source,
  map_source' := e.map_target',
  map_target' := e.map_source',
  left_inv'   := e.right_inv',
  right_inv'  := e.left_inv' }

instance : has_coe_to_fun (local_equiv α β) (λ _, α → β) := ⟨local_equiv.to_fun⟩

/-- See Note [custom simps projection] -/
def simps.symm_apply (e : local_equiv α β) : β → α := e.symm

initialize_simps_projections local_equiv (to_fun → apply, inv_fun → symm_apply)

@[simp, mfld_simps] theorem coe_mk (f : α → β) (g s t ml mr il ir) :
  (local_equiv.mk f g s t ml mr il ir : α → β) = f := rfl

@[simp, mfld_simps] theorem coe_symm_mk (f : α → β) (g s t ml mr il ir) :
  ((local_equiv.mk f g s t ml mr il ir).symm : β → α) = g := rfl

@[simp, mfld_simps] lemma to_fun_as_coe : e.to_fun = e := rfl

@[simp, mfld_simps] lemma inv_fun_as_coe : e.inv_fun = e.symm := rfl

@[simp, mfld_simps] lemma map_source {x : α} (h : x ∈ e.source) : e x ∈ e.target :=
e.map_source' h

@[simp, mfld_simps] lemma map_target {x : β} (h : x ∈ e.target) : e.symm x ∈ e.source :=
e.map_target' h

@[simp, mfld_simps] lemma left_inv {x : α} (h : x ∈ e.source) : e.symm (e x) = x :=
e.left_inv' h

@[simp, mfld_simps] lemma right_inv {x : β} (h : x ∈ e.target) : e (e.symm x) = x :=
e.right_inv' h

protected lemma maps_to : maps_to e e.source e.target := λ x, e.map_source
lemma symm_maps_to : maps_to e.symm e.target e.source := e.symm.maps_to
protected lemma left_inv_on : left_inv_on e.symm e e.source := λ x, e.left_inv
protected lemma right_inv_on : right_inv_on e.symm e e.target := λ x, e.right_inv
protected lemma inv_on : inv_on e.symm e e.source e.target := ⟨e.left_inv_on, e.right_inv_on⟩
protected lemma inj_on : inj_on e e.source := e.left_inv_on.inj_on
protected lemma bij_on : bij_on e e.source e.target := e.inv_on.bij_on e.maps_to e.symm_maps_to
protected lemma surj_on : surj_on e e.source e.target := e.bij_on.surj_on

/-- Create a copy of a `local_equiv` providing better definitional equalities. -/
@[simps] def copy (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
  (s : set α) (hs : e.source = s) (t : set β) (ht : e.target = t) :
  local_equiv α β :=
{ to_fun := f,
  inv_fun := g,
  source := s,
  target := t,
  map_source' := λ x, ht ▸ hs ▸ hf ▸ e.map_source,
  map_target' := λ y, hs ▸ ht ▸ hg ▸ e.map_target,
  left_inv' := λ x, hs ▸ hf ▸ hg ▸ e.left_inv,
  right_inv' := λ x, ht ▸ hf ▸ hg ▸ e.right_inv }

lemma copy_eq_self (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
  (s : set α) (hs : e.source = s) (t : set β) (ht : e.target = t) :
  e.copy f hf g hg s hs t ht = e :=
by { substs f g s t, cases e, refl }

/-- Associating to a local_equiv an equiv between the source and the target -/
protected def to_equiv : equiv (e.source) (e.target) :=
{ to_fun    := λ x, ⟨e x, e.map_source x.mem⟩,
  inv_fun   := λ y, ⟨e.symm y, e.map_target y.mem⟩,
  left_inv  := λ⟨x, hx⟩, subtype.eq $ e.left_inv hx,
  right_inv := λ⟨y, hy⟩, subtype.eq $ e.right_inv hy }

@[simp, mfld_simps] lemma symm_source : e.symm.source = e.target := rfl
@[simp, mfld_simps] lemma symm_target : e.symm.target = e.source := rfl
@[simp, mfld_simps] lemma symm_symm : e.symm.symm = e := by { cases e, refl }

lemma image_source_eq_target : e '' e.source = e.target := e.bij_on.image_eq

/-- We say that `t : set β` is an image of `s : set α` under a local equivalence if
any of the following equivalent conditions hold:

* `e '' (e.source ∩ s) = e.target ∩ t`;
* `e.source ∩ e ⁻¹ t = e.source ∩ s`;
* `∀ x ∈ e.source, e x ∈ t ↔ x ∈ s` (this one is used in the definition).
-/
def is_image (s : set α) (t : set β) : Prop := ∀ ⦃x⦄, x ∈ e.source → (e x ∈ t ↔ x ∈ s)

namespace is_image

variables {e} {s : set α} {t : set β} {x : α} {y : β}

lemma apply_mem_iff (h : e.is_image s t) (hx : x ∈ e.source) : e x ∈ t ↔ x ∈ s := h hx

lemma symm_apply_mem_iff (h : e.is_image s t) : ∀ ⦃y⦄, y ∈ e.target → (e.symm y ∈ s ↔ y ∈ t) :=
by { rw [← e.image_source_eq_target, ball_image_iff], intros x hx, rw [e.left_inv hx, h hx] }

protected lemma symm (h : e.is_image s t) : e.symm.is_image t s := h.symm_apply_mem_iff

@[simp] lemma symm_iff : e.symm.is_image t s ↔ e.is_image s t := ⟨λ h, h.symm, λ h, h.symm⟩

protected lemma maps_to (h : e.is_image s t) : maps_to e (e.source ∩ s) (e.target ∩ t) :=
λ x hx, ⟨e.maps_to hx.1, (h hx.1).2 hx.2⟩

lemma symm_maps_to (h : e.is_image s t) : maps_to e.symm (e.target ∩ t) (e.source ∩ s) :=
h.symm.maps_to

/-- Restrict a `local_equiv` to a pair of corresponding sets. -/
@[simps] def restr (h : e.is_image s t) : local_equiv α β :=
{ to_fun := e,
  inv_fun := e.symm,
  source := e.source ∩ s,
  target := e.target ∩ t,
  map_source' := h.maps_to,
  map_target' := h.symm_maps_to,
  left_inv' := e.left_inv_on.mono (inter_subset_left _ _),
  right_inv' := e.right_inv_on.mono (inter_subset_left _ _) }

lemma image_eq (h : e.is_image s t) : e '' (e.source ∩ s) = e.target ∩ t :=
h.restr.image_source_eq_target

lemma symm_image_eq (h : e.is_image s t) : e.symm '' (e.target ∩ t) = e.source ∩ s :=
h.symm.image_eq

lemma iff_preimage_eq : e.is_image s t ↔ e.source ∩ e ⁻¹' t = e.source ∩ s :=
by simp only [is_image, set.ext_iff, mem_inter_eq, and.congr_right_iff, mem_preimage]

alias iff_preimage_eq ↔ local_equiv.is_image.preimage_eq local_equiv.is_image.of_preimage_eq

lemma iff_symm_preimage_eq : e.is_image s t ↔ e.target ∩ e.symm ⁻¹' s = e.target ∩ t :=
symm_iff.symm.trans iff_preimage_eq

alias iff_symm_preimage_eq ↔ local_equiv.is_image.symm_preimage_eq
  local_equiv.is_image.of_symm_preimage_eq

lemma of_image_eq (h : e '' (e.source ∩ s) = e.target ∩ t) : e.is_image s t :=
of_symm_preimage_eq $ eq.trans (of_symm_preimage_eq rfl).image_eq.symm h

lemma of_symm_image_eq (h : e.symm '' (e.target ∩ t) = e.source ∩ s) : e.is_image s t :=
of_preimage_eq $ eq.trans (of_preimage_eq rfl).symm_image_eq.symm h

protected lemma compl (h : e.is_image s t) : e.is_image sᶜ tᶜ :=
λ x hx, not_congr (h hx)

protected lemma inter {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s ∩ s') (t ∩ t') :=
λ x hx, and_congr (h hx) (h' hx)

protected lemma union {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s ∪ s') (t ∪ t') :=
λ x hx, or_congr (h hx) (h' hx)

protected lemma diff {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s \ s') (t \ t') :=
h.inter h'.compl

lemma left_inv_on_piecewise {e' : local_equiv α β} [∀ i, decidable (i ∈ s)] [∀ i, decidable (i ∈ t)]
  (h : e.is_image s t) (h' : e'.is_image s t) :
  left_inv_on (t.piecewise e.symm e'.symm) (s.piecewise e e') (s.ite e.source e'.source) :=
begin
  rintro x (⟨he, hs⟩|⟨he, hs : x ∉ s⟩),
  { rw [piecewise_eq_of_mem _ _ _ hs, piecewise_eq_of_mem _ _ _ ((h he).2 hs), e.left_inv he], },
  { rw [piecewise_eq_of_not_mem _ _ _ hs, piecewise_eq_of_not_mem _ _ _ ((h'.compl he).2 hs),
      e'.left_inv he] }
end

lemma inter_eq_of_inter_eq_of_eq_on {e' : local_equiv α β} (h : e.is_image s t)
  (h' : e'.is_image s t) (hs : e.source ∩ s = e'.source ∩ s) (Heq : eq_on e e' (e.source ∩ s)) :
  e.target ∩ t = e'.target ∩ t :=
by rw [← h.image_eq, ← h'.image_eq, ← hs, Heq.image_eq]

lemma symm_eq_on_of_inter_eq_of_eq_on {e' : local_equiv α β} (h : e.is_image s t)
  (hs : e.source ∩ s = e'.source ∩ s) (Heq : eq_on e e' (e.source ∩ s)) :
  eq_on e.symm e'.symm (e.target ∩ t) :=
begin
  rw [← h.image_eq],
  rintros y ⟨x, hx, rfl⟩,
  have hx' := hx, rw hs at hx',
  rw [e.left_inv hx.1, Heq hx, e'.left_inv hx'.1]
end

end is_image

lemma is_image_source_target : e.is_image e.source e.target := λ x hx, by simp [hx]

lemma is_image_source_target_of_disjoint (e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) :
  e.is_image e'.source e'.target :=
assume x hx,
have x ∉ e'.source, from λ hx', hs ⟨hx, hx'⟩,
have e x ∉ e'.target, from λ hx', ht ⟨e.maps_to hx, hx'⟩,
by simp only *

lemma image_source_inter_eq' (s : set α) :
  e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' s :=
by rw [inter_comm, e.left_inv_on.image_inter', image_source_eq_target, inter_comm]

lemma image_source_inter_eq (s : set α) :
  e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' (e.source ∩ s) :=
by rw [inter_comm, e.left_inv_on.image_inter, image_source_eq_target, inter_comm]

lemma image_eq_target_inter_inv_preimage {s : set α} (h : s ⊆ e.source) :
  e '' s = e.target ∩ e.symm ⁻¹' s :=
by rw [← e.image_source_inter_eq', inter_eq_self_of_subset_right h]

lemma symm_image_eq_source_inter_preimage {s : set β} (h : s ⊆ e.target) :
  e.symm '' s = e.source ∩ e ⁻¹' s :=
e.symm.image_eq_target_inter_inv_preimage h

lemma symm_image_target_inter_eq (s : set β) :
  e.symm '' (e.target ∩ s) = e.source ∩ e ⁻¹' (e.target ∩ s) :=
e.symm.image_source_inter_eq _

lemma symm_image_target_inter_eq' (s : set β) :
  e.symm '' (e.target ∩ s) = e.source ∩ e ⁻¹' s :=
e.symm.image_source_inter_eq' _

lemma source_inter_preimage_inv_preimage (s : set α) :
  e.source ∩ e ⁻¹' (e.symm ⁻¹' s) = e.source ∩ s :=
set.ext $ λ x, and.congr_right_iff.2 $ λ hx, by simp only [mem_preimage, e.left_inv hx]

lemma source_inter_preimage_target_inter (s : set β) :
  e.source ∩ (e ⁻¹' (e.target ∩ s)) = e.source ∩ (e ⁻¹' s) :=
ext $ λ x, ⟨λ hx, ⟨hx.1, hx.2.2⟩, λ hx, ⟨hx.1, e.map_source hx.1, hx.2⟩⟩

lemma target_inter_inv_preimage_preimage (s : set β) :
  e.target ∩ e.symm ⁻¹' (e ⁻¹' s) = e.target ∩ s :=
e.symm.source_inter_preimage_inv_preimage _

lemma source_subset_preimage_target : e.source ⊆ e ⁻¹' e.target :=
e.maps_to

lemma symm_image_target_eq_source : e.symm '' e.target = e.source :=
e.symm.image_source_eq_target

/-- Two local equivs that have the same `source`, same `to_fun` and same `inv_fun`, coincide. -/
@[ext]
protected lemma ext {e e' : local_equiv α β} (h : ∀x, e x = e' x)
  (hsymm : ∀x, e.symm x = e'.symm x) (hs : e.source = e'.source) : e = e' :=
begin
  have A : (e : α → β) = e', by { ext x, exact h x },
  have B : (e.symm : β → α) = e'.symm, by { ext x, exact hsymm x },
  have I : e '' e.source = e.target := e.image_source_eq_target,
  have I' : e' '' e'.source = e'.target := e'.image_source_eq_target,
  rw [A, hs, I'] at I,
  cases e; cases e',
  simp * at *
end

/-- Restricting a local equivalence to e.source ∩ s -/
protected def restr (s : set α) : local_equiv α β :=
(@is_image.of_symm_preimage_eq α β e s (e.symm ⁻¹' s) rfl).restr

@[simp, mfld_simps] lemma restr_coe (s : set α) : (e.restr s : α → β) = e := rfl
@[simp, mfld_simps] lemma restr_coe_symm (s : set α) : ((e.restr s).symm : β → α) = e.symm := rfl
@[simp, mfld_simps] lemma restr_source (s : set α) : (e.restr s).source = e.source ∩ s := rfl
@[simp, mfld_simps] lemma restr_target (s : set α) :
  (e.restr s).target = e.target ∩ e.symm ⁻¹' s := rfl

lemma restr_eq_of_source_subset {e : local_equiv α β} {s : set α} (h : e.source ⊆ s) :
  e.restr s = e :=
local_equiv.ext (λ_, rfl) (λ_, rfl) (by simp [inter_eq_self_of_subset_left h])

@[simp, mfld_simps] lemma restr_univ {e : local_equiv α β} : e.restr univ = e :=
restr_eq_of_source_subset (subset_univ _)

/-- The identity local equiv -/
protected def refl (α : Type*) : local_equiv α α := (equiv.refl α).to_local_equiv

@[simp, mfld_simps] lemma refl_source : (local_equiv.refl α).source = univ := rfl
@[simp, mfld_simps] lemma refl_target : (local_equiv.refl α).target = univ := rfl
@[simp, mfld_simps] lemma refl_coe : (local_equiv.refl α : α → α) = id := rfl
@[simp, mfld_simps] lemma refl_symm : (local_equiv.refl α).symm = local_equiv.refl α := rfl

@[simp, mfld_simps] lemma refl_restr_source (s : set α) :
  ((local_equiv.refl α).restr s).source = s :=
by simp

@[simp, mfld_simps] lemma refl_restr_target (s : set α) :
  ((local_equiv.refl α).restr s).target = s :=
by { change univ ∩ id⁻¹' s = s, simp }

/-- The identity local equiv on a set `s` -/
def of_set (s : set α) : local_equiv α α :=
{ to_fun      := id,
  inv_fun     := id,
  source      := s,
  target      := s,
  map_source' := λx hx, hx,
  map_target' := λx hx, hx,
  left_inv'   := λx hx, rfl,
  right_inv'  := λx hx, rfl }

@[simp, mfld_simps] lemma of_set_source (s : set α) : (local_equiv.of_set s).source = s := rfl
@[simp, mfld_simps] lemma of_set_target (s : set α) : (local_equiv.of_set s).target = s := rfl
@[simp, mfld_simps] lemma of_set_coe (s : set α) : (local_equiv.of_set s : α → α) = id := rfl
@[simp, mfld_simps] lemma of_set_symm (s : set α) :
  (local_equiv.of_set s).symm = local_equiv.of_set s := rfl

/-- Composing two local equivs if the target of the first coincides with the source of the
second. -/
protected def trans' (e' : local_equiv β γ) (h : e.target = e'.source) :
  local_equiv α γ :=
{ to_fun := e' ∘ e,
  inv_fun := e.symm ∘ e'.symm,
  source := e.source,
  target := e'.target,
  map_source' := λx hx, by simp [h.symm, hx],
  map_target' := λy hy, by simp [h, hy],
  left_inv' := λx hx, by simp [hx, h.symm],
  right_inv' := λy hy, by simp [hy, h] }

/-- Composing two local equivs, by restricting to the maximal domain where their composition
is well defined. -/
protected def trans : local_equiv α γ :=
  local_equiv.trans' (e.symm.restr (e'.source)).symm (e'.restr (e.target)) (inter_comm _ _)

@[simp, mfld_simps] lemma coe_trans : (e.trans e' : α → γ) = e' ∘ e := rfl
@[simp, mfld_simps] lemma coe_trans_symm : ((e.trans e').symm : γ → α) = e.symm ∘ e'.symm := rfl

lemma trans_symm_eq_symm_trans_symm : (e.trans e').symm = e'.symm.trans e.symm :=
by cases e; cases e'; refl

@[simp, mfld_simps] lemma trans_source : (e.trans e').source = e.source ∩ e ⁻¹' e'.source := rfl

lemma trans_source' : (e.trans e').source = e.source ∩ e ⁻¹' (e.target ∩ e'.source) :=
by mfld_set_tac

lemma trans_source'' : (e.trans e').source = e.symm '' (e.target ∩ e'.source) :=
by rw [e.trans_source', e.symm_image_target_inter_eq]

lemma image_trans_source : e '' (e.trans e').source = e.target ∩ e'.source :=
(e.symm.restr e'.source).symm.image_source_eq_target

@[simp, mfld_simps] lemma trans_target :
  (e.trans e').target = e'.target ∩ e'.symm ⁻¹' e.target := rfl

lemma trans_target' : (e.trans e').target = e'.target ∩ e'.symm ⁻¹' (e'.source ∩ e.target) :=
trans_source' e'.symm e.symm

lemma trans_target'' : (e.trans e').target = e' '' (e'.source ∩ e.target) :=
trans_source'' e'.symm e.symm

lemma inv_image_trans_target : e'.symm '' (e.trans e').target = e'.source ∩ e.target :=
image_trans_source e'.symm e.symm

lemma trans_assoc (e'' : local_equiv γ δ) : (e.trans e').trans e'' = e.trans (e'.trans e'') :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source, @preimage_comp α β γ, inter_assoc])

@[simp, mfld_simps] lemma trans_refl : e.trans (local_equiv.refl β) = e :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source])

@[simp, mfld_simps] lemma refl_trans : (local_equiv.refl α).trans e = e :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source, preimage_id])

lemma trans_refl_restr (s : set β) :
  e.trans ((local_equiv.refl β).restr s) = e.restr (e ⁻¹' s) :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source])

lemma trans_refl_restr' (s : set β) :
  e.trans ((local_equiv.refl β).restr s) = e.restr (e.source ∩ e ⁻¹' s) :=
local_equiv.ext (λx, rfl) (λx, rfl) $ by { simp [trans_source], rw [← inter_assoc, inter_self] }

lemma restr_trans (s : set α) :
  (e.restr s).trans e' = (e.trans e').restr s :=
local_equiv.ext (λx, rfl) (λx, rfl) $ by { simp [trans_source, inter_comm], rwa inter_assoc }

/-- `eq_on_source e e'` means that `e` and `e'` have the same source, and coincide there. Then `e`
and `e'` should really be considered the same local equiv. -/
def eq_on_source (e e' : local_equiv α β) : Prop :=
e.source = e'.source ∧ (e.source.eq_on e e')

/-- `eq_on_source` is an equivalence relation -/
instance eq_on_source_setoid : setoid (local_equiv α β) :=
{ r     := eq_on_source,
  iseqv := ⟨
    λe, by simp [eq_on_source],
    λe e' h, by { simp [eq_on_source, h.1.symm], exact λx hx, (h.2 hx).symm },
    λe e' e'' h h', ⟨by rwa [← h'.1, ← h.1], λx hx, by { rw [← h'.2, h.2 hx], rwa ← h.1 }⟩⟩ }

lemma eq_on_source_refl : e ≈ e := setoid.refl _

/-- Two equivalent local equivs have the same source -/
lemma eq_on_source.source_eq {e e' : local_equiv α β} (h : e ≈ e') : e.source = e'.source :=
h.1

/-- Two equivalent local equivs coincide on the source -/
lemma eq_on_source.eq_on {e e' : local_equiv α β} (h : e ≈ e') : e.source.eq_on e e' :=
h.2

/-- Two equivalent local equivs have the same target -/
lemma eq_on_source.target_eq {e e' : local_equiv α β} (h : e ≈ e') : e.target = e'.target :=
by simp only [← image_source_eq_target, ← h.source_eq, h.2.image_eq]

/-- If two local equivs are equivalent, so are their inverses. -/
lemma eq_on_source.symm' {e e' : local_equiv α β} (h : e ≈ e') : e.symm ≈ e'.symm :=
begin
  refine ⟨h.target_eq, eq_on_of_left_inv_on_of_right_inv_on e.left_inv_on _ _⟩;
    simp only [symm_source, h.target_eq, h.source_eq, e'.symm_maps_to],
  exact e'.right_inv_on.congr_right e'.symm_maps_to (h.source_eq ▸ h.eq_on.symm),
end

/-- Two equivalent local equivs have coinciding inverses on the target -/
lemma eq_on_source.symm_eq_on {e e' : local_equiv α β} (h : e ≈ e') :
  eq_on e.symm e'.symm e.target :=
h.symm'.eq_on

/-- Composition of local equivs respects equivalence -/
lemma eq_on_source.trans' {e e' : local_equiv α β} {f f' : local_equiv β γ}
  (he : e ≈ e') (hf : f ≈ f') : e.trans f ≈ e'.trans f' :=
begin
  split,
  { rw [trans_source'', trans_source'', ← he.target_eq, ← hf.1],
    exact (he.symm'.eq_on.mono $ inter_subset_left _ _).image_eq },
  { assume x hx,
    rw trans_source at hx,
    simp [(he.2 hx.1).symm, hf.2 hx.2] }
end

/-- Restriction of local equivs respects equivalence -/
lemma eq_on_source.restr {e e' : local_equiv α β} (he : e ≈ e') (s : set α) :
  e.restr s ≈ e'.restr s :=
begin
  split,
  { simp [he.1] },
  { assume x hx,
    simp only [mem_inter_eq, restr_source] at hx,
    exact he.2 hx.1 }
end

/-- Preimages are respected by equivalence -/
lemma eq_on_source.source_inter_preimage_eq {e e' : local_equiv α β} (he : e ≈ e') (s : set β) :
  e.source ∩ e ⁻¹' s = e'.source ∩ e' ⁻¹' s :=
by rw [he.eq_on.inter_preimage_eq, he.source_eq]

/-- Composition of a local equiv and its inverse is equivalent to the restriction of the identity
to the source -/
lemma trans_self_symm :
  e.trans e.symm ≈ local_equiv.of_set e.source :=
begin
  have A : (e.trans e.symm).source = e.source, by mfld_set_tac,
  refine ⟨by simp [A], λx hx, _⟩,
  rw A at hx,
  simp only [hx] with mfld_simps
end

/-- Composition of the inverse of a local equiv and this local equiv is equivalent to the
restriction of the identity to the target -/
lemma trans_symm_self :
  e.symm.trans e ≈ local_equiv.of_set e.target :=
trans_self_symm (e.symm)

/-- Two equivalent local equivs are equal when the source and target are univ -/
lemma eq_of_eq_on_source_univ (e e' : local_equiv α β) (h : e ≈ e')
  (s : e.source = univ) (t : e.target = univ) : e = e' :=
begin
  apply local_equiv.ext (λx, _) (λx, _) h.1,
  { apply h.2,
    rw s,
    exact mem_univ _ },
  { apply h.symm'.2,
    rw [symm_source, t],
    exact mem_univ _ }
end

section prod

/-- The product of two local equivs, as a local equiv on the product. -/
def prod (e : local_equiv α β) (e' : local_equiv γ δ) : local_equiv (α × γ) (β × δ) :=
{ source := e.source ×ˢ e'.source,
  target := e.target ×ˢ e'.target,
  to_fun := λp, (e p.1, e' p.2),
  inv_fun := λp, (e.symm p.1, e'.symm p.2),
  map_source' := λp hp, by { simp at hp, simp [hp] },
  map_target' := λp hp, by { simp at hp, simp [map_target, hp] },
  left_inv'   := λp hp, by { simp at hp, simp [hp] },
  right_inv'  := λp hp, by { simp at hp, simp [hp] } }

@[simp, mfld_simps] lemma prod_source (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').source = e.source ×ˢ e'.source := rfl

@[simp, mfld_simps] lemma prod_target (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').target = e.target ×ˢ e'.target := rfl

@[simp, mfld_simps] lemma prod_coe (e : local_equiv α β) (e' : local_equiv γ δ) :
  ((e.prod e') : α × γ → β × δ) = (λp, (e p.1, e' p.2)) := rfl

lemma prod_coe_symm (e : local_equiv α β) (e' : local_equiv γ δ) :
  ((e.prod e').symm : β × δ → α × γ) = (λp, (e.symm p.1, e'.symm p.2)) := rfl

@[simp, mfld_simps] lemma prod_symm (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').symm = (e.symm.prod e'.symm) :=
by ext x; simp [prod_coe_symm]

@[simp, mfld_simps] lemma prod_trans {η : Type*} {ε : Type*}
  (e : local_equiv α β) (f : local_equiv β γ) (e' : local_equiv δ η) (f' : local_equiv η ε) :
  (e.prod e').trans (f.prod f') = (e.trans f).prod (e'.trans f') :=
by ext x; simp [ext_iff]; tauto

end prod

/-- Combine two `local_equiv`s using `set.piecewise`. The source of the new `local_equiv` is
`s.ite e.source e'.source = e.source ∩ s ∪ e'.source \ s`, and similarly for target.  The function
sends `e.source ∩ s` to `e.target ∩ t` using `e` and `e'.source \ s` to `e'.target \ t` using `e'`,
and similarly for the inverse function. The definition assumes `e.is_image s t` and
`e'.is_image s t`. -/
@[simps] def piecewise (e e' : local_equiv α β) (s : set α) (t : set β)
  [∀ x, decidable (x ∈ s)] [∀ y, decidable (y ∈ t)] (H : e.is_image s t) (H' : e'.is_image s t) :
  local_equiv α β :=
{ to_fun := s.piecewise e e',
  inv_fun := t.piecewise e.symm e'.symm,
  source := s.ite e.source e'.source,
  target := t.ite e.target e'.target,
  map_source' := H.maps_to.piecewise_ite H'.compl.maps_to,
  map_target' := H.symm.maps_to.piecewise_ite H'.symm.compl.maps_to,
  left_inv' := H.left_inv_on_piecewise H',
  right_inv' := H.symm.left_inv_on_piecewise H'.symm }

lemma symm_piecewise (e e' : local_equiv α β) {s : set α} {t : set β}
  [∀ x, decidable (x ∈ s)] [∀ y, decidable (y ∈ t)]
  (H : e.is_image s t) (H' : e'.is_image s t) :
  (e.piecewise e' s t H H').symm = e.symm.piecewise e'.symm t s H.symm H'.symm :=
rfl

/-- Combine two `local_equiv`s with disjoint sources and disjoint targets. We reuse
`local_equiv.piecewise`, then override `source` and `target` to ensure better definitional
equalities. -/
@[simps] def disjoint_union (e e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) [∀ x, decidable (x ∈ e.source)]
  [∀ y, decidable (y ∈ e.target)] :
  local_equiv α β :=
(e.piecewise e' e.source e.target e.is_image_source_target $
  e'.is_image_source_target_of_disjoint _ hs.symm ht.symm).copy
  _ rfl _ rfl (e.source ∪ e'.source) (ite_left _ _) (e.target ∪ e'.target) (ite_left _ _)

lemma disjoint_union_eq_piecewise (e e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) [∀ x, decidable (x ∈ e.source)]
  [∀ y, decidable (y ∈ e.target)] :
  e.disjoint_union e' hs ht = e.piecewise e' e.source e.target e.is_image_source_target
    (e'.is_image_source_target_of_disjoint _ hs.symm ht.symm) :=
copy_eq_self _ _ _ _ _ _ _ _ _

section pi

variables {ι : Type*} {αi βi : ι → Type*} (ei : Π i, local_equiv (αi i) (βi i))

/-- The product of a family of local equivs, as a local equiv on the pi type. -/
@[simps source target] protected def pi : local_equiv (Π i, αi i) (Π i, βi i) :=
{ to_fun := λ f i, ei i (f i),
  inv_fun := λ f i, (ei i).symm (f i),
  source := pi univ (λ i, (ei i).source),
  target := pi univ (λ i, (ei i).target),
  map_source' := λ f hf i hi, (ei i).map_source (hf i hi),
  map_target' := λ f hf i hi, (ei i).map_target (hf i hi),
  left_inv' := λ f hf, funext $ λ i, (ei i).left_inv (hf i trivial),
  right_inv' := λ f hf, funext $ λ i, (ei i).right_inv (hf i trivial) }

attribute [mfld_simps] pi_source pi_target

@[simp, mfld_simps] lemma pi_coe : ⇑(local_equiv.pi ei) = λ (f : Π i, αi i) i, ei i (f i) := rfl
@[simp, mfld_simps] lemma pi_symm :
  (local_equiv.pi ei).symm = local_equiv.pi (λ i, (ei i).symm) := rfl

end pi

end local_equiv

namespace set

-- All arguments are explicit to avoid missing information in the pretty printer output
/-- A bijection between two sets `s : set α` and `t : set β` provides a local equivalence
between `α` and `β`. -/
@[simps] noncomputable def bij_on.to_local_equiv [nonempty α] (f : α → β) (s : set α) (t : set β)
  (hf : bij_on f s t) :
  local_equiv α β :=
{ to_fun := f,
  inv_fun := inv_fun_on f s,
  source := s,
  target := t,
  map_source' := hf.maps_to,
  map_target' := hf.surj_on.maps_to_inv_fun_on,
  left_inv'   := hf.inv_on_inv_fun_on.1,
  right_inv'  := hf.inv_on_inv_fun_on.2 }

/-- A map injective on a subset of its domain provides a local equivalence. -/
@[simp, mfld_simps] noncomputable def inj_on.to_local_equiv [nonempty α] (f : α → β) (s : set α)
  (hf : inj_on f s) :
  local_equiv α β :=
hf.bij_on_image.to_local_equiv f s (f '' s)

end set

namespace equiv
/- equivs give rise to local_equiv. We set up simp lemmas to reduce most properties of the local
equiv to that of the equiv. -/
variables (e : equiv α β) (e' : equiv β γ)

@[simp, mfld_simps] lemma to_local_equiv_coe : (e.to_local_equiv : α → β) = e := rfl
@[simp, mfld_simps] lemma to_local_equiv_symm_coe : (e.to_local_equiv.symm : β → α) = e.symm := rfl
@[simp, mfld_simps] lemma to_local_equiv_source : e.to_local_equiv.source = univ := rfl
@[simp, mfld_simps] lemma to_local_equiv_target : e.to_local_equiv.target = univ := rfl
@[simp, mfld_simps] lemma refl_to_local_equiv :
  (equiv.refl α).to_local_equiv = local_equiv.refl α := rfl
@[simp, mfld_simps] lemma symm_to_local_equiv : e.symm.to_local_equiv = e.to_local_equiv.symm := rfl
@[simp, mfld_simps] lemma trans_to_local_equiv :
  (e.trans e').to_local_equiv = e.to_local_equiv.trans e'.to_local_equiv :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [local_equiv.trans_source, equiv.to_local_equiv])

end equiv


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek
-/
import data.list.prod_sigma
import tactic.omega.clause
import tactic.omega.nat.form

/-!
# DNF transformation
-/

namespace omega
namespace nat

open_locale omega.nat

@[simp] def dnf_core : preform → list clause
| (p ∨* q) := (dnf_core p) ++ (dnf_core q)
| (p ∧* q) :=
  (list.product (dnf_core p) (dnf_core q)).map
  (λ pq, clause.append pq.fst pq.snd)
| (t =* s) :=
  [([term.sub (canonize s) (canonize t)],[])]
| (t ≤* s) := [([],[term.sub (canonize s) (canonize t)])]
| (¬* _)   := []

lemma exists_clause_holds_core {v : nat → nat} :
  ∀ {p : preform}, p.neg_free → p.sub_free → p.holds v →
  ∃ c ∈ (dnf_core p), clause.holds (λ x, ↑(v x)) c :=
begin
  preform.induce `[intros h1 h0 h2],
  { apply list.exists_mem_cons_of,
    constructor, rw list.forall_mem_singleton,
    cases h0 with ht hs,
    simp only [val_canonize ht, val_canonize hs,
      term.val_sub, preform.holds, sub_eq_add_neg] at *,
    rw [h2, add_neg_self], apply list.forall_mem_nil },
  { apply list.exists_mem_cons_of,
    constructor,
    apply list.forall_mem_nil,
    rw list.forall_mem_singleton,
    simp only [val_canonize (h0.left), val_canonize (h0.right),
      term.val_sub, preform.holds, sub_eq_add_neg] at *,
    rw [←sub_eq_add_neg, le_sub_comm, sub_zero, int.coe_nat_le],
    assumption },
  { cases h1 },
  { cases h2 with h2 h2;
    [ {cases (ihp h1.left h0.left h2) with c h3},
      {cases (ihq h1.right h0.right h2) with c h3}];
    cases h3 with h3 h4;
    refine ⟨c, list.mem_append.elim_right _, h4⟩;
    [left,right]; assumption },
  { rcases (ihp h1.left h0.left h2.left) with ⟨cp, hp1, hp2⟩,
    rcases (ihq h1.right h0.right h2.right) with ⟨cq, hq1, hq2⟩,
    refine ⟨clause.append cp cq, ⟨_, clause.holds_append hp2 hq2⟩⟩,
    simp only [dnf_core, list.mem_map],
    refine ⟨(cp,cq),⟨_,rfl⟩⟩,
    rw list.mem_product,
    constructor; assumption }
end

def term.vars_core (is : list int) : list bool :=
is.map (λ i, if i = 0 then ff else tt)

/-- Return a list of bools that encodes which variables have nonzero coefficients -/
def term.vars (t : term) : list bool :=
term.vars_core t.snd

def bools.or : list bool → list bool → list bool
| []        bs2       := bs2
| bs1       []        := bs1
| (b1::bs1) (b2::bs2) := (b1 || b2)::(bools.or bs1 bs2)

/-- Return a list of bools that encodes which variables have nonzero coefficients in any one of the
input terms. -/
def terms.vars : list term → list bool
| []      := []
| (t::ts) := bools.or (term.vars t) (terms.vars ts)

open_locale list.func -- get notation for list.func.set

def nonneg_consts_core : nat → list bool → list term
| _ [] := []
| k (ff::bs) := nonneg_consts_core (k+1) bs
| k (tt::bs) := ⟨0, [] {k ↦ 1}⟩::nonneg_consts_core (k+1) bs

def nonneg_consts (bs : list bool) : list term :=
nonneg_consts_core 0 bs

def nonnegate : clause → clause | (eqs,les) :=
let xs := terms.vars eqs in
let ys := terms.vars les in
let bs := bools.or xs ys in
(eqs, nonneg_consts bs ++ les)

/-- DNF transformation -/
def dnf (p : preform) : list clause :=
(dnf_core p).map nonnegate

lemma holds_nonneg_consts_core {v : nat → int} (h1 : ∀ x, 0 ≤ v x) :
  ∀ m bs, (∀ t ∈ (nonneg_consts_core m bs), 0 ≤ term.val v t)
| _ []       := λ _ h2, by cases h2
| k (ff::bs) := holds_nonneg_consts_core (k+1) bs
| k (tt::bs) :=
  begin
    simp only [nonneg_consts_core],
    rw list.forall_mem_cons,
    constructor,
    { simp only [term.val, one_mul, zero_add, coeffs.val_set],
      apply h1 },
    { apply holds_nonneg_consts_core (k+1) bs }
  end

lemma holds_nonneg_consts {v : nat → int} {bs : list bool} :
  (∀ x, 0 ≤ v x) → (∀ t ∈ (nonneg_consts bs), 0 ≤ term.val v t)
| h1 :=
by apply holds_nonneg_consts_core h1

lemma exists_clause_holds {v : nat → nat} {p : preform} :
  p.neg_free → p.sub_free → p.holds v →
  ∃ c ∈ (dnf p), clause.holds (λ x, ↑(v x)) c :=
begin
  intros h1 h2 h3,
  rcases (exists_clause_holds_core h1 h2 h3) with ⟨c,h4,h5⟩,
  existsi (nonnegate c),
  have h6 : nonnegate c ∈ dnf p,
  { simp only [dnf], rw list.mem_map,
    refine ⟨c,h4,rfl⟩ },
  refine ⟨h6,_⟩, cases c with eqs les,
  simp only [nonnegate, clause.holds],
  constructor, apply h5.left,
  rw list.forall_mem_append,
  apply and.intro (holds_nonneg_consts _) h5.right,
  assume x,
  apply int.coe_nat_nonneg
end

lemma exists_clause_sat {p : preform} :
  p.neg_free → p.sub_free →
  p.sat → ∃ c ∈ (dnf p), clause.sat c :=
begin
  intros h1 h2 h3, cases h3 with v h3,
  rcases (exists_clause_holds h1 h2 h3) with ⟨c,h4,h5⟩,
  refine ⟨c,h4,_,h5⟩
end

lemma unsat_of_unsat_dnf (p : preform) :
  p.neg_free → p.sub_free → clauses.unsat (dnf p) → p.unsat :=
begin
  intros hnf hsf h1 h2, apply h1,
  apply exists_clause_sat hnf hsf h2
end

end nat

end omega


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland
Ported by: Matej Penciak

! This file was ported from Lean 3 source module algebra.ring.divisibility
! leanprover-community/mathlib commit f1a2caaf51ef593799107fe9a8d5e411599f3996
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Divisibility.Basic
import Mathlib.Algebra.Ring.Defs
import Mathlib.Tactic.Convert

/-!
# Lemmas about divisibility in rings
-/

variable {α β : Type _}

section DistribSemigroup

variable [Add α] [Semigroup α]

theorem dvd_add [LeftDistribClass α] {a b c : α} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c :=
  Dvd.elim h₁ fun d hd => Dvd.elim h₂ fun e he => Dvd.intro (d + e) (by simp [left_distrib, hd, he])
#align dvd_add dvd_add

end DistribSemigroup

set_option linter.deprecated false in
@[simp]
theorem two_dvd_bit0 [Semiring α] {a : α} : 2 ∣ bit0 a :=
  ⟨a, bit0_eq_two_mul _⟩
#align two_dvd_bit0 two_dvd_bit0

section NonUnitalCommSemiring

variable [NonUnitalCommSemiring α] [NonUnitalCommSemiring β] {a b c : α}

theorem Dvd.dvd.linear_comb {d x y : α} (hdx : d ∣ x) (hdy : d ∣ y) (a b : α) : d ∣ a * x + b * y :=
  dvd_add (hdx.mul_left a) (hdy.mul_left b)
#align has_dvd.dvd.linear_comb Dvd.dvd.linear_comb

end NonUnitalCommSemiring

section Semigroup

variable [Semigroup α] [HasDistribNeg α] {a b c : α}

theorem dvd_neg_of_dvd (h : a ∣ b) : a ∣ -b :=
  let ⟨c, hc⟩ := h
  ⟨-c, by simp [hc]⟩
#align dvd_neg_of_dvd dvd_neg_of_dvd

theorem dvd_of_dvd_neg (h : a ∣ -b) : a ∣ b := by
  let t := dvd_neg_of_dvd h
  rwa [neg_neg] at t
#align dvd_of_dvd_neg dvd_of_dvd_neg

/-- An element a of a semigroup with a distributive negation divides the negation of an element b
iff a divides b. -/
@[simp]
theorem dvd_neg (a b : α) : a ∣ -b ↔ a ∣ b :=
  ⟨dvd_of_dvd_neg, dvd_neg_of_dvd⟩
#align dvd_neg dvd_neg

theorem neg_dvd_of_dvd (h : a ∣ b) : -a ∣ b :=
  let ⟨c, hc⟩ := h
  ⟨-c, by simp [hc]⟩
#align neg_dvd_of_dvd neg_dvd_of_dvd

theorem dvd_of_neg_dvd (h : -a ∣ b) : a ∣ b := by
  let t := neg_dvd_of_dvd h
  rwa [neg_neg] at t
#align dvd_of_neg_dvd dvd_of_neg_dvd

/-- The negation of an element a of a semigroup with a distributive negation divides
another element b iff a divides b. -/
@[simp]
theorem neg_dvd (a b : α) : -a ∣ b ↔ a ∣ b :=
  ⟨dvd_of_neg_dvd, neg_dvd_of_dvd⟩
#align neg_dvd neg_dvd

end Semigroup

section NonUnitalRing

variable [NonUnitalRing α] {a b c : α}

theorem dvd_sub (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b - c := by
  rw [sub_eq_add_neg]
  exact dvd_add h₁ (dvd_neg_of_dvd h₂)
#align dvd_sub dvd_sub

theorem dvd_add_iff_left (h : a ∣ c) : a ∣ b ↔ a ∣ b + c :=
  ⟨fun h₂ => dvd_add h₂ h, fun H => by have t := dvd_sub H h ; rwa [add_sub_cancel] at t⟩
#align dvd_add_iff_left dvd_add_iff_left

theorem dvd_add_iff_right (h : a ∣ b) : a ∣ c ↔ a ∣ b + c := by
  rw [add_comm] ; exact dvd_add_iff_left h
#align dvd_add_iff_right dvd_add_iff_right

/-- If an element a divides another element c in a commutative ring, a divides the sum of another
  element b with c iff a divides b. -/
theorem dvd_add_left (h : a ∣ c) : a ∣ b + c ↔ a ∣ b :=
  (dvd_add_iff_left h).symm
#align dvd_add_left dvd_add_left

/-- If an element a divides another element b in a commutative ring, a divides the sum of b and
  another element c iff a divides c. -/
theorem dvd_add_right (h : a ∣ b) : a ∣ b + c ↔ a ∣ c :=
  (dvd_add_iff_right h).symm
#align dvd_add_right dvd_add_right

theorem dvd_iff_dvd_of_dvd_sub {a b c : α} (h : a ∣ b - c) : a ∣ b ↔ a ∣ c := by
  constructor
  · intro h'
    convert dvd_sub h' h
    exact Eq.symm (sub_sub_self b c)
  · intro h'
    convert dvd_add h h'
    exact eq_add_of_sub_eq rfl
#align dvd_iff_dvd_of_dvd_sub dvd_iff_dvd_of_dvd_sub

end NonUnitalRing

section Ring

variable [Ring α] {a b c : α}

set_option linter.deprecated false in
theorem two_dvd_bit1 : 2 ∣ bit1 a ↔ (2 : α) ∣ 1 :=
  (dvd_add_iff_right (@two_dvd_bit0 _ _ a)).symm
#align two_dvd_bit1 two_dvd_bit1

/-- An element a divides the sum a + b if and only if a divides b.-/
@[simp]
theorem dvd_add_self_left {a b : α} : a ∣ a + b ↔ a ∣ b :=
  dvd_add_right (dvd_refl a)
#align dvd_add_self_left dvd_add_self_left

/-- An element a divides the sum b + a if and only if a divides b.-/
@[simp]
theorem dvd_add_self_right {a b : α} : a ∣ b + a ↔ a ∣ b :=
  dvd_add_left (dvd_refl a)
#align dvd_add_self_right dvd_add_self_right

end Ring

section NonUnitalCommRing

variable [NonUnitalCommRing α] {a b c : α}

theorem dvd_mul_sub_mul {k a b x y : α} (hab : k ∣ a - b) (hxy : k ∣ x - y) :
    k ∣ a * x - b * y := by
  convert dvd_add (hxy.mul_left a) (hab.mul_right y) using 1
  rw [mul_sub_left_distrib, mul_sub_right_distrib]
  simp only [sub_eq_add_neg, add_assoc, neg_add_cancel_left]
#align dvd_mul_sub_mul dvd_mul_sub_mul

end NonUnitalCommRing


/-
Copyright (c) 2020 Ruben Van de Velde, Stanislas Polu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ruben Van de Velde, Stanislas Polu
-/

import data.real.basic
import data.set.basic
import analysis.normed_space.basic

/-!
# IMO 1972 B2

Problem: `f` and `g` are real-valued functions defined on the real line. For all `x` and `y`,
`f(x + y) + f(x - y) = 2f(x)g(y)`. `f` is not identically zero and `|f(x)| ≤ 1` for all `x`.
Prove that `|g(x)| ≤ 1` for all `x`.
-/

/--
This proof begins by introducing the supremum of `f`, `k ≤ 1` as well as `k' = k / ∥g y∥`. We then
suppose that the conclusion does not hold (`hneg`) and show that `k ≤ k'` (by
`2 * (∥f x∥ * ∥g y∥) ≤ 2 * k` obtained from the main hypothesis `hf1`) and that `k' < k` (obtained
from `hneg` directly), finally raising a contradiction with `k' < k'`.

(Authored by Stanislas Polu inspired by Ruben Van de Velde).
-/
example (f g : ℝ → ℝ)
  (hf1 : ∀ x, ∀ y, (f(x+y) + f(x-y)) = 2 * f(x) * g(y))
  (hf2 : ∀ y, ∥f(y)∥ ≤ 1)
  (hf3 : ∃ x, f(x) ≠ 0)
  (y : ℝ) :
  ∥g(y)∥ ≤ 1 :=
begin
  classical,
  set S := set.range (λ x, ∥f x∥),
  -- Introduce `k`, the supremum of `f`.
  let k : ℝ := Sup (S),

  -- Show that `∥f x∥ ≤ k`.
  have hk₁ : ∀ x, ∥f x∥ ≤ k,
  { have h : bdd_above S, from ⟨1, set.forall_range_iff.mpr hf2⟩,
    intro x,
    exact le_cSup h (set.mem_range_self x), },
  -- Show that `2 * (∥f x∥ * ∥g y∥) ≤ 2 * k`.
  have hk₂ : ∀ x, 2 * (∥f x∥ * ∥g y∥) ≤ 2 * k,
  { intro x,
    calc 2 * (∥f x∥ * ∥g y∥)
        = ∥2 * f x * g y∥ : by simp [real.norm_eq_abs, abs_mul, mul_assoc]
    ... = ∥f (x + y) + f (x - y)∥ : by rw hf1
    ... ≤ ∥f (x + y)∥ + ∥f (x - y)∥ : norm_add_le _ _
    ... ≤ k + k : add_le_add (hk₁ _) (hk₁ _)
    ... = 2 * k : (two_mul _).symm, },

  -- Suppose the conclusion does not hold.
  by_contra hneg,
  push_neg at hneg,
  set k' := k / ∥g y∥,

  -- Demonstrate that `k' < k` using `hneg`.
  have H₁ : k' < k,
  { have h₁ : 0 < k,
    { obtain ⟨x, hx⟩ := hf3,
      calc 0
          < ∥f x∥ : norm_pos_iff.mpr hx
      ... ≤ k : hk₁ x },
    rw div_lt_iff,
    apply lt_mul_of_one_lt_right h₁ hneg,
    exact trans zero_lt_one hneg },

  -- Demonstrate that `k ≤ k'` using `hk₂`.
  have H₂ : k ≤ k',
  { have h₁ : ∃ x : ℝ, x ∈ S,
    { use ∥f 0∥, exact set.mem_range_self 0, },
    have h₂ : ∀ x, ∥f x∥ ≤ k',
    { intros x,
      rw le_div_iff,
      { apply (mul_le_mul_left zero_lt_two).mp (hk₂ x) },
      { exact trans zero_lt_one hneg } },
    apply cSup_le h₁,
    rintros y' ⟨yy, rfl⟩,
    exact h₂ yy },

  -- Conclude by obtaining a contradiction, `k' < k'`.
  apply lt_irrefl k',
  calc k'
      < k : H₁
  ... ≤ k' : H₂,
end

/-- IMO 1972 B2

Problem: `f` and `g` are real-valued functions defined on the real line. For all `x` and `y`,
`f(x + y) + f(x - y) = 2f(x)g(y)`. `f` is not identically zero and `|f(x)| ≤ 1` for all `x`.
Prove that `|g(x)| ≤ 1` for all `x`.

This is a more concise version of the proof proposed by Ruben Van de Velde.
-/
example (f g : ℝ → ℝ)
  (hf1 : ∀ x, ∀ y, (f (x+y) + f(x-y)) = 2 * f(x) * g(y))
  (hf2 : bdd_above (set.range (λ x, ∥f x∥)))
  (hf3 : ∃ x, f(x) ≠ 0)
  (y : ℝ) :
  ∥g(y)∥ ≤ 1 :=
begin
  obtain ⟨x, hx⟩ := hf3,
  set k := ⨆ x, ∥f x∥,
  have h : ∀ x, ∥f x∥ ≤ k := le_csupr hf2,
  by_contradiction H, push_neg at H,
  have hgy : 0 < ∥g y∥,
    by linarith,
  have k_pos : 0 < k := lt_of_lt_of_le (norm_pos_iff.mpr hx) (h x),
  have : k / ∥g y∥ < k := (div_lt_iff hgy).mpr (lt_mul_of_one_lt_right k_pos H),
  have : k ≤ k / ∥g y∥,
  { suffices : ∀ x, ∥f x∥ ≤ k / ∥g y∥, from csupr_le this,
    intro x,
    suffices : 2 * (∥f x∥ * ∥g y∥) ≤ 2 * k,
      by { rwa [le_div_iff hgy, ←mul_le_mul_left zero_lt_two], apply_instance },
    calc 2 * (∥f x∥ * ∥g y∥)
        = ∥2 * f x * g y∥           : by simp [abs_mul, mul_assoc]
    ... = ∥f (x + y) + f (x - y)∥   : by rw hf1
    ... ≤ ∥f (x + y)∥ + ∥f (x - y)∥ : abs_add _ _
    ... ≤ 2 * k                     : by linarith [h (x+y), h (x -y)] },
  linarith,
end


/-
Copyright (c) 2018 Ellen Arlt. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ellen Arlt, Blair Shi, Sean Leather, Mario Carneiro, Johan Commelin
Matrices
-/

import algebra.module data.fintype algebra.pi_instances
import data.set.enumerate
import data.rat

universes u v

def matrix (m n : Type u) [fintype m] [fintype n] (α : Type v) : Type (max u v) :=
m → n → α

namespace matrix
variables {l m n o : Type u} [fintype l] [fintype m] [fintype n] [fintype o]
variables {α : Type v}

section ext
variables {M N : matrix m n α}

theorem ext_iff : (∀ i j, M i j = N i j) ↔ M = N :=
⟨λ h, funext $ λ i, funext $ h i, λ h, by simp [h]⟩

@[extensionality] theorem ext : (∀ i j, M i j = N i j) → M = N :=
ext_iff.mp

end ext

instance [has_add α] : has_add (matrix m n α) := pi.has_add
instance [add_semigroup α] : add_semigroup (matrix m n α) := pi.add_semigroup
instance [add_comm_semigroup α] : add_comm_semigroup (matrix m n α) := pi.add_comm_semigroup
instance [has_zero α] : has_zero (matrix m n α) := pi.has_zero
instance [add_monoid α] : add_monoid (matrix m n α) := pi.add_monoid
instance [add_comm_monoid α] : add_comm_monoid (matrix m n α) := pi.add_comm_monoid
instance [has_neg α] : has_neg (matrix m n α) := pi.has_neg
instance [add_group α] : add_group (matrix m n α) := pi.add_group
instance [add_comm_group α] : add_comm_group (matrix m n α) := pi.add_comm_group

@[simp] theorem zero_val [has_zero α] (i j) : (0 : matrix m n α) i j = 0 := rfl
@[simp] theorem neg_val [has_neg α] (M : matrix m n α) (i j) : (- M) i j = - M i j := rfl
@[simp] theorem add_val [has_add α] (M N : matrix m n α) (i j) : (M + N) i j = M i j + N i j := rfl

section diagonal
variables [decidable_eq n]

def diagonal [has_zero α] (d : n → α) : matrix n n α := λ i j, if i = j then d i else 0

@[simp] theorem diagonal_val_eq [has_zero α] {d : n → α} (i : n) : (diagonal d) i i = d i :=
by simp [diagonal]

@[simp] theorem diagonal_val_ne [has_zero α] {d : n → α} {i j : n} (h : i ≠ j) :
  (diagonal d) i j = 0 := by simp [diagonal, h]

theorem diagonal_val_ne' [has_zero α] {d : n → α} {i j : n} (h : j ≠ i) :
  (diagonal d) i j = 0 := diagonal_val_ne h.symm

@[simp] theorem diagonal_zero [has_zero α] : (diagonal (λ _, 0) : matrix n n α) = 0 :=
by simp [diagonal]; refl

section one
variables [has_zero α] [has_one α]

instance : has_one (matrix n n α) := ⟨diagonal (λ _, 1)⟩

@[simp] theorem diagonal_one : (diagonal (λ _, 1) : matrix n n α) = 1 := rfl

theorem one_val {i j} : (1 : matrix n n α) i j = if i = j then 1 else 0 := rfl

@[simp] theorem one_val_eq (i) : (1 : matrix n n α) i i = 1 := diagonal_val_eq i

@[simp] theorem one_val_ne {i j} : i ≠ j → (1 : matrix n n α) i j = 0 :=
diagonal_val_ne

theorem one_val_ne' {i j} : j ≠ i → (1 : matrix n n α) i j = 0 :=
diagonal_val_ne'

end one
end diagonal

@[simp] theorem diagonal_add [decidable_eq n] [add_monoid α] (d₁ d₂ : n → α) :
  diagonal d₁ + diagonal d₂ = diagonal (λ i, d₁ i + d₂ i) :=
by ext i j; by_cases i = j; simp [h]

protected def mul [has_mul α] [add_comm_monoid α] (M : matrix l m α) (N : matrix m n α) :
  matrix l n α :=
λ i k, finset.univ.sum (λ j, M i j * N j k)

theorem mul_val [has_mul α] [add_comm_monoid α] {M : matrix l m α} {N : matrix m n α} {i k} :
  (M.mul N) i k = finset.univ.sum (λ j, M i j * N j k) := rfl

local attribute [simp] mul_val

instance [has_mul α] [add_comm_monoid α] : has_mul (matrix n n α) := ⟨matrix.mul⟩

@[simp] theorem mul_eq_mul [has_mul α] [add_comm_monoid α] (M N : matrix n n α) :
  M * N = M.mul N := rfl

theorem mul_val' [has_mul α] [add_comm_monoid α] {M N : matrix n n α} {i k} :
  (M * N) i k = finset.univ.sum (λ j, M i j * N j k) := rfl

section semigroup
variables [decidable_eq m] [decidable_eq n] [semiring α]

protected theorem mul_assoc (L : matrix l m α) (M : matrix m n α) (N : matrix n o α) :
  (L.mul M).mul N = L.mul (M.mul N) :=
by funext i k;
   simp [finset.mul_sum, finset.sum_mul, mul_assoc];
   rw finset.sum_comm

instance : semigroup (matrix n n α) :=
{ mul_assoc := matrix.mul_assoc, ..matrix.has_mul }

end semigroup

@[simp] theorem diagonal_neg [decidable_eq n] [add_group α] (d : n → α) :
  -diagonal d = diagonal (λ i, -d i) :=
by ext i j; by_cases i = j; simp [h]

section semiring
variables [semiring α]

theorem mul_zero (M : matrix m n α) : M.mul (0 : matrix n n α) = 0 :=
by ext i j; simp

theorem zero_mul (M : matrix m n α) : (0 : matrix m m α).mul M = 0 :=
by ext i j; simp

theorem mul_add (L : matrix m n α) (M N : matrix n n α) : L.mul (M + N) = L.mul M + L.mul N :=
by ext i j; simp [finset.sum_add_distrib, mul_add]

theorem add_mul (L M : matrix m m α) (N : matrix m n α) : (L + M).mul N = L.mul N + M.mul N :=
by ext i j; simp [finset.sum_add_distrib, add_mul]

@[simp] theorem diagonal_mul [decidable_eq m]
  (d : m → α) (M : matrix m n α) (i j) : (diagonal d).mul M i j = d i * M i j :=
by simp; rw finset.sum_eq_single i; simp [diagonal_val_ne'] {contextual := tt}

@[simp] theorem mul_diagonal [decidable_eq n]
  (d : n → α) (M : matrix m n α) (i j) : M.mul (diagonal d) i j = M i j * d j :=
by simp; rw finset.sum_eq_single j; simp {contextual := tt}

protected theorem one_mul [decidable_eq m] (M : matrix m n α) : (1 : matrix m m α).mul M = M :=
by ext i j; rw [← diagonal_one, diagonal_mul, one_mul]

protected theorem mul_one [decidable_eq n] (M : matrix m n α) : M.mul (1 : matrix n n α) = M :=
by ext i j; rw [← diagonal_one, mul_diagonal, mul_one]

instance [decidable_eq n] : monoid (matrix n n α) :=
{ one_mul := matrix.one_mul,
  mul_one := matrix.mul_one,
  ..matrix.has_one, ..matrix.semigroup }

instance [decidable_eq n] : semiring (matrix n n α) :=
{ mul_zero := mul_zero,
  zero_mul := zero_mul,
  left_distrib := mul_add,
  right_distrib := add_mul,
  ..matrix.add_comm_monoid,
  ..matrix.monoid }

@[simp] theorem diagonal_mul_diagonal' [decidable_eq n] (d₁ d₂ : n → α) :
  (diagonal d₁).mul (diagonal d₂) = diagonal (λ i, d₁ i * d₂ i) :=
by ext i j; by_cases i = j; simp [h]

theorem diagonal_mul_diagonal [decidable_eq n] (d₁ d₂ : n → α) :
  diagonal d₁ * diagonal d₂ = diagonal (λ i, d₁ i * d₂ i) :=
diagonal_mul_diagonal' _ _

end semiring

instance [decidable_eq n] [ring α] : ring (matrix n n α) :=
{ ..matrix.add_comm_group, ..matrix.semiring }

instance [has_mul α] : has_scalar α (matrix m n α) := ⟨λ a M i j, a * M i j⟩

instance [ring α] : module α (matrix m n α) :=
module.of_core
{ smul_add := λ a M N, ext $ λ i j, _root_.mul_add a (M i j) (N i j),
  add_smul := λ a b M, ext $ λ i j, _root_.add_mul a b (M i j),
  mul_smul := λ a b M, ext $ λ i j, mul_assoc a b (M i j),
  one_smul := λ M, ext $ λ i j, one_mul (M i j),
  .. (infer_instance : has_scalar α (matrix m n α)) }

def minor (A : matrix m n α) (col : l → m) (row : o → n) : matrix l o α :=
λ i j, A (col i) (row j)

@[reducible]
def sub_left {m l r : nat} (A : matrix (fin m) (fin (l + r)) α) : matrix (fin m) (fin l) α :=
minor A id (fin.cast_add r)

@[reducible]
def sub_right {m l r : nat} (A : matrix (fin m) (fin (l + r)) α) : matrix (fin m) (fin r) α :=
minor A id (fin.nat_add l)

@[reducible]
def sub_up {d u n : nat} (A : matrix (fin (u + d)) (fin n) α) : matrix (fin u) (fin n) α :=
minor A (fin.cast_add d) id

@[reducible]
def sub_down {d u n : nat} (A : matrix (fin (u + d)) (fin n) α) : matrix (fin d) (fin n) α :=
minor A (fin.nat_add u) id

@[reducible]
def sub_up_right {d u l r : nat} (A: matrix (fin (u + d)) (fin (l + r)) α) :
  matrix (fin u) (fin r) α :=
sub_up (sub_right A)

@[reducible]
def sub_down_right {d u l r : nat} (A : matrix (fin (u + d)) (fin (l + r)) α) :
  matrix (fin d) (fin r) α :=
sub_down (sub_right A)

@[reducible]
def sub_up_left {d u l r : nat} (A : matrix (fin (u + d)) (fin (l + r)) α) :
  matrix (fin u) (fin (l)) α :=
sub_up (sub_left A)

@[reducible]
def sub_down_left {d u l r : nat} (A: matrix (fin (u + d)) (fin (l + r)) α) :
  matrix (fin d) (fin (l)) α :=
sub_down (sub_left A)

/-- exchange row r1 with row r2. -/
def xrow [decidable_eq m] (r1 : m) (r2 : m) (A : matrix m n α) : matrix m n α :=
λ x y, if x = r1 then A r2 y else if x = r2 then A r1 y else A x y

/-- exchange column c1 with c2. -/
def xcol [decidable_eq n] (c1 : n) (c2 : n) (A : matrix m n α) : matrix m n α :=
λ x y, if y = c1 then A x c2 else if y = c2 then A x c1 else A x y

/-- pick a matrix element that matches a given property or return none in case of no match. -/
def pick (α : Type) (p : α → Prop) [decidable_pred p] {m n : nat} (A :matrix (fin m) (fin n) α) :
option (fin m × fin n) :=
if h : ∃ (ij : fin m × fin n), p (A ij.1 ij.2)
  then let idx := encodable.choose h in
    some idx
  else
    none

/-- combine four matrices into a single matrix. -/
def block_combine {u d l r : nat}
  (up_left : matrix (fin u) (fin l) α) (up_right : matrix (fin u) (fin r) α)
  (down_left : matrix (fin d) (fin l) α) (down_right : matrix (fin d) (fin r) α) :
  matrix (fin (u + d)) (fin (l + r)) α :=
λ i j,
 if h_i: i.val < u
 then
    if h_j: j.val < l
    then
      up_left (fin.cast_lt i (by assumption))
              (fin.cast_lt j (by assumption))
    else
      up_right (fin.cast_lt i (by assumption))
               (fin.sub_nat l j (by apply le_of_not_gt; assumption))
  else
   if h_j: j.val < l
    then
      down_left (fin.sub_nat u i (by apply le_of_not_gt; assumption))
                (fin.cast_lt j (by assumption))
    else
      down_right (fin.sub_nat u i (by apply le_of_not_gt; assumption))
                 (fin.sub_nat l j (by apply le_of_not_gt; assumption))

/-- compute an extended gaussian elimination. -/
def Gaussian_elimination {α : Type} [discrete_field α] :
   Π (m n), matrix (fin m) (fin n) α →
   (matrix (fin m) (fin m) α × matrix (fin n) (fin n) α × nat)
| (x+1) (y+1) A :=
  match pick α (λ el, el ≠ 0) A with
  | some ij :=
    let i := ij.1 in
    let j := ij.2 in
    let a := A i j in
    let B := xrow i x (xcol j y A) in
    let u := sub_down_left B in
    let v := a⁻¹ • sub_up_right B in
    let R := Gaussian_elimination (x) (y) (sub_up_left B - matrix.mul v u) in
    let L := R.1 in let U := R.2.1 in let r := R.2.2 in
    (
      xrow i x (block_combine L v 0 1),
      xcol j y (block_combine U 0 u (λ i1 j1, a)),
      r + 1
    )
  | none :=
     (
      (1 : (matrix (fin (x+1)) (fin (x+1)) α)),
      (1 : (matrix (fin (y+1)) (fin (y+1)) α)),
      0
     )
  end
| x y A :=
     (
      (1 : (matrix (fin (x)) (fin (x)) α)),
      (1 : (matrix (fin (y)) (fin (y)) α)),
      0
     )

/-- the extended column base of A -/
def col_ebase {α : Type} [discrete_field α] {m n : nat} (A : matrix (fin n) (fin m) α) :=
(Gaussian_elimination n m A).1

/-- the extended row base of A -/
def row_ebase {α : Type} [discrete_field α] {m n : nat} (A : matrix (fin n) (fin m) α) :=
(Gaussian_elimination n m A).2.1

/-- the rank of A -/
def rank {α : Type} [discrete_field α] {m n : nat} (A : matrix (fin n) (fin m) α) :=
(Gaussian_elimination n m A).2.2

lemma rank_le_col {α : Type} [discrete_field α] {m n : nat}
  (M : matrix (fin n) (fin m) α) :
  rank M ≤ n :=
begin
  rw rank,
  induction n generalizing m; try {simp [Gaussian_elimination]},
  induction m; try {simp [Gaussian_elimination]},
  rw pick,
  by_cases h : (∃ (ij : fin (n_n + 1) × fin (m_n + 1)), ¬ M (ij.fst) (ij.snd) = 0),
  { simp only [h, dif_pos, ne.def], apply nat.succ_le_succ, apply n_ih},
  { simp only [h, ne.def, dif_neg, not_false_iff], rw Gaussian_elimination, simp}
end

lemma rank_le_row {α : Type} [discrete_field α] {m n : nat}
  (M : matrix (fin n) (fin m) α) :
  rank M ≤ m :=
begin
  rw rank,
  induction m generalizing n; try {simp [Gaussian_elimination]};
  induction n; try {simp [Gaussian_elimination]},
  rw pick,
  by_cases h : (∃ (ij : fin (n_n + 1) × fin (m_n + 1)), ¬ M (ij.fst) (ij.snd) = 0),
  { simp only [h, dif_pos, ne.def], apply nat.succ_le_succ, apply m_ih},
  { simp only [h, ne.def, dif_neg, not_false_iff], rw Gaussian_elimination, simp}
end

end matrix


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou
-/
import algebra.support

/-!
# Indicator function

- `indicator (s : set α) (f : α → β) (a : α)` is `f a` if `a ∈ s` and is `0` otherwise.
- `mul_indicator (s : set α) (f : α → β) (a : α)` is `f a` if `a ∈ s` and is `1` otherwise.

## Implementation note

In mathematics, an indicator function or a characteristic function is a function
used to indicate membership of an element in a set `s`,
having the value `1` for all elements of `s` and the value `0` otherwise.
But since it is usually used to restrict a function to a certain set `s`,
we let the indicator function take the value `f x` for some function `f`, instead of `1`.
If the usual indicator function is needed, just set `f` to be the constant function `λx, 1`.

The indicator function is implemented non-computably, to avoid having to pass around `decidable`
arguments. This is in contrast with the design of `pi.single` or `set.piecewise`.

## Tags
indicator, characteristic
-/

open_locale big_operators
open function

variables {α β ι M N : Type*}

namespace set

section has_one
variables [has_one M] [has_one N] {s t : set α} {f g : α → M} {a : α}

/-- `indicator s f a` is `f a` if `a ∈ s`, `0` otherwise.  -/
noncomputable def indicator {M} [has_zero M] (s : set α) (f : α → M) : α → M
| x := by haveI := classical.dec_pred (∈ s); exact if x ∈ s then f x else 0

/-- `mul_indicator s f a` is `f a` if `a ∈ s`, `1` otherwise.  -/
@[to_additive]
noncomputable def mul_indicator (s : set α) (f : α → M) : α → M
| x :=  by haveI := classical.dec_pred (∈ s); exact if x ∈ s then f x else 1

@[simp, to_additive] lemma piecewise_eq_mul_indicator [decidable_pred (∈ s)] :
  s.piecewise f 1 = s.mul_indicator f :=
funext $ λ x, @if_congr _ _ _ _ (id _) _ _ _ _ iff.rfl rfl rfl

@[to_additive] lemma mul_indicator_apply (s : set α) (f : α → M) (a : α) [decidable (a ∈ s)] :
  mul_indicator s f a = if a ∈ s then f a else 1 := by convert rfl

@[simp, to_additive] lemma mul_indicator_of_mem (h : a ∈ s) (f : α → M) :
  mul_indicator s f a = f a :=
by { letI := classical.dec (a ∈ s), exact if_pos h }

@[simp, to_additive] lemma mul_indicator_of_not_mem (h : a ∉ s) (f : α → M) :
  mul_indicator s f a = 1 :=
by { letI := classical.dec (a ∈ s), exact if_neg h }

@[to_additive] lemma mul_indicator_eq_one_or_self (s : set α) (f : α → M) (a : α) :
  mul_indicator s f a = 1 ∨ mul_indicator s f a = f a :=
begin
  by_cases h : a ∈ s,
  { exact or.inr (mul_indicator_of_mem h f) },
  { exact or.inl (mul_indicator_of_not_mem h f) }
end

@[simp, to_additive] lemma mul_indicator_apply_eq_self :
  s.mul_indicator f a = f a ↔ (a ∉ s → f a = 1) :=
by letI := classical.dec (a ∈ s); exact ite_eq_left_iff.trans (by rw [@eq_comm _ (f a)])

@[simp, to_additive] lemma mul_indicator_eq_self : s.mul_indicator f = f ↔ mul_support f ⊆ s :=
by simp only [funext_iff, subset_def, mem_mul_support, mul_indicator_apply_eq_self, not_imp_comm]

@[to_additive] lemma mul_indicator_eq_self_of_superset (h1 : s.mul_indicator f = f) (h2 : s ⊆ t) :
  t.mul_indicator f = f :=
by { rw mul_indicator_eq_self at h1 ⊢, exact subset.trans h1 h2 }

@[simp, to_additive] lemma mul_indicator_apply_eq_one :
  mul_indicator s f a = 1 ↔ (a ∈ s → f a = 1) :=
by letI := classical.dec (a ∈ s); exact ite_eq_right_iff

@[simp, to_additive] lemma mul_indicator_eq_one :
  mul_indicator s f = (λ x, 1) ↔ disjoint (mul_support f) s :=
by simp only [funext_iff, mul_indicator_apply_eq_one, set.disjoint_left, mem_mul_support,
  not_imp_not]

@[simp, to_additive] lemma mul_indicator_eq_one' :
  mul_indicator s f = 1 ↔ disjoint (mul_support f) s :=
mul_indicator_eq_one

@[to_additive] lemma mul_indicator_apply_ne_one {a : α} :
  s.mul_indicator f a ≠ 1 ↔ a ∈ s ∩ mul_support f :=
by simp only [ne.def, mul_indicator_apply_eq_one, not_imp, mem_inter_eq, mem_mul_support]

@[simp, to_additive] lemma mul_support_mul_indicator :
  function.mul_support (s.mul_indicator f) = s ∩ function.mul_support f :=
ext $ λ x, by simp [function.mem_mul_support, mul_indicator_apply_eq_one]

/-- If a multiplicative indicator function is not equal to `1` at a point, then that point is in the
set. -/
@[to_additive "If an additive indicator function is not equal to `0` at a point, then that point is
in the set."]
lemma mem_of_mul_indicator_ne_one (h : mul_indicator s f a ≠ 1) : a ∈ s :=
not_imp_comm.1 (λ hn, mul_indicator_of_not_mem hn f) h

@[to_additive] lemma eq_on_mul_indicator : eq_on (mul_indicator s f) f s :=
λ x hx, mul_indicator_of_mem hx f

@[to_additive] lemma mul_support_mul_indicator_subset : mul_support (s.mul_indicator f) ⊆ s :=
λ x hx, hx.imp_symm (λ h, mul_indicator_of_not_mem h f)

@[simp, to_additive] lemma mul_indicator_mul_support : mul_indicator (mul_support f) f = f :=
mul_indicator_eq_self.2 subset.rfl

@[simp, to_additive] lemma mul_indicator_range_comp {ι : Sort*} (f : ι → α) (g : α → M) :
  mul_indicator (range f) g ∘ f = g ∘ f :=
by letI := classical.dec_pred (∈ range f); exact piecewise_range_comp _ _ _

@[to_additive] lemma mul_indicator_congr (h : eq_on f g s) :
  mul_indicator s f = mul_indicator s g :=
funext $ λx, by { simp only [mul_indicator], split_ifs, { exact h h_1 }, refl }

@[simp, to_additive] lemma mul_indicator_univ (f : α → M) : mul_indicator (univ : set α) f = f :=
mul_indicator_eq_self.2 $ subset_univ _

@[simp, to_additive] lemma mul_indicator_empty (f : α → M) : mul_indicator (∅ : set α) f = λa, 1 :=
mul_indicator_eq_one.2 $ disjoint_empty _

@[to_additive] lemma mul_indicator_empty' (f : α → M) : mul_indicator (∅ : set α) f = 1 :=
mul_indicator_empty f

variable (M)

@[simp, to_additive] lemma mul_indicator_one (s : set α) :
  mul_indicator s (λx, (1:M)) = λx, (1:M) :=
mul_indicator_eq_one.2 $ by simp only [mul_support_one, empty_disjoint]

@[simp, to_additive] lemma mul_indicator_one' {s : set α} : s.mul_indicator (1 : α → M) = 1 :=
mul_indicator_one M s

variable {M}

@[to_additive] lemma mul_indicator_mul_indicator (s t : set α) (f : α → M) :
  mul_indicator s (mul_indicator t f) = mul_indicator (s ∩ t) f :=
funext $ λx, by { simp only [mul_indicator], split_ifs, repeat {simp * at * {contextual := tt}} }

@[simp, to_additive] lemma mul_indicator_inter_mul_support (s : set α) (f : α → M) :
  mul_indicator (s ∩ mul_support f) f = mul_indicator s f :=
by rw [← mul_indicator_mul_indicator, mul_indicator_mul_support]

@[to_additive] lemma comp_mul_indicator (h : M → β) (f : α → M) {s : set α} {x : α}
  [decidable_pred (∈ s)] :
  h (s.mul_indicator f x) = s.piecewise (h ∘ f) (const α (h 1)) x :=
by letI := classical.dec_pred (∈ s); convert s.apply_piecewise f (const α 1) (λ _, h)

@[to_additive] lemma mul_indicator_comp_right {s : set α} (f : β → α) {g : α → M} {x : β} :
  mul_indicator (f ⁻¹' s) (g ∘ f) x = mul_indicator s g (f x) :=
by { simp only [mul_indicator], split_ifs; refl }

@[to_additive] lemma mul_indicator_image {s : set α} {f : β → M} {g : α → β} (hg : injective g)
  {x : α} : mul_indicator (g '' s) f (g x) = mul_indicator s (f ∘ g) x :=
by rw [← mul_indicator_comp_right, preimage_image_eq _ hg]

@[to_additive] lemma mul_indicator_comp_of_one {g : M → N} (hg : g 1 = 1) :
  mul_indicator s (g ∘ f) = g ∘ (mul_indicator s f) :=
begin
  funext,
  simp only [mul_indicator],
  split_ifs; simp [*]
end

@[to_additive] lemma comp_mul_indicator_const (c : M) (f : M → N) (hf : f 1 = 1) :
  (λ x, f (s.mul_indicator (λ x, c) x)) = s.mul_indicator (λ x, f c) :=
(mul_indicator_comp_of_one hf).symm

@[to_additive] lemma mul_indicator_preimage (s : set α) (f : α → M) (B : set M) :
  (mul_indicator s f)⁻¹' B = s.ite (f ⁻¹' B) (1 ⁻¹' B) :=
by letI := classical.dec_pred (∈ s); exact piecewise_preimage s f 1 B

@[to_additive] lemma mul_indicator_preimage_of_not_mem (s : set α) (f : α → M)
  {t : set M} (ht : (1:M) ∉ t) :
  (mul_indicator s f)⁻¹' t = f ⁻¹' t ∩ s :=
by simp [mul_indicator_preimage, pi.one_def, set.preimage_const_of_not_mem ht]

@[to_additive] lemma mem_range_mul_indicator {r : M} {s : set α} {f : α → M} :
  r ∈ range (mul_indicator s f) ↔ (r = 1 ∧ s ≠ univ) ∨ (r ∈ f '' s) :=
by simp [mul_indicator, ite_eq_iff, exists_or_distrib, eq_univ_iff_forall, and_comm, or_comm,
  @eq_comm _ r 1]

@[to_additive] lemma mul_indicator_rel_mul_indicator {r : M → M → Prop} (h1 : r 1 1)
  (ha : a ∈ s → r (f a) (g a)) :
  r (mul_indicator s f a) (mul_indicator s g a) :=
by { simp only [mul_indicator], split_ifs with has has, exacts [ha has, h1] }

end has_one

section monoid
variables [mul_one_class M] {s t : set α} {f g : α → M} {a : α}

@[to_additive] lemma mul_indicator_union_mul_inter_apply (f : α → M) (s t : set α) (a : α) :
  mul_indicator (s ∪ t) f a * mul_indicator (s ∩ t) f a =
    mul_indicator s f a * mul_indicator t f a :=
by by_cases hs : a ∈ s; by_cases ht : a ∈ t; simp *

@[to_additive] lemma mul_indicator_union_mul_inter (f : α → M) (s t : set α) :
  mul_indicator (s ∪ t) f * mul_indicator (s ∩ t) f = mul_indicator s f * mul_indicator t f :=
funext $ mul_indicator_union_mul_inter_apply f s t

@[to_additive] lemma mul_indicator_union_of_not_mem_inter (h : a ∉ s ∩ t) (f : α → M) :
  mul_indicator (s ∪ t) f a = mul_indicator s f a * mul_indicator t f a :=
by rw [← mul_indicator_union_mul_inter_apply f s t, mul_indicator_of_not_mem h, mul_one]

@[to_additive] lemma mul_indicator_union_of_disjoint (h : disjoint s t) (f : α → M) :
  mul_indicator (s ∪ t) f = λa, mul_indicator s f a * mul_indicator t f a :=
funext $ λa, mul_indicator_union_of_not_mem_inter (λ ha, h ha) _

@[to_additive] lemma mul_indicator_mul (s : set α) (f g : α → M) :
  mul_indicator s (λa, f a * g a) = λa, mul_indicator s f a * mul_indicator s g a :=
by { funext, simp only [mul_indicator], split_ifs, { refl }, rw mul_one }

@[to_additive] lemma mul_indicator_mul' (s : set α) (f g : α → M) :
  mul_indicator s (f * g) = mul_indicator s f * mul_indicator s g :=
mul_indicator_mul s f g

@[simp, to_additive] lemma mul_indicator_compl_mul_self_apply (s : set α) (f : α → M) (a : α) :
  mul_indicator sᶜ f a * mul_indicator s f a = f a :=
classical.by_cases (λ ha : a ∈ s, by simp [ha]) (λ ha, by simp [ha])

@[simp, to_additive] lemma mul_indicator_compl_mul_self (s : set α) (f : α → M) :
  mul_indicator sᶜ f * mul_indicator s f = f :=
funext $ mul_indicator_compl_mul_self_apply s f

@[simp, to_additive] lemma mul_indicator_self_mul_compl_apply (s : set α) (f : α → M) (a : α) :
  mul_indicator s f a * mul_indicator sᶜ f a = f a :=
classical.by_cases (λ ha : a ∈ s, by simp [ha]) (λ ha, by simp [ha])

@[simp, to_additive]

@[to_additive] lemma mul_indicator_mul_eq_left {f g : α → M}
  (h : disjoint (mul_support f) (mul_support g)) :
  (mul_support f).mul_indicator (f * g) = f :=
begin
  refine (mul_indicator_congr $ λ x hx, _).trans mul_indicator_mul_support,
  have : g x = 1, from nmem_mul_support.1 (disjoint_left.1 h hx),
  rw [pi.mul_apply, this, mul_one]
end

@[to_additive] lemma mul_indicator_mul_eq_right {f g : α → M}
  (h : disjoint (mul_support f) (mul_support g)) :
  (mul_support g).mul_indicator (f * g) = g :=
begin
  refine (mul_indicator_congr $ λ x hx, _).trans mul_indicator_mul_support,
  have : f x = 1, from nmem_mul_support.1 (disjoint_right.1 h hx),
  rw [pi.mul_apply, this, one_mul]
end

@[to_additive] lemma mul_indicator_mul_compl_eq_piecewise
  [decidable_pred (∈ s)] (f g : α → M) :
  s.mul_indicator f * sᶜ.mul_indicator g = s.piecewise f g :=
begin
  ext x,
  by_cases h : x ∈ s,
  { rw [piecewise_eq_of_mem _ _ _ h, pi.mul_apply, set.mul_indicator_of_mem h,
      set.mul_indicator_of_not_mem (set.not_mem_compl_iff.2 h), mul_one] },
  { rw [piecewise_eq_of_not_mem _ _ _ h, pi.mul_apply, set.mul_indicator_of_not_mem h,
      set.mul_indicator_of_mem (set.mem_compl h), one_mul] },
end

/-- `set.mul_indicator` as a `monoid_hom`. -/
@[to_additive "`set.indicator` as an `add_monoid_hom`."]
noncomputable def mul_indicator_hom {α} (M) [mul_one_class M] (s : set α) : (α → M) →* (α → M) :=
{ to_fun := mul_indicator s,
  map_one' := mul_indicator_one M s,
  map_mul' := mul_indicator_mul s }

end monoid

section distrib_mul_action

variables {A : Type*} [add_monoid A] [monoid M] [distrib_mul_action M A]

lemma indicator_smul_apply (s : set α) (r : α → M) (f : α → A) (x : α) :
  indicator s (λ x, r x • f x) x = r x • indicator s f x :=
by { dunfold indicator, split_ifs, exacts [rfl, (smul_zero (r x)).symm] }

lemma indicator_smul (s : set α) (r : α → M) (f : α → A) :
  indicator s (λ (x : α), r x • f x) = λ (x : α), r x • indicator s f x :=
funext $ indicator_smul_apply s r f

lemma indicator_const_smul_apply (s : set α) (r : M) (f : α → A) (x : α) :
  indicator s (λ x, r • f x) x = r • indicator s f x :=
indicator_smul_apply s (λ x, r) f x

lemma indicator_const_smul (s : set α) (r : M) (f : α → A) :
  indicator s (λ (x : α), r • f x) = λ (x : α), r • indicator s f x :=
funext $ indicator_const_smul_apply s r f

end distrib_mul_action

section group
variables {G : Type*} [group G] {s t : set α} {f g : α → G} {a : α}

@[to_additive] lemma mul_indicator_inv' (s : set α) (f : α → G) :
  mul_indicator s (f⁻¹) = (mul_indicator s f)⁻¹ :=
(mul_indicator_hom G s).map_inv f

@[to_additive] lemma mul_indicator_inv (s : set α) (f : α → G) :
  mul_indicator s (λa, (f a)⁻¹) = λa, (mul_indicator s f a)⁻¹ :=
mul_indicator_inv' s f

@[to_additive] lemma mul_indicator_div (s : set α) (f g : α → G) :
  mul_indicator s (λ a, f a / g a) =
  λ a, mul_indicator s f a / mul_indicator s g a :=
(mul_indicator_hom G s).map_div f g

@[to_additive] lemma mul_indicator_div' (s : set α) (f g : α → G) :
  mul_indicator s (f / g) = mul_indicator s f / mul_indicator s g :=
mul_indicator_div s f g

@[to_additive indicator_compl'] lemma mul_indicator_compl (s : set α) (f : α → G) :
  mul_indicator sᶜ f = f * (mul_indicator s f)⁻¹ :=
eq_mul_inv_of_mul_eq $ s.mul_indicator_compl_mul_self f

lemma indicator_compl {G} [add_group G] (s : set α) (f : α → G) :
  indicator sᶜ f = f - indicator s f :=
by rw [sub_eq_add_neg, indicator_compl']

@[to_additive indicator_diff'] lemma mul_indicator_diff (h : s ⊆ t) (f : α → G) :
  mul_indicator (t \ s) f = mul_indicator t f * (mul_indicator s f)⁻¹ :=
eq_mul_inv_of_mul_eq $ by rw [pi.mul_def, ← mul_indicator_union_of_disjoint disjoint_diff.symm f,
  diff_union_self, union_eq_self_of_subset_right h]

lemma indicator_diff {G : Type*} [add_group G] {s t : set α} (h : s ⊆ t) (f : α → G) :
  indicator (t \ s) f = indicator t f - indicator s f :=
by rw [indicator_diff' h, sub_eq_add_neg]

end group

section comm_monoid

variables [comm_monoid M]

/-- Consider a product of `g i (f i)` over a `finset`.  Suppose `g` is a
function such as `pow`, which maps a second argument of `1` to
`1`. Then if `f` is replaced by the corresponding multiplicative indicator
function, the `finset` may be replaced by a possibly larger `finset`
without changing the value of the sum. -/
@[to_additive] lemma prod_mul_indicator_subset_of_eq_one [has_one N] (f : α → N)
  (g : α → N → M) {s t : finset α} (h : s ⊆ t) (hg : ∀ a, g a 1 = 1) :
  ∏ i in s, g i (f i) = ∏ i in t, g i (mul_indicator ↑s f i) :=
begin
  rw ← finset.prod_subset h _,
  { apply finset.prod_congr rfl,
    intros i hi,
    congr,
    symmetry,
    exact mul_indicator_of_mem hi _ },
  { refine λ i hi hn, _,
    convert hg i,
    exact mul_indicator_of_not_mem hn _ }
end

/-- Consider a sum of `g i (f i)` over a `finset`. Suppose `g` is a
function such as multiplication, which maps a second argument of 0 to
0.  (A typical use case would be a weighted sum of `f i * h i` or `f i
• h i`, where `f` gives the weights that are multiplied by some other
function `h`.)  Then if `f` is replaced by the corresponding indicator
function, the `finset` may be replaced by a possibly larger `finset`
without changing the value of the sum. -/
add_decl_doc set.sum_indicator_subset_of_eq_zero

/-- Taking the product of an indicator function over a possibly larger `finset` is the same as
taking the original function over the original `finset`. -/
@[to_additive "Summing an indicator function over a possibly larger `finset` is the same as summing
the original function over the original `finset`."]
lemma prod_mul_indicator_subset (f : α → M) {s t : finset α} (h : s ⊆ t) :
  ∏ i in s, f i = ∏ i in t, mul_indicator ↑s f i :=
prod_mul_indicator_subset_of_eq_one _ (λ a b, b) h (λ _, rfl)

@[to_additive] lemma _root_.finset.prod_mul_indicator_eq_prod_filter
  (s : finset ι) (f : ι → α → M) (t : ι → set α) (g : ι → α) [decidable_pred (λ i, g i ∈ t i)]:
  ∏ i in s, mul_indicator (t i) (f i) (g i) = ∏ i in s.filter (λ i, g i ∈ t i), f i (g i) :=
begin
  refine (finset.prod_filter_mul_prod_filter_not s (λ i, g i ∈ t i) _).symm.trans _,
  refine eq.trans _ (mul_one _),
  exact congr_arg2 (*)
    (finset.prod_congr rfl $ λ x hx, mul_indicator_of_mem (finset.mem_filter.1 hx).2 _)
    (finset.prod_eq_one $ λ x hx, mul_indicator_of_not_mem (finset.mem_filter.1 hx).2 _)
end

@[to_additive] lemma mul_indicator_finset_prod (I : finset ι) (s : set α) (f : ι → α → M) :
  mul_indicator s (∏ i in I, f i) = ∏ i in I, mul_indicator s (f i) :=
(mul_indicator_hom M s).map_prod _ _

@[to_additive] lemma mul_indicator_finset_bUnion {ι} (I : finset ι)
  (s : ι → set α) {f : α → M} : (∀ (i ∈ I) (j ∈ I), i ≠ j → disjoint (s i) (s j)) →
  mul_indicator (⋃ i ∈ I, s i) f = λ a, ∏ i in I, mul_indicator (s i) f a :=
begin
  classical,
  refine finset.induction_on I _ _,
  { intro h, funext, simp },
  assume a I haI ih hI,
  funext,
  rw [finset.prod_insert haI, finset.set_bUnion_insert, mul_indicator_union_of_not_mem_inter, ih _],
  { assume i hi j hj hij,
    exact hI i (finset.mem_insert_of_mem hi) j (finset.mem_insert_of_mem hj) hij },
  simp only [not_exists, exists_prop, mem_Union, mem_inter_eq, not_and],
  assume hx a' ha',
  refine disjoint_left.1 (hI a (finset.mem_insert_self _ _) a' (finset.mem_insert_of_mem ha') _) hx,
  exact (ne_of_mem_of_not_mem ha' haI).symm
end

@[to_additive] lemma mul_indicator_finset_bUnion_apply {ι} (I : finset ι)
  (s : ι → set α) {f : α → M} (h : ∀ (i ∈ I) (j ∈ I), i ≠ j → disjoint (s i) (s j)) (x : α) :
  mul_indicator (⋃ i ∈ I, s i) f x = ∏ i in I, mul_indicator (s i) f x :=
by rw set.mul_indicator_finset_bUnion I s h

end comm_monoid

section mul_zero_class

variables [mul_zero_class M] {s t : set α} {f g : α → M} {a : α}

lemma indicator_mul (s : set α) (f g : α → M) :
  indicator s (λa, f a * g a) = λa, indicator s f a * indicator s g a :=
by { funext, simp only [indicator], split_ifs, { refl }, rw mul_zero }

lemma indicator_mul_left (s : set α) (f g : α → M) :
  indicator s (λa, f a * g a) a = indicator s f a * g a :=
by { simp only [indicator], split_ifs, { refl }, rw [zero_mul] }

lemma indicator_mul_right (s : set α) (f g : α → M) :
  indicator s (λa, f a * g a) a = f a * indicator s g a :=
by { simp only [indicator], split_ifs, { refl }, rw [mul_zero] }

lemma inter_indicator_mul {t1 t2 : set α} (f g : α → M) (x : α) :
  (t1 ∩ t2).indicator (λ x, f x * g x) x = t1.indicator f x * t2.indicator g x :=
by { rw [← set.indicator_indicator], simp [indicator] }

end mul_zero_class

section mul_zero_one_class

variables [mul_zero_one_class M]

lemma inter_indicator_one {s t : set α} :
  (s ∩ t).indicator (1 : _ → M) = s.indicator 1 * t.indicator 1 :=
funext (λ _, by simpa only [← inter_indicator_mul, pi.mul_apply, pi.one_apply, one_mul])

lemma indicator_prod_one {s : set α} {t : set β} {x : α} {y : β} :
  (s ×ˢ t : set _).indicator (1 : _ → M) (x, y) = s.indicator 1 x * t.indicator 1 y :=
begin
  letI := classical.dec_pred (∈ s),
  letI := classical.dec_pred (∈ t),
  simp [indicator_apply, ← ite_and],
end

variables (M) [nontrivial M]

lemma indicator_eq_zero_iff_not_mem {U : set α} {x : α} :
  indicator U 1 x = (0 : M) ↔ x ∉ U :=
by { classical, simp [indicator_apply, imp_false] }

lemma indicator_eq_one_iff_mem {U : set α} {x : α} :
  indicator U 1 x = (1 : M) ↔ x ∈ U :=
by { classical, simp [indicator_apply, imp_false] }

lemma indicator_one_inj {U V : set α} (h : indicator U (1 : α → M) = indicator V 1) : U = V :=
by { ext, simp_rw [← indicator_eq_one_iff_mem M, h] }

end mul_zero_one_class

section order

variables [has_one M] {s t : set α} {f g : α → M} {a : α} {y : M}

section
variables [has_le M]

@[to_additive] lemma mul_indicator_apply_le' (hfg : a ∈ s → f a ≤ y) (hg : a ∉ s → 1 ≤ y) :
  mul_indicator s f a ≤ y :=
begin
  by_cases ha : a ∈ s,
  { simpa [ha] using hfg ha },
  { simpa [ha] using hg ha },
end

@[to_additive] lemma mul_indicator_le' (hfg : ∀ a ∈ s, f a ≤ g a) (hg : ∀ a ∉ s, 1 ≤ g a) :
  mul_indicator s f ≤ g :=
λ a, mul_indicator_apply_le' (hfg _) (hg _)

@[to_additive] lemma le_mul_indicator_apply {y} (hfg : a ∈ s → y ≤ g a) (hf : a ∉ s → y ≤ 1) :
  y ≤ mul_indicator s g a :=
@mul_indicator_apply_le' α Mᵒᵈ ‹_› _ _ _ _ _ hfg hf

@[to_additive] lemma le_mul_indicator (hfg : ∀ a ∈ s, f a ≤ g a) (hf : ∀ a ∉ s, f a ≤ 1) :
  f ≤ mul_indicator s g :=
λ a, le_mul_indicator_apply (hfg _) (hf _)

end

variables [preorder M]

@[to_additive indicator_apply_nonneg]
lemma one_le_mul_indicator_apply (h : a ∈ s → 1 ≤ f a) : 1 ≤ mul_indicator s f a :=
le_mul_indicator_apply h (λ _, le_rfl)

@[to_additive indicator_nonneg]
lemma one_le_mul_indicator (h : ∀ a ∈ s, 1 ≤ f a) (a : α) : 1 ≤ mul_indicator s f a :=
one_le_mul_indicator_apply (h a)

@[to_additive] lemma mul_indicator_apply_le_one (h : a ∈ s → f a ≤ 1) : mul_indicator s f a ≤ 1 :=
mul_indicator_apply_le' h (λ _, le_rfl)

@[to_additive] lemma mul_indicator_le_one (h : ∀ a ∈ s, f a ≤ 1) (a : α) :
  mul_indicator s f a ≤ 1 :=
mul_indicator_apply_le_one (h a)

@[to_additive] lemma mul_indicator_le_mul_indicator (h : f a ≤ g a) :
  mul_indicator s f a ≤ mul_indicator s g a :=
mul_indicator_rel_mul_indicator le_rfl (λ _, h)

attribute [mono] mul_indicator_le_mul_indicator indicator_le_indicator

@[to_additive] lemma mul_indicator_le_mul_indicator_of_subset (h : s ⊆ t) (hf : ∀ a, 1 ≤ f a)
  (a : α) :
  mul_indicator s f a ≤ mul_indicator t f a :=
mul_indicator_apply_le' (λ ha, le_mul_indicator_apply (λ _, le_rfl) (λ hat, (hat $ h ha).elim))
  (λ ha, one_le_mul_indicator_apply (λ _, hf _))

@[to_additive] lemma mul_indicator_le_self' (hf : ∀ x ∉ s, 1 ≤ f x) : mul_indicator s f ≤ f :=
mul_indicator_le' (λ _ _, le_rfl) hf

@[to_additive] lemma mul_indicator_Union_apply {ι M} [complete_lattice M] [has_one M]
  (h1 : (⊥:M) = 1) (s : ι → set α) (f : α → M) (x : α) :
  mul_indicator (⋃ i, s i) f x = ⨆ i, mul_indicator (s i) f x :=
begin
  by_cases hx : x ∈ ⋃ i, s i,
  { rw [mul_indicator_of_mem hx],
    rw [mem_Union] at hx,
    refine le_antisymm _ (supr_le $ λ i, mul_indicator_le_self' (λ x hx, h1 ▸ bot_le) x),
    rcases hx with ⟨i, hi⟩,
    exact le_supr_of_le i (ge_of_eq $ mul_indicator_of_mem hi _) },
  { rw [mul_indicator_of_not_mem hx],
    simp only [mem_Union, not_exists] at hx,
    simp [hx, ← h1] }
end

end order

section canonically_ordered_monoid

variables [canonically_ordered_monoid M]

@[to_additive] lemma mul_indicator_le_self (s : set α) (f : α → M) :
  mul_indicator s f ≤ f :=
mul_indicator_le_self' $ λ _ _, one_le _

@[to_additive] lemma mul_indicator_apply_le {a : α} {s : set α} {f g : α → M}
  (hfg : a ∈ s → f a ≤ g a) :
  mul_indicator s f a ≤ g a :=
mul_indicator_apply_le' hfg $ λ _, one_le _

@[to_additive] lemma mul_indicator_le {s : set α} {f g : α → M} (hfg : ∀ a ∈ s, f a ≤ g a) :
  mul_indicator s f ≤ g :=
mul_indicator_le' hfg $ λ _ _, one_le _

end canonically_ordered_monoid

lemma indicator_le_indicator_nonneg {β} [linear_order β] [has_zero β] (s : set α) (f : α → β) :
  s.indicator f ≤ {x | 0 ≤ f x}.indicator f :=
begin
  intro x,
  classical,
  simp_rw indicator_apply,
  split_ifs,
  { exact le_rfl, },
  { exact (not_le.mp h_1).le, },
  { exact h_1, },
  { exact le_rfl, },
end

lemma indicator_nonpos_le_indicator {β} [linear_order β] [has_zero β] (s : set α) (f : α → β) :
  {x | f x ≤ 0}.indicator f ≤ s.indicator f :=
@indicator_le_indicator_nonneg α βᵒᵈ _ _ s f

end set

@[to_additive] lemma monoid_hom.map_mul_indicator
  {M N : Type*} [mul_one_class M] [mul_one_class N] (f : M →* N)
  (s : set α) (g : α → M) (x : α) :
  f (s.mul_indicator g x) = s.mul_indicator (f ∘ g) x :=
congr_fun (set.mul_indicator_comp_of_one f.map_one).symm x


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker, Anne Baanen
-/

import algebra.associated
import data.list.big_operators.lemmas
import data.list.perm

/-!
# Products of lists of prime elements.

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

This file contains some theorems relating `prime` and products of `list`s.

-/

open list

section comm_monoid_with_zero

variables {M : Type*} [comm_monoid_with_zero M]

/-- Prime `p` divides the product of a list `L` iff it divides some `a ∈ L` -/
lemma prime.dvd_prod_iff {p : M} {L : list M} (pp : prime p) : p ∣ L.prod ↔ ∃ a ∈ L, p ∣ a :=
begin
  split,
  { intros h,
    induction L with L_hd L_tl L_ih,
    { rw prod_nil at h, exact absurd h pp.not_dvd_one },
    { rw prod_cons at h,
      cases pp.dvd_or_dvd h with hd hd,
      { exact ⟨L_hd, mem_cons_self L_hd L_tl, hd⟩ },
      { obtain ⟨x, hx1, hx2⟩ := L_ih hd,
        exact ⟨x, mem_cons_of_mem L_hd hx1, hx2⟩ } } },
  { exact λ ⟨a, ha1, ha2⟩, dvd_trans ha2 (dvd_prod ha1) },
end

lemma prime.not_dvd_prod {p : M} {L : list M} (pp : prime p) (hL : ∀ a ∈ L, ¬ p ∣ a) :
  ¬ p ∣ L.prod :=
mt (prime.dvd_prod_iff pp).mp $ not_bex.mpr hL

end comm_monoid_with_zero

section cancel_comm_monoid_with_zero

variables {M : Type*} [cancel_comm_monoid_with_zero M] [unique (units M)]

lemma mem_list_primes_of_dvd_prod {p : M} (hp : prime p) {L : list M} (hL : ∀ q ∈ L, prime q)
  (hpL : p ∣ L.prod) : p ∈ L :=
begin
  obtain ⟨x, hx1, hx2⟩ := hp.dvd_prod_iff.mp hpL,
  rwa (prime_dvd_prime_iff_eq hp (hL x hx1)).mp hx2
end

lemma perm_of_prod_eq_prod : ∀ {l₁ l₂ : list M}, l₁.prod = l₂.prod →
  (∀ p ∈ l₁, prime p) → (∀ p ∈ l₂, prime p) → perm l₁ l₂
| []        []        _  _  _  := perm.nil
| []        (a :: l)  h₁ h₂ h₃ :=
  have ha : a ∣ 1 := @prod_nil M _ ▸ h₁.symm ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _,
  absurd ha (prime.not_dvd_one (h₃ a (mem_cons_self _ _)))
| (a :: l)  []        h₁ h₂ h₃ :=
  have ha : a ∣ 1 := @prod_nil M _ ▸ h₁ ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _,
  absurd ha (prime.not_dvd_one (h₂ a (mem_cons_self _ _)))
| (a :: l₁) (b :: l₂) h hl₁ hl₂ :=
  begin
    classical,
    have hl₁' : ∀ p ∈ l₁, prime p := λ p hp, hl₁ p (mem_cons_of_mem _ hp),
    have hl₂' : ∀ p ∈ (b :: l₂).erase a, prime p := λ p hp, hl₂ p (mem_of_mem_erase hp),
    have ha : a ∈ (b :: l₂) := mem_list_primes_of_dvd_prod (hl₁ a (mem_cons_self _ _)) hl₂
      (h ▸ by rw prod_cons; exact dvd_mul_right _ _),
    have hb : b :: l₂ ~ a :: (b :: l₂).erase a := perm_cons_erase ha,
    have hl : prod l₁ = prod ((b :: l₂).erase a) :=
      ((mul_right_inj' (hl₁ a (mem_cons_self _ _)).ne_zero).1 $
        by rwa [← prod_cons, ← prod_cons, ← hb.prod_eq]),
    exact perm.trans ((perm_of_prod_eq_prod hl hl₁' hl₂').cons _) hb.symm
  end

end cancel_comm_monoid_with_zero