import data.int.modeq
import data.nat.basic
import data.nat.modeq
import data.nat.parity
import data.nat.digits
import data.nat.gcd.basic
import algebra.big_operators.ring

import tactic.ring_exp

/-!
Let n be a natural number. Prove that

  (a) n has a (nonzero) multiple whose representation in base 10 contains
      only zeroes and ones; and
  (b) 2^n has a multiple whose representation contains only ones and twos.
-/

open_locale big_operators

def ones (b : ℕ) : ℕ → ℕ
| k := ∑(i : ℕ) in finset.range k, b^i

def map_mod (n : ℕ) (hn: 0 < n) (f : ℕ → ℕ) : ℕ → fin n
| m := ⟨f m % n, nat.mod_lt (f m) hn⟩

lemma pigeonhole (n : ℕ) (f : ℕ → fin n) :
  ∃ a b : ℕ, a < b ∧ f a = f b :=
let ⟨a, b, hne, hfe⟩ := finite.exists_ne_map_eq_of_infinite f
in hne.lt_or_lt.elim (λ h, ⟨a, b, h, hfe⟩) (λ h, ⟨b, a, h, hfe.symm⟩)

def is_zero_or_one : ℕ → Prop
| 0 := true
| 1 := true
| _ := false

def all_zero_or_one (l : list ℕ) : Prop := ∀ e ∈ l, is_zero_or_one e

lemma digits_lemma
  (base: ℕ)
  (h2: 2 ≤ base)
  (n: ℕ)
  (hn: 0 < n)
  : (nat.digits base (base * n)) = 0 :: (nat.digits base n) :=
begin
  have := nat.digits_add base h2 0 n (nat.lt_of_succ_lt (nat.succ_le_iff.mp h2))
                              (or.inr (ne_of_gt hn)),
  rwa (zero_add (base * n)) at this,
end

lemma times_base_still_all_zero_or_one
  (base: ℕ)
  (h2: 2 ≤ base)
  (n: ℕ)
  (hn : all_zero_or_one (nat.digits base n))
  : all_zero_or_one (nat.digits base (base * n)) :=
begin
  cases (nat.eq_zero_or_pos n) with hz hp,
  { rw hz,
    simp [mul_zero, nat.digits_zero, all_zero_or_one] },
  { rw (digits_lemma base h2 n hp),
    simpa[is_zero_or_one, all_zero_or_one] }
end

lemma base_pow_still_all_zero_or_one
  (base: ℕ)
  (h2: 2 ≤ base)
  (k n: ℕ)
  (hn : all_zero_or_one (nat.digits base n))
  : all_zero_or_one (nat.digits base ((base ^ k) * n)) :=
