/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Robert Y. Lewis

A tactic for discharging linear arithmetic goals using Fourier-Motzkin elimination.

`linarith` is (in principle) complete for ℚ and ℝ. It is not complete for non-dense orders, i.e. ℤ.

@TODO: investigate storing comparisons in a list instead of a set, for possible efficiency gains
@TODO: perform slightly better on ℤ by strengthening t < 0 hyps to t + 1 ≤ 0
@TODO: alternative discharger to `ring`
@TODO: delay proofs of denominator normalization and nat casting until after contradiction is found
-/

import tactic.ring data.nat.gcd data.list.basic meta.rb_map

meta def nat.to_pexpr : ℕ → pexpr
| 0 := ``(0)
| 1 := ``(1)
| n := if n % 2 = 0 then ``(bit0 %%(nat.to_pexpr (n/2))) else ``(bit1 %%(nat.to_pexpr (n/2)))

open native
namespace linarith

section lemmas

lemma int.coe_nat_bit0 (n : ℕ) : (↑(bit0 n : ℕ) : ℤ) = bit0 (↑n : ℤ) := by simp [bit0]
lemma int.coe_nat_bit1 (n : ℕ) : (↑(bit1 n : ℕ) : ℤ) = bit1 (↑n : ℤ) := by simp [bit1, bit0]

lemma nat_eq_subst {n1 n2 : ℕ} {z1 z2 : ℤ} (hn : n1 = n2) (h1 : ↑n1 = z1) (h2 : ↑n2 = z2) : z1 = z2 :=
by simpa [eq.symm h1, eq.symm h2, int.coe_nat_eq_coe_nat_iff]

lemma nat_le_subst {n1 n2 : ℕ} {z1 z2 : ℤ} (hn : n1 ≤ n2) (h1 : ↑n1 = z1) (h2 : ↑n2 = z2) : z1 ≤ z2 :=
by simpa [eq.symm h1, eq.symm h2, int.coe_nat_le]

lemma nat_lt_subst {n1 n2 : ℕ} {z1 z2 : ℤ} (hn : n1 < n2) (h1 : ↑n1 = z1) (h2 : ↑n2 = z2) : z1 < z2 :=
by simpa [eq.symm h1, eq.symm h2, int.coe_nat_lt]

lemma eq_of_eq_of_eq {α} [ordered_semiring α] {a b : α} (ha : a = 0) (hb : b = 0) : a + b = 0 :=
by simp *

lemma le_of_eq_of_le {α} [ordered_semiring α] {a b : α} (ha : a = 0) (hb : b ≤ 0) : a + b ≤ 0 :=
by simp *

lemma lt_of_eq_of_lt {α} [ordered_semiring α] {a b : α} (ha : a = 0) (hb : b < 0) : a + b < 0 :=
by simp *

lemma le_of_le_of_eq {α} [ordered_semiring α] {a b : α} (ha : a ≤ 0) (hb : b = 0) : a + b ≤ 0 :=
by simp *

lemma lt_of_lt_of_eq {α} [ordered_semiring α] {a b : α} (ha : a < 0) (hb : b = 0) : a + b < 0 :=
by simp *

lemma mul_neg {α} [ordered_ring α] {a b : α} (ha : a < 0) (hb : b > 0) : b * a < 0 :=
have (-b)*a > 0, from mul_pos_of_neg_of_neg (neg_neg_of_pos hb) ha,
neg_of_neg_pos (by simpa)

lemma mul_nonpos {α} [ordered_ring α] {a b : α} (ha : a ≤ 0) (hb : b > 0) : b * a ≤ 0 :=
have (-b)*a ≥ 0, from mul_nonneg_of_nonpos_of_nonpos (le_of_lt (neg_neg_of_pos hb)) ha,
nonpos_of_neg_nonneg (by simp at this; exact this)

lemma mul_eq {α} [ordered_semiring α] {a b : α} (ha : a = 0) (hb : b > 0) : b * a = 0 :=
by simp *

lemma eq_of_not_lt_of_not_gt {α} [linear_order α] (a b : α) (h1 : ¬ a < b) (h2 : ¬ b < a) : a = b :=
le_antisymm (le_of_not_gt h2) (le_of_not_gt h1)

lemma add_subst {α} [ring α] {n e1 e2 t1 t2 : α} (h1 : n * e1 = t1) (h2 : n * e2 = t2) :
      n * (e1 + e2) = t1 + t2 := by simp [left_distrib, *]

lemma sub_subst {α} [ring α] {n e1 e2 t1 t2 : α} (h1 : n * e1 = t1) (h2 : n * e2 = t2) :
      n * (e1 - e2) = t1 - t2 := by simp [left_distrib, *]

lemma neg_subst {α} [ring α] {n e t : α} (h1 : n * e = t) : n * (-e) = -t := by simp *

private meta def apnn : tactic unit := `[norm_num]

lemma mul_subst {α} [comm_ring α] {n1 n2 k e1 e2 t1 t2 : α} (h1 : n1 * e1 = t1) (h2 : n2 * e2 = t2)
     (h3 : n1*n2 = k . apnn) : k * (e1 * e2) = t1 * t2 :=
have h3 : n1 * n2 = k, from h3,
by rw [←h3, mul_comm n1, mul_assoc n2, ←mul_assoc n1, h1, ←mul_assoc n2, mul_comm n2, mul_assoc, h2] -- OUCH

lemma div_subst {α} [field α] {n1 n2 k e1 e2 t1 : α} (h1 : n1 * e1 = t1) (h2 : n2 / e2 = 1) (h3 : n1*n2 = k) :
      k * (e1 / e2) = t1 :=
by rw [←h3, mul_assoc, mul_div_comm, h2, ←mul_assoc, h1, mul_comm, one_mul]

end lemmas

section datatypes

@[derive decidable_eq]
inductive ineq
| eq | le | lt

open ineq

def ineq.max : ineq → ineq → ineq
| eq a := a
| le a := a
| lt a := lt

def ineq.is_lt : ineq → ineq → bool
| eq le := tt
| eq lt := tt
| le lt := tt
| _ _ := ff

def ineq.to_string : ineq → string
| eq := "="
| le := "≤"
| lt := "<"

instance : has_to_string ineq := ⟨ineq.to_string⟩

/--
  The main datatype for FM elimination.
  Variables are represented by natural numbers, each of which has an integer coefficient.
  Index 0 is reserved for constants, i.e. `coeffs.find 0` is the coefficient of 1.
  The represented term is coeffs.keys.sum (λ i, coeffs.find i * Var[i]).
  str determines the direction of the comparison -- is it < 0, ≤ 0, or = 0?
-/
meta structure comp :=
(str : ineq)
(coeffs : rb_map ℕ int)

meta instance : inhabited comp := ⟨⟨ineq.eq, mk_rb_map⟩⟩

meta inductive comp_source
| assump : ℕ → comp_source
| add : comp_source → comp_source → comp_source
| scale : ℕ → comp_source → comp_source

meta def comp_source.flatten : comp_source → rb_map ℕ ℕ
| (comp_source.assump n) := mk_rb_map.insert n 1
| (comp_source.add c1 c2) := (comp_source.flatten c1).add (comp_source.flatten c2)
| (comp_source.scale n c) := (comp_source.flatten c).map (λ v, v * n)

meta def comp_source.to_string : comp_source → string
| (comp_source.assump e) := to_string e
| (comp_source.add c1 c2) := comp_source.to_string c1 ++ " + " ++ comp_source.to_string c2
| (comp_source.scale n c) := to_string n ++ " * " ++ comp_source.to_string c

meta instance comp_source.has_to_format : has_to_format comp_source :=
⟨λ a, comp_source.to_string a⟩

meta structure pcomp :=
(c : comp)
(src : comp_source)

meta def map_lt (m1 m2 : rb_map ℕ int) : bool :=
list.lex (prod.lex (<) (<)) m1.to_list m2.to_list

-- make more efficient
meta def comp.lt (c1 c2 : comp) : bool :=
(c1.str.is_lt c2.str) || (c1.str = c2.str) && map_lt c1.coeffs c2.coeffs

meta instance comp.has_lt : has_lt comp := ⟨λ a b, comp.lt a b⟩
meta instance pcomp.has_lt : has_lt pcomp := ⟨λ p1 p2, p1.c < p2.c⟩
meta instance pcomp.has_lt_dec : decidable_rel ((<) : pcomp → pcomp → Prop) := by apply_instance

meta def comp.coeff_of (c : comp) (a : ℕ) : ℤ :=
c.coeffs.zfind a

meta def comp.scale (c : comp) (n : ℕ) : comp :=
{ c with coeffs := c.coeffs.map ((*) (n : ℤ)) }

meta def comp.add (c1 c2 : comp) : comp :=
⟨c1.str.max c2.str, c1.coeffs.add c2.coeffs⟩

meta def pcomp.scale (c : pcomp) (n : ℕ) : pcomp :=
⟨c.c.scale n, comp_source.scale n c.src⟩

meta def pcomp.add (c1 c2 : pcomp) : pcomp :=
⟨c1.c.add c2.c, comp_source.add c1.src c2.src⟩

meta instance pcomp.to_format : has_to_format pcomp :=
⟨λ p, to_fmt p.c.coeffs ++ to_string p.c.str ++ "0"⟩

meta instance comp.to_format : has_to_format comp :=
⟨λ p, to_fmt p.coeffs⟩

end datatypes

section fm_elim

/-- If c1 and c2 both contain variable a with opposite coefficients,
   produces v1, v2, and c such that a has been cancelled in c := v1*c1 + v2*c2 -/
meta def elim_var (c1 c2 : comp) (a : ℕ) : option (ℕ × ℕ × comp) :=
let v1 := c1.coeff_of a,
    v2 := c2.coeff_of a in
if v1 * v2 < 0 then
  let vlcm :=  nat.lcm v1.nat_abs v2.nat_abs,
      v1' := vlcm / v1.nat_abs,
      v2' := vlcm / v2.nat_abs in
  some ⟨v1', v2', comp.add (c1.scale v1') (c2.scale v2')⟩
else none

meta def pelim_var (p1 p2 : pcomp) (a : ℕ) : option pcomp :=
do (n1, n2, c) ← elim_var p1.c p2.c a,
   return ⟨c, comp_source.add (p1.src.scale n1) (p2.src.scale n2)⟩

meta def comp.is_contr (c : comp) : bool := c.coeffs.empty ∧ c.str = ineq.lt

meta def pcomp.is_contr (p : pcomp) : bool := p.c.is_contr

meta def elim_with_set (a : ℕ) (p : pcomp) (comps : rb_set pcomp) : rb_set pcomp :=
if ¬ p.c.coeffs.contains a then mk_rb_set.insert p else
comps.fold mk_rb_set $ λ pc s,
match pelim_var p pc a with
| some pc := s.insert pc
| none := s
end

/--
  The state for the elimination monad.
    vars: the set of variables present in comps
    comps: a set of comparisons
    inputs: a set of pairs of exprs (t, pf), where t is a term and pf is a proof that t {<, ≤, =} 0,
      indexed by ℕ.
    has_false: stores a pcomp of 0 < 0 if one has been found
    TODO: is it more efficient to store comps as a list, to avoid comparisons?
-/
meta structure linarith_structure :=
(vars : rb_set ℕ)
(comps : rb_set pcomp)

@[reducible] meta def linarith_monad :=
state_t linarith_structure (except_t pcomp id)

meta instance : monad linarith_monad := state_t.monad
meta instance : monad_except pcomp linarith_monad :=
state_t.monad_except pcomp

meta def get_vars : linarith_monad (rb_set ℕ) :=
linarith_structure.vars <$> get

meta def get_var_list : linarith_monad (list ℕ) :=
rb_set.to_list <$> get_vars

meta def get_comps : linarith_monad (rb_set pcomp) :=
linarith_structure.comps <$> get

meta def validate : linarith_monad unit :=
do ⟨_, comps⟩ ← get,
match comps.to_list.find (λ p : pcomp, p.is_contr) with
| none := return ()
| some c := throw c
end

meta def update (vars : rb_set ℕ) (comps : rb_set pcomp) : linarith_monad unit :=
state_t.put ⟨vars, comps⟩ >> validate

meta def monad.elim_var (a : ℕ) : linarith_monad unit :=
do vs ← get_vars,
   when (vs.contains a) $
do comps ← get_comps,
   let cs' := comps.fold mk_rb_set (λ p s, s.union (elim_with_set a p comps)),
   update (vs.erase a) cs'

meta def elim_all_vars : linarith_monad unit :=
get_var_list >>= list.mmap' monad.elim_var

end fm_elim

section parse

open ineq tactic

meta def map_of_expr_mul_aux (c1 c2 : rb_map ℕ ℤ) : option (rb_map ℕ ℤ) :=
match c1.keys, c2.keys with
| [0], _ := some $ c2.scale (c1.zfind 0)
| _, [0] := some $ c1.scale (c2.zfind 0)
| _, _ := none
end

/--
  Turns an expression into a map from ℕ to ℤ, for use in a comp object.
    The expr_map ℕ argument identifies which expressions have already been assigned numbers.
    Returns a new map.
-/
meta def map_of_expr : expr_map ℕ → expr → option (expr_map ℕ × rb_map ℕ ℤ)
| m `(%%e1 * %%e2) :=
   do (m', comp1) ← map_of_expr m e1,
      (m', comp2) ← map_of_expr m' e2,
      mp ← map_of_expr_mul_aux comp1 comp2,
      return (m', mp)
| m `(%%e1 + %%e2) :=
   do (m', comp1) ← map_of_expr m e1,
      (m', comp2) ← map_of_expr m' e2,
      return (m', comp1.add comp2)
| m `(%%e1 - %%e2) :=
   do (m', comp1) ← map_of_expr m e1,
      (m', comp2) ← map_of_expr m' e2,
      return (m', comp1.add (comp2.scale (-1)))
| m `(-%%e) := do (m', comp) ← map_of_expr m e, return (m', comp.scale (-1))
| m e :=
  match e.to_int, m.find e with
  | some 0, _ := return ⟨m, mk_rb_map⟩
  | some z, _ := return ⟨m, mk_rb_map.insert 0 z⟩
  | none, some k := return (m, mk_rb_map.insert k 1)
  | none, none := let n := m.size + 1 in
    return (m.insert e n, mk_rb_map.insert n 1)
  end

meta def parse_into_comp_and_expr : expr → option (ineq × expr)
| `(%%e < 0) := (ineq.lt, e)
| `(%%e ≤ 0) := (ineq.le, e)
| `(%%e = 0) := (ineq.eq, e)
| _ := none

meta def to_comp (e : expr) (m : expr_map ℕ) : option (comp × expr_map ℕ) :=
do (iq, e) ← parse_into_comp_and_expr e,
   (m', comp') ← map_of_expr m e,
   return ⟨⟨iq, comp'⟩, m'⟩

meta def to_comp_fold : expr_map ℕ → list expr →
      (list (option comp) × expr_map ℕ)
| m [] := ([], m)
| m (h::t) :=
  match to_comp h m with
  | some (c, m') := let (l, mp) := to_comp_fold m' t in (c::l, mp)
  | none := let (l, mp) := to_comp_fold m t in (none::l, mp)
  end

/--
  Takes a list of proofs of props of the form t {<, ≤, =} 0, and creates a linarith_structure.
-/
meta def mk_linarith_structure (l : list expr) : tactic (linarith_structure × rb_map ℕ (expr × expr)) :=
do pftps ← l.mmap infer_type,
  let (l', map) := to_comp_fold mk_rb_map pftps,
  let lz := list.enum $ ((l.zip pftps).zip l').filter_map (λ ⟨a, b⟩, prod.mk a <$> b),
  let prmap := rb_map.of_list $ lz.map (λ ⟨n, x⟩, (n, x.1)),
  let vars : rb_set ℕ := rb_map.set_of_list $ list.range map.size.succ,
  let pc : rb_set pcomp := rb_map.set_of_list $
    lz.map (λ ⟨n, x⟩, ⟨x.2, comp_source.assump n⟩),
  return (⟨vars, pc⟩, prmap)

meta def linarith_monad.run {α} (tac : linarith_monad α) (l : list expr) : tactic ((pcomp ⊕ α) × rb_map ℕ (expr × expr)) :=
do (struct, inputs) ← mk_linarith_structure l,
match (state_t.run (validate >> tac) struct).run with
| (except.ok (a, _)) := return (sum.inr a, inputs)
| (except.error contr) := return (sum.inl contr, inputs)
end

end parse

section prove
open ineq tactic

meta def get_rel_sides : expr → tactic (expr × expr)
| `(%%a < %%b) := return (a, b)
| `(%%a ≤ %%b) := return (a, b)
| `(%%a = %%b) := return (a, b)
| `(%%a ≥ %%b) := return (a, b)
| `(%%a > %%b) := return (a, b)
| _ := failed

meta def mul_expr (n : ℕ) (e : expr) : pexpr :=
if n = 1 then ``(%%e) else
``(%%(nat.to_pexpr n) * %%e)

meta def add_exprs_aux : pexpr → list pexpr → pexpr
| p [] := p
| p [a] := ``(%%p + %%a)
| p (h::t) := add_exprs_aux ``(%%p + %%h) t

meta def add_exprs : list pexpr → pexpr
| [] := ``(0)
| (h::t) := add_exprs_aux h t

meta def find_contr (m : rb_set pcomp) : option pcomp :=
m.keys.find (λ p, p.c.is_contr)

meta def ineq_const_mul_nm : ineq → name
| lt := ``mul_neg
| le := ``mul_nonpos
| eq := ``mul_eq

meta def ineq_const_nm : ineq → ineq → (name × ineq)
| eq eq := (``eq_of_eq_of_eq, eq)
| eq le := (``le_of_eq_of_le, le)
| eq lt := (``lt_of_eq_of_lt, lt)
| le eq := (``le_of_le_of_eq, le)
| le le := (`add_nonpos, le)
| le lt := (`add_neg_of_nonpos_of_neg, lt)
| lt eq := (``lt_of_lt_of_eq, lt)
| lt le := (`add_neg_of_neg_of_nonpos, lt)
| lt lt := (`add_neg, lt)

meta def mk_single_comp_zero_pf (c : ℕ) (h : expr) : tactic (ineq × expr) :=
do tp ← infer_type h,
  some (iq, e) ← return $ parse_into_comp_and_expr tp,
  if c = 0 then
    do e' ← mk_app ``zero_mul [e], return (eq, e')
  else if c = 1 then return (iq, h)
  else
    do nm ← resolve_name (ineq_const_mul_nm iq),
       tp ← (prod.snd <$> (infer_type h >>= get_rel_sides)) >>= infer_type,
       cpos ← to_expr ``((%%c.to_pexpr : %%tp) > 0),
       (_, ex) ← solve_aux cpos `[norm_num, done],
--       e' ← mk_app (ineq_const_mul_nm iq) [h, ex], -- this takes many seconds longer in some examples! why?
       e' ← to_expr ``(%%nm %%h %%ex) ff,
       return (iq, e')

meta def mk_lt_zero_pf_aux (c : ineq) (pf npf : expr) (coeff : ℕ) : tactic (ineq × expr) :=
do (iq, h') ← mk_single_comp_zero_pf coeff npf,
   let (nm, niq) := ineq_const_nm c iq,
   n ← resolve_name nm,
   e' ← to_expr ``(%%n %%pf %%h'),
   return (niq, e')

/--
  Takes a list of coefficients [c] and list of expressions, of equal length.
  Each expression is a proof of a prop of the form t {<, ≤, =} 0.
  Produces a proof that the sum of (c*t) {<, ≤, =} 0, where the comp is as strong as possible.
-/
meta def mk_lt_zero_pf : list ℕ → list expr → tactic expr
| _ [] := fail "no linear hypotheses found"
| [c] [h] := prod.snd <$> mk_single_comp_zero_pf c h
| (c::ct) (h::t) :=
  do (iq, h') ← mk_single_comp_zero_pf c h,
     prod.snd <$> (ct.zip t).mfoldl (λ pr ce, mk_lt_zero_pf_aux pr.1 pr.2 ce.2 ce.1) (iq, h')
| _ _ := fail "not enough args to mk_lt_zero_pf"

meta def term_of_ineq_prf (prf : expr) : tactic expr :=
do (lhs, _) ← infer_type prf >>= get_rel_sides,
   return lhs

meta structure linarith_config :=
(discharger : tactic unit := `[ring])
(restrict_type : option Type := none)
(restrict_type_reflect : reflected restrict_type . apply_instance)
(exfalso : bool := tt)

meta def ineq_pf_tp (pf : expr) : tactic expr :=
do (_, z) ← infer_type pf >>= get_rel_sides,
   infer_type z

meta def mk_neg_one_lt_zero_pf (tp : expr) : tactic expr :=
to_expr ``((neg_neg_of_pos zero_lt_one : -1 < (0 : %%tp)))

/--
  Assumes e is a proof that t = 0. Creates a proof that -t = 0.
-/
meta def mk_neg_eq_zero_pf (e : expr) : tactic expr :=
to_expr ``(neg_eq_zero.mpr %%e)

meta def add_neg_eq_pfs : list expr → tactic (list expr)
| [] := return []
| (h::t) :=
  do some (iq, tp) ← parse_into_comp_and_expr <$> infer_type h,
  match iq with
  | ineq.eq := do nep ← mk_neg_eq_zero_pf h, tl ← add_neg_eq_pfs t, return $ h::nep::tl
  | _ := list.cons h <$> add_neg_eq_pfs t
  end

/--
  Takes a list of proofs of propositions of the form t {<, ≤, =} 0,
  and tries to prove the goal `false`.
-/
meta def prove_false_by_linarith1 (cfg : linarith_config) : list expr → tactic unit
| [] := fail "no args to linarith"
| l@(h::t) :=
do extp ← match cfg.restrict_type with
    | none := do (_, z) ← infer_type h >>= get_rel_sides, infer_type z
    | some rtp := do
      m ← mk_mvar,
      unify `(some %%m : option Type) cfg.restrict_type_reflect,
      return m
    end,
  hz ← mk_neg_one_lt_zero_pf extp,
  l' ← if cfg.restrict_type.is_some then
          l.mfilter (λ e, succeeds (ineq_pf_tp e >>= is_def_eq extp))
      else return l,
  l' ← add_neg_eq_pfs l',
  (sum.inl contr, inputs) ← elim_all_vars.run (hz::l')
    | fail "linarith failed to find a contradiction",
  let coeffs := inputs.keys.map (λ k, (contr.src.flatten.ifind k)),
  let pfs : list expr := inputs.keys.map (λ k, (inputs.ifind k).1),
  let zip := (coeffs.zip pfs).filter (λ pr, pr.1 ≠ 0),
  let (coeffs, pfs) := zip.unzip,
  mls ← zip.mmap (λ pr, do e ← term_of_ineq_prf pr.2, return (mul_expr pr.1 e)),
  sm ← to_expr $ add_exprs mls,
  tgt ← to_expr ``(%%sm = 0),
  (a, b) ← solve_aux tgt (cfg.discharger >> done),
  pf ← mk_lt_zero_pf coeffs pfs,
  pftp ← infer_type pf,
  (_, nep, _) ← rewrite_core b pftp,
  pf' ← mk_eq_mp nep pf,
  mk_app `lt_irrefl [pf'] >>= exact

end prove

section normalize
open tactic

set_option eqn_compiler.max_steps 50000

meta def rearr_comp (prf : expr) : expr → tactic expr
| `(%%a ≤ 0) := return prf
| `(%%a < 0) := return prf
| `(%%a = 0) := return prf
| `(%%a ≥ 0) := to_expr ``(neg_nonpos.mpr %%prf)
| `(%%a > 0) := to_expr ``(neg_neg_of_pos %%prf) --mk_app ``neg_neg_of_pos [prf]
| `(0 ≥ %%a) := to_expr ``(show %%a ≤ 0, from %%prf)
| `(0 > %%a) := to_expr ``(show %%a < 0, from %%prf)
| `(0 = %%a) := to_expr ``(eq.symm %%prf)
| `(0 ≤ %%a) := to_expr ``(neg_nonpos.mpr %%prf)
| `(0 < %%a) := to_expr ``(neg_neg_of_pos %%prf)
| `(%%a ≤ %%b) := to_expr ``(sub_nonpos.mpr %%prf)
| `(%%a < %%b) := to_expr ``(sub_neg_of_lt %%prf) -- mk_app ``sub_neg_of_lt [prf]
| `(%%a = %%b) := to_expr ``(sub_eq_zero.mpr %%prf)
| `(%%a > %%b) := to_expr ``(sub_neg_of_lt %%prf) -- mk_app ``sub_neg_of_lt [prf]
| `(%%a ≥ %%b) := to_expr ``(sub_nonpos.mpr %%prf)
| _ := fail "couldn't rearrange comp"

meta def is_numeric : expr → option ℚ
| `(%%e1 + %%e2) := (+) <$> is_numeric e1 <*> is_numeric e2
| `(%%e1 - %%e2) := has_sub.sub <$> is_numeric e1 <*> is_numeric e2
| `(%%e1 * %%e2) := (*) <$> is_numeric e1 <*> is_numeric e2
| `(%%e1 / %%e2) := (/) <$> is_numeric e1 <*> is_numeric e2
| `(-%%e) := rat.neg <$> is_numeric e
| e := e.to_rat

inductive {u} tree (α : Type u) : Type u
| nil {} : tree
| node : α → tree → tree → tree

def tree.repr {α} [has_repr α] : tree α → string
| tree.nil := "nil"
| (tree.node a t1 t2) := "tree.node " ++ repr a ++ " (" ++ tree.repr t1 ++ ") (" ++ tree.repr t2 ++ ")"

instance {α} [has_repr α] : has_repr (tree α) := ⟨tree.repr⟩

meta def find_cancel_factor : expr → ℕ × tree ℕ
| `(%%e1 + %%e2) :=
  let (v1, t1) := find_cancel_factor e1, (v2, t2) := find_cancel_factor e2, lcm := v1.lcm v2 in
  (lcm, tree.node lcm t1 t2)
| `(%%e1 - %%e2) :=
  let (v1, t1) := find_cancel_factor e1, (v2, t2) := find_cancel_factor e2, lcm := v1.lcm v2 in
  (lcm, tree.node lcm t1 t2)
| `(%%e1 * %%e2) :=
  let (v1, t1) := find_cancel_factor e1, (v2, t2) := find_cancel_factor e2, pd := v1*v2 in
  (pd, tree.node pd t1 t2)
| `(%%e1 / %%e2) := --do q ← is_numeric e2, return q.num.nat_abs
  match is_numeric e2 with
  | some q := let (v1, t1) := find_cancel_factor e1, n := v1.lcm q.num.nat_abs in
    (n, tree.node n t1 (tree.node q.num.nat_abs tree.nil tree.nil))
  | none := (1, tree.node 1 tree.nil tree.nil)
  end
| `(-%%e) := find_cancel_factor e
| _ := (1, tree.node 1 tree.nil tree.nil)

open tree

meta def mk_prod_prf : ℕ → tree ℕ → expr → tactic expr
| v (node _ lhs rhs) `(%%e1 + %%e2) :=
  do v1 ← mk_prod_prf v lhs e1, v2 ← mk_prod_prf v rhs e2, mk_app ``add_subst [v1, v2]
| v (node _ lhs rhs) `(%%e1 - %%e2) :=
  do v1 ← mk_prod_prf v lhs e1, v2 ← mk_prod_prf v rhs e2, mk_app ``sub_subst [v1, v2]
| v (node n lhs@(node ln _ _) rhs) `(%%e1 * %%e2) :=
  do tp ← infer_type e1, v1 ← mk_prod_prf ln lhs e1, v2 ← mk_prod_prf (v/ln) rhs e2,
     ln' ← tp.of_nat ln, vln' ← tp.of_nat (v/ln), v' ← tp.of_nat v,
     ntp ← to_expr ``(%%ln' * %%vln' = %%v'),
     (_, npf) ← solve_aux ntp `[norm_num, done],
     mk_app ``mul_subst [v1, v2, npf]
| v (node n lhs rhs@(node rn _ _)) `(%%e1 / %%e2) :=
  do tp ← infer_type e1, v1 ← mk_prod_prf (v/rn) lhs e1,
     rn' ← tp.of_nat rn, vrn' ← tp.of_nat (v/rn), n' ← tp.of_nat n, v' ← tp.of_nat v,
     ntp ← to_expr ``(%%rn' / %%e2 = 1),
     (_, npf) ← solve_aux ntp `[norm_num, done],
     ntp2 ← to_expr ``(%%vrn' * %%n' = %%v'),
     (_, npf2) ← solve_aux ntp2 `[norm_num, done],
     mk_app ``div_subst [v1, npf, npf2]
| v t `(-%%e) := do v' ← mk_prod_prf v t e, mk_app ``neg_subst [v']
| v _ e :=
  do tp ← infer_type e,
     v' ← tp.of_nat v,
     e' ← to_expr ``(%%v' * %%e),
     mk_app `eq.refl [e']

/--
 e is a term with rational division. produces a natural number n and a proof that n*e = e',
 where e' has no division.
-/
meta def kill_factors (e : expr) : tactic (ℕ × expr) :=
let (n, t) := find_cancel_factor e in
do e' ← mk_prod_prf n t e, return (n, e')

open expr
meta def expr_contains (n : name) : expr → bool
| (const nm _) := nm = n
| (lam _ _ _ bd) := expr_contains bd
| (pi _ _ _ bd) := expr_contains bd
| (app e1 e2) := expr_contains e1 || expr_contains e2
| _ := ff

lemma sub_into_lt {α} [ordered_semiring α] {a b : α} (he : a = b) (hl : a ≤ 0) : b ≤ 0 :=
by rwa he at hl

meta def norm_hyp_aux (h' lhs : expr) : tactic expr :=
do (v, lhs') ← kill_factors lhs,
   (ih, h'') ← mk_single_comp_zero_pf v h',
   (_, nep, _) ← infer_type h'' >>= rewrite_core lhs',
   mk_eq_mp nep h''

meta def norm_hyp (h : expr) : tactic expr :=
do htp ← infer_type h,
   h' ← rearr_comp h htp,
   some (c, lhs) ← parse_into_comp_and_expr <$> infer_type h',
   if expr_contains `has_div.div lhs then
     norm_hyp_aux h' lhs
   else return h'

meta def get_contr_lemma_name : expr → option name
| `(%%a < %%b) := return `lt_of_not_ge
| `(%%a ≤ %%b) := return `le_of_not_gt
| `(%%a = %%b) := return ``eq_of_not_lt_of_not_gt
| `(%%a ≥ %%b) := return `le_of_not_gt
| `(%%a > %%b) := return `lt_of_not_ge
| _ := none

-- assumes the input t is of type ℕ. Produces t' of type ℤ such that ↑t = t' and a proof of equality
meta def cast_expr (e : expr) : tactic (expr × expr) :=
do s ← [`int.coe_nat_add, `int.coe_nat_mul, `int.coe_nat_zero, `int.coe_nat_one,
        ``int.coe_nat_bit0, ``int.coe_nat_bit1].mfoldl simp_lemmas.add_simp simp_lemmas.mk,
   ce ← to_expr ``(↑%%e : ℤ),
   simplify s [] ce {fail_if_unchanged := ff}

meta def is_nat_int_coe : expr → option expr
| `((↑(%%n : ℕ) : ℤ)) := some n
| _ := none

meta def mk_coe_nat_nonneg_prf (e : expr) : tactic expr :=
mk_app `int.coe_nat_nonneg [e]

meta def get_nat_comps : expr → list expr
| `(%%a + %%b) := (get_nat_comps a).append (get_nat_comps b)
| `(%%a * %%b) := (get_nat_comps a).append (get_nat_comps b)
| e := match is_nat_int_coe e with
  | some e' := [e']
  | none := []
  end

meta def mk_coe_nat_nonneg_prfs (e : expr) : tactic (list expr) :=
(get_nat_comps e).mmap mk_coe_nat_nonneg_prf

meta def mk_cast_eq_and_nonneg_prfs (pf a b : expr) (ln : name) : tactic (list expr) :=
do (a', prfa) ← cast_expr a,
   (b', prfb) ← cast_expr b,
   la ← mk_coe_nat_nonneg_prfs a',
   lb ← mk_coe_nat_nonneg_prfs b',
   pf' ← mk_app ln [pf, prfa, prfb],
   return $ pf'::(la.append lb)

meta def mk_int_pfs_of_nat_pf (pf : expr) : tactic (list expr) :=
do tp ← infer_type pf,
match tp with
| `(%%a = %%b) := mk_cast_eq_and_nonneg_prfs pf a b ``nat_eq_subst
| `(%%a ≤ %%b) := mk_cast_eq_and_nonneg_prfs pf a b ``nat_le_subst
| `(%%a < %%b) := mk_cast_eq_and_nonneg_prfs pf a b ``nat_lt_subst
| `(%%a ≥ %%b) := mk_cast_eq_and_nonneg_prfs pf b a ``nat_le_subst
| `(%%a > %%b) := mk_cast_eq_and_nonneg_prfs pf b a ``nat_lt_subst
| _ := fail "mk_coe_comp_prf failed: proof is not an inequality"
end

meta def replace_nat_pfs : list expr → tactic (list expr)
| [] := return []
| (h::t) :=
  (do (a, _) ← infer_type h >>= get_rel_sides,
     infer_type a >>= unify `(ℕ),
     ls ← mk_int_pfs_of_nat_pf h,
     list.append ls <$> replace_nat_pfs t) <|> list.cons h <$> replace_nat_pfs t

/--
  Takes a list of proofs of propositions.
  Filters out the proofs of linear (in)equalities,
  and tries to use them to prove `false`.
-/
meta def prove_false_by_linarith (cfg : linarith_config) (l : list expr) : tactic unit :=
do l' ← replace_nat_pfs l,
   ls ← l'.mmap (λ h, (do s ← norm_hyp h, return (some s)) <|> return none),
   prove_false_by_linarith1 cfg ls.reduce_option

end normalize

end linarith

section
open tactic linarith

open lean lean.parser interactive tactic interactive.types
local postfix `?`:9001 := optional
local postfix *:9001 := many

meta def linarith.interactive_aux (cfg : linarith_config) :
     parse ident* → (parse (tk "using" *> pexpr_list)?) → tactic unit
| l (some pe) := pe.mmap (λ p, i_to_expr p >>= note_anon) >> linarith.interactive_aux l none
| [] none :=
  do t ← target,
     if t = `(false) then local_context >>= prove_false_by_linarith cfg
     else match get_contr_lemma_name t with
     | some nm := seq (applyc nm) (intro1 >> linarith.interactive_aux [] none)
     | none := if cfg.exfalso then exfalso >> linarith.interactive_aux [] none
               else fail "linarith failed: target type is not an inequality."
     end
| ls none := (ls.mmap get_local) >>= prove_false_by_linarith cfg

/--
  Tries to prove a goal of `false` by linear arithmetic on hypotheses.
  If the goal is a linear (in)equality, tries to prove it by contradiction.
  If the goal is not `false` or an inequality, applies `exfalso` and tries linarith on the
  hypotheses.
  `linarith` will use all relevant hypotheses in the local context.
  `linarith h1 h2 h3` will only use hypotheses h1, h2, h3.
  `linarith using [t1, t2, t3]` will add proof terms t1, t2, t3 to the local context.

  Config options:
  `linarith {exfalso := ff}` will fail on a goal that is neither an inequality nor `false`
  `linarith {restrict_type := T}` will run only on hypotheses that are inequalities over `T`
  `linarith {discharger := tac}` will use `tac` instead of `ring` for normalization.
    Options: `ring2`, `ring SOP`, `simp`
-/
meta def tactic.interactive.linarith (ids : parse (many ident))
     (using_hyps : parse (tk "using" *> pexpr_list)?) (cfg : linarith_config := {}) : tactic unit :=
linarith.interactive_aux cfg ids using_hyps

end


/-
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, Mario Carneiro

! This file was ported from Lean 3 source module data.finset.preimage
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Finite
import Mathbin.Algebra.BigOperators.Basic

/-!
# Preimage of a `finset` under an injective map.

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

open Set Function

open BigOperators

universe u v w x

variable {α : Type u} {β : Type v} {ι : Sort w} {γ : Type x}

namespace Finset

section Preimage

#print Finset.preimage /-
/-- Preimage of `s : finset β` under a map `f` injective of `f ⁻¹' s` as a `finset`.  -/
noncomputable def preimage (s : Finset β) (f : α → β) (hf : Set.InjOn f (f ⁻¹' ↑s)) : Finset α :=
  (s.finite_toSet.Preimage hf).toFinset
#align finset.preimage Finset.preimage
-/

#print Finset.mem_preimage /-
@[simp]
theorem mem_preimage {f : α → β} {s : Finset β} {hf : Set.InjOn f (f ⁻¹' ↑s)} {x : α} :
    x ∈ preimage s f hf ↔ f x ∈ s :=
  Set.Finite.mem_toFinset _
#align finset.mem_preimage Finset.mem_preimage
-/

#print Finset.coe_preimage /-
@[simp, norm_cast]
theorem coe_preimage {f : α → β} (s : Finset β) (hf : Set.InjOn f (f ⁻¹' ↑s)) :
    (↑(preimage s f hf) : Set α) = f ⁻¹' ↑s :=
  Set.Finite.coe_toFinset _
#align finset.coe_preimage Finset.coe_preimage
-/

#print Finset.preimage_empty /-
@[simp]
theorem preimage_empty {f : α → β} : preimage ∅ f (by simp [inj_on]) = ∅ :=
  Finset.coe_injective (by simp)
#align finset.preimage_empty Finset.preimage_empty
-/

#print Finset.preimage_univ /-
@[simp]
theorem preimage_univ {f : α → β} [Fintype α] [Fintype β] (hf) : preimage univ f hf = univ :=
  Finset.coe_injective (by simp)
#align finset.preimage_univ Finset.preimage_univ
-/

#print Finset.preimage_inter /-
@[simp]
theorem preimage_inter [DecidableEq α] [DecidableEq β] {f : α → β} {s t : Finset β}
    (hs : Set.InjOn f (f ⁻¹' ↑s)) (ht : Set.InjOn f (f ⁻¹' ↑t)) :
    (preimage (s ∩ t) f fun x₁ hx₁ x₂ hx₂ =>
        hs (mem_of_mem_inter_left hx₁) (mem_of_mem_inter_left hx₂)) =
      preimage s f hs ∩ preimage t f ht :=
  Finset.coe_injective (by simp)
#align finset.preimage_inter Finset.preimage_inter
-/

#print Finset.preimage_union /-
@[simp]
theorem preimage_union [DecidableEq α] [DecidableEq β] {f : α → β} {s t : Finset β} (hst) :
    preimage (s ∪ t) f hst =
      (preimage s f fun x₁ hx₁ x₂ hx₂ => hst (mem_union_left _ hx₁) (mem_union_left _ hx₂)) ∪
        preimage t f fun x₁ hx₁ x₂ hx₂ => hst (mem_union_right _ hx₁) (mem_union_right _ hx₂) :=
  Finset.coe_injective (by simp)
#align finset.preimage_union Finset.preimage_union
-/

#print Finset.preimage_compl /-
@[simp]
theorem preimage_compl [DecidableEq α] [DecidableEq β] [Fintype α] [Fintype β] {f : α → β}
    (s : Finset β) (hf : Function.Injective f) :
    preimage (sᶜ) f (hf.InjOn _) = preimage s f (hf.InjOn _)ᶜ :=
  Finset.coe_injective (by simp)
#align finset.preimage_compl Finset.preimage_compl
-/

#print Finset.monotone_preimage /-
theorem monotone_preimage {f : α → β} (h : Injective f) :
    Monotone fun s => preimage s f (h.InjOn _) := fun s t hst x hx =>
  mem_preimage.2 (hst <| mem_preimage.1 hx)
#align finset.monotone_preimage Finset.monotone_preimage
-/

#print Finset.image_subset_iff_subset_preimage /-
theorem image_subset_iff_subset_preimage [DecidableEq β] {f : α → β} {s : Finset α} {t : Finset β}
    (hf : Set.InjOn f (f ⁻¹' ↑t)) : s.image f ⊆ t ↔ s ⊆ t.Preimage f hf :=
  image_subset_iff.trans <| by simp only [subset_iff, mem_preimage]
#align finset.image_subset_iff_subset_preimage Finset.image_subset_iff_subset_preimage
-/

#print Finset.map_subset_iff_subset_preimage /-
theorem map_subset_iff_subset_preimage {f : α ↪ β} {s : Finset α} {t : Finset β} :
    s.map f ⊆ t ↔ s ⊆ t.Preimage f (f.Injective.InjOn _) := by
  classical rw [map_eq_image, image_subset_iff_subset_preimage]
#align finset.map_subset_iff_subset_preimage Finset.map_subset_iff_subset_preimage
-/

#print Finset.image_preimage /-
theorem image_preimage [DecidableEq β] (f : α → β) (s : Finset β) [∀ x, Decidable (x ∈ Set.range f)]
    (hf : Set.InjOn f (f ⁻¹' ↑s)) :
    image f (preimage s f hf) = s.filterₓ fun x => x ∈ Set.range f :=
  Finset.coe_inj.1 <| by
    simp only [coe_image, coe_preimage, coe_filter, Set.image_preimage_eq_inter_range,
      Set.sep_mem_eq]
#align finset.image_preimage Finset.image_preimage
-/

#print Finset.image_preimage_of_bij /-
theorem image_preimage_of_bij [DecidableEq β] (f : α → β) (s : Finset β)
    (hf : Set.BijOn f (f ⁻¹' ↑s) ↑s) : image f (preimage s f hf.InjOn) = s :=
  Finset.coe_inj.1 <| by simpa using hf.image_eq
#align finset.image_preimage_of_bij Finset.image_preimage_of_bij
-/

#print Finset.preimage_subset /-
theorem preimage_subset {f : α ↪ β} {s : Finset β} {t : Finset α} (hs : s ⊆ t.map f) :
    s.Preimage f (f.Injective.InjOn _) ⊆ t := fun x hx => (mem_map' f).1 (hs (mem_preimage.1 hx))
#align finset.preimage_subset Finset.preimage_subset
-/

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (u «expr ⊆ » t) -/
#print Finset.subset_map_iff /-
theorem subset_map_iff {f : α ↪ β} {s : Finset β} {t : Finset α} :
    s ⊆ t.map f ↔ ∃ (u : _)(_ : u ⊆ t), s = u.map f := by
  classical
    refine' ⟨fun h => ⟨_, preimage_subset h, _⟩, _⟩
    · rw [map_eq_image, image_preimage, filter_true_of_mem fun x hx => _]
      exact coe_map_subset_range _ _ (h hx)
    · rintro ⟨u, hut, rfl⟩
      exact map_subset_map.2 hut
#align finset.subset_map_iff Finset.subset_map_iff
-/

/- warning: finset.sigma_preimage_mk -> Finset.sigma_preimage_mk is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] (s : Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (t : Finset.{u1} α), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (i : α) => β i))) (Finset.sigma.{u1, u2} α (fun (a : α) => β a) t (fun (a : α) => Finset.preimage.{u2, max u1 u2} (β a) (Sigma.{u1, u2} α (fun (a : α) => β a)) s (Sigma.mk.{u1, u2} α (fun (a : α) => β a) a) (Function.Injective.injOn.{u2, max u1 u2} (β a) (Sigma.{u1, u2} α (fun (a : α) => β a)) (Sigma.mk.{u1, u2} α (fun (a : α) => β a) a) (sigma_mk_injective.{u1, u2} α (fun (a : α) => β a) a) (Set.preimage.{u2, max u1 u2} (β a) (Sigma.{u1, u2} α (fun (a : α) => β a)) (Sigma.mk.{u1, u2} α (fun (a : α) => β a) a) ((fun (a : Type.{max u1 u2}) (b : Type.{max u1 u2}) [self : HasLiftT.{succ (max u1 u2), succ (max u1 u2)} a b] => self.0) (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Set.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (HasLiftT.mk.{succ (max u1 u2), succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Set.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (CoeTCₓ.coe.{succ (max u1 u2), succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Set.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Finset.Set.hasCoeT.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))))) s))))) (Finset.filter.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a)) (fun (a : Sigma.{u1, u2} α (fun (a : α) => β a)) => Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) (Sigma.fst.{u1, u2} α (fun (a : α) => β a) a) t) (fun (a : Sigma.{u1, u2} α (fun (a : α) => β a)) => Finset.decidableMem.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (Sigma.fst.{u1, u2} α (fun (a : α) => β a) a) t) s)
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} α] (s : Finset.{max u1 u2} (Sigma.{u2, u1} α (fun (a : α) => β a))) (t : Finset.{u2} α), Eq.{max (succ u2) (succ u1)} (Finset.{max u1 u2} (Sigma.{u2, u1} α (fun (i : α) => β i))) (Finset.sigma.{u2, u1} α (fun (a : α) => β a) t (fun (a : α) => Finset.preimage.{u1, max u2 u1} (β a) (Sigma.{u2, u1} α (fun (a : α) => β a)) s (Sigma.mk.{u2, u1} α (fun (a : α) => β a) a) (Function.Injective.injOn.{max u1 u2, u1} (β a) (Sigma.{u2, u1} α (fun (a : α) => β a)) (Sigma.mk.{u2, u1} α (fun (a : α) => β a) a) (sigma_mk_injective.{u2, u1} α (fun (a : α) => β a) a) (Set.preimage.{u1, max u2 u1} (β a) (Sigma.{u2, u1} α (fun (a : α) => β a)) (Sigma.mk.{u2, u1} α (fun (a : α) => β a) a) (Finset.toSet.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a)) s))))) (Finset.filter.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a)) (fun (a : Sigma.{u2, u1} α (fun (a : α) => β a)) => Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) (Sigma.fst.{u2, u1} α (fun (a : α) => β a) a) t) (fun (a : Sigma.{u2, u1} α (fun (a : α) => β a)) => Finset.decidableMem.{u2} α (fun (a : α) (b : α) => _inst_1 a b) (Sigma.fst.{u2, u1} α (fun (a : α) => β a) a) t) s)
Case conversion may be inaccurate. Consider using '#align finset.sigma_preimage_mk Finset.sigma_preimage_mkₓ'. -/
theorem sigma_preimage_mk {β : α → Type _} [DecidableEq α] (s : Finset (Σa, β a)) (t : Finset α) :
    (t.Sigma fun a => s.Preimage (Sigma.mk a) <| sigma_mk_injective.InjOn _) =
      s.filterₓ fun a => a.1 ∈ t :=
  by
  ext x
  simp [and_comm']
#align finset.sigma_preimage_mk Finset.sigma_preimage_mk

/- warning: finset.sigma_preimage_mk_of_subset -> Finset.sigma_preimage_mk_of_subset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] (s : Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) {t : Finset.{u1} α}, (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.hasSubset.{u1} α) (Finset.image.{max u1 u2, u1} (Sigma.{u1, u2} α (fun (a : α) => β a)) α (fun (a : α) (b : α) => _inst_1 a b) (Sigma.fst.{u1, u2} α (fun (a : α) => β a)) s) t) -> (Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (i : α) => β i))) (Finset.sigma.{u1, u2} α (fun (a : α) => β a) t (fun (a : α) => Finset.preimage.{u2, max u1 u2} (β a) (Sigma.{u1, u2} α (fun (a : α) => β a)) s (Sigma.mk.{u1, u2} α (fun (a : α) => β a) a) (Function.Injective.injOn.{u2, max u1 u2} (β a) (Sigma.{u1, u2} α (fun (a : α) => β a)) (Sigma.mk.{u1, u2} α (fun (a : α) => β a) a) (sigma_mk_injective.{u1, u2} α (fun (a : α) => β a) a) (Set.preimage.{u2, max u1 u2} (β a) (Sigma.{u1, u2} α (fun (a : α) => β a)) (Sigma.mk.{u1, u2} α (fun (a : α) => β a) a) ((fun (a : Type.{max u1 u2}) (b : Type.{max u1 u2}) [self : HasLiftT.{succ (max u1 u2), succ (max u1 u2)} a b] => self.0) (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Set.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (HasLiftT.mk.{succ (max u1 u2), succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Set.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (CoeTCₓ.coe.{succ (max u1 u2), succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Set.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Finset.Set.hasCoeT.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))))) s))))) s)
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} α] (s : Finset.{max u1 u2} (Sigma.{u2, u1} α (fun (a : α) => β a))) {t : Finset.{u2} α}, (HasSubset.Subset.{u2} (Finset.{u2} α) (Finset.instHasSubsetFinset.{u2} α) (Finset.image.{max u1 u2, u2} (Sigma.{u2, u1} α (fun (a : α) => β a)) α (fun (a : α) (b : α) => _inst_1 a b) (Sigma.fst.{u2, u1} α (fun (a : α) => β a)) s) t) -> (Eq.{max (succ u2) (succ u1)} (Finset.{max u1 u2} (Sigma.{u2, u1} α (fun (i : α) => β i))) (Finset.sigma.{u2, u1} α (fun (a : α) => β a) t (fun (a : α) => Finset.preimage.{u1, max u2 u1} (β a) (Sigma.{u2, u1} α (fun (a : α) => β a)) s (Sigma.mk.{u2, u1} α (fun (a : α) => β a) a) (Function.Injective.injOn.{max u1 u2, u1} (β a) (Sigma.{u2, u1} α (fun (a : α) => β a)) (Sigma.mk.{u2, u1} α (fun (a : α) => β a) a) (sigma_mk_injective.{u2, u1} α (fun (a : α) => β a) a) (Set.preimage.{u1, max u2 u1} (β a) (Sigma.{u2, u1} α (fun (a : α) => β a)) (Sigma.mk.{u2, u1} α (fun (a : α) => β a) a) (Finset.toSet.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a)) s))))) s)
Case conversion may be inaccurate. Consider using '#align finset.sigma_preimage_mk_of_subset Finset.sigma_preimage_mk_of_subsetₓ'. -/
theorem sigma_preimage_mk_of_subset {β : α → Type _} [DecidableEq α] (s : Finset (Σa, β a))
    {t : Finset α} (ht : s.image Sigma.fst ⊆ t) :
    (t.Sigma fun a => s.Preimage (Sigma.mk a) <| sigma_mk_injective.InjOn _) = s := by
  rw [sigma_preimage_mk, filter_true_of_mem <| image_subset_iff.1 ht]
#align finset.sigma_preimage_mk_of_subset Finset.sigma_preimage_mk_of_subset

/- warning: finset.sigma_image_fst_preimage_mk -> Finset.sigma_image_fst_preimage_mk is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] (s : Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (i : α) => β i))) (Finset.sigma.{u1, u2} α (fun (a : α) => β a) (Finset.image.{max u1 u2, u1} (Sigma.{u1, u2} α (fun (a : α) => β a)) α (fun (a : α) (b : α) => _inst_1 a b) (Sigma.fst.{u1, u2} α (fun (a : α) => β a)) s) (fun (a : α) => Finset.preimage.{u2, max u1 u2} (β a) (Sigma.{u1, u2} α (fun (a : α) => β a)) s (Sigma.mk.{u1, u2} α (fun (a : α) => β a) a) (Function.Injective.injOn.{u2, max u1 u2} (β a) (Sigma.{u1, u2} α (fun (a : α) => β a)) (Sigma.mk.{u1, u2} α (fun (a : α) => β a) a) (sigma_mk_injective.{u1, u2} α (fun (a : α) => β a) a) (Set.preimage.{u2, max u1 u2} (β a) (Sigma.{u1, u2} α (fun (a : α) => β a)) (Sigma.mk.{u1, u2} α (fun (a : α) => β a) a) ((fun (a : Type.{max u1 u2}) (b : Type.{max u1 u2}) [self : HasLiftT.{succ (max u1 u2), succ (max u1 u2)} a b] => self.0) (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Set.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (HasLiftT.mk.{succ (max u1 u2), succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Set.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (CoeTCₓ.coe.{succ (max u1 u2), succ (max u1 u2)} (Finset.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Set.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Finset.Set.hasCoeT.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))))) s))))) s
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} α] (s : Finset.{max u1 u2} (Sigma.{u2, u1} α (fun (a : α) => β a))), Eq.{max (succ u2) (succ u1)} (Finset.{max u1 u2} (Sigma.{u2, u1} α (fun (i : α) => β i))) (Finset.sigma.{u2, u1} α (fun (a : α) => β a) (Finset.image.{max u1 u2, u2} (Sigma.{u2, u1} α (fun (a : α) => β a)) α (fun (a : α) (b : α) => _inst_1 a b) (Sigma.fst.{u2, u1} α (fun (a : α) => β a)) s) (fun (a : α) => Finset.preimage.{u1, max u2 u1} (β a) (Sigma.{u2, u1} α (fun (a : α) => β a)) s (Sigma.mk.{u2, u1} α (fun (a : α) => β a) a) (Function.Injective.injOn.{max u1 u2, u1} (β a) (Sigma.{u2, u1} α (fun (a : α) => β a)) (Sigma.mk.{u2, u1} α (fun (a : α) => β a) a) (sigma_mk_injective.{u2, u1} α (fun (a : α) => β a) a) (Set.preimage.{u1, max u2 u1} (β a) (Sigma.{u2, u1} α (fun (a : α) => β a)) (Sigma.mk.{u2, u1} α (fun (a : α) => β a) a) (Finset.toSet.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a)) s))))) s
Case conversion may be inaccurate. Consider using '#align finset.sigma_image_fst_preimage_mk Finset.sigma_image_fst_preimage_mkₓ'. -/
theorem sigma_image_fst_preimage_mk {β : α → Type _} [DecidableEq α] (s : Finset (Σa, β a)) :
    ((s.image Sigma.fst).Sigma fun a => s.Preimage (Sigma.mk a) <| sigma_mk_injective.InjOn _) =
      s :=
  s.sigma_preimage_mk_of_subset (Subset.refl _)