begin
  induction k with pk hpk,
  { simpa },
  have := times_base_still_all_zero_or_one base h2 _ hpk,
  rwa [←(nat.add_one pk), pow_succ' base pk, mul_comm (base^pk) base, mul_assoc],
end

lemma times_base_plus_one_still_all_zero_or_one
  (base: ℕ)
  (h2: 2 ≤ base)
  (n: ℕ)
  (hazoo : all_zero_or_one (nat.digits base n))
  : all_zero_or_one (nat.digits base (1 + base * n)) :=
begin
  rw (nat.digits_add base h2 1 n (nat.succ_le_iff.mp h2) (or.inl nat.one_ne_zero)),
  simpa[all_zero_or_one, is_zero_or_one],
end

lemma lemma_0 (k b : ℕ) (h2 : 2 ≤ b) :
  all_zero_or_one (b.digits (∑(i : ℕ) in finset.range k, b^i)) :=
begin
  induction k with pk hpk,
  { simp[all_zero_or_one] },
  { have hh := calc
          ∑ (i : ℕ) in finset.range pk.succ, b ^ i
        = ∑ (i : ℕ) in finset.range pk, b ^ i.succ + b ^ 0 :
               finset.sum_range_succ' (λ (i : ℕ), b ^ i) pk
    ... = b ^ 0 + ∑ (i : ℕ) in finset.range pk, b ^ i.succ : add_comm _ _
    ... = 1 + ∑ (i : ℕ) in finset.range pk, b ^ i.succ : by rw pow_zero
    ... = 1 + ∑ (i : ℕ) in finset.range pk, b * b ^ i :
          by {simp, exact finset.sum_congr rfl (λx _, pow_succ _ _)}
    ... =  1 + b * ∑ (i : ℕ) in finset.range pk, b ^ i :
          by simp [finset.mul_sum],
    have := times_base_plus_one_still_all_zero_or_one
               b h2
               (∑ (i : ℕ) in finset.range pk, b ^ i) hpk,
    rwa hh,
  },
end

lemma lemma_1 (k b m: ℕ) (h2 : 2 ≤ b):
  all_zero_or_one (b.digits (∑(i : ℕ) in finset.range k, b^(i + m))) :=
begin
  have h := calc
          (∑ (i : ℕ) in finset.range k, b ^ (i + m))
        = (∑ (i : ℕ) in finset.range k, b ^ i * b ^ m) :
             by { refine finset.sum_congr rfl _, intros x hx, exact pow_add b x m }
    ... = (∑ (i : ℕ) in finset.range k, b ^ m * b ^ i) :
             by { refine finset.sum_congr rfl _, intros x hx, exact mul_comm (b ^ x) (b ^ m) }
    ... = b^m * (∑ (i : ℕ) in finset.range k, b ^ i) : finset.mul_sum.symm,

  have := base_pow_still_all_zero_or_one b h2 m
                       (∑ (i : ℕ) in finset.range k, b ^ i)
                       (lemma_0 k b h2),
  rwa h,
end

lemma lemma_2'''
  (c d : ℕ)
  (f: ℕ → ℕ) :
  (∑(i : ℕ) in finset.range c, f (i + d)) + (∑(i : ℕ) in finset.range d, f i)  =
     ∑(i : ℕ) in finset.range (c+d), f i :=
begin
  induction c with pc hpc,
  { simp },
  { have h1 : ∑ (i : ℕ) in finset.range pc.succ, f (i + d) =
              ∑ (i : ℕ) in finset.range pc, f (i + d) + f (pc + d) :=
         finset.sum_range_succ (λ (x : ℕ), f (x + d)) pc,

    have h2 := calc
          ∑ (i : ℕ) in finset.range (pc.succ + d), f i
        = ∑ (i : ℕ) in finset.range (pc + d).succ, f i        : by rw nat.succ_add
    ... = ∑ (i : ℕ) in finset.range (pc + d), f i + f(pc + d) : finset.sum_range_succ f _,

    linarith
  },
end

lemma lemma_2''
  (a b : ℕ)
  (hlt : a < b)
  (f: ℕ → ℕ) :
  (∑(i : ℕ) in finset.range (b - a), f (i + a)) + (∑(i : ℕ) in finset.range a, f i)  =
     ∑(i : ℕ) in finset.range b, f i :=
begin
  have := lemma_2''' (b - a) a f,
  rwa [nat.sub_add_cancel (le_of_lt hlt)] at this,
end

lemma lemma_2'
  (a b : ℕ)
  (hlt : a < b) :
  (∑(i : ℕ) in finset.range (b - a), 10^(i + a)) + (∑(i : ℕ) in finset.range a, 10^i)  =
     ∑(i : ℕ) in finset.range b, 10^i :=
begin
  exact lemma_2'' a b hlt (λi, 10^i),
end

lemma lemma_2_aux (n a b c: ℕ) (hc : a + b = c) (hab: a % n = c % n) : b % n = 0 :=
begin
  have h1: a ≡ c [MOD n] := hab,
  have h2 : a + b ≡ c + b [MOD n] := nat.modeq.add h1 rfl,
  rw hc at h2,
  have h2' : c + 0 = c := self_eq_add_right.mpr rfl,
  have h2'' : c + 0 ≡ c + b [MOD n] := by rwa h2',
  have h3 : 0 ≡ b [MOD n] := nat.modeq.add_left_cancel' c h2'',
  have h4 : 0 % n = b % n := h3,
  rw [nat.zero_mod] at h4,
  exact eq.symm h4,
end

lemma lemma_2
  (n : ℕ)
  (hn : n > 0)
  (a b : ℕ)
  (hlt : a < b)
  (hab : (∑(i : ℕ) in finset.range a, 10^i) % n = (∑(i : ℕ) in finset.range b, 10^i) % n) :
  (∑(i : ℕ) in finset.range (b - a), 10^(i + a)) % n = 0 :=
begin
  have h1 := lemma_2' a b hlt,
  refine lemma_2_aux n _ (∑(i : ℕ) in finset.range (b - a), 10^(i + a)) _ _ hab,
  rwa add_comm,
end

lemma lemma_3 {a n : ℕ} (ha: 0 < a) (hm : a % n = 0) : (∃ k : ℕ+, a = n * k) :=
begin
  have h2 : n ∣ a := nat.dvd_of_mod_eq_zero hm,
  obtain ⟨k', hk'⟩ := exists_eq_mul_right_of_dvd h2,
  have hkp : 0 < k',
  { cases k',
    { rw hk' at ha,
      rwa mul_zero at ha },
    { exact nat.succ_pos k' } },
  use ⟨k', hkp⟩,
  simpa [hkp],
end

lemma lemma_4 {k : ℕ} (hk : 0 < k) (f: ℕ → ℕ) (hf0 : 0 < f 0) :
      0 < ∑(i : ℕ) in finset.range k, f i :=
begin
  cases k,
  { exfalso, exact nat.lt_asymm hk hk },
  calc 0 < f 0                                         : hf0
    ... ≤ (∑(i : ℕ) in finset.range k, f i.succ) + f 0 : nat.le_add_left _ _
    ... = (∑(i : ℕ) in finset.range k.succ, f i)       : (finset.sum_range_succ' _ _).symm
end

lemma two_le_ten : (2 : ℕ) ≤ 10 := tsub_eq_zero_iff_le.mp rfl

--
-- Prove that n has a positive multiple whose representation contains only zeroes and ones.
--
theorem zeroes_and_ones (n : ℕ) : ∃ k : ℕ+, all_zero_or_one (nat.digits 10 (n * k)) :=
begin
  obtain (hn0 : n = 0 ) | (hn : n > 0) := nat.eq_zero_or_pos n,
  { use 1, rw hn0, simp[all_zero_or_one] },
  obtain ⟨a, b, hlt, hab⟩ := pigeonhole n (λm, map_mod n hn (ones 10) m),
  have h' : (∑(i : ℕ) in finset.range (b - a), 10^(i + a)) % n = 0 :=
   lemma_2 n hn a b hlt (fin.mk.inj hab),
  have ha: 0 < ∑(i : ℕ) in finset.range (b - a), 10^(i + a),
  { have hm : 0 < b - a := nat.sub_pos_of_lt hlt,
    have hp : 0 < 10 ^ (0 + a) := pow_pos (nat.succ_pos _) _,
    exact lemma_4 hm (λ (i : ℕ), 10 ^ (i + a)) hp,
  },
  obtain ⟨k, hk⟩ := lemma_3 ha h',
  use k,
  rw [←hk],
  exact lemma_1 (b - a) 10 a two_le_ten
end

def is_one_or_two : ℕ → Prop
| 1 := true
| 2 := true
| _ := false

def all_one_or_two (l : list ℕ) : Prop := ∀ e ∈ l, is_one_or_two e

def prepend_one (n : ℕ) := 10 ^ (list.length (nat.digits 10 n)) + n

lemma prepend_one_pos (n: ℕ) : 0 < prepend_one n :=
begin
  cases n,
  { simp[prepend_one], },
  { rw[prepend_one],
    norm_num },
end

lemma digits_len' (n : ℕ) (hn : 0 < n) :
      list.length (nat.digits 10 n) = 1 + list.length (nat.digits 10 (n / 10)) :=
begin
  rw[nat.digits_def' two_le_ten hn],
  rw[list.length],
  exact add_comm _ _,
end

lemma prepend_one_div (n : ℕ) (hn : 0 < n) : prepend_one n / 10 = prepend_one (n / 10) :=
begin
  rw[prepend_one, prepend_one],
  cases n,
  { exfalso, exact nat.lt_asymm hn hn },
  { rw[digits_len' n.succ (nat.succ_pos n)],
    rw[pow_add, pow_one, add_comm],
    rw [nat.add_mul_div_left _ _ (nat.succ_pos 9)],
    exact add_comm _ _ }
end

lemma prepend_one_mod (n : ℕ) (hn : 0 < n) : prepend_one n % 10 = n % 10 :=
begin
  rw[prepend_one],
  rw[nat.digits_len _ _ two_le_ten (ne_of_gt hn)],
  rw[pow_add, pow_one],
  exact nat.mul_add_mod _ 10 n
end

lemma prepend_one_eq_append (n : ℕ) :
    nat.digits 10 (prepend_one n) = (nat.digits 10 n) ++ [1] :=
begin
  induction n using nat.strong_induction_on with n' ih,
  cases n',
  { simp[prepend_one], },
  { rw[nat.digits_def' two_le_ten (prepend_one_pos _)],
    rw[prepend_one_div _ (nat.succ_pos n')],
    have hns : n'.succ / 10 < n'.succ := nat.div_lt_self' n' 8,
    rw[ih _ hns],
    rw[←list.cons_append],
    rw[prepend_one_mod _ (nat.succ_pos _), ← nat.digits_def' two_le_ten (nat.succ_pos n')] }
end

lemma prepend_one_all_one_or_two (n : ℕ) (hn : all_one_or_two (nat.digits 10 n)) :
    all_one_or_two (nat.digits 10 (prepend_one n)) :=
begin
 rw[prepend_one_eq_append, all_one_or_two],
 rw[all_one_or_two] at hn,
 intros e he,
 rw[list.mem_append] at he,
 cases he,
 { exact hn e he },
 { rw[list.mem_singleton] at he,
   rw[he],
   simp[is_one_or_two] }
end

def prepend_two (n : ℕ) := 2 * (10 ^ (list.length (nat.digits 10 n))) + n

lemma prepend_two_pos (n: ℕ) : 0 < prepend_two n :=
begin
  cases n,
  { simp[prepend_two], },
  { rw[prepend_two],
    norm_num },
end

lemma prepend_two_div (n : ℕ) (hn : 0 < n) : prepend_two n / 10 = prepend_two (n / 10) :=
begin
  rw[prepend_two, prepend_two],
  cases n,
  { exfalso, exact nat.lt_asymm hn hn },
  { rw[digits_len' n.succ (nat.succ_pos n)],
    rw[pow_add, pow_one],
    rw[add_comm],
    rw[←mul_left_comm],
    rw [nat.add_mul_div_left _ _ (nat.succ_pos 9)],
    exact add_comm _ _ }
end

lemma prepend_two_mod (n : ℕ) (hn : 0 < n) : prepend_two n % 10 = n % 10 :=
begin
  rw[prepend_two],
  rw[nat.digits_len _ _ two_le_ten (ne_of_gt hn)],
  rw[pow_add, pow_one, ←mul_assoc],
  exact nat.mul_add_mod _ 10 n
end

lemma prepend_two_eq_append (n : ℕ) :
    nat.digits 10 (prepend_two n) = (nat.digits 10 n) ++ [2] :=
begin
  induction n using nat.strong_induction_on with n' ih,
  cases n',
  { simp[prepend_two], },
  { rw[nat.digits_def' two_le_ten (prepend_two_pos _)],
    rw[prepend_two_div _ (nat.succ_pos n')],
    have hns : n'.succ / 10 < n'.succ := nat.div_lt_self' n' 8,
    rw[ih _ hns],
    rw[←list.cons_append],
    rw[prepend_two_mod _ (nat.succ_pos _), ← nat.digits_def' two_le_ten (nat.succ_pos n')] }
end

lemma prepend_two_all_one_or_two (n : ℕ) (hn : all_one_or_two (nat.digits 10 n)) :
    all_one_or_two (nat.digits 10 (prepend_two n)) :=
begin
 rw[prepend_two_eq_append, all_one_or_two],
 rw[all_one_or_two] at hn,
 intros e he,
 rw[list.mem_append] at he,
 cases he,
 { exact hn e he },
 { rw[list.mem_singleton] at he,
   rw[he],
   simp[is_one_or_two] }
end

lemma factor_ten_pow (k : ℕ) : 10 ^ k = (2^k) * (5^k) :=
begin
  induction k with k' ih,
  { simp only [pow_zero, mul_one] },
  { rw[pow_succ, pow_succ, pow_succ],
    linarith }
end

lemma even_5_pow_plus_one (n : ℕ) : 2 ∣ 5 ^ n + 1 :=
begin
  apply nat.dvd_of_mod_eq_zero,
  have h0 : 5 ^ n % 2 = 1,
  { induction n with n' ih,
    { simp },
    { rw[pow_succ, nat.mul_mod, ih],
      simp}},
  rw[nat.add_mod, h0],
  simp
end

lemma ones_and_twos_aux (n : ℕ) :
  ∃ k : ℕ+, (list.length (nat.digits 10 (2^n.succ * k)) = n.succ) ∧
             all_one_or_two (nat.digits 10 (2^n.succ * k)) :=
begin
  induction n with pn hpn,
  { use 1, simp[all_one_or_two] },
  obtain ⟨pk, hpk1, hpk2⟩ := hpn,

  /-
    Adding a 1 or a 2 to the front of 2^pn.succ * pk increments it by 2^pn.succ * 5^pn.succ or
    by 2^{pn.succ+1} * 5^pn.succ, in each case preserving divisibility by 2^pn.succ. Since the
    two choices differ by 2^pn.succ * 5^pn.succ, one of them must actually achieve
    divisibility by 2^{pn.succ+1}.
  -/

  obtain ⟨t, ht : ↑pk = t + t⟩ | ⟨t, ht : ↑pk = 2 * t + 1⟩ := (pk : ℕ).even_or_odd,
  { -- Even case. Prepend 2.
    rw[← two_mul] at ht,
    have hd : 2 ^ pn.succ.succ ∣ prepend_two (2 ^ pn.succ * ↑pk),
    { rw [prepend_two, factor_ten_pow, hpk1, ht],
      have hr : 2 * (2 ^ pn.succ * 5 ^ pn.succ) + 2 ^ pn.succ * (2 * t) =
                   2 ^ pn.succ.succ * (5 ^ pn.succ + t) := by ring_exp,
      rw[hr],
      exact dvd.intro (5 ^ nat.succ pn + t) rfl },
    obtain ⟨k', hk'⟩ := hd,
    have hkp': 0 < k',
    { cases k',
      { exfalso,
        have hzz := prepend_two_pos (2 ^ pn.succ * ↑pk),
        rw[mul_zero] at hk',
        linarith },
      {exact nat.succ_pos _}, },
    use ⟨k', hkp'⟩,
    dsimp,
    rw[← hk'],
    split,
    { rw[prepend_two_eq_append],
      rw [list.length_append, list.length_singleton, hpk1] },
    { exact prepend_two_all_one_or_two _ hpk2, },
  },
  { -- Odd case. Prepend 1.
    have hd : 2 ^ pn.succ.succ ∣ prepend_one (2 ^ pn.succ * ↑pk),
    { rw[prepend_one, hpk1, factor_ten_pow, ht],
      have h5 : 2 ^ pn.succ * 5 ^ pn.succ + 2 ^ pn.succ * (2 * t + 1) =
            2^pn.succ * (2 * (2 * 5 ^ pn + t) + (5^pn + 1)) := by ring_exp,
      rw[h5],
      obtain ⟨k5,hk5⟩:= even_5_pow_plus_one pn,
      rw[hk5],
      have h5' : 2 ^ pn.succ * (2 * (2 * 5 ^ pn + t) + 2 * k5) =
           2^pn.succ.succ * (2 * 5 ^ pn + t + k5) := by ring_exp,
      rw[h5'],
      exact dvd.intro (2 * 5 ^ pn + t + k5) rfl},
    obtain ⟨k', hk'⟩ := hd,
    have hkp': 0 < k',
    { cases k',
      { exfalso,
        have hzz := prepend_one_pos (2 ^ pn.succ * ↑pk),
        rw[mul_zero] at hk',
        linarith },
      {exact nat.succ_pos _}, },
    use ⟨k', hkp'⟩,
    dsimp,
    rw[← hk'],
    split,
    { rw [prepend_one_eq_append],
      rw [list.length_append, list.length_singleton, hpk1] },
    { exact prepend_one_all_one_or_two _ hpk2, }},
end

--
-- Prove that 2^n has a positive multiple whose representation contains only ones and twos.
--
theorem ones_and_twos (n : ℕ) : ∃ k : ℕ+, all_one_or_two (nat.digits 10 (2^n * k)) :=
begin
  cases n,
  { use 1, simp[all_one_or_two] },
  obtain ⟨k, hk1, hk2⟩ := ones_and_twos_aux n,
  exact ⟨k, hk2⟩
end


import .love01_definitions_and_statements_demo

/-! # LoVe Demo 3: Forward Proofs

When developing a proof, often it makes sense to work __forward__: to start with
what we already know and proceed step by step towards our goal. Lean's
structured proofs and raw proof terms are two styles that support forward
reasoning. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace forward_proofs

/-! ## Structured Constructs

Structured proofs are syntactic sugar sprinkled on top of Lean's
__proof terms__.

The simplest kind of structured proof is the name of a lemma, possibly with
arguments. -/

lemma add_comm (i j : ℕ) :
  add i j = add j i :=
sorry

lemma add_comm_zero_left (n : ℕ) :
  add 0 n = add n 0 :=
add_comm 0 n

lemma add_comm_zero_left₂ (n : ℕ) :
  add 0 n = add n 0 :=
by exact add_comm 0 n

/-! `fix` and `assume` move `∀`-quantified variables and assumptions from the
goal into the local context. They can be seen as structured versions of the
`intros` tactic.

`show` repeats the goal to prove. It is useful as documentation or to rephrase
the goal (up to computation). -/

lemma fst_of_two_props :
  ∀a b : Prop, a → b → a :=
fix a b : Prop,
assume ha : a,
assume hb : b,
show a, from
  ha

lemma fst_of_two_props₂ (a b : Prop) (ha : a) (hb : b) :
  a :=
show a, from
  begin
    exact ha
  end

#print fst_of_two_props
#print fst_of_two_props₂

lemma fst_of_two_props₃ (a b : Prop) (ha : a) (hb : b) :
  a :=
ha

/-! `have` proves an intermediate lemma, which can refer to the local context. -/

lemma prop_comp (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
assume ha : a,
have hb : b :=
  hab ha,
have hc : c :=
  hbc hb,
show c, from
  hc

lemma prop_comp₂ (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
assume ha : a,
show c, from
  hbc (hab ha)

/-! ## Forward Reasoning about Connectives and Quantifiers -/

lemma and_swap (a b : Prop) :
  a ∧ b → b ∧ a :=
assume hab : a ∧ b,
have ha : a :=
  and.elim_left hab,
have hb : b :=
  and.elim_right hab,
show b ∧ a, from
  and.intro hb ha

lemma or_swap (a b : Prop) :
  a ∨ b → b ∨ a :=
assume hab : a ∨ b,
show b ∨ a, from
  or.elim hab
    (assume ha : a,
     show b ∨ a, from
       or.intro_right b ha)
    (assume hb : b,
     show b ∨ a, from
       or.intro_left a hb)

def double (n : ℕ) : ℕ :=
n + n

lemma nat_exists_double_iden :
  ∃n : ℕ, double n = n :=
exists.intro 0
  (show double 0 = 0, from
     by refl)

lemma nat_exists_double_iden₂ :
  ∃n : ℕ, double n = n :=
exists.intro 0 (by refl)

lemma modus_ponens (a b : Prop) :
  (a → b) → a → b :=
assume hab : a → b,
assume ha : a,
show b, from
  hab ha

lemma not_not_intro (a : Prop) :
  a → ¬¬ a :=
assume ha : a,
assume hna : ¬ a,
show false, from
  hna ha

lemma forall.one_point {α : Type} (t : α) (p : α → Prop) :
  (∀x, x = t → p x) ↔ p t :=
iff.intro
  (assume hall : ∀x, x = t → p x,
   show p t, from
     begin
       apply hall t,
       refl
     end)
  (assume hp : p t,
   fix x,
   assume heq : x = t,
   show p x, from
     begin
       rw heq,
       exact hp
     end)

lemma beast_666 (beast : ℕ) :
  (∀n, n = 666 → beast ≥ n) ↔ beast ≥ 666 :=
forall.one_point _ _

#print beast_666

lemma exists.one_point {α : Type} (t : α) (p : α → Prop) :
  (∃x : α, x = t ∧ p x) ↔ p t :=
iff.intro
  (assume hex : ∃x, x = t ∧ p x,
   show p t, from
     exists.elim hex
       (fix x,
        assume hand : x = t ∧ p x,
        show p t, from
          by cc))
  (assume hp : p t,
   show ∃x : α, x = t ∧ p x, from
     exists.intro t
       (show t = t ∧ p t, from
          by cc))

/-! ## Calculational Proofs

In informal mathematics, we often use transitive chains of equalities,
inequalities, or equivalences (e.g., `a ≥ b ≥ c`). In Lean, such calculational
proofs are supported by `calc`.

Syntax:

    calc      _term₀_
        _op₁_ _term₁_ :
      _proof₁_
    ... _op₂_ _term₂_ :
      _proof₂_
     ⋮
    ... _opN_ _termN_ :
      _proofN_ -/

lemma two_mul_example (m n : ℕ) :
  2 * m + n = m + n + m :=
calc  2 * m + n
    = (m + m) + n :
  by rw two_mul
... = m + n + m :
  by cc

/-! `calc` saves some repetition, some `have` labels, and some transitive
reasoning: -/

lemma two_mul_example₂ (m n : ℕ) :
  2 * m + n = m + n + m :=
have h₁ : 2 * m + n = (m + m) + n :=
  by rw two_mul,
have h₂ : (m + m) + n = m + n + m :=
  by cc,
show _, from
  eq.trans h₁ h₂

/-! ## Forward Reasoning with Tactics

The `have`, `let`, and `calc` structured proof commands are also available as a
tactic. Even in tactic mode, it can be useful to state intermediate results and
definitions in a forward fashion.

Observe that the syntax for the tactic `let` is slightly different than for the
structured proof command `let`, with `,` instead of `in`. -/

lemma prop_comp₃ (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
begin
  intro ha,
  have hb : b :=
    hab ha,
  let c' := c,
  have hc : c' :=
    hbc hb,
  exact hc
end

/-! ## Dependent Types

Dependent types are the defining feature of the dependent type theory family of
logics.

Consider a function `pick` that take a number `n : ℕ` and that returns a number
between 0 and `n`. Conceptually, `pick` has a dependent type, namely

    `(n : ℕ) → {i : ℕ // i ≤ n}`

We can think of this type as a `ℕ`-indexed family, where each member's type may
depend on the index:

    `pick n : {i : ℕ // i ≤ n}`

But a type may also depend on another type, e.g., `list` (or `λα, list α`) and
`λα, α → α`.

A term may depend on a type, e.g., `λα, λx : α, x` (a polymorphic identity
function).

Of course, a term may also depend on a term.

Unless otherwise specified, a __dependent type__ means a type depending on a
term. This is what we mean when we say that simple type theory does not support
dependent types.

In summary, there are four cases for `λx, t` in the calculus of inductive
constructions (cf. Barendregt's `λ`-cube):

Body (`t`) |              | Argument (`x`) | Description
---------- | ------------ | -------------- | ------------------------------
A term     | depending on | a term         | Simply typed `λ`-expression
A type     | depending on | a term         | Dependent type (strictly speaking)
A term     | depending on | a type         | Polymorphic term
A type     | depending on | a type         | Type constructor

Revised typing rules:

    C ⊢ t : (x : σ) → τ[x]    C ⊢ u : σ
    ———————————————————————————————————— App'
    C ⊢ t u : τ[u]

    C, x : σ ⊢ t : τ[x]
    ———————————————————————————————— Lam'
    C ⊢ (λx : σ, t) : (x : σ) → τ[x]

These two rules degenerate to `App` and `Lam` if `x` does not occur in `τ[x]`

Example of `App'`:

    ⊢ pick : (x : ℕ) → {y : ℕ // y ≤ x}    ⊢ 5 : ℕ
    ——————————————————————————————————————————————— App'
    ⊢ pick 5 : {y : ℕ // y ≤ 5}

Example of `Lam'`:

    α : Type, x : α ⊢ x : α
    ——————————————————————————————— Lam or Lam'
    α : Type ⊢ (λx : α, x) : α → α
    ————————————————————————————————————————————— Lam'
    ⊢ (λα : Type, λx : α, x) : (α : Type) → α → α

Regrettably, the intuitive syntax `(x : σ) → τ` is not available in Lean.
Instead, we must write `∀x : σ, τ` to specify a dependent type.

Aliases:

    `σ → τ` := `∀_ : σ, τ`
    `Π`     := `∀`

## The PAT Principle

`→` is used both as the implication symbol and as the type constructor of
functions. Similarly, `∀` is used both as a quantifier and in dependent types.

The two pairs of concepts not only look the same, they are the same, by the PAT
principle:

* PAT = propositions as types;
* PAT = proofs as terms.

Types:

* `σ → τ` is the type of total functions from `σ` to `τ`;
* `∀x : σ, τ[x]` is the dependent function type from `x : σ` to `τ[x]`.

Propositions:

* `P → Q` can be read as "`P` implies `Q`", or as the type of functions mapping
  proofs of `P` to proofs of `Q`.
* `∀x : σ, Q[x]` can be read as "for all `x`, `Q[x]`", or as the type of
  functions mapping values `x` of type `σ` to proofs of `Q[x]`.

Terms:

* A constant is a term.
* A variable is a term.
* `t u` is the application of function `t` to value `u`.
* `λx, t[x]` is a function mapping `x` to `t[x]`.

Proofs:

* A lemma or hypothesis name is a proof.
* `H t`, which instantiates the leading parameter or quantifier of proof `H`'
  statement with term `t`, is a proof.
* `H G`, which discharges the leading assumption of `H`'s statement with
  proof `G`, is a proof.
* `λh : P, H[h]` is a proof of `P → Q`, assuming `H[h]` is a proof of `Q`
  for `h : P`.
* `λx : σ, H[x]` is a proof of `∀x : σ, Q[x]`, assuming `H[x]` is a proof of
  `Q[x]` for `x : σ`. -/

lemma and_swap₃ (a b : Prop) :
  a ∧ b → b ∧ a :=
λhab : a ∧ b, and.intro (and.elim_right hab) (and.elim_left hab)

lemma and_swap₄ (a b : Prop) :
  a ∧ b → b ∧ a :=
begin
  intro hab,
  apply and.intro,
  apply and.elim_right,
  exact hab,
  apply and.elim_left,
  exact hab
end

/-! Tactical proofs are reduced to proof terms. -/

#print and_swap₃
#print and_swap₄

end forward_proofs

/-! ## Induction by Pattern Matching

By the PAT principle, a proof by induction is the same as a recursively
specified proof term. Thus, as alternative to the `induction'` tactic, induction
can also be done by pattern matching:

 * the induction hypothesis is then available under the name of the lemma we are
   proving;

 * well-foundedness of the argument is often proved automatically. -/

#check reverse

lemma reverse_append {α : Type} :
  ∀xs ys : list α,
    reverse (xs ++ ys) = reverse ys ++ reverse xs
| []        ys := by simp [reverse]
| (x :: xs) ys := by simp [reverse, reverse_append xs]

lemma reverse_append₂ {α : Type} (xs ys : list α) :
  reverse (xs ++ ys) = reverse ys ++ reverse xs :=
begin
  induction' xs,
  { simp [reverse] },
  { simp [reverse, ih] }
end

lemma reverse_reverse {α : Type} :
  ∀xs : list α, reverse (reverse xs) = xs
| []        := by refl
| (x :: xs) :=
  by simp [reverse, reverse_append, reverse_reverse xs]

end LoVe


import game.max.level09 -- hide

open_locale classical -- hide

noncomputable theory -- hide

namespace xena -- hide

/-
# Chapter ? : Max

## Level 10

And finally `lt_max_iff`.
-/

/- Lemma
If $a$, $b$, $c$ are real numbers,
then $a<\max(b,c)$ iff ($a<b$ or $a<c$).
-/

theorem lt_max_iff {a b c : ℝ} : a < max b c ↔ a < b ∨ a < c :=
begin
  split,
  { intro ha,
    cases le_total b c with hbc hcb,
    { rw max_eq_right hbc at ha,
      right,
      assumption,
    },
    { rw max_eq_left hcb at ha,
      left,
      assumption
    }
  },
  { intro habc,
    cases habc with hab hac,
    { apply lt_of_lt_of_le hab,
      apply le_max_left},
    { apply lt_of_lt_of_le hac,
      apply le_max_right},
  }
end

end xena --hide


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

import algebra.order.absolute_value
import algebra.big_operators.basic

/-!
# Results about big operators with values in an ordered algebraic structure.

Mostly monotonicity results for the `∏` and `∑` operations.

-/

open function
open_locale big_operators

variables {ι α β M N G k R : Type*}

namespace finset

section ordered_comm_monoid

variables [comm_monoid M] [ordered_comm_monoid N]

/-- Let `{x | p x}` be a subsemigroup of a commutative monoid `M`. Let `f : M → N` be a map
submultiplicative on `{x | p x}`, i.e., `p x → p y → f (x * y) ≤ f x * f y`. Let `g i`, `i ∈ s`, be
a nonempty finite family of elements of `M` such that `∀ i ∈ s, p (g i)`. Then
`f (∏ x in s, g x) ≤ ∏ x in s, f (g x)`. -/
@[to_additive le_sum_nonempty_of_subadditive_on_pred]
lemma le_prod_nonempty_of_submultiplicative_on_pred
  (f : M → N) (p : M → Prop) (h_mul : ∀ x y, p x → p y → f (x * y) ≤ f x * f y)
  (hp_mul : ∀ x y, p x → p y → p (x * y)) (g : ι → M) (s : finset ι) (hs_nonempty : s.nonempty)
  (hs : ∀ i ∈ s, p (g i)) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
begin
  refine le_trans (multiset.le_prod_nonempty_of_submultiplicative_on_pred f p h_mul hp_mul _ _ _) _,
  { simp [hs_nonempty.ne_empty], },
  { exact multiset.forall_mem_map_iff.mpr hs, },
  rw multiset.map_map,
  refl,
end

/-- Let `{x | p x}` be an additive subsemigroup of an additive commutative monoid `M`. Let
`f : M → N` be a map subadditive on `{x | p x}`, i.e., `p x → p y → f (x + y) ≤ f x + f y`. Let
`g i`, `i ∈ s`, be a nonempty finite family of elements of `M` such that `∀ i ∈ s, p (g i)`. Then
`f (∑ i in s, g i) ≤ ∑ i in s, f (g i)`. -/
add_decl_doc le_sum_nonempty_of_subadditive_on_pred

/-- If `f : M → N` is a submultiplicative function, `f (x * y) ≤ f x * f y` and `g i`, `i ∈ s`, is a
nonempty finite family of elements of `M`, then `f (∏ i in s, g i) ≤ ∏ i in s, f (g i)`. -/
@[to_additive le_sum_nonempty_of_subadditive]
lemma le_prod_nonempty_of_submultiplicative
  (f : M → N) (h_mul : ∀ x y, f (x * y) ≤ f x * f y) {s : finset ι} (hs : s.nonempty) (g : ι → M) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
le_prod_nonempty_of_submultiplicative_on_pred f (λ i, true) (λ x y _ _, h_mul x y)
  (λ _ _ _ _, trivial) g s hs (λ _ _, trivial)

/-- If `f : M → N` is a subadditive function, `f (x + y) ≤ f x + f y` and `g i`, `i ∈ s`, is a
nonempty finite family of elements of `M`, then `f (∑ i in s, g i) ≤ ∑ i in s, f (g i)`. -/
add_decl_doc le_sum_nonempty_of_subadditive

/-- Let `{x | p x}` be a subsemigroup of a commutative monoid `M`. Let `f : M → N` be a map
such that `f 1 = 1` and `f` is submultiplicative on `{x | p x}`, i.e.,
`p x → p y → f (x * y) ≤ f x * f y`. Let `g i`, `i ∈ s`, be a finite family of elements of `M` such
that `∀ i ∈ s, p (g i)`. Then `f (∏ i in s, g i) ≤ ∏ i in s, f (g i)`. -/
@[to_additive le_sum_of_subadditive_on_pred]
lemma le_prod_of_submultiplicative_on_pred (f : M → N) (p : M → Prop) (h_one : f 1 = 1)
  (h_mul : ∀ x y, p x → p y → f (x * y) ≤ f x * f y)
  (hp_mul : ∀ x y, p x → p y → p (x * y)) (g : ι → M) {s : finset ι} (hs : ∀ i ∈ s, p (g i)) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
begin
  rcases eq_empty_or_nonempty s with rfl|hs_nonempty,
  { simp [h_one] },
  { exact le_prod_nonempty_of_submultiplicative_on_pred f p h_mul hp_mul g s hs_nonempty hs, },
end

/-- Let `{x | p x}` be a subsemigroup of a commutative additive monoid `M`. Let `f : M → N` be a map
such that `f 0 = 0` and `f` is subadditive on `{x | p x}`, i.e. `p x → p y → f (x + y) ≤ f x + f y`.
Let `g i`, `i ∈ s`, be a finite family of elements of `M` such that `∀ i ∈ s, p (g i)`. Then
`f (∑ x in s, g x) ≤ ∑ x in s, f (g x)`. -/
add_decl_doc le_sum_of_subadditive_on_pred

/-- If `f : M → N` is a submultiplicative function, `f (x * y) ≤ f x * f y`, `f 1 = 1`, and `g i`,
`i ∈ s`, is a finite family of elements of `M`, then `f (∏ i in s, g i) ≤ ∏ i in s, f (g i)`. -/
@[to_additive le_sum_of_subadditive]
lemma le_prod_of_submultiplicative (f : M → N) (h_one : f 1 = 1)
  (h_mul : ∀ x y, f (x * y) ≤ f x * f y) (s : finset ι) (g : ι → M) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
begin
  refine le_trans (multiset.le_prod_of_submultiplicative f h_one h_mul _) _,
  rw multiset.map_map,
  refl,
end

/-- If `f : M → N` is a subadditive function, `f (x + y) ≤ f x + f y`, `f 0 = 0`, and `g i`,
`i ∈ s`, is a finite family of elements of `M`, then `f (∑ i in s, g i) ≤ ∑ i in s, f (g i)`. -/
add_decl_doc le_sum_of_subadditive

variables {f g : ι → N} {s t : finset ι}

/-- In an ordered commutative monoid, if each factor `f i` of one finite product is less than or
equal to the corresponding factor `g i` of another finite product, then
`∏ i in s, f i ≤ ∏ i in s, g i`. -/
@[to_additive sum_le_sum]
lemma prod_le_prod'' (h : ∀ i ∈ s, f i ≤ g i) : ∏ i in s, f i ≤ ∏ i in s, g i :=
begin
  classical,
  induction s using finset.induction_on with i s hi ihs h,
  { refl },
  { simp only [prod_insert hi],
    exact mul_le_mul' (h _ (mem_insert_self _ _)) (ihs $ λ j hj, h j (mem_insert_of_mem hj)) }
end

/-- In an ordered additive commutative monoid, if each summand `f i` of one finite sum is less than
or equal to the corresponding summand `g i` of another finite sum, then
`∑ i in s, f i ≤ ∑ i in s, g i`. -/
add_decl_doc sum_le_sum

@[to_additive sum_nonneg] lemma one_le_prod' (h : ∀i ∈ s, 1 ≤ f i) : 1 ≤ (∏ i in s, f i) :=
le_trans (by rw prod_const_one) (prod_le_prod'' h)

@[to_additive finset.sum_nonneg']
lemma one_le_prod'' (h : ∀ (i : ι), 1 ≤ f i) : 1 ≤ ∏ (i : ι) in s, f i :=
finset.one_le_prod' (λ i hi, h i)

@[to_additive sum_nonpos] lemma prod_le_one' (h : ∀i ∈ s, f i ≤ 1) : (∏ i in s, f i) ≤ 1 :=
(prod_le_prod'' h).trans_eq (by rw prod_const_one)

@[to_additive sum_le_sum_of_subset_of_nonneg]
lemma prod_le_prod_of_subset_of_one_le' (h : s ⊆ t) (hf : ∀ i ∈ t, i ∉ s → 1 ≤ f i) :
  ∏ i in s, f i ≤ ∏ i in t, f i :=
by classical;
calc (∏ i in s, f i) ≤ (∏ i in t \ s, f i) * (∏ i in s, f i) :
    le_mul_of_one_le_left' $ one_le_prod' $ by simpa only [mem_sdiff, and_imp]
  ... = ∏ i in t \ s ∪ s, f i : (prod_union sdiff_disjoint).symm
  ... = ∏ i in t, f i         : by rw [sdiff_union_of_subset h]

@[to_additive sum_mono_set_of_nonneg]
lemma prod_mono_set_of_one_le' (hf : ∀ x, 1 ≤ f x) : monotone (λ s, ∏ x in s, f x) :=
λ s t hst, prod_le_prod_of_subset_of_one_le' hst $ λ x _ _, hf x

@[to_additive sum_le_univ_sum_of_nonneg]
lemma prod_le_univ_prod_of_one_le' [fintype ι] {s : finset ι} (w : ∀ x, 1 ≤ f x) :
  ∏ x in s, f x ≤ ∏ x, f x :=
prod_le_prod_of_subset_of_one_le' (subset_univ s) (λ a _ _, w a)

@[to_additive sum_eq_zero_iff_of_nonneg]
lemma prod_eq_one_iff_of_one_le' : (∀ i ∈ s, 1 ≤ f i) → (∏ i in s, f i = 1 ↔ ∀ i ∈ s, f i = 1) :=
begin
  classical,
  apply finset.induction_on s,
  exact λ _, ⟨λ _ _, false.elim, λ _, rfl⟩,
  assume a s ha ih H,
  have : ∀ i ∈ s, 1 ≤ f i, from λ _, H _ ∘ mem_insert_of_mem,
  rw [prod_insert ha, mul_eq_one_iff' (H _ $ mem_insert_self _ _) (one_le_prod' this),
    forall_mem_insert, ih this]
end

@[to_additive sum_eq_zero_iff_of_nonneg]
lemma prod_eq_one_iff_of_le_one' : (∀ i ∈ s, f i ≤ 1) → (∏ i in s, f i = 1 ↔ ∀ i ∈ s, f i = 1) :=
@prod_eq_one_iff_of_one_le' _ (order_dual N) _ _ _

@[to_additive single_le_sum]
lemma single_le_prod' (hf : ∀ i ∈ s, 1 ≤ f i) {a} (h : a ∈ s) : f a ≤ (∏ x in s, f x) :=
calc f a = ∏ i in {a}, f i : prod_singleton.symm
     ... ≤ ∏ i in s, f i   :
  prod_le_prod_of_subset_of_one_le' (singleton_subset_iff.2 h) $ λ i hi _, hf i hi

@[to_additive]
lemma prod_le_of_forall_le (s : finset ι) (f : ι → N) (n : N) (h : ∀ x ∈ s, f x ≤ n) :
  s.prod f ≤ n ^ s.card :=
begin
  refine (multiset.prod_le_of_forall_le (s.val.map f) n _).trans _,
  { simpa using h },
  { simpa }
end

@[to_additive]
lemma le_prod_of_forall_le (s : finset ι) (f : ι → N) (n : N) (h : ∀ x ∈ s, n ≤ f x) :
  n ^ s.card ≤ s.prod f :=
@finset.prod_le_of_forall_le _ (order_dual N) _ _ _ _ h

lemma card_bUnion_le_card_mul [decidable_eq β] (s : finset ι) (f : ι → finset β) (n : ℕ)
  (h : ∀ a ∈ s, (f a).card ≤ n) :
  (s.bUnion f).card ≤ s.card * n :=
card_bUnion_le.trans $ sum_le_of_forall_le _ _ _ h

variables {ι' : Type*} [decidable_eq ι']

@[to_additive sum_fiberwise_le_sum_of_sum_fiber_nonneg]
lemma prod_fiberwise_le_prod_of_one_le_prod_fiber' {t : finset ι'}
  {g : ι → ι'} {f : ι → N} (h : ∀ y ∉ t, (1 : N) ≤ ∏ x in s.filter (λ x, g x = y), f x) :
  ∏ y in t, ∏ x in s.filter (λ x, g x = y), f x ≤ ∏ x in s, f x :=
calc (∏ y in t, ∏ x in s.filter (λ x, g x = y), f x) ≤
  (∏ y in t ∪ s.image g, ∏ x in s.filter (λ x, g x = y), f x) :
  prod_le_prod_of_subset_of_one_le' (subset_union_left _ _) $ λ y hyts, h y
... = ∏ x in s, f x :
  prod_fiberwise_of_maps_to (λ x hx, mem_union.2 $ or.inr $ mem_image_of_mem _ hx) _

@[to_additive sum_le_sum_fiberwise_of_sum_fiber_nonpos]
lemma prod_le_prod_fiberwise_of_prod_fiber_le_one' {t : finset ι'}
  {g : ι → ι'} {f : ι → N} (h : ∀ y ∉ t, (∏ x in s.filter (λ x, g x = y), f x) ≤ 1) :
  (∏ x in s, f x) ≤ ∏ y in t, ∏ x in s.filter (λ x, g x = y), f x :=
@prod_fiberwise_le_prod_of_one_le_prod_fiber' _ (order_dual N) _ _ _ _ _ _ _ h

end ordered_comm_monoid

lemma abs_sum_le_sum_abs {G : Type*} [linear_ordered_add_comm_group G] (f : ι → G) (s : finset ι) :
  |∑ i in s, f i| ≤ ∑ i in s, |f i| :=
le_sum_of_subadditive _ abs_zero abs_add s f

lemma abs_sum_of_nonneg {G : Type*} [linear_ordered_add_comm_group G] {f : ι → G} {s : finset ι}
  (hf : ∀ i ∈ s, 0 ≤ f i) :
  |∑ (i : ι) in s, f i| = ∑ (i : ι) in s, f i :=
by rw abs_of_nonneg (finset.sum_nonneg hf)

lemma abs_sum_of_nonneg' {G : Type*} [linear_ordered_add_comm_group G] {f : ι → G} {s : finset ι}
  (hf : ∀ i, 0 ≤ f i) :
  |∑ (i : ι) in s, f i| = ∑ (i : ι) in s, f i :=
by rw abs_of_nonneg (finset.sum_nonneg' hf)

lemma abs_prod {R : Type*} [linear_ordered_comm_ring R] {f : ι → R} {s : finset ι} :
  |∏ x in s, f x| = ∏ x in s, |f x| :=
(abs_hom.to_monoid_hom : R →* R).map_prod _ _

section pigeonhole

variable [decidable_eq β]

theorem card_le_mul_card_image_of_maps_to {f : α → β} {s : finset α} {t : finset β}
  (Hf : ∀ a ∈ s, f a ∈ t) (n : ℕ) (hn : ∀ a ∈ t, (s.filter (λ x, f x = a)).card ≤ n) :
  s.card ≤ n * t.card :=
calc s.card = (∑ a in t, (s.filter (λ x, f x = a)).card) : card_eq_sum_card_fiberwise Hf
        ... ≤ (∑ _ in t, n)                              : sum_le_sum hn
        ... = _                                          : by simp [mul_comm]

theorem card_le_mul_card_image {f : α → β} (s : finset α)
  (n : ℕ) (hn : ∀ a ∈ s.image f, (s.filter (λ x, f x = a)).card ≤ n) :
  s.card ≤ n * (s.image f).card :=
card_le_mul_card_image_of_maps_to (λ x, mem_image_of_mem _) n hn

theorem mul_card_image_le_card_of_maps_to {f : α → β} {s : finset α} {t : finset β}
  (Hf : ∀ a ∈ s, f a ∈ t) (n : ℕ) (hn : ∀ a ∈ t, n ≤ (s.filter (λ x, f x = a)).card) :
  n * t.card ≤ s.card :=
calc n * t.card = (∑ _ in t, n) : by simp [mul_comm]
            ... ≤ (∑ a in t, (s.filter (λ x, f x = a)).card) : sum_le_sum hn
            ... = s.card : by rw ← card_eq_sum_card_fiberwise Hf

theorem mul_card_image_le_card {f : α → β} (s : finset α)
  (n : ℕ) (hn : ∀ a ∈ s.image f, n ≤ (s.filter (λ x, f x = a)).card) :
  n * (s.image f).card ≤ s.card :=
mul_card_image_le_card_of_maps_to (λ x, mem_image_of_mem _) n hn

end pigeonhole

section double_counting
variables [decidable_eq α] {s : finset α} {B : finset (finset α)} {n : ℕ}

/-- If every element belongs to at most `n` finsets, then the sum of their sizes is at most `n`
times how many they are. -/
lemma sum_card_inter_le (h : ∀ a ∈ s, (B.filter $ (∈) a).card ≤ n) :
  ∑ t in B, (s ∩ t).card ≤ s.card * n :=
begin
  refine le_trans _ (s.sum_le_of_forall_le _ _ h),
  simp_rw [←filter_mem_eq_inter, card_eq_sum_ones, sum_filter],
  exact sum_comm.le,
end

/-- If every element belongs to at most `n` finsets, then the sum of their sizes is at most `n`
times how many they are. -/
lemma sum_card_le [fintype α] (h : ∀ a, (B.filter $ (∈) a).card ≤ n) :
  ∑ s in B, s.card ≤ fintype.card α * n :=
calc ∑ s in B, s.card = ∑ s in B, (univ ∩ s).card : by simp_rw univ_inter
                  ... ≤ fintype.card α * n        : sum_card_inter_le (λ a _, h a)

/-- If every element belongs to at least `n` finsets, then the sum of their sizes is at least `n`
times how many they are. -/
lemma le_sum_card_inter (h : ∀ a ∈ s, n ≤ (B.filter $ (∈) a).card) :
  s.card * n ≤ ∑ t in B, (s ∩ t).card :=
begin
  apply (s.le_sum_of_forall_le _ _ h).trans,
  simp_rw [←filter_mem_eq_inter, card_eq_sum_ones, sum_filter],
  exact sum_comm.le,
end

/-- If every element belongs to at least `n` finsets, then the sum of their sizes is at least `n`
times how many they are. -/
lemma le_sum_card [fintype α] (h : ∀ a, n ≤ (B.filter $ (∈) a).card) :
  fintype.card α * n ≤ ∑ s in B, s.card :=
calc fintype.card α * n ≤ ∑ s in B, (univ ∩ s).card : le_sum_card_inter (λ a _, h a)
                    ... = ∑ s in B, s.card          : by simp_rw univ_inter

/-- If every element belongs to exactly `n` finsets, then the sum of their sizes is `n` times how
many they are. -/
lemma sum_card_inter (h : ∀ a ∈ s, (B.filter $ (∈) a).card = n) :
  ∑ t in B, (s ∩ t).card = s.card * n :=
(sum_card_inter_le $ λ a ha, (h a ha).le).antisymm (le_sum_card_inter $ λ a ha, (h a ha).ge)

/-- If every element belongs to exactly `n` finsets, then the sum of their sizes is `n` times how
many they are. -/
lemma sum_card [fintype α] (h : ∀ a, (B.filter $ (∈) a).card = n) :
  ∑ s in B, s.card = fintype.card α * n :=
by simp_rw [fintype.card, ←sum_card_inter (λ a _, h a), univ_inter]

lemma card_le_card_bUnion {s : finset ι} {f : ι → finset α} (hs : (s : set ι).pairwise_disjoint f)
  (hf : ∀ i ∈ s, (f i).nonempty) :
  s.card ≤ (s.bUnion f).card :=
by { rw [card_bUnion hs, card_eq_sum_ones], exact sum_le_sum (λ i hi, (hf i hi).card_pos) }

lemma card_le_card_bUnion_add_card_fiber {s : finset ι} {f : ι → finset α}
  (hs : (s : set ι).pairwise_disjoint f) :
  s.card ≤ (s.bUnion f).card + (s.filter $ λ i, f i = ∅).card :=
begin
  rw [←finset.filter_card_add_filter_neg_card_eq_card (λ i, f i = ∅), add_comm],
  exact add_le_add_right ((card_le_card_bUnion (hs.subset $ filter_subset _ _) $ λ i hi,
    nonempty_of_ne_empty $ (mem_filter.1 hi).2).trans $ card_le_of_subset $
    bUnion_subset_bUnion_of_subset_left _ $ filter_subset _ _) _,
end

lemma card_le_card_bUnion_add_one {s : finset ι} {f : ι → finset α} (hf : injective f)
  (hs : (s : set ι).pairwise_disjoint f) :
  s.card ≤ (s.bUnion f).card + 1 :=
(card_le_card_bUnion_add_card_fiber hs).trans $ add_le_add_left (card_le_one.2 $ λ i hi j hj, hf $
  (mem_filter.1 hi).2.trans (mem_filter.1 hj).2.symm) _

end double_counting

section canonically_ordered_monoid

variables [canonically_ordered_monoid M] {f : ι → M} {s t : finset ι}

@[simp, to_additive sum_eq_zero_iff]
lemma prod_eq_one_iff' : ∏ x in s, f x = 1 ↔ ∀ x ∈ s, f x = 1 :=
prod_eq_one_iff_of_one_le' $ λ x hx, one_le (f x)

@[to_additive sum_le_sum_of_subset]
lemma prod_le_prod_of_subset' (h : s ⊆ t) : ∏ x in s, f x ≤ ∏ x in t, f x :=
prod_le_prod_of_subset_of_one_le' h $ assume x h₁ h₂, one_le _

@[to_additive sum_mono_set]
lemma prod_mono_set' (f : ι → M) : monotone (λ s, ∏ x in s, f x) :=
λ s₁ s₂ hs, prod_le_prod_of_subset' hs

@[to_additive sum_le_sum_of_ne_zero]
lemma prod_le_prod_of_ne_one' (h : ∀ x ∈ s, f x ≠ 1 → x ∈ t) :
  ∏ x in s, f x ≤ ∏ x in t, f x :=
by classical;
calc ∏ x in s, f x = (∏ x in s.filter (λ x, f x = 1), f x) * ∏ x in s.filter (λ x, f x ≠ 1), f x :
    by rw [← prod_union, filter_union_filter_neg_eq];
       exact disjoint_filter.2 (assume _ _ h n_h, n_h h)
  ... ≤ (∏ x in t, f x) : mul_le_of_le_one_of_le
      (prod_le_one' $ by simp only [mem_filter, and_imp]; exact λ _ _, le_of_eq)
      (prod_le_prod_of_subset' $ by simpa only [subset_iff, mem_filter, and_imp])

end canonically_ordered_monoid

section ordered_cancel_comm_monoid

variables [ordered_cancel_comm_monoid M] {f g : ι → M} {s t : finset ι}

@[to_additive sum_lt_sum]
theorem prod_lt_prod' (Hle : ∀ i ∈ s, f i ≤ g i) (Hlt : ∃ i ∈ s, f i < g i) :
  ∏ i in s, f i < ∏ i in s, g i :=
begin
  classical,
  rcases Hlt with ⟨i, hi, hlt⟩,
  rw [← insert_erase hi, prod_insert (not_mem_erase _ _), prod_insert (not_mem_erase _ _)],
  exact mul_lt_mul_of_lt_of_le hlt (prod_le_prod'' $ λ j hj, Hle j  $ mem_of_mem_erase hj)
end

@[to_additive sum_lt_sum_of_nonempty]
lemma prod_lt_prod_of_nonempty' (hs : s.nonempty) (Hlt : ∀ i ∈ s, f i < g i) :
  ∏ i in s, f i < ∏ i in s, g i :=
begin
  apply prod_lt_prod',
  { intros i hi, apply le_of_lt (Hlt i hi) },
  cases hs with i hi,
  exact ⟨i, hi, Hlt i hi⟩,
end

@[to_additive sum_lt_sum_of_subset]
lemma prod_lt_prod_of_subset' (h : s ⊆ t) {i : ι} (ht : i ∈ t) (hs : i ∉ s) (hlt : 1 < f i)
  (hle : ∀ j ∈ t, j ∉ s → 1 ≤ f j) :
  ∏ j in s, f j < ∏ j in t, f j :=
by classical;
calc ∏ j in s, f j < ∏ j in insert i s, f j :
begin
  rw prod_insert hs,
  exact lt_mul_of_one_lt_left' (∏ j in s, f j) hlt,
end
... ≤ ∏ j in t, f j :
begin
  apply prod_le_prod_of_subset_of_one_le',
  { simp [finset.insert_subset, h, ht] },
  { assume x hx h'x,
    simp only [mem_insert, not_or_distrib] at h'x,
    exact hle x hx h'x.2 }
end

@[to_additive single_lt_sum]
lemma single_lt_prod' {i j : ι} (hij : j ≠ i) (hi : i ∈ s) (hj : j ∈ s) (hlt : 1 < f j)
  (hle : ∀ k ∈ s, k ≠ i → 1 ≤ f k) :
  f i < ∏ k in s, f k :=
calc f i = ∏ k in {i}, f k : prod_singleton.symm
     ... < ∏ k in s, f k   :
  prod_lt_prod_of_subset' (singleton_subset_iff.2 hi) hj (mt mem_singleton.1 hij) hlt $
    λ k hks hki, hle k hks (mt mem_singleton.2 hki)

@[to_additive sum_pos] lemma one_lt_prod (h : ∀i ∈ s, 1 < f i) (hs : s.nonempty) :
  1 < (∏ i in s, f i) :=
lt_of_le_of_lt (by rw prod_const_one) $ prod_lt_prod_of_nonempty' hs h

@[to_additive] lemma prod_lt_one (h : ∀i ∈ s, f i < 1) (hs : s.nonempty) :
  (∏ i in s, f i) < 1 :=
(prod_lt_prod_of_nonempty' hs h).trans_le (by rw prod_const_one)

@[to_additive] lemma prod_eq_prod_iff_of_le {f g : ι → M} (h : ∀ i ∈ s, f i ≤ g i) :
  ∏ i in s, f i = ∏ i in s, g i ↔ ∀ i ∈ s, f i = g i :=
begin
  classical,
  revert h,
  refine finset.induction_on s (λ _, ⟨λ _ _, false.elim, λ _, rfl⟩) (λ a s ha ih H, _),
  specialize ih (λ i, H i ∘ finset.mem_insert_of_mem),
  rw [finset.prod_insert ha, finset.prod_insert ha, finset.forall_mem_insert, ←ih],
  exact mul_eq_mul_iff_eq_and_eq (H a (s.mem_insert_self a)) (finset.prod_le_prod''
    (λ i, H i ∘ finset.mem_insert_of_mem)),
end

end ordered_cancel_comm_monoid

section linear_ordered_cancel_comm_monoid

variables [linear_ordered_cancel_comm_monoid M] {f g : ι → M} {s t : finset ι}

@[to_additive exists_lt_of_sum_lt]
theorem exists_lt_of_prod_lt' (Hlt : ∏ i in s, f i < ∏ i in s, g i) :
  ∃ i ∈ s, f i < g i :=
begin
  contrapose! Hlt with Hle,
  exact prod_le_prod'' Hle
end

@[to_additive exists_le_of_sum_le]
theorem exists_le_of_prod_le' (hs : s.nonempty) (Hle : ∏ i in s, f i ≤ ∏ i in s, g i) :
  ∃ i ∈ s, f i ≤ g i :=
begin
  contrapose! Hle with Hlt,
  exact prod_lt_prod_of_nonempty' hs Hlt
end

@[to_additive exists_pos_of_sum_zero_of_exists_nonzero]
lemma exists_one_lt_of_prod_one_of_exists_ne_one' (f : ι → M)
  (h₁ : ∏ i in s, f i = 1) (h₂ : ∃ i ∈ s, f i ≠ 1) :
  ∃ i ∈ s, 1 < f i :=
begin
  contrapose! h₁,
  obtain ⟨i, m, i_ne⟩ : ∃ i ∈ s, f i ≠ 1 := h₂,
  apply ne_of_lt,
  calc ∏ j in s, f j < ∏ j in s, 1 : prod_lt_prod' h₁ ⟨i, m, (h₁ i m).lt_of_ne i_ne⟩
                 ... = 1           : prod_const_one
end

end linear_ordered_cancel_comm_monoid

section ordered_comm_semiring

variables [ordered_comm_semiring R] {f g : ι → R} {s t : finset ι}
open_locale classical

/- this is also true for a ordered commutative multiplicative monoid -/
lemma prod_nonneg (h0 : ∀ i ∈ s, 0 ≤ f i) : 0 ≤ ∏ i in s, f i :=
prod_induction f (λ i, 0 ≤ i) (λ _ _ ha hb, mul_nonneg ha hb) zero_le_one h0

/- this is also true for a ordered commutative multiplicative monoid -/
lemma prod_pos [nontrivial R] (h0 : ∀ i ∈ s, 0 < f i) :
  0 < ∏ i in s, f i :=
prod_induction f (λ x, 0 < x) (λ _ _ ha hb, mul_pos ha hb) zero_lt_one h0

/-- If all `f i`, `i ∈ s`, are nonnegative and each `f i` is less than or equal to `g i`, then the
product of `f i` is less than or equal to the product of `g i`. See also `finset.prod_le_prod''` for
the case of an ordered commutative multiplicative monoid. -/
lemma prod_le_prod (h0 : ∀ i ∈ s, 0 ≤ f i) (h1 : ∀ i ∈ s, f i ≤ g i) :
  ∏ i in s, f i ≤ ∏ i in s, g i :=
begin
  induction s using finset.induction with a s has ih h,
  { simp },
  { simp only [prod_insert has], apply mul_le_mul,
    { exact h1 a (mem_insert_self a s) },
    { apply ih (λ x H, h0 _ _) (λ x H, h1 _ _); exact (mem_insert_of_mem H) },
    { apply prod_nonneg (λ x H, h0 x (mem_insert_of_mem H)) },
    { apply le_trans (h0 a (mem_insert_self a s)) (h1 a (mem_insert_self a s)) } }
end

/-- If each `f i`, `i ∈ s` belongs to `[0, 1]`, then their product is less than or equal to one.
See also `finset.prod_le_one'` for the case of an ordered commutative multiplicative monoid. -/
lemma prod_le_one (h0 : ∀ i ∈ s, 0 ≤ f i) (h1 : ∀ i ∈ s, f i ≤ 1) :
  ∏ i in s, f i ≤ 1 :=
begin
  convert ← prod_le_prod h0 h1,
  exact finset.prod_const_one
end

/-- If `g, h ≤ f` and `g i + h i ≤ f i`, then the product of `f` over `s` is at least the
  sum of the products of `g` and `h`. This is the version for `ordered_comm_semiring`. -/
lemma prod_add_prod_le {i : ι} {f g h : ι → R}
  (hi : i ∈ s) (h2i : g i + h i ≤ f i) (hgf : ∀ j ∈ s, j ≠ i → g j ≤ f j)
  (hhf : ∀ j ∈ s, j ≠ i → h j ≤ f j) (hg : ∀ i ∈ s, 0 ≤ g i) (hh : ∀ i ∈ s, 0 ≤ h i) :
  ∏ i in s, g i + ∏ i in s, h i ≤ ∏ i in s, f i :=
begin
  simp_rw [prod_eq_mul_prod_diff_singleton hi],
  refine le_trans _ (mul_le_mul_of_nonneg_right h2i _),
  { rw [right_distrib],
    apply add_le_add; apply mul_le_mul_of_nonneg_left; try { apply_assumption; assumption };
      apply prod_le_prod; simp * { contextual := tt } },
  { apply prod_nonneg, simp only [and_imp, mem_sdiff, mem_singleton],
    intros j h1j h2j, exact le_trans (hg j h1j) (hgf j h1j h2j) }
end

end ordered_comm_semiring

section canonically_ordered_comm_semiring

variables [canonically_ordered_comm_semiring R] {f g h : ι → R} {s : finset ι} {i : ι}

lemma prod_le_prod' (h : ∀ i ∈ s, f i ≤ g i) :
  ∏ i in s, f i ≤ ∏ i in s, g i :=
begin
  classical,
  induction s using finset.induction with a s has ih h,
  { simp },
  { rw [finset.prod_insert has, finset.prod_insert has],
    apply mul_le_mul',
    { exact h _ (finset.mem_insert_self a s) },
    { exact ih (λ i hi, h _ (finset.mem_insert_of_mem hi)) } }
end

/-- If `g, h ≤ f` and `g i + h i ≤ f i`, then the product of `f` over `s` is at least the
  sum of the products of `g` and `h`. This is the version for `canonically_ordered_comm_semiring`.
-/
lemma prod_add_prod_le' (hi : i ∈ s) (h2i : g i + h i ≤ f i)
  (hgf : ∀ j ∈ s, j ≠ i → g j ≤ f j) (hhf : ∀ j ∈ s, j ≠ i → h j ≤ f j) :
  ∏ i in s, g i + ∏ i in s, h i ≤ ∏ i in s, f i :=
begin
  classical, simp_rw [prod_eq_mul_prod_diff_singleton hi],
  refine le_trans _ (mul_le_mul_right' h2i _),
  rw [right_distrib],
  apply add_le_add; apply mul_le_mul_left'; apply prod_le_prod';
  simp only [and_imp, mem_sdiff, mem_singleton]; intros; apply_assumption; assumption
end

end canonically_ordered_comm_semiring

end finset

namespace fintype

variables [fintype ι]

@[to_additive sum_mono, mono]
lemma prod_mono' [ordered_comm_monoid M] : monotone (λ f : ι → M, ∏ i, f i) :=
λ f g hfg, finset.prod_le_prod'' $ λ x _, hfg x

attribute [mono] sum_mono

@[to_additive sum_strict_mono]
lemma prod_strict_mono' [ordered_cancel_comm_monoid M] : strict_mono (λ f : ι → M, ∏ x, f x) :=
λ f g hfg, let ⟨hle, i, hlt⟩ := pi.lt_def.mp hfg in
  finset.prod_lt_prod' (λ i _, hle i) ⟨i, finset.mem_univ i, hlt⟩

end fintype

namespace with_top
open finset

/-- A product of finite numbers is still finite -/
lemma prod_lt_top [canonically_ordered_comm_semiring R] [nontrivial R] [decidable_eq R]
  {s : finset ι} {f : ι → with_top R} (h : ∀ i ∈ s, f i ≠ ⊤) :
  ∏ i in s, f i < ⊤ :=
prod_induction f (λ a, a < ⊤) (λ a b h₁ h₂, mul_lt_top h₁.ne h₂.ne) (coe_lt_top 1) $
  λ a ha, lt_top_iff_ne_top.2 (h a ha)

/-- A sum of finite numbers is still finite -/
lemma sum_lt_top [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M}
  (h : ∀ i ∈ s, f i ≠ ⊤) : (∑ i in s, f i) < ⊤ :=
sum_induction f (λ a, a < ⊤) (λ a b h₁ h₂, add_lt_top.2 ⟨h₁, h₂⟩) zero_lt_top $
  λ i hi, lt_top_iff_ne_top.2 (h i hi)

/-- A sum of numbers is infinite iff one of them is infinite -/
lemma sum_eq_top_iff [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M} :
  ∑ i in s, f i = ⊤ ↔ ∃ i ∈ s, f i = ⊤ :=
begin
  classical,
  split,
  { contrapose!,
    exact λ h, (sum_lt_top $ λ i hi, (h i hi)).ne },
  { rintro ⟨i, his, hi⟩,
    rw [sum_eq_add_sum_diff_singleton his, hi, top_add] }
end

/-- A sum of finite numbers is still finite -/
lemma sum_lt_top_iff [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M} :
  ∑ i in s, f i < ⊤ ↔ ∀ i ∈ s, f i < ⊤ :=
by simp only [lt_top_iff_ne_top, ne.def, sum_eq_top_iff, not_exists]

end with_top

section absolute_value

variables {S : Type*}

lemma absolute_value.sum_le [semiring R] [ordered_semiring S]
  (abv : absolute_value R S) (s : finset ι) (f : ι → R) :
  abv (∑ i in s, f i) ≤ ∑ i in s, abv (f i) :=
begin
  letI := classical.dec_eq ι,
  refine finset.induction_on s _ (λ i s hi ih, _),
  { simp },
  { simp only [finset.sum_insert hi],
  exact (abv.add_le _ _).trans (add_le_add le_rfl ih) },
end

lemma is_absolute_value.abv_sum [semiring R] [ordered_semiring S] (abv : R → S)
  [is_absolute_value abv] (f : ι → R) (s : finset ι) :
  abv (∑ i in s, f i) ≤ ∑ i in s, abv (f i) :=
(is_absolute_value.to_absolute_value abv).sum_le _ _

lemma absolute_value.map_prod [comm_semiring R] [nontrivial R] [linear_ordered_comm_ring S]
  (abv : absolute_value R S) (f : ι → R) (s : finset ι) :
  abv (∏ i in s, f i) = ∏ i in s, abv (f i) :=
abv.to_monoid_hom.map_prod f s

lemma is_absolute_value.map_prod [comm_semiring R] [nontrivial R] [linear_ordered_comm_ring S]
  (abv : R → S) [is_absolute_value abv] (f : ι → R) (s : finset ι) :
  abv (∏ i in s, f i) = ∏ i in s, abv (f i) :=
(is_absolute_value.to_absolute_value abv).map_prod _ _

end absolute_value


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

! This file was ported from Lean 3 source module measure_theory.group.integration
! leanprover-community/mathlib commit ec247d43814751ffceb33b758e8820df2372bf6f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Integral.Bochner
import Mathbin.MeasureTheory.Group.Measure
import Mathbin.MeasureTheory.Group.Action

/-!
# Integration on Groups

We develop properties of integrals with a group as domain.
This file contains properties about integrability, Lebesgue integration and Bochner integration.
-/

namespace MeasureTheory

open Measure TopologicalSpace

open ENNReal

variable {𝕜 M α G E F : Type _} [MeasurableSpace G]

variable [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E] [NormedAddCommGroup F]

variable {μ : Measure G} {f : G → E} {g : G}

section MeasurableInv

variable [Group G] [HasMeasurableInv G]

@[to_additive]
theorem Integrable.compInv [IsInvInvariant μ] {f : G → F} (hf : Integrable f μ) :
    Integrable (fun t => f t⁻¹) μ :=
  (hf.monoMeasure (map_inv_eq_self μ).le).compMeasurable measurable_inv
#align measure_theory.integrable.comp_inv MeasureTheory.Integrable.compInv
#align measure_theory.integrable.comp_neg MeasureTheory.Integrable.comp_neg

@[to_additive]
theorem integral_inv_eq_self (f : G → E) (μ : Measure G) [IsInvInvariant μ] :
    (∫ x, f x⁻¹ ∂μ) = ∫ x, f x ∂μ :=
  by
  have h : MeasurableEmbedding fun x : G => x⁻¹ := (MeasurableEquiv.inv G).MeasurableEmbedding
  rw [← h.integral_map, map_inv_eq_self]
#align measure_theory.integral_inv_eq_self MeasureTheory.integral_inv_eq_self
#align measure_theory.integral_neg_eq_self MeasureTheory.integral_neg_eq_self

end MeasurableInv

section MeasurableMul

variable [Group G] [HasMeasurableMul G]

/-- Translating a function by left-multiplication does not change its `measure_theory.lintegral`
with respect to a left-invariant measure. -/
@[to_additive
      "Translating a function by left-addition does not change its\n`measure_theory.lintegral` with respect to a left-invariant measure."]
theorem lintegral_mul_left_eq_self [IsMulLeftInvariant μ] (f : G → ℝ≥0∞) (g : G) :
    (∫⁻ x, f (g * x) ∂μ) = ∫⁻ x, f x ∂μ :=
  by
  convert(lintegral_map_equiv f <| MeasurableEquiv.mulLeft g).symm
  simp [map_mul_left_eq_self μ g]
#align measure_theory.lintegral_mul_left_eq_self MeasureTheory.lintegral_mul_left_eq_self
#align measure_theory.lintegral_add_left_eq_self MeasureTheory.lintegral_add_left_eq_self

/-- Translating a function by right-multiplication does not change its `measure_theory.lintegral`
with respect to a right-invariant measure. -/
@[to_additive
      "Translating a function by right-addition does not change its\n`measure_theory.lintegral` with respect to a right-invariant measure."]
theorem lintegral_mul_right_eq_self [IsMulRightInvariant μ] (f : G → ℝ≥0∞) (g : G) :
    (∫⁻ x, f (x * g) ∂μ) = ∫⁻ x, f x ∂μ :=
  by
  convert(lintegral_map_equiv f <| MeasurableEquiv.mulRight g).symm
  simp [map_mul_right_eq_self μ g]
#align measure_theory.lintegral_mul_right_eq_self MeasureTheory.lintegral_mul_right_eq_self
#align measure_theory.lintegral_add_right_eq_self MeasureTheory.lintegral_add_right_eq_self

@[simp, to_additive]
theorem lintegral_div_right_eq_self [IsMulRightInvariant μ] (f : G → ℝ≥0∞) (g : G) :
    (∫⁻ x, f (x / g) ∂μ) = ∫⁻ x, f x ∂μ := by
  simp_rw [div_eq_mul_inv, lintegral_mul_right_eq_self f g⁻¹]
#align measure_theory.lintegral_div_right_eq_self MeasureTheory.lintegral_div_right_eq_self
#align measure_theory.lintegral_sub_right_eq_self MeasureTheory.lintegral_sub_right_eq_self

/-- Translating a function by left-multiplication does not change its integral with respect to a
left-invariant measure. -/
@[simp,
  to_additive
      "Translating a function by left-addition does not change its integral with\n  respect to a left-invariant measure."]
theorem integral_mul_left_eq_self [IsMulLeftInvariant μ] (f : G → E) (g : G) :
    (∫ x, f (g * x) ∂μ) = ∫ x, f x ∂μ :=
  by
  have h_mul : MeasurableEmbedding fun x => g * x := (MeasurableEquiv.mulLeft g).MeasurableEmbedding
  rw [← h_mul.integral_map, map_mul_left_eq_self]
#align measure_theory.integral_mul_left_eq_self MeasureTheory.integral_mul_left_eq_self
#align measure_theory.integral_add_left_eq_self MeasureTheory.integral_add_left_eq_self

/-- Translating a function by right-multiplication does not change its integral with respect to a
right-invariant measure. -/
@[simp,
  to_additive
      "Translating a function by right-addition does not change its integral with\n  respect to a right-invariant measure."]
theorem integral_mul_right_eq_self [IsMulRightInvariant μ] (f : G → E) (g : G) :
    (∫ x, f (x * g) ∂μ) = ∫ x, f x ∂μ :=
  by
  have h_mul : MeasurableEmbedding fun x => x * g :=
    (MeasurableEquiv.mulRight g).MeasurableEmbedding
  rw [← h_mul.integral_map, map_mul_right_eq_self]
#align measure_theory.integral_mul_right_eq_self MeasureTheory.integral_mul_right_eq_self
#align measure_theory.integral_add_right_eq_self MeasureTheory.integral_add_right_eq_self

@[simp, to_additive]
theorem integral_div_right_eq_self [IsMulRightInvariant μ] (f : G → E) (g : G) :
    (∫ x, f (x / g) ∂μ) = ∫ x, f x ∂μ := by
  simp_rw [div_eq_mul_inv, integral_mul_right_eq_self f g⁻¹]
#align measure_theory.integral_div_right_eq_self MeasureTheory.integral_div_right_eq_self
#align measure_theory.integral_sub_right_eq_self MeasureTheory.integral_sub_right_eq_self

/-- If some left-translate of a function negates it, then the integral of the function with respect
to a left-invariant measure is 0. -/
@[to_additive
      "If some left-translate of a function negates it, then the integral of the function\nwith respect to a left-invariant measure is 0."]
theorem integral_eq_zero_of_mul_left_eq_neg [IsMulLeftInvariant μ] (hf' : ∀ x, f (g * x) = -f x) :
    (∫ x, f x ∂μ) = 0 := by
  simp_rw [← self_eq_neg ℝ E, ← integral_neg, ← hf', integral_mul_left_eq_self]
#align measure_theory.integral_eq_zero_of_mul_left_eq_neg MeasureTheory.integral_eq_zero_of_mul_left_eq_neg
#align measure_theory.integral_eq_zero_of_add_left_eq_neg MeasureTheory.integral_eq_zero_of_add_left_eq_neg

/-- If some right-translate of a function negates it, then the integral of the function with respect
to a right-invariant measure is 0. -/
@[to_additive
      "If some right-translate of a function negates it, then the integral of the function\nwith respect to a right-invariant measure is 0."]
theorem integral_eq_zero_of_mul_right_eq_neg [IsMulRightInvariant μ] (hf' : ∀ x, f (x * g) = -f x) :
    (∫ x, f x ∂μ) = 0 := by
  simp_rw [← self_eq_neg ℝ E, ← integral_neg, ← hf', integral_mul_right_eq_self]
#align measure_theory.integral_eq_zero_of_mul_right_eq_neg MeasureTheory.integral_eq_zero_of_mul_right_eq_neg
#align measure_theory.integral_eq_zero_of_add_right_eq_neg MeasureTheory.integral_eq_zero_of_add_right_eq_neg

@[to_additive]
theorem Integrable.compMulLeft {f : G → F} [IsMulLeftInvariant μ] (hf : Integrable f μ) (g : G) :
    Integrable (fun t => f (g * t)) μ :=
  (hf.monoMeasure (map_mul_left_eq_self μ g).le).compMeasurable <| measurable_const_mul g
#align measure_theory.integrable.comp_mul_left MeasureTheory.Integrable.compMulLeft
#align measure_theory.integrable.comp_add_left MeasureTheory.Integrable.comp_add_left

@[to_additive]
theorem Integrable.compMulRight {f : G → F} [IsMulRightInvariant μ] (hf : Integrable f μ) (g : G) :
    Integrable (fun t => f (t * g)) μ :=
  (hf.monoMeasure (map_mul_right_eq_self μ g).le).compMeasurable <| measurable_mul_const g
#align measure_theory.integrable.comp_mul_right MeasureTheory.Integrable.compMulRight
#align measure_theory.integrable.comp_add_right MeasureTheory.Integrable.comp_add_right

@[to_additive]
theorem Integrable.compDivRight {f : G → F} [IsMulRightInvariant μ] (hf : Integrable f μ) (g : G) :
    Integrable (fun t => f (t / g)) μ :=
  by
  simp_rw [div_eq_mul_inv]
  exact hf.comp_mul_right g⁻¹
#align measure_theory.integrable.comp_div_right MeasureTheory.Integrable.compDivRight
#align measure_theory.integrable.comp_sub_right MeasureTheory.Integrable.comp_sub_right

variable [HasMeasurableInv G]

@[to_additive]
theorem Integrable.compDivLeft {f : G → F} [IsInvInvariant μ] [IsMulLeftInvariant μ]
    (hf : Integrable f μ) (g : G) : Integrable (fun t => f (g / t)) μ :=
  ((measurePreservingDivLeft μ g).integrable_comp hf.AeStronglyMeasurable).mpr hf
#align measure_theory.integrable.comp_div_left MeasureTheory.Integrable.compDivLeft
#align measure_theory.integrable.comp_sub_left MeasureTheory.Integrable.comp_sub_left

@[simp, to_additive]
theorem integrable_comp_div_left (f : G → F) [IsInvInvariant μ] [IsMulLeftInvariant μ] (g : G) :
    Integrable (fun t => f (g / t)) μ ↔ Integrable f μ :=
  by
  refine' ⟨fun h => _, fun h => h.compDivLeft g⟩
  convert h.comp_inv.comp_mul_left g⁻¹
  simp_rw [div_inv_eq_mul, mul_inv_cancel_left]
#align measure_theory.integrable_comp_div_left MeasureTheory.integrable_comp_div_left
#align measure_theory.integrable_comp_sub_left MeasureTheory.integrable_comp_sub_left

@[simp, to_additive]
theorem integral_div_left_eq_self (f : G → E) (μ : Measure G) [IsInvInvariant μ]
    [IsMulLeftInvariant μ] (x' : G) : (∫ x, f (x' / x) ∂μ) = ∫ x, f x ∂μ := by
  simp_rw [div_eq_mul_inv, integral_inv_eq_self (fun x => f (x' * x)) μ,
    integral_mul_left_eq_self f x']
#align measure_theory.integral_div_left_eq_self MeasureTheory.integral_div_left_eq_self
#align measure_theory.integral_sub_left_eq_self MeasureTheory.integral_sub_left_eq_self

end MeasurableMul

section Smul

variable [Group G] [MeasurableSpace α] [MulAction G α] [HasMeasurableSmul G α]

@[simp, to_additive]
theorem integral_smul_eq_self {μ : Measure α} [SmulInvariantMeasure G α μ] (f : α → E) {g : G} :
    (∫ x, f (g • x) ∂μ) = ∫ x, f x ∂μ :=
  by
  have h : MeasurableEmbedding fun x : α => g • x := (MeasurableEquiv.smul g).MeasurableEmbedding
  rw [← h.integral_map, map_smul]
#align measure_theory.integral_smul_eq_self MeasureTheory.integral_smul_eq_self
#align measure_theory.integral_vadd_eq_self MeasureTheory.integral_vadd_eq_self

end Smul

section TopologicalGroup

variable [TopologicalSpace G] [Group G] [TopologicalGroup G] [BorelSpace G] [IsMulLeftInvariant μ]

/-- For nonzero regular left invariant measures, the integral of a continuous nonnegative function
  `f` is 0 iff `f` is 0. -/
@[to_additive
      "For nonzero regular left invariant measures, the integral of a continuous nonnegative\nfunction `f` is 0 iff `f` is 0."]
theorem lintegral_eq_zero_of_isMulLeftInvariant [Regular μ] (hμ : μ ≠ 0) {f : G → ℝ≥0∞}
    (hf : Continuous f) : (∫⁻ x, f x ∂μ) = 0 ↔ f = 0 :=
  by
  haveI := is_open_pos_measure_of_mul_left_invariant_of_regular hμ
  rw [lintegral_eq_zero_iff hf.measurable, hf.ae_eq_iff_eq μ continuous_zero]
#align measure_theory.lintegral_eq_zero_of_is_mul_left_invariant MeasureTheory.lintegral_eq_zero_of_isMulLeftInvariant
#align measure_theory.lintegral_eq_zero_of_is_add_left_invariant MeasureTheory.lintegral_eq_zero_of_is_add_left_invariant

end TopologicalGroup

end MeasureTheory


/-
Copyright (c) 2021 Stuart Presnell. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stuart Presnell
-/
import algebra.big_operators.finsupp
import data.finsupp.multiset
import data.nat.prime_fin
import number_theory.padics.padic_val
import data.nat.interval
import tactic.interval_cases

/-!
# Prime factorizations

 `n.factorization` is the finitely supported function `ℕ →₀ ℕ`
 mapping each prime factor of `n` to its multiplicity in `n`.  For example, since 2000 = 2^4 * 5^3,
  * `factorization 2000 2` is 4
  * `factorization 2000 5` is 3
  * `factorization 2000 k` is 0 for all other `k : ℕ`.

## TODO

* As discussed in this Zulip thread:
https://leanprover.zulipchat.com/#narrow/stream/217875/topic/Multiplicity.20in.20the.20naturals
We have lots of disparate ways of talking about the multiplicity of a prime
in a natural number, including `factors.count`, `padic_val_nat`, `multiplicity`,
and the material in `data/pnat/factors`.  Move some of this material to this file,
prove results about the relationships between these definitions,
and (where appropriate) choose a uniform canonical way of expressing these ideas.

* Moreover, the results here should be generalised to an arbitrary unique factorization monoid
with a normalization function, and then deduplicated.  The basics of this have been started in
`ring_theory/unique_factorization_domain`.

* Extend the inductions to any `normalization_monoid` with unique factorization.

-/

open nat finset list finsupp
open_locale big_operators

namespace nat

/-- `n.factorization` is the finitely supported function `ℕ →₀ ℕ`
 mapping each prime factor of `n` to its multiplicity in `n`. -/
def factorization (n : ℕ) : ℕ →₀ ℕ :=
{ support := n.factors.to_finset,
  to_fun := λ p, if p.prime then padic_val_nat p n else 0,
  mem_support_to_fun :=
      begin
        rcases eq_or_ne n 0 with rfl | hn0, { simp },
        simp only [mem_factors hn0, mem_to_finset, ne.def, ite_eq_right_iff, not_forall,
          exists_prop, and.congr_right_iff],
        rintro p hp,
        haveI := fact_iff.mpr hp,
        exact dvd_iff_padic_val_nat_ne_zero hn0,
      end }

lemma factorization_def (n : ℕ) {p : ℕ} (pp : p.prime) : n.factorization p = padic_val_nat p n :=
by simpa [factorization] using absurd pp

/-- We can write both `n.factorization p` and `n.factors.count p` to represent the power
of `p` in the factorization of `n`: we declare the former to be the simp-normal form. -/
@[simp] lemma factors_count_eq {n p : ℕ} : n.factors.count p = n.factorization p :=
begin
  rcases n.eq_zero_or_pos with rfl | hn0, { simp [factorization] },
  by_cases pp : p.prime, swap,
  { rw count_eq_zero_of_not_mem (mt prime_of_mem_factors pp), simp [factorization, pp] },
  simp only [factorization, coe_mk, pp, if_true],
  rw [←part_enat.coe_inj, padic_val_nat_def' pp.ne_one hn0,
    unique_factorization_monoid.multiplicity_eq_count_normalized_factors pp hn0.ne'],
  simp [factors_eq],
end

lemma factorization_eq_factors_multiset (n : ℕ) :
  n.factorization = (n.factors : multiset ℕ).to_finsupp :=
by { ext p, simp }

lemma multiplicity_eq_factorization {n p : ℕ} (pp : p.prime) (hn : n ≠ 0) :
  multiplicity p n = n.factorization p :=
by simp [factorization, pp, (padic_val_nat_def' pp.ne_one hn.bot_lt)]

/-! ### Basic facts about factorization -/

@[simp] lemma factorization_prod_pow_eq_self {n : ℕ} (hn : n ≠ 0) : n.factorization.prod pow = n :=
begin
  rw factorization_eq_factors_multiset n,
  simp only [←prod_to_multiset, factorization, multiset.coe_prod, multiset.to_finsupp_to_multiset],
  exact prod_factors hn,
end

lemma eq_of_factorization_eq {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0)
  (h : ∀ p : ℕ, a.factorization p = b.factorization p) : a = b :=
eq_of_perm_factors ha hb (by simpa only [list.perm_iff_count, factors_count_eq] using h)

/-- Every nonzero natural number has a unique prime factorization -/
lemma factorization_inj : set.inj_on factorization { x : ℕ | x ≠ 0 } :=
λ a ha b hb h, eq_of_factorization_eq ha hb (λ p, by simp [h])

@[simp] lemma factorization_zero : factorization 0 = 0 :=
by simpa [factorization]

@[simp] lemma factorization_one : factorization 1 = 0 :=
by simpa [factorization]

/-- The support of `n.factorization` is exactly `n.factors.to_finset` -/
@[simp] lemma support_factorization {n : ℕ} : n.factorization.support = n.factors.to_finset :=
by simp [factorization]

lemma factor_iff_mem_factorization {n p : ℕ} : p ∈ n.factorization.support ↔ p ∈ n.factors :=
by simp only [support_factorization, list.mem_to_finset]

lemma prime_of_mem_factorization {n p : ℕ} (hp : p ∈ n.factorization.support) : p.prime :=
prime_of_mem_factors (factor_iff_mem_factorization.mp hp)

lemma pos_of_mem_factorization {n p : ℕ} (hp : p ∈ n.factorization.support) : 0 < p :=
prime.pos (prime_of_mem_factorization hp)

lemma le_of_mem_factorization {n p : ℕ} (h : p ∈ n.factorization.support) : p ≤ n :=
le_of_mem_factors (factor_iff_mem_factorization.mp h)

/-! ## Lemmas characterising when `n.factorization p = 0` -/

lemma factorization_eq_zero_iff (n p : ℕ) :
  n.factorization p = 0 ↔ ¬p.prime ∨ ¬p ∣ n ∨ n = 0 :=
begin
  rw [←not_mem_support_iff, support_factorization, mem_to_finset],
  rcases eq_or_ne n 0 with rfl | hn,
  { simp },
  { simp [hn, nat.mem_factors, not_and_distrib] },
end

@[simp]
lemma factorization_eq_zero_of_non_prime (n : ℕ) {p : ℕ} (hp : ¬p.prime) : n.factorization p = 0 :=
by simp [factorization_eq_zero_iff, hp]

lemma factorization_eq_zero_of_not_dvd {n p : ℕ} (h : ¬ p ∣ n) : n.factorization p = 0 :=
by simp [factorization_eq_zero_iff, h]

lemma factorization_eq_zero_of_lt {n p : ℕ} (h : n < p) : n.factorization p = 0 :=
finsupp.not_mem_support_iff.mp (mt le_of_mem_factorization (not_le_of_lt h))

@[simp] lemma factorization_zero_right (n : ℕ) : n.factorization 0 = 0 :=
factorization_eq_zero_of_non_prime _ not_prime_zero

@[simp] lemma factorization_one_right (n : ℕ) : n.factorization 1 = 0 :=
factorization_eq_zero_of_non_prime _ not_prime_one

lemma dvd_of_factorization_pos {n p : ℕ} (hn : n.factorization p ≠ 0) : p ∣ n :=
dvd_of_mem_factors (factor_iff_mem_factorization.1 (mem_support_iff.2 hn))

lemma prime.factorization_pos_of_dvd {n p : ℕ} (hp : p.prime) (hn : n ≠ 0) (h : p ∣ n) :
  0 < n.factorization p :=
by rwa [←factors_count_eq, count_pos, mem_factors_iff_dvd hn hp]

lemma factorization_eq_zero_of_remainder {p r : ℕ} (i : ℕ) (hr : ¬ p ∣ r) :
  (p * i + r).factorization p = 0 :=
by { apply factorization_eq_zero_of_not_dvd, rwa ←nat.dvd_add_iff_right (dvd.intro i rfl) }

lemma factorization_eq_zero_iff_remainder {p r : ℕ} (i : ℕ) (pp : p.prime) (hr0 : r ≠ 0) :
  (¬ p ∣ r) ↔ (p * i + r).factorization p = 0 :=
begin
  refine ⟨factorization_eq_zero_of_remainder i, λ h, _⟩,
  rw factorization_eq_zero_iff at h,
  contrapose! h,
  refine ⟨pp, _, _⟩,
  { rwa ←nat.dvd_add_iff_right ((dvd.intro i rfl)) },
  { contrapose! hr0, exact (_root_.add_eq_zero_iff.mp hr0).2 },
end

/-- The only numbers with empty prime factorization are `0` and `1` -/
lemma factorization_eq_zero_iff' (n : ℕ) : n.factorization = 0 ↔ n = 0 ∨ n = 1 :=
begin
  rw factorization_eq_factors_multiset n,
  simp [factorization, add_equiv.map_eq_zero_iff, multiset.coe_eq_zero],
end

/-! ## Lemmas about factorizations of products and powers -/

/-- For nonzero `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/
@[simp] lemma factorization_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
  (a * b).factorization = a.factorization + b.factorization :=
by { ext p, simp only [add_apply, ←factors_count_eq,
                       perm_iff_count.mp (perm_factors_mul ha hb) p, count_append] }

lemma factorization_mul_support {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
  (a * b).factorization.support = a.factorization.support ∪ b.factorization.support :=
begin
  ext q,
  simp only [finset.mem_union, factor_iff_mem_factorization],
  exact mem_factors_mul ha hb
end

/-- If a product over `n.factorization` doesn't use the multiplicities of the prime factors
then it's equal to the corresponding product over `n.factors.to_finset` -/
lemma prod_factorization_eq_prod_factors {n : ℕ} {β : Type*} [comm_monoid β] (f : ℕ → β) :
  n.factorization.prod (λ p k, f p) = ∏ p in n.factors.to_finset, (f p) :=
by { apply prod_congr support_factorization, simp }

/-- For any `p : ℕ` and any function `g : α → ℕ` that's non-zero on `S : finset α`,
the power of `p` in `S.prod g` equals the sum over `x ∈ S` of the powers of `p` in `g x`.
Generalises `factorization_mul`, which is the special case where `S.card = 2` and `g = id`. -/
lemma factorization_prod {α : Type*} {S : finset α} {g : α → ℕ} (hS : ∀ x ∈ S, g x ≠ 0) :
  (S.prod g).factorization = S.sum (λ x, (g x).factorization) :=
begin
  classical,
  ext p,
  apply finset.induction_on' S, { simp },
  { intros x T hxS hTS hxT IH,
    have hT : T.prod g ≠ 0 := prod_ne_zero_iff.mpr (λ x hx, hS x (hTS hx)),
    simp [prod_insert hxT, sum_insert hxT, ←IH, factorization_mul (hS x hxS) hT] }
end

/-- For any `p`, the power of `p` in `n^k` is `k` times the power in `n` -/
@[simp] lemma factorization_pow (n k : ℕ) :
  factorization (n^k) = k • n.factorization :=
begin
  induction k with k ih, { simp },
  rcases eq_or_ne n 0 with rfl | hn, { simp },
  rw [pow_succ, factorization_mul hn (pow_ne_zero _ hn), ih, succ_eq_one_add, add_smul, one_smul],
end

/-! ## Lemmas about factorizations of primes and prime powers -/

/-- The only prime factor of prime `p` is `p` itself, with multiplicity `1` -/
@[simp] lemma prime.factorization {p : ℕ} (hp : prime p) :
  p.factorization = single p 1 :=
begin
  ext q,
  rw [←factors_count_eq, factors_prime hp, single_apply, count_singleton', if_congr eq_comm];
  refl,
end

/-- The multiplicity of prime `p` in `p` is `1` -/
@[simp] lemma prime.factorization_self {p : ℕ} (hp : prime p) : p.factorization p = 1 :=
by simp [hp]

/-- For prime `p` the only prime factor of `p^k` is `p` with multiplicity `k` -/
lemma prime.factorization_pow {p k : ℕ} (hp : prime p) :
  factorization (p ^ k) = single p k :=
by simp [hp]

/-- If the factorization of `n` contains just one number `p` then `n` is a power of `p` -/
lemma eq_pow_of_factorization_eq_single {n p k : ℕ} (hn : n ≠ 0)
  (h : n.factorization = finsupp.single p k) : n = p ^ k :=
by { rw [←nat.factorization_prod_pow_eq_self hn, h], simp }

/-- The only prime factor of prime `p` is `p` itself. -/
lemma prime.eq_of_factorization_pos {p q : ℕ} (hp : prime p) (h : p.factorization q ≠ 0) :
  p = q :=
by simpa [hp.factorization, single_apply] using h

/-! ### Equivalence between `ℕ+` and `ℕ →₀ ℕ` with support in the primes. -/

/-- Any finsupp `f : ℕ →₀ ℕ` whose support is in the primes is equal to the factorization of
the product `∏ (a : ℕ) in f.support, a ^ f a`. -/
lemma prod_pow_factorization_eq_self {f : ℕ →₀ ℕ} (hf : ∀ (p : ℕ), p ∈ f.support → prime p) :
  (f.prod pow).factorization = f :=
begin
  have h : ∀ x : ℕ, x ∈ f.support → x ^ f x ≠ 0 := λ p hp, pow_ne_zero _ (prime.ne_zero (hf p hp)),
  simp only [finsupp.prod, factorization_prod h],
  nth_rewrite_rhs 0 (sum_single f).symm,
  exact sum_congr rfl (λ p hp, prime.factorization_pow (hf p hp)),
end

lemma eq_factorization_iff {n : ℕ} {f : ℕ →₀ ℕ} (hn : n ≠ 0) (hf : ∀ p ∈ f.support, prime p) :
  f = n.factorization ↔ f.prod pow = n :=
⟨λ h, by rw [h, factorization_prod_pow_eq_self hn],
 λ h, by rw [←h, prod_pow_factorization_eq_self hf]⟩

/-- The equiv between `ℕ+` and `ℕ →₀ ℕ` with support in the primes. -/
def factorization_equiv : ℕ+ ≃ {f : ℕ →₀ ℕ | ∀ p ∈ f.support, prime p} :=
{ to_fun    := λ ⟨n, hn⟩, ⟨n.factorization, λ _, prime_of_mem_factorization⟩,
  inv_fun   := λ ⟨f, hf⟩, ⟨f.prod pow,
    prod_pow_pos_of_zero_not_mem_support (λ H, not_prime_zero (hf 0 H))⟩,
  left_inv  := λ ⟨x, hx⟩, subtype.ext $ factorization_prod_pow_eq_self hx.ne.symm,
  right_inv := λ ⟨f, hf⟩, subtype.ext $ prod_pow_factorization_eq_self hf }

lemma factorization_equiv_apply (n : ℕ+) : (factorization_equiv n).1 = n.1.factorization :=
by { cases n, refl }

lemma factorization_equiv_inv_apply {f : ℕ →₀ ℕ} (hf : ∀ p ∈ f.support, prime p) :
  (factorization_equiv.symm ⟨f, hf⟩).1 = f.prod pow := rfl

/-! ### Generalisation of the "even part" and "odd part" of a natural number

We introduce the notations `ord_proj[p] n` for the largest power of the prime `p` that
divides `n` and `ord_compl[p] n` for the complementary part. The `ord` naming comes from
the $p$-adic order/valuation of a number, and `proj` and `compl` are for the projection and
complementary projection. The term `n.factorization p` is the $p$-adic order itself.
For example, `ord_proj[2] n` is the even part of `n` and `ord_compl[2] n` is the odd part. -/

notation `ord_proj[` p `] ` n:max := p ^ (nat.factorization n p)
notation `ord_compl[` p `] ` n:max := n / ord_proj[p] n

@[simp] lemma ord_proj_of_not_prime (n p : ℕ) (hp : ¬ p.prime) : ord_proj[p] n = 1 :=
by simp [factorization_eq_zero_of_non_prime n hp]

@[simp] lemma ord_compl_of_not_prime (n p : ℕ) (hp : ¬ p.prime) : ord_compl[p] n = n :=
by simp [factorization_eq_zero_of_non_prime n hp]

lemma ord_proj_dvd (n p : ℕ) : ord_proj[p] n ∣ n :=
begin
  by_cases hp : p.prime, swap, { simp [hp] },
  rw ←factors_count_eq,
  apply dvd_of_factors_subperm (pow_ne_zero _ hp.ne_zero),
  rw [hp.factors_pow, list.subperm_ext_iff],
  intros q hq,
  simp [list.eq_of_mem_replicate hq],
end

lemma ord_compl_dvd (n p : ℕ) : ord_compl[p] n ∣ n :=
div_dvd_of_dvd (ord_proj_dvd n p)

lemma ord_proj_pos (n p : ℕ) : 0 < ord_proj[p] n :=
begin
  by_cases pp : p.prime,
  { simp [pow_pos pp.pos] },
  { simp [pp] },
end

lemma ord_proj_le {n : ℕ} (p : ℕ) (hn : n ≠ 0) : ord_proj[p] n ≤ n :=
le_of_dvd hn.bot_lt (nat.ord_proj_dvd n p)

lemma ord_compl_pos {n : ℕ} (p : ℕ) (hn : n ≠ 0) : 0 < ord_compl[p] n :=
begin
  cases em' p.prime with pp pp,
  { simpa [nat.factorization_eq_zero_of_non_prime n pp] using hn.bot_lt },
  exact nat.div_pos (ord_proj_le p hn) (ord_proj_pos n p),
end

lemma ord_compl_le (n p : ℕ) : ord_compl[p] n ≤ n :=
nat.div_le_self _ _

lemma ord_proj_mul_ord_compl_eq_self (n p : ℕ) : ord_proj[p] n * ord_compl[p] n = n :=
nat.mul_div_cancel' (ord_proj_dvd n p)

lemma ord_proj_mul {a b : ℕ} (p : ℕ) (ha : a ≠ 0) (hb : b ≠ 0):
  ord_proj[p] (a * b) = ord_proj[p] a * ord_proj[p] b :=
by simp [factorization_mul ha hb, pow_add]

lemma ord_compl_mul (a b p : ℕ) :
  ord_compl[p] (a * b) = ord_compl[p] a * ord_compl[p] b :=
begin
  rcases eq_or_ne a 0 with rfl | ha, { simp },
  rcases eq_or_ne b 0 with rfl | hb, { simp },
  simp only [ord_proj_mul p ha hb],
  rw (mul_div_mul_comm_of_dvd_dvd (ord_proj_dvd a p) (ord_proj_dvd b p)),
end

/-! ### Factorization and divisibility -/

lemma dvd_of_mem_factorization {n p : ℕ} (h : p ∈ n.factorization.support) : p ∣ n :=
begin
  rcases eq_or_ne n 0 with rfl | hn, { simp },
  simp [←mem_factors_iff_dvd hn (prime_of_mem_factorization h), factor_iff_mem_factorization.mp h],
end

/-- A crude upper bound on `n.factorization p` -/
lemma factorization_lt {n : ℕ} (p : ℕ) (hn : n ≠ 0) : n.factorization p < n :=
begin
  by_cases pp : p.prime, swap, { simp [factorization_eq_zero_of_non_prime n pp], exact hn.bot_lt },
  rw ←pow_lt_iff_lt_right pp.two_le,
  apply lt_of_le_of_lt (ord_proj_le p hn),
  exact lt_of_lt_of_le (lt_two_pow n) (pow_le_pow_of_le_left (by linarith) pp.two_le n),
end

/-- An upper bound on `n.factorization p` -/
lemma factorization_le_of_le_pow {n p b : ℕ} (hb : n ≤ p ^ b) : n.factorization p ≤ b :=
begin
  rcases eq_or_ne n 0 with rfl | hn, { simp },
  by_cases pp : p.prime,
  { exact (pow_le_iff_le_right pp.two_le).1 (le_trans (ord_proj_le p hn) hb) },
  { simp [factorization_eq_zero_of_non_prime n pp] }
end

lemma factorization_le_iff_dvd {d n : ℕ} (hd : d ≠ 0) (hn : n ≠ 0) :
  d.factorization ≤ n.factorization ↔ d ∣ n :=
begin
  split,
  { intro hdn,
    set K := n.factorization - d.factorization with hK,
    use K.prod pow,
    rw [←factorization_prod_pow_eq_self hn, ←factorization_prod_pow_eq_self hd,
        ←finsupp.prod_add_index' pow_zero pow_add, hK, add_tsub_cancel_of_le hdn] },
  { rintro ⟨c, rfl⟩, rw factorization_mul hd (right_ne_zero_of_mul hn), simp },
end

lemma factorization_prime_le_iff_dvd {d n : ℕ} (hd : d ≠ 0) (hn : n ≠ 0) :
  (∀ p : ℕ, p.prime → d.factorization p ≤ n.factorization p) ↔ d ∣ n :=
begin
  rw ← factorization_le_iff_dvd hd hn,
  refine ⟨λ h p, (em p.prime).elim (h p) (λ hp, _), λ h p _, h p⟩,
  simp_rw factorization_eq_zero_of_non_prime _ hp,
end

lemma pow_succ_factorization_not_dvd {n p : ℕ} (hn : n ≠ 0) (hp : p.prime) :
  ¬ p ^ (n.factorization p + 1) ∣ n :=
begin
  intro h,
  rw ←factorization_le_iff_dvd (pow_pos hp.pos _).ne' hn at h,
  simpa [hp.factorization] using h p,
end

lemma factorization_le_factorization_mul_left {a b : ℕ} (hb : b ≠ 0) :
  a.factorization ≤ (a * b).factorization :=
begin
  rcases eq_or_ne a 0 with rfl | ha, { simp },
  rw [factorization_le_iff_dvd ha $ mul_ne_zero ha hb],
  exact dvd.intro b rfl
end

lemma factorization_le_factorization_mul_right {a b : ℕ} (ha : a ≠ 0) :
  b.factorization ≤ (a * b).factorization :=
by { rw mul_comm, apply factorization_le_factorization_mul_left ha }

lemma prime.pow_dvd_iff_le_factorization {p k n : ℕ} (pp : prime p) (hn : n ≠ 0) :
  p ^ k ∣ n ↔ k ≤ n.factorization p :=
by rw [←factorization_le_iff_dvd (pow_pos pp.pos k).ne' hn, pp.factorization_pow, single_le_iff]

lemma prime.pow_dvd_iff_dvd_ord_proj {p k n : ℕ} (pp : prime p) (hn : n ≠ 0) :
  p ^ k ∣ n ↔ p ^ k ∣ ord_proj[p] n :=
by rw [pow_dvd_pow_iff_le_right pp.one_lt, pp.pow_dvd_iff_le_factorization hn]

lemma exists_factorization_lt_of_lt {a b : ℕ} (ha : a ≠ 0) (hab : a < b) :
  ∃ p : ℕ, a.factorization p < b.factorization p :=
begin
  have hb : b ≠ 0 := (ha.bot_lt.trans hab).ne',
  contrapose! hab,
  rw [←finsupp.le_def, factorization_le_iff_dvd hb ha] at hab,
  exact le_of_dvd ha.bot_lt hab,
end

@[simp] lemma factorization_div {d n : ℕ} (h : d ∣ n) :
  (n / d).factorization = n.factorization - d.factorization :=
begin
  rcases eq_or_ne d 0 with rfl | hd, { simp [zero_dvd_iff.mp h] },
  rcases eq_or_ne n 0 with rfl | hn, { simp },
  apply add_left_injective d.factorization,
  simp only,
  rw [tsub_add_cancel_of_le $ (nat.factorization_le_iff_dvd hd hn).mpr h,
      ←nat.factorization_mul (nat.div_pos (nat.le_of_dvd hn.bot_lt h) hd.bot_lt).ne' hd,
      nat.div_mul_cancel h],
end

lemma dvd_ord_proj_of_dvd {n p : ℕ} (hn : n ≠ 0) (pp : p.prime) (h : p ∣ n) :
  p ∣ ord_proj[p] n :=
dvd_pow_self p (prime.factorization_pos_of_dvd pp hn h).ne'

lemma not_dvd_ord_compl {n p : ℕ} (hp : prime p) (hn : n ≠ 0) :
  ¬p ∣ ord_compl[p] n :=
begin
  rw [nat.prime.dvd_iff_one_le_factorization hp (ord_compl_pos p hn).ne'],
  rw [nat.factorization_div (nat.ord_proj_dvd n p)],
  simp [hp.factorization],
end

lemma coprime_ord_compl {n p : ℕ} (hp : prime p) (hn : n ≠ 0) :
  coprime p (ord_compl[p] n) :=
(or_iff_left (not_dvd_ord_compl hp hn)).mp $ coprime_or_dvd_of_prime hp _

lemma factorization_ord_compl (n p : ℕ) :
  (ord_compl[p] n).factorization = n.factorization.erase p :=
begin
  rcases eq_or_ne n 0 with rfl | hn, { simp },
  by_cases pp : p.prime, swap, { simp [pp] },
  ext q,
  rcases eq_or_ne q p with rfl | hqp,
  { simp only [finsupp.erase_same, factorization_eq_zero_iff, not_dvd_ord_compl pp hn],
    simp },
  { rw [finsupp.erase_ne hqp, factorization_div (ord_proj_dvd n p)],
    simp [pp.factorization, hqp.symm] },
end

-- `ord_compl[p] n` is the largest divisor of `n` not divisible by `p`.
lemma dvd_ord_compl_of_dvd_not_dvd {p d n : ℕ} (hdn : d ∣ n) (hpd : ¬ p ∣ d) :
  d ∣ ord_compl[p] n :=
begin
  rcases eq_or_ne n 0 with rfl | hn0, { simp },
  rcases eq_or_ne d 0 with rfl | hd0, { simp at hpd, cases hpd },
  rw [←(factorization_le_iff_dvd hd0 (ord_compl_pos p hn0).ne'), factorization_ord_compl],
  intro q,
  rcases eq_or_ne q p with rfl | hqp,
  { simp [factorization_eq_zero_iff, hpd] },
  { simp [hqp, (factorization_le_iff_dvd hd0 hn0).2 hdn q] },
end

/-- If `n` is a nonzero natural number and `p ≠ 1`, then there are natural numbers `e`
and `n'` such that `n'` is not divisible by `p` and `n = p^e * n'`. -/
lemma exists_eq_pow_mul_and_not_dvd {n : ℕ} (hn : n ≠ 0) (p : ℕ) (hp : p ≠ 1) :
  ∃ e n' : ℕ, ¬ p ∣ n' ∧ n = p ^ e * n' :=
let ⟨a', h₁, h₂⟩ := multiplicity.exists_eq_pow_mul_and_not_dvd
                      (multiplicity.finite_nat_iff.mpr ⟨hp, nat.pos_of_ne_zero hn⟩) in
⟨_, a', h₂, h₁⟩

lemma dvd_iff_div_factorization_eq_tsub {d n : ℕ} (hd : d ≠ 0) (hdn : d ≤ n) :
  d ∣ n ↔ (n / d).factorization = n.factorization - d.factorization :=
begin
  refine ⟨factorization_div, _⟩,
  rcases eq_or_lt_of_le hdn with rfl | hd_lt_n, { simp },
  have h1 : n / d ≠ 0 := λ H, nat.lt_asymm hd_lt_n ((nat.div_eq_zero_iff hd.bot_lt).mp H),
  intros h,
  rw dvd_iff_le_div_mul n d,
  by_contra h2,
  cases (exists_factorization_lt_of_lt (mul_ne_zero h1 hd) (not_le.mp h2)) with p hp,
  rwa [factorization_mul h1 hd, add_apply, ←lt_tsub_iff_right, h, tsub_apply,
    lt_self_iff_false] at hp
end

lemma ord_proj_dvd_ord_proj_of_dvd {a b : ℕ} (hb0 : b ≠ 0) (hab : a ∣ b) (p : ℕ) :
  ord_proj[p] a ∣ ord_proj[p] b :=
begin
  rcases em' p.prime with pp | pp, { simp [pp] },
  rcases eq_or_ne a 0 with rfl | ha0, { simp },
  rw pow_dvd_pow_iff_le_right pp.one_lt,
  exact (factorization_le_iff_dvd ha0 hb0).2 hab p,
end

lemma ord_proj_dvd_ord_proj_iff_dvd {a b : ℕ} (ha0 : a ≠ 0) (hb0 : b ≠ 0) :
  (∀ p : ℕ, ord_proj[p] a ∣ ord_proj[p] b) ↔ (a ∣ b) :=
begin
  refine ⟨λ h, _, λ hab p, ord_proj_dvd_ord_proj_of_dvd hb0 hab p⟩,
  rw ←factorization_le_iff_dvd ha0 hb0,
  intro q,
  rcases le_or_lt q 1 with hq_le | hq1, { interval_cases q; simp },
  exact (pow_dvd_pow_iff_le_right hq1).1 (h q),
end

lemma ord_compl_dvd_ord_compl_of_dvd {a b : ℕ} (hab : a ∣ b) (p : ℕ) :
  ord_compl[p] a ∣ ord_compl[p] b :=
begin
  rcases em' p.prime with pp | pp, { simp [pp, hab] },
  rcases eq_or_ne b 0 with rfl | hb0, { simp },
  rcases eq_or_ne a 0 with rfl | ha0, { cases hb0 (zero_dvd_iff.1 hab) },
  have ha := (nat.div_pos (ord_proj_le p ha0) (ord_proj_pos a p)).ne',
  have hb := (nat.div_pos (ord_proj_le p hb0) (ord_proj_pos b p)).ne',
  rw [←factorization_le_iff_dvd ha hb, factorization_ord_compl a p, factorization_ord_compl b p],
  intro q,
  rcases eq_or_ne q p with rfl | hqp, { simp },
  simp_rw erase_ne hqp,
  exact (factorization_le_iff_dvd ha0 hb0).2 hab q,
end

lemma ord_compl_dvd_ord_compl_iff_dvd (a b : ℕ) :
  (∀ p : ℕ, ord_compl[p] a ∣ ord_compl[p] b) ↔ (a ∣ b) :=
begin
  refine ⟨λ h, _, λ hab p, ord_compl_dvd_ord_compl_of_dvd hab p⟩,
  rcases eq_or_ne b 0 with rfl | hb0, { simp },
  by_cases pa : a.prime, swap, { simpa [pa] using h a },
  by_cases pb : b.prime, swap, { simpa [pb] using h b },
  rw prime_dvd_prime_iff_eq pa pb,
  by_contradiction hab,
  apply pa.ne_one,
  rw [←nat.dvd_one, ←nat.mul_dvd_mul_iff_left hb0.bot_lt, mul_one],
  simpa [prime.factorization_self pb, prime.factorization pa, hab] using h b,
end

lemma dvd_iff_prime_pow_dvd_dvd (n d : ℕ) :
  d ∣ n ↔ ∀ p k : ℕ, prime p → p ^ k ∣ d → p ^ k ∣ n :=
begin
  rcases eq_or_ne n 0 with rfl | hn, { simp },
  rcases eq_or_ne d 0 with rfl | hd,
  { simp only [zero_dvd_iff, hn, false_iff, not_forall],
    exact ⟨2, n, prime_two, dvd_zero _, mt (le_of_dvd hn.bot_lt) (lt_two_pow n).not_le⟩ },
  refine ⟨λ h p k _ hpkd, dvd_trans hpkd h, _⟩,
  rw [←factorization_prime_le_iff_dvd hd hn],
  intros h p pp,
  simp_rw ←pp.pow_dvd_iff_le_factorization hn,
  exact h p _ pp (ord_proj_dvd _ _)
end

lemma prod_prime_factors_dvd (n : ℕ) : (∏ (p : ℕ) in n.factors.to_finset, p) ∣ n :=
begin
  by_cases hn : n = 0, { subst hn, simp },
  simpa [prod_factors hn] using multiset.to_finset_prod_dvd_prod (n.factors : multiset ℕ),
end

lemma factorization_gcd {a b : ℕ} (ha_pos : a ≠ 0) (hb_pos : b ≠ 0) :
  (gcd a b).factorization = a.factorization ⊓ b.factorization :=
begin
  let dfac := a.factorization ⊓ b.factorization,
  let d := dfac.prod pow,
  have dfac_prime : ∀ (p : ℕ), p ∈ dfac.support → prime p,
  { intros p hp,
    have : p ∈ a.factors ∧ p ∈ b.factors := by simpa using hp,
    exact prime_of_mem_factors this.1 },
  have h1 : d.factorization = dfac := prod_pow_factorization_eq_self dfac_prime,
  have hd_pos : d ≠ 0 := (factorization_equiv.inv_fun ⟨dfac, dfac_prime⟩).2.ne.symm,
  suffices : d = (gcd a b), { rwa ←this },
  apply gcd_greatest,
  { rw [←factorization_le_iff_dvd hd_pos ha_pos, h1], exact inf_le_left },
  { rw [←factorization_le_iff_dvd hd_pos hb_pos, h1], exact inf_le_right },
  { intros e hea heb,
    rcases decidable.eq_or_ne e 0 with rfl | he_pos,
    { simp only [zero_dvd_iff] at hea, contradiction, },
    have hea' := (factorization_le_iff_dvd he_pos ha_pos).mpr hea,
    have heb' := (factorization_le_iff_dvd he_pos hb_pos).mpr heb,
    simp [←factorization_le_iff_dvd he_pos hd_pos, h1, hea', heb'] },
end

lemma factorization_lcm {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
  (a.lcm b).factorization = a.factorization ⊔ b.factorization :=
begin
  rw [← add_right_inj (a.gcd b).factorization,
    ← factorization_mul (mt gcd_eq_zero_iff.1 $ λ h, ha h.1) (lcm_ne_zero ha hb),
    gcd_mul_lcm, factorization_gcd ha hb, factorization_mul ha hb],
  ext1, exact (min_add_max _ _).symm,
end

@[to_additive sum_factors_gcd_add_sum_factors_mul]
lemma prod_factors_gcd_mul_prod_factors_mul {β : Type*} [comm_monoid β] (m n : ℕ) (f : ℕ → β) :
  (m.gcd n).factors.to_finset.prod f * (m * n).factors.to_finset.prod f
    = m.factors.to_finset.prod f * n.factors.to_finset.prod f :=
begin
  rcases eq_or_ne n 0 with rfl | hm0, { simp },
  rcases eq_or_ne m 0 with rfl | hn0, { simp },
  rw [←@finset.prod_union_inter _ _ m.factors.to_finset n.factors.to_finset, mul_comm],
  congr,
  { apply factors_mul_to_finset; assumption },
  { simp only [←support_factorization, factorization_gcd hn0 hm0, finsupp.support_inf] },
end

lemma set_of_pow_dvd_eq_Icc_factorization {n p : ℕ} (pp : p.prime) (hn : n ≠ 0) :
  {i : ℕ | i ≠ 0 ∧ p ^ i ∣ n} = set.Icc 1 (n.factorization p) :=
by { ext, simp [lt_succ_iff, one_le_iff_ne_zero, pp.pow_dvd_iff_le_factorization hn] }

/-- The set of positive powers of prime `p` that divide `n` is exactly the set of
positive natural numbers up to `n.factorization p`. -/
lemma Icc_factorization_eq_pow_dvd (n : ℕ) {p : ℕ} (pp : prime p) :
  Icc 1 ((n.factorization) p) = (Ico 1 n).filter (λ (i : ℕ), p ^ i ∣ n) :=
begin
  rcases eq_or_ne n 0 with rfl | hn, { simp },
  ext x,
  simp only [mem_Icc, finset.mem_filter, mem_Ico, and_assoc, and.congr_right_iff,
    pp.pow_dvd_iff_le_factorization hn, iff_and_self],
  exact λ H1 H2, lt_of_le_of_lt H2 (factorization_lt p hn),
end

lemma factorization_eq_card_pow_dvd (n : ℕ) {p : ℕ} (pp : p.prime) :
  n.factorization p = ((Ico 1 n).filter (λ i, p ^ i ∣ n)).card :=
by simp [←Icc_factorization_eq_pow_dvd n pp]

lemma Ico_filter_pow_dvd_eq {n p b : ℕ} (pp : p.prime) (hn : n ≠ 0) (hb : n ≤ p ^ b):
  (Ico 1 n).filter (λ i, p ^ i ∣ n) = (Icc 1 b).filter (λ i, p ^ i ∣ n) :=
begin
  ext x,
  simp only [finset.mem_filter, mem_Ico, mem_Icc, and.congr_left_iff, and.congr_right_iff],
  rintro h1 -,
  simp [lt_of_pow_dvd_right hn pp.two_le h1,
    (pow_le_iff_le_right pp.two_le).1 ((le_of_dvd hn.bot_lt h1).trans hb)],
end

/-! ### Factorization and coprimes -/

/-- For coprime `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/
lemma factorization_mul_apply_of_coprime {p a b : ℕ} (hab : coprime a b)  :
  (a * b).factorization p = a.factorization p + b.factorization p :=
by simp only [←factors_count_eq, perm_iff_count.mp (perm_factors_mul_of_coprime hab), count_append]

/-- For coprime `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/
lemma factorization_mul_of_coprime {a b : ℕ} (hab : coprime a b) :
  (a * b).factorization = a.factorization + b.factorization :=
begin
  ext q,
  simp only [finsupp.coe_add, add_apply, ←factors_count_eq, factorization_mul_apply_of_coprime hab],
end

/-- If `p` is a prime factor of `a` then the power of `p` in `a` is the same that in `a * b`,
for any `b` coprime to `a`. -/
lemma factorization_eq_of_coprime_left {p a b : ℕ} (hab : coprime a b) (hpa : p ∈ a.factors) :
  (a * b).factorization p = a.factorization p :=
begin
  rw [factorization_mul_apply_of_coprime hab, ←factors_count_eq, ←factors_count_eq],
  simpa only [count_eq_zero_of_not_mem (coprime_factors_disjoint hab hpa)],
end

/-- If `p` is a prime factor of `b` then the power of `p` in `b` is the same that in `a * b`,
for any `a` coprime to `b`. -/
lemma factorization_eq_of_coprime_right {p a b : ℕ} (hab : coprime a b) (hpb : p ∈ b.factors) :
  (a * b).factorization p = b.factorization p :=
by { rw mul_comm, exact factorization_eq_of_coprime_left (coprime_comm.mp hab) hpb }

/-- The prime factorizations of coprime `a` and `b` are disjoint -/
lemma factorization_disjoint_of_coprime {a b : ℕ} (hab : coprime a b) :
  disjoint a.factorization.support b.factorization.support :=
by simpa only [support_factorization]
  using disjoint_to_finset_iff_disjoint.mpr (coprime_factors_disjoint hab)

/-- For coprime `a` and `b` the prime factorization `a * b` is the union of those of `a` and `b` -/
lemma factorization_mul_support_of_coprime {a b : ℕ} (hab : coprime a b) :
  (a * b).factorization.support = a.factorization.support ∪ b.factorization.support :=
begin
  rw factorization_mul_of_coprime hab,
  exact support_add_eq (factorization_disjoint_of_coprime hab),
end

/-! ### Induction principles involving factorizations -/

/-- Given `P 0, P 1` and a way to extend `P a` to `P (p ^ n * a)` for prime `p` not dividing `a`,
we can define `P` for all natural numbers. -/
@[elab_as_eliminator]
def rec_on_prime_pow {P : ℕ → Sort*} (h0 : P 0) (h1 : P 1)
  (h : ∀ a p n : ℕ, p.prime → ¬ p ∣ a → 0 < n → P a → P (p ^ n * a)) : ∀ (a : ℕ), P a :=
λ a, nat.strong_rec_on a $ λ n,
  match n with
  | 0     := λ _, h0
  | 1     := λ _, h1
  | (k+2) := λ hk, begin
    let p := (k + 2).min_fac,
    have hp : prime p := min_fac_prime (succ_succ_ne_one k),
    -- the awkward `let` stuff here is because `factorization` is noncomputable (finsupp);
    -- we get around this by using the computable `factors.count`, and rewriting when we want
    -- to use the `factorization` API
    let t := (k+2).factors.count p,
    have ht : t = (k+2).factorization p := factors_count_eq,
    have hpt : p ^ t ∣ k + 2 := by { rw ht, exact ord_proj_dvd _ _ },
    have htp : 0 < t :=
    by { rw ht, exact hp.factorization_pos_of_dvd (nat.succ_ne_zero _) (min_fac_dvd _) },
    convert h ((k + 2) / p ^ t) p t hp _ _ _,
    { rw nat.mul_div_cancel' hpt, },
    { rw [nat.dvd_div_iff hpt, ←pow_succ', ht],
      exact pow_succ_factorization_not_dvd (k + 1).succ_ne_zero hp },
    { exact htp },
    { apply hk _ (nat.div_lt_of_lt_mul _),
      simp [lt_mul_iff_one_lt_left nat.succ_pos', one_lt_pow_iff htp.ne, hp.one_lt] },
    end
  end

/-- Given `P 0`, `P 1`, and `P (p ^ n)` for positive prime powers, and a way to extend `P a` and
`P b` to `P (a * b)` when `a, b` are positive coprime, we can define `P` for all natural numbers. -/
@[elab_as_eliminator]
def rec_on_pos_prime_pos_coprime {P : ℕ → Sort*} (hp : ∀ p n : ℕ, prime p → 0 < n → P (p ^ n))
  (h0 : P 0) (h1 : P 1) (h : ∀ a b, 1 < a → 1 < b → coprime a b → P a → P b → P (a * b)) :
  ∀ a, P a :=
rec_on_prime_pow h0 h1 $
begin
  intros a p n hp' hpa hn hPa,
  by_cases ha1 : a = 1,
  { rw [ha1, mul_one],
    exact hp p n hp' hn },
  refine h (p^n) a ((hp'.one_lt).trans_le (le_self_pow hn.ne' _)) _ _ (hp _ _ hp' hn) hPa,
  { contrapose! hpa,
    simp [lt_one_iff.1 (lt_of_le_of_ne hpa ha1)] },
  simpa [hn, prime.coprime_iff_not_dvd hp'],
end

/-- Given `P 0`, `P (p ^ n)` for all prime powers, and a way to extend `P a` and `P b` to
`P (a * b)` when `a, b` are positive coprime, we can define `P` for all natural numbers. -/
@[elab_as_eliminator]
def rec_on_prime_coprime {P : ℕ → Sort*} (h0 : P 0) (hp : ∀ p n : ℕ, prime p → P (p ^ n))
  (h : ∀ a b, 1 < a → 1 < b → coprime a b → P a → P b → P (a * b)) : ∀ a, P a :=
rec_on_pos_prime_pos_coprime (λ p n h _, hp p n h) h0 (hp 2 0 prime_two) h

/-- Given `P 0`, `P 1`, `P p` for all primes, and a way to extend `P a` and `P b` to
`P (a * b)`, we can define `P` for all natural numbers. -/
@[elab_as_eliminator]
def rec_on_mul {P : ℕ → Sort*} (h0 : P 0) (h1 : P 1)
  (hp : ∀ p, prime p → P p) (h : ∀ a b, P a → P b → P (a * b)) : ∀ a, P a :=
let hp : ∀ p n : ℕ, prime p → P (p ^ n) :=
  λ p n hp', match n with
  | 0     := h1
  | (n+1) := by exact h _ _ (hp p hp') (_match _)
  end in
rec_on_prime_coprime h0 hp $ λ a b _ _ _, h a b

/-- For any multiplicative function `f` with `f 1 = 1` and any `n ≠ 0`,
we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/
lemma multiplicative_factorization {β : Type*} [comm_monoid β] (f : ℕ → β)
  (h_mult : ∀ x y : ℕ, coprime x y → f (x * y) = f x * f y) (hf : f 1 = 1) :
  ∀ {n : ℕ}, n ≠ 0 → f n = n.factorization.prod (λ p k, f (p ^ k)) :=
begin
  apply' nat.rec_on_pos_prime_pos_coprime,
  { intros p k hp hk hpk, simp [prime.factorization_pow hp, finsupp.prod_single_index _, hf] },
  { simp },
  { rintros -, rw [factorization_one, hf], simp },
  { intros a b _ _ hab ha hb hab_pos,
    rw [h_mult a b hab, ha (left_ne_zero_of_mul hab_pos), hb (right_ne_zero_of_mul hab_pos),
        factorization_mul_of_coprime hab, ←prod_add_index_of_disjoint],
    convert (factorization_disjoint_of_coprime hab) },
end

/-- For any multiplicative function `f` with `f 1 = 1` and `f 0 = 1`,
we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/
lemma multiplicative_factorization' {β : Type*} [comm_monoid β] (f : ℕ → β)
  (h_mult : ∀ x y : ℕ, coprime x y → f (x * y) = f x * f y) (hf0 : f 0 = 1) (hf1 : f 1 = 1) :
  ∀ {n : ℕ}, f n = n.factorization.prod (λ p k, f (p ^ k)) :=
begin
  apply' nat.rec_on_pos_prime_pos_coprime,
  { intros p k hp hk, simp only [hp.factorization_pow], rw prod_single_index _, simp [hf1] },
  { simp [hf0] },
  { rw [factorization_one, hf1], simp },
  { intros a b _ _ hab ha hb,
    rw [h_mult a b hab, ha, hb, factorization_mul_of_coprime hab, ←prod_add_index_of_disjoint],
    convert (factorization_disjoint_of_coprime hab) },
end

/-- Two positive naturals are equal if their prime padic valuations are equal -/
lemma eq_iff_prime_padic_val_nat_eq (a b : ℕ) (ha : a ≠ 0) (hb : b ≠ 0) :
  a = b ↔ (∀ p : ℕ, p.prime → padic_val_nat p a = padic_val_nat p b) :=
begin
  split,
  { rintros rfl, simp },
  { intro h,
    refine eq_of_factorization_eq ha hb (λ p, _),
    by_cases pp : p.prime,
    { simp [factorization_def, pp, h p pp] },
    { simp [factorization_eq_zero_of_non_prime, pp] } },
end

lemma prod_pow_prime_padic_val_nat (n : nat) (hn : n ≠ 0) (m : nat) (pr : n < m) :
  ∏ p in finset.filter nat.prime (finset.range m), p ^ (padic_val_nat p n) = n :=
begin
  nth_rewrite_rhs 0 ←factorization_prod_pow_eq_self hn,
  rw eq_comm,
  apply finset.prod_subset_one_on_sdiff,
  { exact λ p hp, finset.mem_filter.mpr
      ⟨finset.mem_range.mpr (gt_of_gt_of_ge pr (le_of_mem_factorization hp)),
       prime_of_mem_factorization hp⟩ },
  { intros p hp,
    cases finset.mem_sdiff.mp hp with hp1 hp2,
    rw ←factorization_def n (finset.mem_filter.mp hp1).2,
    simp [finsupp.not_mem_support_iff.mp hp2] },
  { intros p hp,
    simp [factorization_def n (prime_of_mem_factorization hp)] }
end

/-! ### Lemmas about factorizations of particular functions -/

-- TODO: Port lemmas from `data/nat/multiplicity` to here, re-written in terms of `factorization`

/-- Exactly `n / p` naturals in `[1, n]` are multiples of `p`. -/
lemma card_multiples (n p : ℕ) : card ((finset.range n).filter (λ e, p ∣ e + 1)) = n / p :=
begin
  induction n with n hn, { simp },
  simp [nat.succ_div, add_ite, add_zero, finset.range_succ, filter_insert, apply_ite card,
    card_insert_of_not_mem, hn],
end

/-- Exactly `n / p` naturals in `(0, n]` are multiples of `p`. -/
lemma Ioc_filter_dvd_card_eq_div (n p : ℕ) :
  ((Ioc 0 n).filter (λ x, p ∣ x)).card = n / p :=
begin
  induction n with n IH, { simp },
  -- TODO: Golf away `h1` after Yaël PRs a lemma asserting this
  have h1 : Ioc 0 n.succ = insert n.succ (Ioc 0 n),
  { rcases n.eq_zero_or_pos with rfl | hn, { simp },
    simp_rw [←Ico_succ_succ, Ico_insert_right (succ_le_succ hn.le), Ico_succ_right] },
  simp [nat.succ_div, add_ite, add_zero, h1, filter_insert, apply_ite card,
    card_insert_eq_ite, IH, finset.mem_filter, mem_Ioc, not_le.2 (lt_add_one n)],
end

end nat