#align finset.sigma_image_fst_preimage_mk Finset.sigma_image_fst_preimage_mk

end Preimage

#print Finset.prod_preimage' /-
@[to_additive]
theorem prod_preimage' [CommMonoid β] (f : α → γ) [DecidablePred fun x => x ∈ Set.range f]
    (s : Finset γ) (hf : Set.InjOn f (f ⁻¹' ↑s)) (g : γ → β) :
    (∏ x in s.Preimage f hf, g (f x)) = ∏ x in s.filterₓ fun x => x ∈ Set.range f, g x := by
  haveI := Classical.decEq γ <;>
    calc
      (∏ x in preimage s f hf, g (f x)) = ∏ x in image f (preimage s f hf), g x :=
        Eq.symm <| prod_image <| by simpa only [mem_preimage, inj_on] using hf
      _ = ∏ x in s.filter fun x => x ∈ Set.range f, g x := by rw [image_preimage]

#align finset.prod_preimage' Finset.prod_preimage'
#align finset.sum_preimage' Finset.sum_preimage'
-/

/- warning: finset.prod_preimage -> Finset.prod_preimage is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} [_inst_1 : CommMonoid.{u2} β] (f : α -> γ) (s : Finset.{u3} γ) (hf : Set.InjOn.{u1, u3} α γ f (Set.preimage.{u1, u3} α γ f ((fun (a : Type.{u3}) (b : Type.{u3}) [self : HasLiftT.{succ u3, succ u3} a b] => self.0) (Finset.{u3} γ) (Set.{u3} γ) (HasLiftT.mk.{succ u3, succ u3} (Finset.{u3} γ) (Set.{u3} γ) (CoeTCₓ.coe.{succ u3, succ u3} (Finset.{u3} γ) (Set.{u3} γ) (Finset.Set.hasCoeT.{u3} γ))) s))) (g : γ -> β), (forall (x : γ), (Membership.Mem.{u3, u3} γ (Finset.{u3} γ) (Finset.hasMem.{u3} γ) x s) -> (Not (Membership.Mem.{u3, u3} γ (Set.{u3} γ) (Set.hasMem.{u3} γ) x (Set.range.{u3, succ u1} γ α f))) -> (Eq.{succ u2} β (g x) (OfNat.ofNat.{u2} β 1 (OfNat.mk.{u2} β 1 (One.one.{u2} β (MulOneClass.toHasOne.{u2} β (Monoid.toMulOneClass.{u2} β (CommMonoid.toMonoid.{u2} β _inst_1)))))))) -> (Eq.{succ u2} β (Finset.prod.{u2, u1} β α _inst_1 (Finset.preimage.{u1, u3} α γ s f hf) (fun (x : α) => g (f x))) (Finset.prod.{u2, u3} β γ _inst_1 s (fun (x : γ) => g x)))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} [_inst_1 : CommMonoid.{u2} β] (f : α -> γ) (s : Finset.{u3} γ) (hf : Set.InjOn.{u1, u3} α γ f (Set.preimage.{u1, u3} α γ f (Finset.toSet.{u3} γ s))) (g : γ -> β), (forall (x : γ), (Membership.mem.{u3, u3} γ (Finset.{u3} γ) (Finset.instMembershipFinset.{u3} γ) x s) -> (Not (Membership.mem.{u3, u3} γ (Set.{u3} γ) (Set.instMembershipSet.{u3} γ) x (Set.range.{u3, succ u1} γ α f))) -> (Eq.{succ u2} β (g x) (OfNat.ofNat.{u2} β 1 (One.toOfNat1.{u2} β (Monoid.toOne.{u2} β (CommMonoid.toMonoid.{u2} β _inst_1)))))) -> (Eq.{succ u2} β (Finset.prod.{u2, u1} β α _inst_1 (Finset.preimage.{u1, u3} α γ s f hf) (fun (x : α) => g (f x))) (Finset.prod.{u2, u3} β γ _inst_1 s (fun (x : γ) => g x)))
Case conversion may be inaccurate. Consider using '#align finset.prod_preimage Finset.prod_preimageₓ'. -/
@[to_additive]
theorem prod_preimage [CommMonoid β] (f : α → γ) (s : Finset γ) (hf : Set.InjOn f (f ⁻¹' ↑s))
    (g : γ → β) (hg : ∀ x ∈ s, x ∉ Set.range f → g x = 1) :
    (∏ x in s.Preimage f hf, g (f x)) = ∏ x in s, g x := by
  classical
    rw [prod_preimage', prod_filter_of_ne]
    exact fun x hx => Not.imp_symm (hg x hx)
#align finset.prod_preimage Finset.prod_preimage
#align finset.sum_preimage Finset.sum_preimage

#print Finset.prod_preimage_of_bij /-
@[to_additive]
theorem prod_preimage_of_bij [CommMonoid β] (f : α → γ) (s : Finset γ)
    (hf : Set.BijOn f (f ⁻¹' ↑s) ↑s) (g : γ → β) :
    (∏ x in s.Preimage f hf.InjOn, g (f x)) = ∏ x in s, g x :=
  prod_preimage _ _ hf.InjOn g fun x hxs hxf => (hxf <| hf.subset_range hxs).elim
#align finset.prod_preimage_of_bij Finset.prod_preimage_of_bij
#align finset.sum_preimage_of_bij Finset.sum_preimage_of_bij
-/

end Finset


/-
Copyright (c) 2021 Benjamin Davidson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Benjamin Davidson
-/
import measure_theory.integral.interval_integral
import analysis.special_functions.trigonometric.arctan_deriv

/-!
# Integration of specific interval integrals

This file contains proofs of the integrals of various specific functions. This includes:
* Integrals of simple functions, such as `id`, `pow`, `inv`, `exp`, `log`
* Integrals of some trigonometric functions, such as `sin`, `cos`, `1 / (1 + x^2)`
* The integral of `cos x ^ 2 - sin x ^ 2`
* Reduction formulae for the integrals of `sin x ^ n` and `cos x ^ n` for `n ≥ 2`
* The computation of `∫ x in 0..π, sin x ^ n` as a product for even and odd `n` (used in proving the
  Wallis product for pi)
* Integrals of the form `sin x ^ m * cos x ^ n`

With these lemmas, many simple integrals can be computed by `simp` or `norm_num`.
See `test/integration.lean` for specific examples.

This file also contains some facts about the interval integrability of specific functions.

This file is still being developed.

## Tags

integrate, integration, integrable, integrability
-/

open real nat set finset
open_locale real big_operators interval
variables {a b : ℝ} (n : ℕ)

namespace interval_integral
open measure_theory
variables {f : ℝ → ℝ} {μ ν : measure ℝ} [is_locally_finite_measure μ] (c d : ℝ)

/-! ### Interval integrability -/

@[simp]
lemma interval_integrable_pow : interval_integrable (λ x, x^n) μ a b :=
(continuous_pow n).interval_integrable a b

lemma interval_integrable_zpow {n : ℤ} (h : 0 ≤ n ∨ (0 : ℝ) ∉ [a, b]) :
  interval_integrable (λ x, x ^ n) μ a b :=
(continuous_on_id.zpow₀ n $ λ x hx, h.symm.imp (ne_of_mem_of_not_mem hx) id).interval_integrable

lemma interval_integrable_rpow {r : ℝ} (h : 0 ≤ r ∨ (0 : ℝ) ∉ [a, b]) :
  interval_integrable (λ x, x ^ r) μ a b :=
(continuous_on_id.rpow_const $ λ x hx, h.symm.imp (ne_of_mem_of_not_mem hx) id).interval_integrable

/-- Alternative version with a weaker hypothesis on `r`, but assuming the measure is volume. -/
lemma interval_integrable_rpow' {r : ℝ} (h : -1 < r) :
  interval_integrable (λ x, x ^ r) volume a b :=
begin
  suffices : ∀ (c : ℝ), interval_integrable (λ x, x ^ r) volume 0 c,
  { exact interval_integrable.trans (this a).symm (this b) },
  have : ∀ (c : ℝ), (0 ≤ c) → interval_integrable (λ x, x ^ r) volume 0 c,
  { intros c hc,
    rw [interval_integrable_iff, interval_oc_of_le hc],
    have hderiv : ∀ x ∈ Ioo 0 c, has_deriv_at (λ x : ℝ, x ^ (r + 1) / (r + 1)) (x ^ r) x,
    { intros x hx, convert (real.has_deriv_at_rpow_const (or.inl hx.1.ne')).div_const (r + 1),
      field_simp [(by linarith : r + 1 ≠ 0)], ring, },
    apply integrable_on_deriv_of_nonneg hc _ hderiv,
    { intros x hx, apply rpow_nonneg_of_nonneg hx.1.le, },
    { refine (continuous_on_id.rpow_const _).div_const, intros x hx, right, linarith } },
  intro c, rcases le_total 0 c with hc|hc,
  { exact this c hc },
  { rw [interval_integrable.iff_comp_neg, neg_zero],
    have m := (this (-c) (by linarith)).smul (cos (r * π)),
    rw interval_integrable_iff at m ⊢,
    refine m.congr_fun _ measurable_set_Ioc, intros x hx,
    rw interval_oc_of_le (by linarith : 0 ≤ -c) at hx,
    simp only [pi.smul_apply, algebra.id.smul_eq_mul, log_neg_eq_log, mul_comm,
      rpow_def_of_pos hx.1, rpow_def_of_neg (by linarith [hx.1] : -x < 0)], }
end

lemma interval_integrable_cpow {r : ℂ} (ha : 0 < a) (hb : 0 < b) :
  interval_integrable (λ x : ℝ, (x : ℂ) ^ r) volume a b :=
begin
  refine (complex.continuous_of_real.continuous_on.cpow_const _).interval_integrable,
  intros c hc,
  left,
  exact_mod_cast lt_of_lt_of_le (lt_min ha hb) hc.left,
end

@[simp]
lemma interval_integrable_id : interval_integrable (λ x, x) μ a b :=
continuous_id.interval_integrable a b

@[simp]
lemma interval_integrable_const : interval_integrable (λ x, c) μ a b :=
continuous_const.interval_integrable a b

@[simp]
lemma interval_integrable.const_mul (h : interval_integrable f ν a b) :
  interval_integrable (λ x, c * f x) ν a b :=
by convert h.smul c

@[simp]
lemma interval_integrable.mul_const (h : interval_integrable f ν a b) :
  interval_integrable (λ x, f x * c) ν a b :=
by simp only [mul_comm, interval_integrable.const_mul c h]

@[simp]
lemma interval_integrable.div (h : interval_integrable f ν a b) :
  interval_integrable (λ x, f x / c) ν a b :=
interval_integrable.mul_const c⁻¹ h

lemma interval_integrable_one_div (h : ∀ x : ℝ, x ∈ [a, b] → f x ≠ 0)
  (hf : continuous_on f [a, b]) :
  interval_integrable (λ x, 1 / f x) μ a b :=
(continuous_on_const.div hf h).interval_integrable

@[simp]
lemma interval_integrable_inv (h : ∀ x : ℝ, x ∈ [a, b] → f x ≠ 0)
  (hf : continuous_on f [a, b]) :
  interval_integrable (λ x, (f x)⁻¹) μ a b :=
by simpa only [one_div] using interval_integrable_one_div h hf

@[simp]
lemma interval_integrable_exp : interval_integrable exp μ a b :=
continuous_exp.interval_integrable a b

@[simp]
lemma interval_integrable.log
  (hf : continuous_on f [a, b]) (h : ∀ x : ℝ, x ∈ [a, b] → f x ≠ 0) :
  interval_integrable (λ x, log (f x)) μ a b :=
(continuous_on.log hf h).interval_integrable

@[simp]
lemma interval_integrable_log (h : (0:ℝ) ∉ [a, b]) :
  interval_integrable log μ a b :=
interval_integrable.log continuous_on_id $ λ x hx, ne_of_mem_of_not_mem hx h

@[simp]
lemma interval_integrable_sin : interval_integrable sin μ a b :=
continuous_sin.interval_integrable a b

@[simp]
lemma interval_integrable_cos : interval_integrable cos μ a b :=
continuous_cos.interval_integrable a b

lemma interval_integrable_one_div_one_add_sq : interval_integrable (λ x : ℝ, 1 / (1 + x^2)) μ a b :=
begin
  refine (continuous_const.div _ (λ x, _)).interval_integrable a b,
  { continuity },
  { nlinarith },
end

@[simp]
lemma interval_integrable_inv_one_add_sq : interval_integrable (λ x : ℝ, (1 + x^2)⁻¹) μ a b :=
by simpa only [one_div] using interval_integrable_one_div_one_add_sq

/-! ### Integrals of the form `c * ∫ x in a..b, f (c * x + d)` -/

@[simp]
lemma mul_integral_comp_mul_right : c * ∫ x in a..b, f (x * c) = ∫ x in a*c..b*c, f x :=
smul_integral_comp_mul_right f c

@[simp]
lemma mul_integral_comp_mul_left : c * ∫ x in a..b, f (c * x) = ∫ x in c*a..c*b, f x :=
smul_integral_comp_mul_left f c

@[simp]
lemma inv_mul_integral_comp_div : c⁻¹ * ∫ x in a..b, f (x / c) = ∫ x in a/c..b/c, f x :=
inv_smul_integral_comp_div f c

@[simp]
lemma mul_integral_comp_mul_add : c * ∫ x in a..b, f (c * x + d) = ∫ x in c*a+d..c*b+d, f x :=
smul_integral_comp_mul_add f c d

@[simp]
lemma mul_integral_comp_add_mul : c * ∫ x in a..b, f (d + c * x) = ∫ x in d+c*a..d+c*b, f x :=
smul_integral_comp_add_mul f c d

@[simp]
lemma inv_mul_integral_comp_div_add : c⁻¹ * ∫ x in a..b, f (x / c + d) = ∫ x in a/c+d..b/c+d, f x :=
inv_smul_integral_comp_div_add f c d

@[simp]
lemma inv_mul_integral_comp_add_div : c⁻¹ * ∫ x in a..b, f (d + x / c) = ∫ x in d+a/c..d+b/c, f x :=
inv_smul_integral_comp_add_div f c d

@[simp]
lemma mul_integral_comp_mul_sub : c * ∫ x in a..b, f (c * x - d) = ∫ x in c*a-d..c*b-d, f x :=
smul_integral_comp_mul_sub f c d

@[simp]
lemma mul_integral_comp_sub_mul : c * ∫ x in a..b, f (d - c * x) = ∫ x in d-c*b..d-c*a, f x :=
smul_integral_comp_sub_mul f c d

@[simp]
lemma inv_mul_integral_comp_div_sub : c⁻¹ * ∫ x in a..b, f (x / c - d) = ∫ x in a/c-d..b/c-d, f x :=
inv_smul_integral_comp_div_sub f c d

@[simp]
lemma inv_mul_integral_comp_sub_div : c⁻¹ * ∫ x in a..b, f (d - x / c) = ∫ x in d-b/c..d-a/c, f x :=
inv_smul_integral_comp_sub_div f c d

end interval_integral

open interval_integral

/-! ### Integrals of simple functions -/

lemma integral_rpow {r : ℝ} (h : -1 < r ∨ (r ≠ -1 ∧ (0 : ℝ) ∉ [a, b])) :
  ∫ x in a..b, x ^ r = (b ^ (r + 1) - a ^ (r + 1)) / (r + 1) :=
begin
  rw sub_div,
  have hderiv : ∀ (x : ℝ), x ≠ 0 → has_deriv_at (λ x : ℝ, x ^ (r + 1) / (r + 1)) (x ^ r) x,
  { intros x hx,
    convert (real.has_deriv_at_rpow_const (or.inl hx)).div_const (r + 1),
    rw [add_sub_cancel, mul_div_cancel_left],
    contrapose! h, rw ←eq_neg_iff_add_eq_zero at h, rw h, tauto, },
  cases h,
  { suffices : ∀ (c : ℝ), ∫ x in 0..c, x ^ r = c ^ (r + 1) / (r + 1),
    { rw [←integral_add_adjacent_intervals
        (interval_integrable_rpow' h) (interval_integrable_rpow' h), this b],
      have t := this a, rw integral_symm at t, apply_fun (λ x, -x) at t, rw neg_neg at t,
      rw t, ring },
    intro c, rcases le_total 0 c with hc|hc,
    { convert integral_eq_sub_of_has_deriv_at_of_le hc _ (λ x hx, hderiv x hx.1.ne') _,
      { rw zero_rpow, ring, linarith,},
      { apply continuous_at.continuous_on, intros x hx,
        refine (continuous_at_id.rpow_const _).div_const, right, linarith,},
      apply interval_integrable_rpow' h },
    { rw integral_symm, symmetry, rw eq_neg_iff_eq_neg,
      convert integral_eq_sub_of_has_deriv_at_of_le hc _ (λ x hx, hderiv x hx.2.ne) _,
      { rw zero_rpow, ring, linarith },
      { apply continuous_at.continuous_on, intros x hx,
        refine (continuous_at_id.rpow_const _).div_const, right, linarith },
      apply interval_integrable_rpow' h, } },
  { have hderiv' : ∀ (x : ℝ), x ∈ [a, b] → has_deriv_at (λ x : ℝ, x ^ (r + 1) / (r + 1)) (x ^ r) x,
    { intros x hx, apply hderiv x, exact ne_of_mem_of_not_mem hx h.2 },
    exact integral_eq_sub_of_has_deriv_at hderiv' (interval_integrable_rpow (or.inr h.2)) },
end

lemma integral_cpow {r : ℂ} (ha : 0 < a) (hb : 0 < b) (hr : r ≠ -1) :
  ∫ (x : ℝ) in a..b, (x : ℂ) ^ r = (b ^ (r + 1) - a ^ (r + 1)) / (r + 1) :=
begin
  suffices : ∀ x ∈ set.interval a b, has_deriv_at (λ x : ℝ, (x : ℂ) ^ (r + 1) / (r + 1)) (x ^ r) x,
  { rw sub_div,
    exact integral_eq_sub_of_has_deriv_at this (interval_integrable_cpow ha hb) },
  intros x hx,
  suffices : has_deriv_at (λ z : ℂ, z ^ (r + 1) / (r + 1)) (x ^ r) x,
  { simpa using has_deriv_at.comp x this complex.of_real_clm.has_deriv_at },
  have hx' : 0 < (x : ℂ).re ∨ (x : ℂ).im ≠ 0,
  { left,
    norm_cast,
    calc 0 < min a b : lt_min ha hb ... ≤ x : hx.left, },
  convert ((has_deriv_at_id (x:ℂ)).cpow_const hx').div_const (r + 1),
  simp only [id.def, add_sub_cancel, mul_one], rw [mul_comm, mul_div_cancel],
  contrapose! hr, rwa add_eq_zero_iff_eq_neg at hr,
end

lemma integral_zpow {n : ℤ} (h : 0 ≤ n ∨ n ≠ -1 ∧ (0 : ℝ) ∉ [a, b]) :
  ∫ x in a..b, x ^ n = (b ^ (n + 1) - a ^ (n + 1)) / (n + 1) :=
begin
  replace h : -1 < (n : ℝ) ∨ (n : ℝ) ≠ -1 ∧ (0 : ℝ) ∉ [a, b], by exact_mod_cast h,
  exact_mod_cast integral_rpow h,
end

@[simp] lemma integral_pow : ∫ x in a..b, x ^ n = (b ^ (n + 1) - a ^ (n + 1)) / (n + 1) :=
by simpa using integral_zpow (or.inl (int.coe_nat_nonneg n))

/-- Integral of `|x - a| ^ n` over `Ι a b`. This integral appears in the proof of the
Picard-Lindelöf/Cauchy-Lipschitz theorem. -/
lemma integral_pow_abs_sub_interval_oc :
  ∫ x in Ι a b, |x - a| ^ n = |b - a| ^ (n + 1) / (n + 1) :=
begin
  cases le_or_lt a b with hab hab,
  { calc ∫ x in Ι a b, |x - a| ^ n = ∫ x in a..b, |x - a| ^ n :
      by rw [interval_oc_of_le hab, ← integral_of_le hab]
    ... = ∫ x in 0..(b - a), x ^ n :
      begin
        simp only [integral_comp_sub_right (λ x, |x| ^ n), sub_self],
        refine integral_congr (λ x hx, congr_arg2 has_pow.pow (abs_of_nonneg $ _) rfl),
        rw interval_of_le (sub_nonneg.2 hab) at hx,
        exact hx.1
      end
    ... = |b - a| ^ (n + 1) / (n + 1) : by simp [abs_of_nonneg (sub_nonneg.2 hab)] },
  { calc ∫ x in Ι a b, |x - a| ^ n = ∫ x in b..a, |x - a| ^ n :
      by rw [interval_oc_of_lt hab, ← integral_of_le hab.le]
    ... = ∫ x in b - a..0, (-x) ^ n :
      begin
        simp only [integral_comp_sub_right (λ x, |x| ^ n), sub_self],
        refine integral_congr (λ x hx, congr_arg2 has_pow.pow (abs_of_nonpos $ _) rfl),
        rw interval_of_le (sub_nonpos.2 hab.le) at hx,
        exact hx.2
      end
    ... = |b - a| ^ (n + 1) / (n + 1) :
      by simp [integral_comp_neg (λ x, x ^ n), abs_of_neg (sub_neg.2 hab)] }
end

@[simp]
lemma integral_id : ∫ x in a..b, x = (b ^ 2 - a ^ 2) / 2 :=
by simpa using integral_pow 1

@[simp]
lemma integral_one : ∫ x in a..b, (1 : ℝ) = b - a :=
by simp only [mul_one, smul_eq_mul, integral_const]

lemma integral_const_on_unit_interval : ∫ x in a..(a + 1), b = b :=
by simp

@[simp]
lemma integral_inv (h : (0:ℝ) ∉ [a, b]) : ∫ x in a..b, x⁻¹ = log (b / a) :=
begin
  have h' := λ x hx, ne_of_mem_of_not_mem hx h,
  rw [integral_deriv_eq_sub' _ deriv_log' (λ x hx, differentiable_at_log (h' x hx))
        (continuous_on_inv₀.mono $ subset_compl_singleton_iff.mpr h),
      log_div (h' b right_mem_interval) (h' a left_mem_interval)],
end

@[simp]
lemma integral_inv_of_pos (ha : 0 < a) (hb : 0 < b) : ∫ x in a..b, x⁻¹ = log (b / a) :=
integral_inv $ not_mem_interval_of_lt ha hb

@[simp]
lemma integral_inv_of_neg (ha : a < 0) (hb : b < 0) : ∫ x in a..b, x⁻¹ = log (b / a) :=
integral_inv $ not_mem_interval_of_gt ha hb

lemma integral_one_div (h : (0:ℝ) ∉ [a, b]) : ∫ x : ℝ in a..b, 1/x = log (b / a) :=
by simp only [one_div, integral_inv h]

lemma integral_one_div_of_pos (ha : 0 < a) (hb : 0 < b) : ∫ x : ℝ in a..b, 1/x = log (b / a) :=
by simp only [one_div, integral_inv_of_pos ha hb]

lemma integral_one_div_of_neg (ha : a < 0) (hb : b < 0) : ∫ x : ℝ in a..b, 1/x = log (b / a) :=
by simp only [one_div, integral_inv_of_neg ha hb]

@[simp]
lemma integral_exp : ∫ x in a..b, exp x = exp b - exp a :=
by rw integral_deriv_eq_sub'; norm_num [continuous_on_exp]

lemma integral_exp_mul_complex {c : ℂ} (hc : c ≠ 0) :
  ∫ x in a..b, complex.exp (c * x) = (complex.exp (c * b) - complex.exp (c * a)) / c :=
begin
  have D : ∀ (x : ℝ), has_deriv_at (λ (y : ℝ), complex.exp (c * y) / c) (complex.exp (c * x)) x,
  { intro x,
    conv { congr, skip, rw ←mul_div_cancel (complex.exp (c * x)) hc, },
    convert ((complex.has_deriv_at_exp _).comp x _).div_const c using 1,
    simpa only [complex.of_real_clm_apply, complex.of_real_one, one_mul, mul_one, mul_comm] using
      complex.of_real_clm.has_deriv_at.mul_const c },
  rw integral_deriv_eq_sub' _ (funext (λ x, (D x).deriv)) (λ x hx, (D x).differentiable_at),
  { ring_nf },
  { apply continuous.continuous_on, continuity,}
end

@[simp]
lemma integral_log (h : (0:ℝ) ∉ [a, b]) :
  ∫ x in a..b, log x = b * log b - a * log a - b + a :=
begin
  obtain ⟨h', heq⟩ := ⟨λ x hx, ne_of_mem_of_not_mem hx h, λ x hx, mul_inv_cancel (h' x hx)⟩,
  convert integral_mul_deriv_eq_deriv_mul (λ x hx, has_deriv_at_log (h' x hx))
      (λ x hx, has_deriv_at_id x)
      (continuous_on_inv₀.mono $ subset_compl_singleton_iff.mpr h).interval_integrable
      continuous_on_const.interval_integrable using 1;
    simp [integral_congr heq, mul_comm, ← sub_add],
end

@[simp]
lemma integral_log_of_pos (ha : 0 < a) (hb : 0 < b) :
  ∫ x in a..b, log x = b * log b - a * log a - b + a :=
integral_log $ not_mem_interval_of_lt ha hb

@[simp]
lemma integral_log_of_neg (ha : a < 0) (hb : b < 0) :
  ∫ x in a..b, log x = b * log b - a * log a - b + a :=
integral_log $ not_mem_interval_of_gt ha hb

@[simp]
lemma integral_sin : ∫ x in a..b, sin x = cos a - cos b :=
by rw integral_deriv_eq_sub' (λ x, -cos x); norm_num [continuous_on_sin]

@[simp]
lemma integral_cos : ∫ x in a..b, cos x = sin b - sin a :=
by rw integral_deriv_eq_sub'; norm_num [continuous_on_cos]

lemma integral_cos_sq_sub_sin_sq :
  ∫ x in a..b, cos x ^ 2 - sin x ^ 2 = sin b * cos b - sin a * cos a :=
by simpa only [sq, sub_eq_add_neg, neg_mul_eq_mul_neg] using integral_deriv_mul_eq_sub
  (λ x hx, has_deriv_at_sin x) (λ x hx, has_deriv_at_cos x) continuous_on_cos.interval_integrable
  continuous_on_sin.neg.interval_integrable

@[simp]
lemma integral_inv_one_add_sq : ∫ x : ℝ in a..b, (1 + x^2)⁻¹ = arctan b - arctan a :=
begin
  simp only [← one_div],
  refine integral_deriv_eq_sub' _ _ _ (continuous_const.div _ (λ x, _)).continuous_on,
  { norm_num },
  { norm_num },
  { continuity },
  { nlinarith },
end

lemma integral_one_div_one_add_sq : ∫ x : ℝ in a..b, 1 / (1 + x^2) = arctan b - arctan a :=
by simp only [one_div, integral_inv_one_add_sq]

/-! ### Integral of `sin x ^ n` -/

lemma integral_sin_pow_aux :
  ∫ x in a..b, sin x ^ (n + 2) = sin a ^ (n + 1) * cos a - sin b ^ (n + 1) * cos b
    + (n + 1) * (∫ x in a..b, sin x ^ n) - (n + 1) * ∫ x in a..b, sin x ^ (n + 2) :=
begin
  let C := sin a ^ (n + 1) * cos a - sin b ^ (n + 1) * cos b,
  have h : ∀ α β γ : ℝ, α * (β * α * γ) = β * (α * α * γ) := λ α β γ, by ring,
  have hu : ∀ x ∈ _, has_deriv_at (λ y, sin y ^ (n + 1 : ℕ)) ((n + 1 : ℕ) * cos x * sin x ^ n) x :=
    λ x hx, by simpa only [mul_right_comm] using (has_deriv_at_sin x).pow,
  have hv : ∀ x ∈ [a, b], has_deriv_at (-cos) (sin x) x :=
    λ x hx, by simpa only [neg_neg] using (has_deriv_at_cos x).neg,
  have H := integral_mul_deriv_eq_deriv_mul hu hv _ _,
  calc  ∫ x in a..b, sin x ^ (n + 2)
      = ∫ x in a..b, sin x ^ (n + 1) * sin x                   : by simp only [pow_succ']
  ... = C + (n + 1) * ∫ x in a..b, cos x ^ 2 * sin x ^ n       : by simp [H, h, sq]
  ... = C + (n + 1) * ∫ x in a..b, sin x ^ n - sin x ^ (n + 2) : by simp [cos_sq', sub_mul,
                                                                          ← pow_add, add_comm]
  ... = C + (n + 1) * (∫ x in a..b, sin x ^ n) - (n + 1) * ∫ x in a..b, sin x ^ (n + 2) :
    by rw [integral_sub, mul_sub, add_sub_assoc]; apply continuous.interval_integrable; continuity,
  all_goals { apply continuous.interval_integrable, continuity },
end

/-- The reduction formula for the integral of `sin x ^ n` for any natural `n ≥ 2`. -/
lemma integral_sin_pow :
  ∫ x in a..b, sin x ^ (n + 2) = (sin a ^ (n + 1) * cos a - sin b ^ (n + 1) * cos b) / (n + 2)
    + (n + 1) / (n + 2) * ∫ x in a..b, sin x ^ n :=
begin
  have : (n : ℝ) + 2 ≠ 0 := by exact_mod_cast succ_ne_zero n.succ,
  field_simp,
  convert eq_sub_iff_add_eq.mp (integral_sin_pow_aux n),
  ring,
end

@[simp]
lemma integral_sin_sq : ∫ x in a..b, sin x ^ 2 = (sin a * cos a - sin b * cos b + b - a) / 2 :=
by field_simp [integral_sin_pow, add_sub_assoc]

theorem integral_sin_pow_odd :
  ∫ x in 0..π, sin x ^ (2 * n + 1) = 2 * ∏ i in range n, (2 * i + 2) / (2 * i + 3) :=
begin
  induction n with k ih, { norm_num },
  rw [prod_range_succ_comm, mul_left_comm, ← ih, mul_succ, integral_sin_pow],
  norm_cast,
  simp [-cast_add] with field_simps,
end

theorem integral_sin_pow_even :
  ∫ x in 0..π, sin x ^ (2 * n) = π * ∏ i in range n, (2 * i + 1) / (2 * i + 2) :=
begin
  induction n with k ih, { simp },
  rw [prod_range_succ_comm, mul_left_comm, ← ih, mul_succ, integral_sin_pow],
  norm_cast,
  simp [-cast_add] with field_simps,
end

lemma integral_sin_pow_pos : 0 < ∫ x in 0..π, sin x ^ n :=
begin
  rcases even_or_odd' n with ⟨k, (rfl | rfl)⟩;
  simp only [integral_sin_pow_even, integral_sin_pow_odd];
  refine mul_pos (by norm_num [pi_pos]) (prod_pos (λ n hn, div_pos _ _));
  norm_cast;
  linarith,
end

lemma integral_sin_pow_succ_le : ∫ x in 0..π, sin x ^ (n + 1) ≤ ∫ x in 0..π, sin x ^ n :=
let H := λ x h, pow_le_pow_of_le_one (sin_nonneg_of_mem_Icc h) (sin_le_one x) (n.le_add_right 1) in
by refine integral_mono_on pi_pos.le _ _ H; exact (continuous_sin.pow _).interval_integrable 0 π

lemma integral_sin_pow_antitone : antitone (λ n : ℕ, ∫ x in 0..π, sin x ^ n) :=
antitone_nat_of_succ_le integral_sin_pow_succ_le

/-! ### Integral of `cos x ^ n` -/

lemma integral_cos_pow_aux :
  ∫ x in a..b, cos x ^ (n + 2) = cos b ^ (n + 1) * sin b - cos a ^ (n + 1) * sin a
    + (n + 1) * (∫ x in a..b, cos x ^ n) - (n + 1) * ∫ x in a..b, cos x ^ (n + 2) :=
begin
  let C := cos b ^ (n + 1) * sin b - cos a ^ (n + 1) * sin a,
  have h : ∀ α β γ : ℝ, α * (β * α * γ) = β * (α * α * γ) := λ α β γ, by ring,
  have hu : ∀ x ∈ _, has_deriv_at (λ y, cos y ^ (n + 1)) (-(n + 1 : ℕ) * sin x * cos x ^ n) x :=
    λ x hx, by simpa only [mul_right_comm, neg_mul, mul_neg]
      using (has_deriv_at_cos x).pow,
  have hv : ∀ x ∈ [a, b], has_deriv_at sin (cos x) x := λ x hx, has_deriv_at_sin x,
  have H := integral_mul_deriv_eq_deriv_mul hu hv _ _,
  calc  ∫ x in a..b, cos x ^ (n + 2)
      = ∫ x in a..b, cos x ^ (n + 1) * cos x                   : by simp only [pow_succ']
  ... = C + (n + 1) * ∫ x in a..b, sin x ^ 2 * cos x ^ n       : by simp [H, h, sq, -neg_add_rev]
  ... = C + (n + 1) * ∫ x in a..b, cos x ^ n - cos x ^ (n + 2) : by simp [sin_sq, sub_mul,
                                                                          ← pow_add, add_comm]
  ... = C + (n + 1) * (∫ x in a..b, cos x ^ n) - (n + 1) * ∫ x in a..b, cos x ^ (n + 2) :
    by rw [integral_sub, mul_sub, add_sub_assoc]; apply continuous.interval_integrable; continuity,
  all_goals { apply continuous.interval_integrable, continuity },
end

/-- The reduction formula for the integral of `cos x ^ n` for any natural `n ≥ 2`. -/
lemma integral_cos_pow :
  ∫ x in a..b, cos x ^ (n + 2) = (cos b ^ (n + 1) * sin b - cos a ^ (n + 1) * sin a) / (n + 2)
    + (n + 1) / (n + 2) * ∫ x in a..b, cos x ^ n :=
begin
  have : (n : ℝ) + 2 ≠ 0 := by exact_mod_cast succ_ne_zero n.succ,
  field_simp,
  convert eq_sub_iff_add_eq.mp (integral_cos_pow_aux n),
  ring,
end

@[simp]
lemma integral_cos_sq : ∫ x in a..b, cos x ^ 2 = (cos b * sin b - cos a * sin a + b - a) / 2 :=
by field_simp [integral_cos_pow, add_sub_assoc]

/-! ### Integral of `sin x ^ m * cos x ^ n` -/

/-- Simplification of the integral of `sin x ^ m * cos x ^ n`, case `n` is odd. -/
lemma integral_sin_pow_mul_cos_pow_odd (m n : ℕ) :
  ∫ x in a..b, sin x ^ m * cos x ^ (2 * n + 1) = ∫ u in sin a..sin b, u ^ m * (1 - u ^ 2) ^ n :=
have hc : continuous (λ u : ℝ, u ^ m * (1 - u ^ 2) ^ n), by continuity,
calc  ∫ x in a..b, sin x ^ m * cos x ^ (2 * n + 1)
    = ∫ x in a..b, sin x ^ m * (1 - sin x ^ 2) ^ n * cos x : by simp only [pow_succ', ← mul_assoc,
                                                                           pow_mul, cos_sq']
... = ∫ u in sin a..sin b, u ^ m * (1 - u ^ 2) ^ n         : integral_comp_mul_deriv
                                                              (λ x hx, has_deriv_at_sin x)
                                                                continuous_on_cos hc

/-- The integral of `sin x * cos x`, given in terms of sin².
  See `integral_sin_mul_cos₂` below for the integral given in terms of cos². -/
@[simp]
lemma integral_sin_mul_cos₁ :
  ∫ x in a..b, sin x * cos x = (sin b ^ 2 - sin a ^ 2) / 2 :=
by simpa using integral_sin_pow_mul_cos_pow_odd 1 0

@[simp]
lemma integral_sin_sq_mul_cos :
  ∫ x in a..b, sin x ^ 2 * cos x = (sin b ^ 3 - sin a ^ 3) / 3 :=
by simpa using integral_sin_pow_mul_cos_pow_odd 2 0

@[simp]
lemma integral_cos_pow_three :
  ∫ x in a..b, cos x ^ 3 = sin b - sin a - (sin b ^ 3 - sin a ^ 3) / 3 :=
by simpa using integral_sin_pow_mul_cos_pow_odd 0 1

/-- Simplification of the integral of `sin x ^ m * cos x ^ n`, case `m` is odd. -/
lemma integral_sin_pow_odd_mul_cos_pow (m n : ℕ) :
  ∫ x in a..b, sin x ^ (2 * m + 1) * cos x ^ n = ∫ u in cos b..cos a, u ^ n * (1 - u ^ 2) ^ m :=
have hc : continuous (λ u : ℝ, u ^ n * (1 - u ^ 2) ^ m), by continuity,
calc   ∫ x in a..b, sin x ^ (2 * m + 1) * cos x ^ n
    = -∫ x in b..a, sin x ^ (2 * m + 1) * cos x ^ n          : by rw integral_symm
... =  ∫ x in b..a, (1 - cos x ^ 2) ^ m * -sin x * cos x ^ n : by simp [pow_succ', pow_mul, sin_sq]
... =  ∫ x in b..a, cos x ^ n * (1 - cos x ^ 2) ^ m * -sin x : by { congr, ext, ring }
... =  ∫ u in cos b..cos a, u ^ n * (1 - u ^ 2) ^ m          : integral_comp_mul_deriv
                                                                (λ x hx, has_deriv_at_cos x)
                                                                  continuous_on_sin.neg hc

/-- The integral of `sin x * cos x`, given in terms of cos².
See `integral_sin_mul_cos₁` above for the integral given in terms of sin². -/
lemma integral_sin_mul_cos₂  :
  ∫ x in a..b, sin x * cos x = (cos a ^ 2 - cos b ^ 2) / 2 :=
by simpa using integral_sin_pow_odd_mul_cos_pow 0 1

@[simp]
lemma integral_sin_mul_cos_sq :
  ∫ x in a..b, sin x * cos x ^ 2 = (cos a ^ 3 - cos b ^ 3) / 3 :=
by simpa using integral_sin_pow_odd_mul_cos_pow 0 2

@[simp]
lemma integral_sin_pow_three :
  ∫ x in a..b, sin x ^ 3 = cos a - cos b - (cos a ^ 3 - cos b ^ 3) / 3 :=
by simpa using integral_sin_pow_odd_mul_cos_pow 1 0

/-- Simplification of the integral of `sin x ^ m * cos x ^ n`, case `m` and `n` are both even. -/
lemma integral_sin_pow_even_mul_cos_pow_even (m n : ℕ) :
    ∫ x in a..b, sin x ^ (2 * m) * cos x ^ (2 * n)
  = ∫ x in a..b, ((1 - cos (2 * x)) / 2) ^ m * ((1 + cos (2 * x)) / 2) ^ n :=
by field_simp [pow_mul, sin_sq, cos_sq, ← sub_sub, (by ring : (2:ℝ) - 1 = 1)]

@[simp]
lemma integral_sin_sq_mul_cos_sq :
  ∫ x in a..b, sin x ^ 2 * cos x ^ 2 = (b - a) / 8 - (sin (4 * b) - sin (4 * a)) / 32 :=
begin
  convert integral_sin_pow_even_mul_cos_pow_even 1 1 using 1,
  have h1 : ∀ c : ℝ, (1 - c) / 2 * ((1 + c) / 2) = (1 - c ^ 2) / 4 := λ c, by ring,
  have h2 : continuous (λ x, cos (2 * x) ^ 2) := by continuity,
  have h3 : ∀ x, cos x * sin x = sin (2 * x) / 2, { intro, rw sin_two_mul, ring },
  have h4 : ∀ d : ℝ, 2 * (2 * d) = 4 * d := λ d, by ring,
  simp [h1, h2.interval_integrable, integral_comp_mul_left (λ x, cos x ^ 2), h3, h4],
  ring,
end


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.well_founded
import Mathlib.order.order_iso_nat
import Mathlib.data.set.finite
import Mathlib.tactic.tfae
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Compactness properties for complete lattices

For complete lattices, there are numerous equivalent ways to express the fact that the relation `>`
is well-founded. In this file we define three especially-useful characterisations and provide
proofs that they are indeed equivalent to well-foundedness.

## Main definitions
 * `complete_lattice.is_sup_closed_compact`
 * `complete_lattice.is_Sup_finite_compact`
 * `complete_lattice.is_compact_element`
 * `complete_lattice.is_compactly_generated`

## Main results
The main result is that the following four conditions are equivalent for a complete lattice:
 * `well_founded (>)`
 * `complete_lattice.is_sup_closed_compact`
 * `complete_lattice.is_Sup_finite_compact`
 * `∀ k, complete_lattice.is_compact_element k`

This is demonstrated by means of the following four lemmas:
 * `complete_lattice.well_founded.is_Sup_finite_compact`
 * `complete_lattice.is_Sup_finite_compact.is_sup_closed_compact`
 * `complete_lattice.is_sup_closed_compact.well_founded`
 * `complete_lattice.is_Sup_finite_compact_iff_all_elements_compact`

 We also show well-founded lattices are compactly generated
 (`complete_lattice.compactly_generated_of_well_founded`).

## Tags

complete lattice, well-founded, compact
-/

namespace complete_lattice

/-- A compactness property for a complete lattice is that any `sup`-closed non-empty subset
contains its `Sup`. -/
def is_sup_closed_compact (α : Type u_1) [complete_lattice α] :=
  ∀ (s : set α), set.nonempty s → (∀ (a b : α), a ∈ s → b ∈ s → a ⊔ b ∈ s) → Sup s ∈ s

/-- A compactness property for a complete lattice is that any subset has a finite subset with the
same `Sup`. -/
def is_Sup_finite_compact (α : Type u_1) [complete_lattice α] :=
  ∀ (s : set α), ∃ (t : finset α), ↑t ⊆ s ∧ Sup s = finset.sup t id

/-- An element `k` of a complete lattice is said to be compact if any set with `Sup`
above `k` has a finite subset with `Sup` above `k`.  Such an element is also called
"finite" or "S-compact". -/
def is_compact_element {α : Type u_1} [complete_lattice α] (k : α) :=
  ∀ (s : set α), k ≤ Sup s → ∃ (t : finset α), ↑t ⊆ s ∧ k ≤ finset.sup t id

/-- A complete lattice is said to be compactly generated if any
element is the `Sup` of compact elements. -/
def is_compactly_generated (α : Type u_1) [complete_lattice α] :=
  ∀ (x : α), ∃ (s : set α), (∀ (x : α), x ∈ s → is_compact_element x) ∧ Sup s = x

/-- An element `k` is compact if and only if any directed set with `Sup` above
`k` already got above `k` at some point in the set. -/
theorem is_compact_element_iff_le_of_directed_Sup_le (α : Type u_1) [complete_lattice α] (k : α) : is_compact_element k ↔ ∀ (s : set α), set.nonempty s → directed_on LessEq s → k ≤ Sup s → ∃ (x : α), x ∈ s ∧ k ≤ x := sorry

theorem finset_sup_compact_of_compact {α : Type u_1} {β : Type u_2} [complete_lattice α] {f : β → α} (s : finset β) (h : ∀ (x : β), x ∈ s → is_compact_element (f x)) : is_compact_element (finset.sup s f) := sorry

theorem well_founded.is_Sup_finite_compact (α : Type u_1) [complete_lattice α] (h : well_founded gt) : is_Sup_finite_compact α := sorry

theorem is_Sup_finite_compact.is_sup_closed_compact (α : Type u_1) [complete_lattice α] (h : is_Sup_finite_compact α) : is_sup_closed_compact α := sorry

theorem is_sup_closed_compact.well_founded (α : Type u_1) [complete_lattice α] (h : is_sup_closed_compact α) : well_founded gt := sorry

theorem is_Sup_finite_compact_iff_all_elements_compact (α : Type u_1) [complete_lattice α] : is_Sup_finite_compact α ↔ ∀ (k : α), is_compact_element k := sorry

theorem well_founded_characterisations (α : Type u_1) [complete_lattice α] : tfae [well_founded gt, is_Sup_finite_compact α, is_sup_closed_compact α, ∀ (k : α), is_compact_element k] := sorry

theorem well_founded_iff_is_Sup_finite_compact (α : Type u_1) [complete_lattice α] : well_founded gt ↔ is_Sup_finite_compact α :=
  list.tfae.out (well_founded_characterisations α) 0 1

theorem is_Sup_finite_compact_iff_is_sup_closed_compact (α : Type u_1) [complete_lattice α] : is_Sup_finite_compact α ↔ is_sup_closed_compact α :=
  list.tfae.out (well_founded_characterisations α) 1 (bit0 1)

theorem is_sup_closed_compact_iff_well_founded (α : Type u_1) [complete_lattice α] : is_sup_closed_compact α ↔ well_founded gt :=
  list.tfae.out (well_founded_characterisations α) (bit0 1) 0

theorem Mathlib.is_Sup_finite_compact.well_founded (α : Type u_1) [complete_lattice α] : is_Sup_finite_compact α → well_founded gt :=
  iff.mpr (well_founded_iff_is_Sup_finite_compact α)

theorem Mathlib.is_sup_closed_compact.is_Sup_finite_compact (α : Type u_1) [complete_lattice α] : is_sup_closed_compact α → is_Sup_finite_compact α :=
  iff.mpr (is_Sup_finite_compact_iff_is_sup_closed_compact α)

theorem Mathlib.well_founded.is_sup_closed_compact (α : Type u_1) [complete_lattice α] : well_founded gt → is_sup_closed_compact α :=
  iff.mpr (is_sup_closed_compact_iff_well_founded α)

theorem compactly_generated_of_well_founded (α : Type u_1) [complete_lattice α] (h : well_founded gt) : is_compactly_generated α := sorry