/- A shallow embedding of temporal logic -/

import galois.tactic
import galois.nat.lemmas
import galois.subset.subset

universe variables u v

open subset

namespace temporal

/--An ordered series of events over states --/
def trace (T : Type u) : Type u := nat -> T

/--Type of Propositions over traces --/
@[reducible]
def tProp (T : Type u) := subset (trace T)

/- This defines a simp attribute named ltl
   later we can say "simp with ltl" in order
   to simplify any rule with this attribute -/
run_cmd mk_simp_attr `ltl
run_cmd mk_simp_attr `tImp
run_cmd mk_simp_attr `trace_map

/--
Move a trace forward in time by n
-/
@[ltl]
def delayn {T : Type u} (n : ℕ) (tr : trace T) := (λ t : ℕ, tr (t + n))

/--
If we move forward twice, we can move forward once by the sum
-/
lemma delayn_combine {T : Type u} (n k : ℕ) (tr : trace T)
  : delayn k (delayn n tr) = delayn (k + n) tr
:= begin
apply funext, intros n, simp with ltl,
end

/--
Delay 0 does nothing
-/
lemma delayn_zero {T : Type u} (tr : trace T)
  : delayn 0 tr = tr := rfl

/--
Lift a prop into ltl at the given time
-/
@[ltl]
def nextn {T : Type u} (n : ℕ) (P : tProp T) : tProp T
  := λ tr, P (delayn n tr)

/--
We can combine multiple nextn
-/
lemma nextn_combine {T : Type u} (n k : ℕ) (P : tProp T)
  : nextn k (nextn n P) = nextn (n + k) P
:= begin
unfold nextn, apply funext, intros, rw delayn_combine
end

/-- Proposition P holds in the next state notation ◯ \ciO --/
@[ltl]
def next {T : Type u} : tProp T → tProp T := nextn 1

notation `◯` := next

/--
Nextn maintains decidability
-/
instance nextn_decidable {T : Type u} (P : tProp T) [decidable_pred P]
  (n : ℕ) : decidable_pred (nextn n P)
:= begin unfold nextn, apply_instance, end

/--
next maintains decidability
-/
instance next_decidable {T : Type u} (P : tProp T) [decidable_pred P]
  : decidable_pred (◯ P)
:= begin unfold next, apply_instance end

/-- Proposition P always holds notation □ \B --/
@[ltl]
def always {T: Type u} (P : tProp T) : tProp T :=
-- given a trace, P holds no matter how far forward we move the trace
 λ (tr : trace T), ∀ n : ℕ, P (delayn n tr)

notation `□` := always

/-- Proposition P eventually holds notation ◇ \dia -/
@[ltl]
def eventually {T: Type u} (P : tProp T) : tProp T :=
-- given a trace, we can find some n such that advancing
-- the trace by n allows p to hold on that trace
 λ (tr : trace T), ∃ n : ℕ, P (delayn n tr)

notation `◇` := eventually

/-- Until, notation \MCU --/
@[ltl]
def until {T : Type u} (P Q : tProp T) : tProp T :=
λ (tr : trace T), ∃ n, Q (delayn n tr) /\ (∀ n', n' < n -> P (delayn n' tr))

-- \MCU
infix `𝓤` : 50 := until

@[ltl]
def tInj1 {T: Type u} (R : Prop -> Prop) (P : tProp T) :=
λ (tr : trace T), R (P tr)

/-- Standard negation on tProps --/
@[ltl]
def tNot {T : Type u} (P : tProp T ) := tInj1 not P

/-- Proposition P holds for the first time -/
@[ltl]
def first {T : Type u} (P: tProp T) : tProp T := tNot P 𝓤 P

@[ltl, tImp]
def tInj2 {T: Type u} (R : Prop -> Prop -> Prop) (P Q : subset T) :=
λ (tr : T), R (P tr) (Q tr)

/-- Lifting of iff --/
@[ltl, tImp]
def tIff {T : Type u} (P Q : tProp T) : tProp T :=
tInj2 iff P Q

infixr `<=>` : 50 := tIff

/-- P holds at the nth step of some trace --/
@[ltl]
def later {T : Type u} (P : subset T) (n: nat) : tProp T :=
λ (tr : trace T), P (tr n)

/-- P holds at the first step of trace --/
@[ltl]
def now {T : Type u} (P: T -> Prop) := later P 0

/-- later maintains decidability-/
instance later_decidable {T : Type u} (P : T → Prop)
  (n : ℕ) [decidable_pred P]
  : decidable_pred (later P n)
:= begin
unfold later, apply_instance,
end

/-- now maintains decidability-/
instance now_decidable {T : Type u} (P : T → Prop) [decidable_pred P]
  : decidable_pred (now P)
:= begin
unfold now, apply_instance,
end

lemma later_mono (T : Type u) (n : ℕ) : monotone (λ P, @later T P n) :=
begin
intros P Q PQ tr, apply PQ,
end

lemma now_mono (T : Type u) : monotone (@now T) :=
begin
unfold monotone now, apply later_mono,
end

/-- Fairness constraints on a trace require that
    something happens infinitely often --/
@[ltl]
def fair {T : Type u} (P : tProp T) := □ (◇ P)

notation `⊩` P := forall tr, P tr

lemma eventually_always_mono {T : Type u} (A B : tProp T)
  : ⊩ □ (A => B) => ◇ A => ◇ B
:= begin
intros tr AB HA, induction HA with k HA,
unfold eventually, existsi k,
apply AB, assumption
end

lemma eventually_mono {T : Type u} (A B : tProp T)
  (AB : A ≤ B)
  : ◇ A ≤ ◇ B
:= begin
intros tr HA, apply eventually_always_mono,
intros n, apply AB, assumption
end

lemma until_always_mono {T : Type u} {A B P : tProp T}
  : ⊩ □ (A => B) => A 𝓤 P => B 𝓤 P
:= begin
intros tr AB AP, induction AP with k Hk,
induction Hk with H1 H2,
unfold until, existsi k, split, assumption,
intros, apply AB, apply H2, assumption
end

lemma until_mono {T : Type u} {A B P : tProp T}
  (AB : A ≤ B)
  : (A 𝓤 P) ≤ (B 𝓤 P)
:= begin
intros tr AP,  apply until_always_mono,
intros n, apply AB, assumption
end

lemma until_always_mono_r {T : Type u} {P A B : tProp T}
  : ⊩ □ (A => B) => P 𝓤 A => P 𝓤 B
:= begin
intros tr AB H, induction H with k Hk,
induction Hk with H1 H2,
constructor, split, apply AB, assumption, assumption
end

lemma and_imp_l {T : Type u} (P Q : tProp T)
  : ⊩ (P ∩ Q) => P
:= begin
intros tr H, induction H with HP HQ, assumption,
end

lemma and_imp_r {T : Type u} (P Q : tProp T)
  : ⊩ (P ∩ Q) => Q
:= begin
intros tr H, induction H with HP HQ, assumption,
end

lemma eventually_and_r {T : Type u} (P Q : tProp T)
 : ⊩ ◇ (P ∩ Q) => ◇ Q
:= begin
apply eventually_mono, apply and_imp_r,
end

/-- Pull out implication from always --/
lemma always_imp : forall {T : Type u} (P Q : tProp T),
(⊩ always (P => Q)) -> ((⊩ always P) -> (⊩ always Q)) :=
begin
simp with ltl,
intros,
    apply a,
    apply a_1,
end

lemma always_tImp : forall {T : Type u} (P Q : tProp T),
(⊩ □ (P => Q)) -> (⊩ □ P => □ Q) :=
begin
intros, intros H n, apply a, apply H,
end

lemma always_tautology {T : Type u} (P : tProp T) :
(⊩ P) → (⊩ □ P) :=
begin
intros, intros n, apply a,
end

/-- pull out top level implication --/
lemma imp_e : ∀ {T : Type u} (P Q : tProp T),
(⊩ (P => Q)) -> ((⊩ P) -> (⊩ Q)) :=
begin
intros, apply a, apply a_1
end

lemma always_mono {T : Type u} (P Q : tProp T)
  (H : P ≤ Q)
  : □ P ≤ □ Q
:= begin
intros tr HP n, apply H, apply HP,
end

lemma nextn_mono {T : Type u} {P Q : tProp T}
  (H : P ≤ Q) (n : ℕ)
  : nextn n P ≤ nextn n Q
:= begin
unfold nextn, intros x H', apply H, assumption
end

lemma next_mono {T : Type u} {P Q : tProp T}
 (H : P ≤ Q) : ◯ P ≤ ◯ Q
 := nextn_mono H 1

/-- always distributes over and --/
lemma always_and {T: Type u} (P Q : tProp T) :
 □ P ∩ □ Q = □ (P ∩ Q)
:= begin
apply funext, intros tr, apply propext,
split; intros H,
{ induction H with HP HQ,
  intros n, constructor, apply HP, apply HQ },
{ constructor,
  { apply always_mono, apply (and_imp_l _ Q), assumption },
  { apply always_mono, apply (and_imp_r P _), assumption }
}
end

def repeat_next {t : Type u} (P : t -> Prop) : nat -> tProp t
| 0 := later P 0
| (nat.succ n') := next (repeat_next n')

/-- lift_at is the same as repeated applictions of next --/
lemma lift_at_n : forall {T : Type u} (P : T -> Prop),
    repeat_next P = later P :=
begin
intros, apply funext, intros n,
apply funext, induction n; intros; simp [repeat_next],
unfold next nextn,
rw ih_1, simp [later, delayn],
end

/-- equivalence between eventually and until tt --/
lemma eventually_until {T : Type u} (P: tProp T) :
  ◇ P = (tt 𝓤 P)
 :=
begin
apply funext, intro tr, apply propext,
split; intros H,
{ induction H with k Hk,
  unfold until, existsi k, split, assumption,
  intros, trivial,
},
{
  induction H with k Hk,
  induction Hk with Hk1 Hk2,
  unfold eventually, existsi k, assumption
}
end

lemma congr_arg_app {T : Type u} ( P : T -> Prop) :
forall a1 a2,
P a1 -> a1 = a2 -> P a2 :=
begin
intros,
subst a1,
assumption
end

lemma ne0_succ_exists : forall n : nat,
¬ n = 0 ->
exists n', n = nat.succ n' :=
begin
intros,
cases n,
{ contradiction },
apply exists.intro,
reflexivity
end

lemma always_and_next {T : Type u} (P : tProp T) :
 (□ P) = (P ∩ ◯ (□ P)) :=
begin
apply funext, intros tr,
apply propext, split; intros H,
{
    constructor,
    { rw ← (delayn_zero tr),
      apply H },
    {
        intro n,
        specialize (H (n + 1)),
        rw delayn_combine, assumption
    }
},
{
    induction H with H0 HS,
    intros n, cases n, rw delayn_zero,
    assumption,
    apply HS
}
end

lemma next_delay {T : Type u} {P : tProp T}
  (n : ℕ) (tr : trace T)
  (H : ◯ P (delayn n tr))
  : P (delayn (nat.succ n) tr)
:= begin
dsimp [next, nextn] at H,
rw delayn_combine at H,
rw add_comm at H, assumption
end

lemma temporal_induction {T : Type u} (P : tProp T)
  : ⊩ (P => □ (P => (◯ P)) => □ P) :=
begin
intros tr H0 HS n,
induction n,
{ rw delayn_zero, assumption },
{ specialize (HS a ih_1), apply next_delay, assumption }
end

lemma temporal_induction' {T : Type u} : ∀ (P : tProp T),
  ∀ trace, P trace -> □ (P => (◯ P)) trace -> □ P trace
 := temporal_induction

lemma always_implies_eventually {T : Type u}
  (P Q : tProp T) :
⊩ □ (P => Q) => ◇ P => ◇ Q
:= begin
intros tr PQ evP,
induction evP with k Hk,
constructor, apply PQ, assumption
end

lemma next_eventually {T : Type u} (P : tProp T)
  : ⊩ ◯ P => ◇ P
:= begin
intros tr H, constructor, assumption
end

lemma eventually_return {T : Type u} (P : tProp T)
  : ⊩ P => ◇ P
:= begin
intros tr H, constructor, rw delayn_zero, assumption
end

lemma eventually_idempotent {T : Type u} (P : tProp T)
  : ◇ (◇ P) = ◇ P
:= begin
apply funext, intro tr, apply propext, split; intros H,
{
induction H with k Hk,
induction Hk with n Hn,
rw delayn_combine at Hn,
constructor, assumption
},
{ apply eventually_return, assumption }
end

lemma eventually_absorbs_next {T : Type u} (P : tProp T)
  :  ◇ (◯ P) ≤ ◇ P
:= begin
intros x Hx; induction Hx with k Hk,
unfold next nextn at Hk, rw delayn_combine at Hk,
constructor, assumption,
end

lemma always_idempotent {T : Type u} (P : tProp T)
  : □ (□ P) = □ P
:= begin
apply funext, intro tr, apply propext, split; intros H,
{ specialize (H 0), rw delayn_zero at H, assumption },
{ intros n k, rw delayn_combine, apply H }
end

lemma always_now {T : Type u} (P : tProp T)
  : ⊩ □ P => P
:= begin
intros tr H, rw ← (delayn_zero tr), apply H,
end

lemma always_next {T : Type u} (P : tProp T)
  : ⊩ □ P => ◯ P
:= begin
intros tr H, rw ← (delayn_zero tr), apply H,
end

lemma eventually_cut {T : Type u} {P Q : tProp T}
  : ⊩ ◇ P => □ (P => ◇ Q) => ◇ Q
:= begin
intros tr HP PQ,
rw ← eventually_idempotent,
revert HP, apply eventually_always_mono, assumption,
end

lemma fair_cut {T : Type u} {P Q : tProp T}
  : ⊩ fair P => □ (P => ◇ Q) => fair Q
:= begin
intros tr fairP PQ n,
apply eventually_cut, apply fairP,
rw ← always_idempotent at PQ,
apply PQ,
end

/-- If I have a type A with a well-founded relation R on it,
    then if for every state that measures to some `x : A`,
      if I am at `x` now, I will eventually reach a smaller state or Q happens,
    then if I am in some state that yields an `A`, eventually Q happens.
   Note: your `meas` will likely take the form of `now _` -/
lemma always_eventually_well_founded_option {T : Type u} {A : Type v}
  {R : A → A → Prop} (wf : well_founded R)
  (meas : trace T → option A) (Q : tProp T)
  (tr : trace T)
  (H : ∀ x : A, □ ((λ s, meas s = some x) => ◇ (((λ s,
  match meas s with
  | none := false
  | (some m) := R m x end)) ∪ Q)) tr)
  (z : A) : □ ((λ s, meas s = some z) => ◇ Q) tr
:= begin
have wf_ind := λ x y z, @well_founded.induction _ _ wf x z y,
revert z,
apply (@wf_ind (λ (z : A), □ ((λ s, meas s = some z)=>◇ Q) tr)),
intros x IH n Hn,
specialize (H x n Hn),
induction H with k Hk,
induction Hk with Hk Hk,
{ generalize Hm : ((meas (delayn k (delayn n tr)))) = m,
  rw Hm at Hk,
  induction m;
    dsimp at Hk,
  contradiction,
  specialize (IH _ Hk (k + n)),
  rw ← eventually_idempotent,
  constructor, rw delayn_combine, apply IH,
  simp with ltl, simp with ltl at Hm,
  assumption
  },
{ constructor, assumption }
end

lemma eventually_or {T : Type u} (P Q : tProp T)
  : ◇ (P ∪ Q) = (◇ P) ∪ (◇ Q)
:= begin
apply included_eq; intros x Hx,
{ induction Hx with k Hk,
  induction Hk with Hk Hk,
  left, constructor, assumption,
  right, constructor, assumption
},
{ induction Hx with Hx Hx;
  induction Hx with H Hk,
  constructor, left, assumption,
  constructor, right, assumption,
}
end

/-- Like the above but without partiality: every state is required
    to have some measure.
-/
lemma always_eventually_well_founded {T : Type u} {A : Type v}
  {R : A → A → Prop} (wf : well_founded R)
  (meas : trace T → A) (Q : tProp T)
  (tr : trace T)
  (H : ∀ x : A, □ ((λ s, meas s = x) => ◇ (((λ s, R (meas s) x)) ∪ Q)) tr)
  : □ (◇ Q) tr
:= begin
have H1 := always_eventually_well_founded_option wf (λ x, some (meas x)) Q tr,
intros n, apply H1; clear H1,
{ intros x n H1,
  specialize (H x n), simp with ltl at H1,
  injection H1 with H1', clear H1, subst x,
  apply H, simp with ltl },
{ unfold now later }
end

lemma now_until_eventually {T : Type u}
  {P Q : tProp T}
  : ⊩ P => (◯ P) 𝓤 Q => ◇ (P ∩ Q)
:= begin
intros tr HP Huntil,
induction Huntil with k Hk,
induction Hk with H1 H2,
constructor, constructor; try { assumption },
cases k,
{ rw delayn_zero, assumption },
{ apply next_delay, apply H2, apply nat.le_refl, }
end

lemma until_next {T : Type u} {P Q : tProp T}
: ⊩ (P𝓤(P ∩ Q)) => (P ∩ ◯ P𝓤Q)
:= begin
intros tr QRP,
induction QRP with k Hk, induction Hk with H1 H2,
induction H1 with HP HQ,
unfold until, existsi k, split, assumption,
intros, constructor,
{ apply H2, assumption },
{ unfold next nextn, rw delayn_combine,
rw add_comm,
apply (if H : n' + 1 = k then _ else _),
rw H, assumption, apply H2,
apply nat.lt_succ_ne_lt,
apply nat.succ_lt_succ, assumption, assumption, }
end

lemma not_eventually_always_not {T : Type u} (P : tProp T)
  : tNot (◇ P) = □ (tNot P)
:= begin
apply included_eq,
{ intros tr contra n contra',
apply contra, constructor, assumption, },
{ intros tr H contra,
  induction contra with k Hk,
  apply (H k), assumption }
end

namespace trace
def map {A : Type u} {B : Type v} (f : A → B)
  : trace A → trace B
  := λ tr n, f (tr n)
end trace

section map_props
parameters {A : Type u} {B : Type v} (f : A → B)

@[trace_map]
lemma later_map (P : subset B)
  (n : ℕ) : later P n ∘ trace.map f = later (P ∘ f) n
:= begin
apply funext, intros x, reflexivity,
end

@[trace_map]
lemma now_map (P : subset B)
  : now P ∘ trace.map f = now (P ∘ f)
:= later_map P 0
end map_props

section precompose_props
parameters {A : Type u} {B : Type v}

@[trace_map]
lemma imp_precompose (P Q : tProp B) (f : A → trace B)
  : (P => Q) ∘ f = ((P ∘ f) => (Q ∘ f))
:= rfl

@[trace_map]
lemma and_precompose (P Q : tProp B) (f : A → trace B)
  : (@has_inter.inter _ subset.subset_has_inter P Q) ∘ f
  = (@has_inter.inter _ subset.subset_has_inter (P ∘ f) (Q ∘ f))
:= rfl

@[trace_map]
lemma or_precompose (P Q : tProp B) (f : A → trace B)
  : (@has_union.union _ subset.subset_has_union P Q) ∘ f
  = (@has_union.union _ subset.subset_has_union (P ∘ f) (Q ∘ f))
:= rfl

@[trace_map]
lemma next_map (P : tProp B) (f : A → B)
  : (◯ P) ∘ trace.map f = ◯ (P ∘ trace.map f)
:= rfl

@[trace_map]
lemma always_map (P : tProp B) (f : A → B)
  : (□ P) ∘ trace.map f = □ (P ∘ trace.map f)
:= rfl

@[trace_map]
lemma eventually_map (P : tProp B) (f : A → B)
  : (◇ P) ∘ trace.map f = ◇ (P ∘ trace.map f)
:= rfl

@[trace_map]
lemma fair_map (P : tProp B) (f : A → B)
  : (fair P) ∘ trace.map f = fair (P ∘ trace.map f)
:= rfl

end precompose_props

end temporal

namespace temporalExample
open temporal
def natTrace := temporal.trace nat

def one_at_one : natTrace :=
λ n, if (n = 1) then 1 else 0

lemma nextone : temporal.next (temporal.now (eq 1)) one_at_one:=
begin
simp [one_at_one] with ltl
end

end temporalExample


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import algebra.polynomial.group_ring_action
import field_theory.normal
import field_theory.separable
import field_theory.tower

/-!
# Fixed field under a group action.

This is the basis of the Fundamental Theorem of Galois Theory.
Given a (finite) group `G` that acts on a field `F`, we define `fixed_points G F`,
the subfield consisting of elements of `F` fixed_points by every element of `G`.

This subfield is then normal and separable, and in addition (TODO) if `G` acts faithfully on `F`
then `finrank (fixed_points G F) F = fintype.card G`.

## Main Definitions

- `fixed_points G F`, the subfield consisting of elements of `F` fixed_points by every element of
`G`, where `G` is a group that acts on `F`.

-/

noncomputable theory
open_locale classical big_operators
open mul_action finset finite_dimensional

universes u v w

variables {M : Type u} [monoid M]
variables (G : Type u) [group G]
variables (F : Type v) [field F] [mul_semiring_action M F] [mul_semiring_action G F] (m : M)

/-- The subfield of F fixed by the field endomorphism `m`. -/
def fixed_by.subfield : subfield F :=
{ carrier := fixed_by M F m,
  zero_mem' := smul_zero m,
  add_mem' := λ x y hx hy, (smul_add m x y).trans $ congr_arg2 _ hx hy,
  neg_mem' := λ x hx, (smul_neg m x).trans $ congr_arg _ hx,
  one_mem' := smul_one m,
  mul_mem' := λ x y hx hy, (smul_mul' m x y).trans $ congr_arg2 _ hx hy,
  inv_mem' := λ x hx, (smul_inv'' m x).trans $ congr_arg _ hx }

section invariant_subfields

variables (M) {F}
/-- A typeclass for subrings invariant under a `mul_semiring_action`. -/
class is_invariant_subfield (S : subfield F) : Prop :=
(smul_mem : ∀ (m : M) {x : F}, x ∈ S → m • x ∈ S)

variable (S : subfield F)

instance is_invariant_subfield.to_mul_semiring_action [is_invariant_subfield M S] :
  mul_semiring_action M S :=
{ smul := λ m x, ⟨m • x, is_invariant_subfield.smul_mem m x.2⟩,
  one_smul := λ s, subtype.eq $ one_smul M s,
  mul_smul := λ m₁ m₂ s, subtype.eq $ mul_smul m₁ m₂ s,
  smul_add := λ m s₁ s₂, subtype.eq $ smul_add m s₁ s₂,
  smul_zero := λ m, subtype.eq $ smul_zero m,
  smul_one := λ m, subtype.eq $ smul_one m,
  smul_mul := λ m s₁ s₂, subtype.eq $ smul_mul' m s₁ s₂ }

instance [is_invariant_subfield M S] : is_invariant_subring M (S.to_subring) :=
{ smul_mem := is_invariant_subfield.smul_mem }

end invariant_subfields

namespace fixed_points

variable (M)

-- we use `subfield.copy` so that the underlying set is `fixed_points M F`
/-- The subfield of fixed points by a monoid action. -/
def subfield : subfield F :=
subfield.copy (⨅ (m : M), fixed_by.subfield F m) (fixed_points M F)
(by { ext z, simp [fixed_points, fixed_by.subfield, infi, subfield.mem_Inf] })

instance : is_invariant_subfield M (fixed_points.subfield M F) :=
{ smul_mem := λ g x hx g', by rw [hx, hx] }

instance : smul_comm_class M (fixed_points.subfield M F) F :=
{ smul_comm := λ m f f', show m • (↑f * f') = f * (m • f'), by rw [smul_mul', f.prop m] }

instance smul_comm_class' : smul_comm_class (fixed_points.subfield M F) M F :=
smul_comm_class.symm _ _ _

@[simp] theorem smul (m : M) (x : fixed_points.subfield M F) : m • x = x :=
subtype.eq $ x.2 m

-- Why is this so slow?
@[simp] theorem smul_polynomial (m : M) (p : polynomial (fixed_points.subfield M F)) : m • p = p :=
polynomial.induction_on p
  (λ x, by rw [polynomial.smul_C, smul])
  (λ p q ihp ihq, by rw [smul_add, ihp, ihq])
  (λ n x ih, by rw [smul_mul', polynomial.smul_C, smul, smul_pow', polynomial.smul_X])

instance : algebra (fixed_points.subfield M F) F :=
algebra.of_subring (fixed_points.subfield M F).to_subring

theorem coe_algebra_map :
  algebra_map (fixed_points.subfield M F) F = subfield.subtype (fixed_points.subfield M F) :=
rfl

lemma linear_independent_smul_of_linear_independent {s : finset F} :
  linear_independent (fixed_points.subfield G F) (λ i : (s : set F), (i : F)) →
  linear_independent F (λ i : (s : set F), mul_action.to_fun G F i) :=
begin
  haveI : is_empty ((∅ : finset F) : set F) := ⟨subtype.prop⟩,
  refine finset.induction_on s (λ _, linear_independent_empty_type)
    (λ a s has ih hs, _),
  rw coe_insert at hs ⊢,
  rw linear_independent_insert (mt mem_coe.1 has) at hs,
  rw linear_independent_insert' (mt mem_coe.1 has), refine ⟨ih hs.1, λ ha, _⟩,
  rw finsupp.mem_span_image_iff_total at ha, rcases ha with ⟨l, hl, hla⟩,
  rw [finsupp.total_apply_of_mem_supported F hl] at hla,
  suffices : ∀ i ∈ s, l i ∈ fixed_points.subfield G F,
  { replace hla := (sum_apply _ _ (λ i, l i • to_fun G F i)).symm.trans (congr_fun hla 1),
    simp_rw [pi.smul_apply, to_fun_apply, one_smul] at hla,
    refine hs.2 (hla ▸ submodule.sum_mem _ (λ c hcs, _)),
    change (⟨l c, this c hcs⟩ : fixed_points.subfield G F) • c ∈ _,
    exact submodule.smul_mem _ _ (submodule.subset_span $ mem_coe.2 hcs) },
  intros i his g,
  refine eq_of_sub_eq_zero (linear_independent_iff'.1 (ih hs.1) s.attach (λ i, g • l i - l i) _
    ⟨i, his⟩ (mem_attach _ _) : _),
  refine (@sum_attach _ _ s _ (λ i, (g • l i - l i) • mul_action.to_fun G F i)).trans _,
  ext g', dsimp only,
  conv_lhs { rw sum_apply, congr, skip, funext, rw [pi.smul_apply, sub_smul, smul_eq_mul] },
  rw [sum_sub_distrib, pi.zero_apply, sub_eq_zero],
  conv_lhs { congr, skip, funext,
    rw [to_fun_apply, ← mul_inv_cancel_left g g', mul_smul, ← smul_mul', ← to_fun_apply _ x] },
  show ∑ x in s, g • (λ y, l y • mul_action.to_fun G F y) x (g⁻¹ * g') =
    ∑ x in s, (λ y, l y • mul_action.to_fun G F y) x g',
  rw [← smul_sum, ← sum_apply _ _ (λ y, l y • to_fun G F y),
      ← sum_apply _ _ (λ y, l y • to_fun G F y)], dsimp only,
  rw [hla, to_fun_apply, to_fun_apply, smul_smul, mul_inv_cancel_left]
end

variables [fintype G] (x : F)

/-- `minpoly G F x` is the minimal polynomial of `(x : F)` over `fixed_points G F`. -/
def minpoly : polynomial (fixed_points.subfield G F) :=
(prod_X_sub_smul G F x).to_subring (fixed_points.subfield G F).to_subring $ λ c hc g,
let ⟨n, hc0, hn⟩ := polynomial.mem_frange_iff.1 hc in hn.symm ▸ prod_X_sub_smul.coeff G F x g n

namespace minpoly

theorem eval₂ : polynomial.eval₂ (subring.subtype $ (fixed_points.subfield G F).to_subring) x
  (minpoly G F x) = 0 :=
begin
  rw [← prod_X_sub_smul.eval G F x, polynomial.eval₂_eq_eval_map],
  simp only [minpoly, polynomial.map_to_subring],
end

theorem eval₂' :
  polynomial.eval₂ (subfield.subtype $ (fixed_points.subfield G F)) x (minpoly G F x) = 0 :=
eval₂ G F x

theorem ne_one :
  minpoly G F x ≠ (1 : polynomial (fixed_points.subfield G F)) :=
λ H, have _ := eval₂ G F x,
(one_ne_zero : (1 : F) ≠ 0) $ by rwa [H, polynomial.eval₂_one] at this

theorem of_eval₂ (f : polynomial (fixed_points.subfield G F))
  (hf : polynomial.eval₂ (subfield.subtype $ fixed_points.subfield G F) x f = 0) :
  minpoly G F x ∣ f :=
begin
  erw [← polynomial.map_dvd_map' (subfield.subtype $ fixed_points.subfield G F),
      minpoly, polynomial.map_to_subring _ (subfield G F).to_subring, prod_X_sub_smul],
  refine fintype.prod_dvd_of_coprime
    (polynomial.pairwise_coprime_X_sub $ mul_action.injective_of_quotient_stabilizer G x)
    (λ y, quotient_group.induction_on y $ λ g, _),
  rw [polynomial.dvd_iff_is_root, polynomial.is_root.def, mul_action.of_quotient_stabilizer_mk,
      polynomial.eval_smul',
      ← subfield.to_subring.subtype_eq_subtype,
      ← is_invariant_subring.coe_subtype_hom' G (fixed_points.subfield G F).to_subring,
      ← mul_semiring_action_hom.coe_polynomial, ← mul_semiring_action_hom.map_smul,
      smul_polynomial, mul_semiring_action_hom.coe_polynomial,
      is_invariant_subring.coe_subtype_hom', polynomial.eval_map,
      subfield.to_subring.subtype_eq_subtype, hf, smul_zero]
end

/- Why is this so slow? -/
theorem irreducible_aux (f g : polynomial (fixed_points.subfield G F))
  (hf : f.monic) (hg : g.monic) (hfg : f * g = minpoly G F x) :
  f = 1 ∨ g = 1 :=
begin
  have hf2 : f ∣ minpoly G F x,
  { rw ← hfg, exact dvd_mul_right _ _ },
  have hg2 : g ∣ minpoly G F x,
  { rw ← hfg, exact dvd_mul_left _ _ },
  have := eval₂ G F x,
  rw [← hfg, polynomial.eval₂_mul, mul_eq_zero] at this,
  cases this,
  { right,
    have hf3 : f = minpoly G F x,
    { exact polynomial.eq_of_monic_of_associated hf (monic G F x)
        (associated_of_dvd_dvd hf2 $ @of_eval₂ G _ F _ _ _  x f this) },
    rwa [← mul_one (minpoly G F x), hf3,
        mul_right_inj' (monic G F x).ne_zero] at hfg },
  { left,
    have hg3 : g = minpoly G F x,
    { exact polynomial.eq_of_monic_of_associated hg (monic G F x)
        (associated_of_dvd_dvd hg2 $ @of_eval₂ G _ F _ _ _  x g this) },
    rwa [← one_mul (minpoly G F x), hg3,
        mul_left_inj' (monic G F x).ne_zero] at hfg }
end

theorem irreducible : irreducible (minpoly G F x) :=
(polynomial.irreducible_of_monic (monic G F x) (ne_one G F x)).2 (irreducible_aux G F x)

end minpoly

theorem is_integral : is_integral (fixed_points.subfield G F) x :=
⟨minpoly G F x, minpoly.monic G F x, minpoly.eval₂ G F x⟩

theorem minpoly_eq_minpoly :
  minpoly G F x = _root_.minpoly (fixed_points.subfield G F) x :=
minpoly.eq_of_irreducible_of_monic (minpoly.irreducible G F x)
  (minpoly.eval₂ G F x) (minpoly.monic G F x)

instance normal : normal (fixed_points.subfield G F) F :=
⟨λ x, is_integral G F x, λ x, (polynomial.splits_id_iff_splits _).1 $
by { rw [← minpoly_eq_minpoly, minpoly,
    coe_algebra_map, ← subfield.to_subring.subtype_eq_subtype,
    polynomial.map_to_subring _ (fixed_points.subfield G F).to_subring, prod_X_sub_smul],
  exact polynomial.splits_prod _ (λ _ _, polynomial.splits_X_sub_C _) }⟩

instance separable : is_separable (fixed_points.subfield G F) F :=
⟨λ x, is_integral G F x,
 λ x, by
{ -- this was a plain rw when we were using unbundled subrings
  erw [← minpoly_eq_minpoly,
    ← polynomial.separable_map (fixed_points.subfield G F).subtype,
    minpoly, polynomial.map_to_subring _ ((subfield G F).to_subring) ],
  exact polynomial.separable_prod_X_sub_C_iff.2 (injective_of_quotient_stabilizer G x) }⟩

lemma dim_le_card : module.rank (fixed_points.subfield G F) F ≤ fintype.card G :=
dim_le $ λ s hs, by simpa only [dim_fun', cardinal.mk_finset, finset.coe_sort_coe,
  cardinal.lift_nat_cast, cardinal.nat_cast_le]
  using cardinal_lift_le_dim_of_linear_independent'
    (linear_independent_smul_of_linear_independent G F hs)

instance : finite_dimensional (fixed_points.subfield G F) F :=
is_noetherian.iff_fg.1 $ is_noetherian.iff_dim_lt_omega.2 $
lt_of_le_of_lt (dim_le_card G F) (cardinal.nat_lt_omega _)

lemma finrank_le_card : finrank (fixed_points.subfield G F) F ≤ fintype.card G :=
begin
  rw [← cardinal.nat_cast_le, finrank_eq_dim],
  apply dim_le_card,
end

end fixed_points

lemma linear_independent_to_linear_map (R : Type u) (A : Type v) (B : Type w)
  [comm_semiring R] [ring A] [algebra R A]
  [comm_ring B] [is_domain B] [algebra R B] :
  linear_independent B (alg_hom.to_linear_map : (A →ₐ[R] B) → (A →ₗ[R] B)) :=
have linear_independent B (linear_map.lto_fun R A B ∘ alg_hom.to_linear_map),
from ((linear_independent_monoid_hom A B).comp
  (coe : (A →ₐ[R] B) → (A →* B))
  (λ f g hfg, alg_hom.ext $ monoid_hom.ext_iff.1 hfg) : _),
this.of_comp _

lemma cardinal_mk_alg_hom (K : Type u) (V : Type v) (W : Type w)
  [field K] [field V] [algebra K V] [finite_dimensional K V]
            [field W] [algebra K W] [finite_dimensional K W] :
  cardinal.mk (V →ₐ[K] W) ≤ finrank W (V →ₗ[K] W) :=
cardinal_mk_le_finrank_of_linear_independent $ linear_independent_to_linear_map K V W

noncomputable instance alg_hom.fintype (K : Type u) (V : Type v) (W : Type w)
  [field K] [field V] [algebra K V] [finite_dimensional K V]
            [field W] [algebra K W] [finite_dimensional K W] :
  fintype (V →ₐ[K] W) :=
classical.choice $ cardinal.lt_omega_iff_fintype.1 $
lt_of_le_of_lt (cardinal_mk_alg_hom K V W) (cardinal.nat_lt_omega _)

noncomputable instance alg_equiv.fintype (K : Type u) (V : Type v)
  [field K] [field V] [algebra K V] [finite_dimensional K V] :
  fintype (V ≃ₐ[K] V) :=
fintype.of_equiv (V →ₐ[K] V) (alg_equiv_equiv_alg_hom K V).symm

lemma finrank_alg_hom (K : Type u) (V : Type v)
  [field K] [field V] [algebra K V] [finite_dimensional K V] :
  fintype.card (V →ₐ[K] V) ≤ finrank V (V →ₗ[K] V) :=
fintype_card_le_finrank_of_linear_independent $ linear_independent_to_linear_map K V V

namespace fixed_points

theorem finrank_eq_card (G : Type u) (F : Type v) [group G] [field F]
  [fintype G] [mul_semiring_action G F] [has_faithful_scalar G F] :
  finrank (fixed_points.subfield G F) F = fintype.card G :=
le_antisymm (fixed_points.finrank_le_card G F) $
calc  fintype.card G
    ≤ fintype.card (F →ₐ[fixed_points.subfield G F] F) :
        fintype.card_le_of_injective _ (mul_semiring_action.to_alg_hom_injective _ F)
... ≤ finrank F (F →ₗ[fixed_points.subfield G F] F) : finrank_alg_hom (fixed_points G F) F
... = finrank (fixed_points.subfield G F) F : finrank_linear_map' _ _ _

/-- `mul_semiring_action.to_alg_hom` is bijective. -/
theorem to_alg_hom_bijective (G : Type u) (F : Type v) [group G] [field F]
  [fintype G] [mul_semiring_action G F] [has_faithful_scalar G F] :
  function.bijective (mul_semiring_action.to_alg_hom _ _ : G → F →ₐ[subfield G F] F) :=
begin
  rw fintype.bijective_iff_injective_and_card,
  split,
  { exact mul_semiring_action.to_alg_hom_injective _ F },
  { apply le_antisymm,
    { exact fintype.card_le_of_injective _ (mul_semiring_action.to_alg_hom_injective _ F) },
    { rw ← finrank_eq_card G F,
      exact has_le.le.trans_eq (finrank_alg_hom _ F) (finrank_linear_map' _ _ _) } },
end

/-- Bijection between G and algebra homomorphisms that fix the fixed points -/
def to_alg_hom_equiv (G : Type u) (F : Type v) [group G] [field F]
  [fintype G] [mul_semiring_action G F] [has_faithful_scalar G F] :
    G ≃ (F →ₐ[fixed_points.subfield G F] F) :=
equiv.of_bijective _ (to_alg_hom_bijective G F)

end fixed_points


/-
Copyright (c) 2021 Bolton Bailey. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bolton Bailey
-/
import analysis.special_functions.log.basic
import analysis.special_functions.pow

/-!
# Logarithm Tonality

In this file we describe the tonality of the logarithm function when multiplied by functions of the
form `x ^ a`.

## Tags

logarithm, tonality
-/

open set filter function
open_locale topology
noncomputable theory

namespace real
variables {x y : ℝ}

lemma log_mul_self_monotone_on : monotone_on (λ x : ℝ, log x * x) {x | 1 ≤ x} :=
begin
  -- TODO: can be strengthened to exp (-1) ≤ x
  simp only [monotone_on, mem_set_of_eq],
  intros x hex y hey hxy,
  have x_pos : 0 < x := lt_of_lt_of_le zero_lt_one hex,
  have y_pos : 0 < y := lt_of_lt_of_le zero_lt_one hey,
  refine mul_le_mul ((log_le_log x_pos y_pos).mpr hxy) hxy (le_of_lt x_pos) _,
  rwa [le_log_iff_exp_le y_pos, real.exp_zero],
end

lemma log_div_self_antitone_on : antitone_on (λ x : ℝ, log x / x) {x | exp 1 ≤ x} :=
begin
  simp only [antitone_on, mem_set_of_eq],
  intros x hex y hey hxy,
  have x_pos : 0 < x := (exp_pos 1).trans_le hex,
  have y_pos : 0 < y := (exp_pos 1).trans_le hey,
  have hlogx : 1 ≤ log x := by rwa le_log_iff_exp_le x_pos,
  have hyx : 0 ≤ y / x - 1 := by rwa [le_sub_iff_add_le, le_div_iff x_pos, zero_add, one_mul],
  rw [div_le_iff y_pos, ←sub_le_sub_iff_right (log x)],
  calc
    log y - log x = log (y / x)           : by rw [log_div (y_pos.ne') (x_pos.ne')]
    ...           ≤ (y / x) - 1           : log_le_sub_one_of_pos (div_pos y_pos x_pos)
    ...           ≤ log x * (y / x - 1)   : le_mul_of_one_le_left hyx hlogx
    ...           = log x / x * y - log x : by ring,
end

lemma log_div_self_rpow_antitone_on {a : ℝ} (ha : 0 < a) :
  antitone_on (λ x : ℝ, log x / x ^ a) {x | exp (1 / a) ≤ x} :=
begin
  simp only [antitone_on, mem_set_of_eq],
  intros x hex y hey hxy,
  have x_pos : 0 < x := lt_of_lt_of_le (exp_pos (1 / a)) hex,
  have y_pos : 0 < y := by linarith,
  have x_nonneg : 0 ≤ x := le_trans (le_of_lt (exp_pos (1 / a))) hex,
  have y_nonneg : 0 ≤ y := by linarith,
  nth_rewrite 0 ←rpow_one y,
  nth_rewrite 0 ←rpow_one x,
  rw [←div_self (ne_of_lt ha).symm, div_eq_mul_one_div a a, rpow_mul y_nonneg, rpow_mul x_nonneg,
    log_rpow (rpow_pos_of_pos y_pos a), log_rpow (rpow_pos_of_pos x_pos a), mul_div_assoc,
    mul_div_assoc, mul_le_mul_left (one_div_pos.mpr ha)],
  { refine log_div_self_antitone_on _ _ _,
    { simp only [set.mem_set_of_eq],
      convert rpow_le_rpow _ hex (le_of_lt ha),
      rw ←exp_mul,
      simp only [real.exp_eq_exp],
      field_simp [(ne_of_lt ha).symm],
      exact le_of_lt (exp_pos (1 / a)), },
    { simp only [set.mem_set_of_eq],
      convert rpow_le_rpow _ (trans hex hxy) (le_of_lt ha),
      rw ←exp_mul,
      simp only [real.exp_eq_exp],
      field_simp [(ne_of_lt ha).symm],
      exact le_of_lt (exp_pos (1 / a)), },
    exact rpow_le_rpow x_nonneg hxy (le_of_lt ha), },
end

lemma log_div_sqrt_antitone_on :
  antitone_on (λ x : ℝ, log x / sqrt x) {x | exp 2 ≤ x} :=
begin
  simp_rw sqrt_eq_rpow,
  convert @log_div_self_rpow_antitone_on (1 / 2) (by norm_num),
  norm_num,
end

end real


example : forall n m: nat, n + m = m + n :=
begin
  intros n,
  induction n with n' ih,
  show forall m, 0 + m = m + 0,
  {
    intro m,
    induction m with m' ih2,
    show 0 + 0 = 0 + 0, { reflexivity },
    show 0 + (m' + 1) = (m' + 1) + 0,
    calc
      0 + (m' + 1) = (0 + m') + 1 : by reflexivity
              ...  = (m' + 0) + 1 : by rw ih2
              ...  = m' + 1 : by reflexivity
              ...  = (m' + 1) + 0 : by reflexivity
  },
  show forall m, (n' + 1) + m = m + (n' + 1),
  intro m,
  induction m with m' ih2,
  show (n' + 1) + 0 = 0 + (n' + 1),
  {
    calc
      (n' + 1) + 0 = n' + 1 : by reflexivity
               ... = (n' + 0) + 1 : by reflexivity
               ... = (0 + n') + 1 : by rw ih
               ... = 0 + (n' + 1) : by reflexivity
  },
  show (n' + 1) + (m' + 1) = (m' + 1) + (n' + 1),
  calc
    (n' + 1) + (m' + 1) = (n' + 1) + m' + 1 : by reflexivity
                   ...  = m' + (n' + 1) + 1 : by rw ih2
                   ...  = m' + n' + 2 : by reflexivity
                   ...  = n' + m' + 2 : by rw <- ih
                   ...  = n' + (m' + 1) + 1 : by reflexivity
                   ...  = (m' + 1) + n' + 1 : by rw ih
                   ...  = (m' + 1) + (n' + 1) : by reflexivity
end


import game.world4.level6 -- hide
namespace mynat -- hide

/-

# Power World

## Level 7: `pow_pow`
-/

/-
Boss level! What will the collectible be?
-/
/- Lemma
For all naturals $a$, $m$, $n$, we have $(a ^ m) ^ n = a ^ {mn}$.
-/
lemma pow_pow (a m n : mynat) : (a ^ m) ^ n = a ^ (m * n) :=
begin [nat_num_game]
  induction' n with t Ht,
    rw [mul_zero, pow_zero, pow_zero],
    refl,
  rw [pow_succ, Ht, mul_succ, pow_add],
  refl,

end

/-
Apparently Lean can't find a collectible, even though you feel like you
just finished power world so you must have proved *something*. What should the
collectible for this level be called?
-/

/-
But what is this? It's one of those twists where there's another
boss after the boss you thought was the final boss! Go to the next
level!
-/

end mynat -- hide


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser

! This file was ported from Lean 3 source module algebra.star.big_operators
! leanprover-community/mathlib commit 008205aa645b3f194c1da47025c5f110c8406eab
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Basic
import Mathlib.Algebra.Star.Basic

/-! # Big-operators lemmas about `star` algebraic operations

These results are kept separate from `Algebra.Star.Basic` to avoid it needing to import `Finset`.
-/

variable {R : Type _}

open BigOperators

@[simp]
theorem star_prod [CommMonoid R] [StarSemigroup R] {α : Type _} (s : Finset α) (f : α → R) :
    star (∏ x in s, f x) = ∏ x in s, star (f x) := map_prod (starMulAut : R ≃* R) _ _
#align star_prod star_prod

@[simp]
theorem star_sum [AddCommMonoid R] [StarAddMonoid R] {α : Type _} (s : Finset α) (f : α → R) :
    star (∑ x in s, f x) = ∑ x in s, star (f x) := (starAddEquiv : R ≃+ R).map_sum _ _
#align star_sum star_sum


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fintype.card
import data.finset.powerset

/-!
# fintype instance for `set α`, when `α` is a fintype

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

variables {α : Type*}

open finset

instance finset.fintype [fintype α] : fintype (finset α) :=
⟨univ.powerset, λ x, finset.mem_powerset.2 (finset.subset_univ _)⟩

@[simp] lemma fintype.card_finset [fintype α] :
  fintype.card (finset α) = 2 ^ (fintype.card α) :=
finset.card_powerset finset.univ

@[simp] lemma finset.powerset_univ [fintype α] : (univ : finset α).powerset = univ :=
coe_injective $ by simp [-coe_eq_univ]

@[simp] lemma finset.powerset_eq_univ [fintype α] {s : finset α} : s.powerset = univ ↔ s = univ :=
by rw [←finset.powerset_univ, powerset_inj]

lemma finset.mem_powerset_len_univ_iff [fintype α] {s : finset α} {k : ℕ} :
  s ∈ powerset_len k (univ : finset α) ↔ card s = k :=
mem_powerset_len.trans $ and_iff_right $ subset_univ _

@[simp] lemma finset.univ_filter_card_eq (α : Type*) [fintype α] (k : ℕ) :
  (finset.univ : finset (finset α)).filter (λ s, s.card = k) = finset.univ.powerset_len k :=
by { ext, simp [finset.mem_powerset_len] }

@[simp] lemma fintype.card_finset_len [fintype α] (k : ℕ) :
  fintype.card {s : finset α // s.card = k} = nat.choose (fintype.card α) k :=
by simp [fintype.subtype_card, finset.card_univ]

instance set.fintype [fintype α] : fintype (set α) :=
⟨(@finset.univ α _).powerset.map ⟨coe, coe_injective⟩, λ s, begin
  classical, refine mem_map.2 ⟨finset.univ.filter s, mem_powerset.2 (subset_univ _), _⟩,
  apply (coe_filter _ _).trans, rw [coe_univ, set.sep_univ], refl
end⟩

-- Not to be confused with `set.finite`, the predicate
instance set.finite' [finite α] : finite (set α) :=
by { casesI nonempty_fintype α, apply_instance }

@[simp] lemma fintype.card_set [fintype α] : fintype.card (set α) = 2 ^ fintype.card α :=
(finset.card_map _).trans (finset.card_powerset _)


namespace Set

def Set (α : Type) := α → Prop

def Mem {α : Type} : α → Set α → Prop := fun a X => X a

instance {α : Type} : Membership α (Set α) where
  mem := Mem

def SetOf {α : Type} (p : α → Prop) : Set α := p

declare_syntax_cat binder_construct
syntax "{" binder_construct "|" term "}" : term

syntax ident " : " term : binder_construct
syntax ident " ∈ " term : binder_construct

macro_rules
| `({ $var:ident : $ty:term | $body:term }) => `(SetOf (fun ($var : $ty) => $body))
| `({ $var:ident ∈ $s:term | $body:term }) => `(SetOf (fun $var => $var ∈ $s ∧ $body))

def Subset {α : Type} (X Y : Set α) : Prop := ∀ a, a ∈ X → a ∈ Y
infix:60 " ⊆ " => Subset

def Univ { α : Type } : Set α := fun _ => True

def Emptyset { α : Type } : Set α := fun _ => False

instance {α : Type} : EmptyCollection (Set α) where
  emptyCollection := Emptyset

def Union {α : Type} (X Y : Set α) : Set α := fun a => a ∈ X ∨ a ∈ Y
infixl:65 " ∪ " => Union

def Inter {α : Type} (X Y : Set α) : Set α := fun a => a ∈ X ∧ a ∈ Y
infixl:65 " ∩ " => Inter

def Diff {α : Type} (X Y : Set α) : Set α := fun a => a ∈ X ∧ a ∉ Y
infixl:65 " \\ " => Diff

def Comp {α : Type} (X : Set α) : Set α := fun x => x ∉ X
postfix:100 "ᶜ " => Comp

def BigUnion {α β : Type} (X : β → Set α) : Set α := fun a => ∃ b, a ∈ X b

def BigInter {α β : Type} (X : β → Set α) : Set α := fun a => ∀ b, a ∈ X b

def PowerSet {α : Type} (X : Set α) : Set (Set α) := fun Y => Y ⊆ X

def Prod {α β : Type} (X : Set α) (Y : Set β) : Set (α × β) := fun a => X a.1 ∧ Y a.2

variable {α β : Type}
variable {a₁ a₂ : α}
variable {X Y Z: Set α}

theorem sub_refl : X ⊆ X := fun _ h => h

theorem sub_trans (h₁ : X ⊆ Y) (h₂ : Y ⊆ Z) : X ⊆ Z := fun x h => h₂ x (h₁ x h)

theorem sub_of_eq (h : X = Y) : X ⊆ Y := by
  rw [←h]
  exact fun _ h => h

theorem set_ext : X = Y ↔ (∀ (x:α), x ∈ X ↔ x ∈ Y) := by
  apply Iff.intro
  · intro h x
    apply Iff.intro
    · exact sub_of_eq h x
    · rw [h]
      exact fun h => h
  · intro h
    apply funext
    intro x
    exact propext (h x)

section
set_option hygiene false
syntax "set_extensionality" : tactic
macro_rules
| `(tactic| set_extensionality ) => `(tactic| apply set_ext.mpr <;> intro x <;> constructor )
end

syntax "setext" : tactic
macro_rules
| `(tactic| setext ) => `(tactic| apply set_ext.mpr) -- <;> intro h $(x?)? <;> constructor )

theorem sub_left_of_union : X ⊆ X ∪ Y := by
  intro x h
  exact Or.inl h

theorem sub_right_of_union : Y ⊆ X ∪ Y := by
  intro x h
  exact Or.inr h

theorem inter_sub_left : X ∩ Y ⊆ X := by
  intro a h
  exact And.left h

theorem inter_sub_right : X ∩ Y ⊆ Y := by
  intro a h
  exact And.right h

theorem diff_sub : X \ Y ⊆ X := fun _ h => And.left h

theorem comm_union : X ∪ Y = Y ∪ X := by
  apply set_ext.mpr
  intro x
  constructor
  · intro h
    cases h with
    | inl g => exact sub_right_of_union x g
    | inr g => exact sub_left_of_union x g
  · intro h
    cases h with
    | inl g => exact sub_right_of_union x g
    | inr g => exact sub_left_of_union x g

theorem comm_inter : X ∩ Y = Y ∩ X := by
  apply set_ext.mpr
  intro x
  constructor
  repeat {exact fun h => ⟨h.right,h.left⟩}

theorem diff_union_eq : X \ Y ∪ (X ∩ Y) = X := by
  apply set_ext.mpr
  intro x
  constructor
  · intro h
    apply Or.elim h
    repeat {exact fun g => And.left g}
  · intro h
    have g : x ∈ Y ∨ x ∉ Y := Classical.em (x ∈ Y)
    cases g with
    | inl g₁ => exact Or.inr ⟨h,g₁⟩
    | inr g₁ => exact Or.inl ⟨h,g₁⟩

theorem comp_comp_eq : (Xᶜ)ᶜ = X := by
  setext
  intro x
  constructor
  · intro h
    apply Classical.byContradiction
    exact fun n => h n
  · exact fun h v => v h

theorem comp_eq_univ_diff : Xᶜ = Univ \ X := by
  setext <;> intro x <;> constructor
  · exact fun h => ⟨trivial,h⟩
  · exact fun h => h.right

theorem union_assoc : X ∪ Y ∪ Z = X ∪ (Y ∪ Z) := by
  setext
  intro x
  constructor
  · intro h
    cases h with
    | inl g₁ => cases g₁ with
      | inl g₂ => exact Or.inl g₂
      | inr g₂ => exact Or.inr <| Or.inl g₂
    | inr g₁ => exact Or.inr <| Or.inr g₁
  · intro h
    cases h with
    | inl g₁ => exact Or.inl <| Or.inl g₁
    | inr g₁ => cases g₁ with
      | inl g₂ => exact Or.inl <| Or.inr g₂
      | inr g₂ => exact Or.inr g₂

theorem empty_union_eq : ∅ ∪ X = X := by
  setext
  intro x
  constructor
  · intro h
    cases h with
    | inl g => exact False.elim g
    | inr g => assumption
  · intro h
    exact .inr h

theorem empty_inter_empty : ∅ ∩ X = ∅ := by
  setext
  intro x
  constructor
  · exact fun h => False.elim h.left
  · exact fun h => False.elim h

theorem not_mem_empty (x : α) : x ∉ Emptyset := fun h => h

theorem diff_empty_eq : X \ ∅ = X := by
  setext
  intro x
  constructor
  · exact fun h => And.left h
  · exact fun h => ⟨h,not_mem_empty x⟩

theorem univ_union_univ : Univ ∪ X = Univ := by
  setext
  intro x
  constructor
  · exact fun _ => trivial
  · exact sub_left_of_union _

theorem dist_inter_union : X ∩ (Y ∪ Z) = (X ∩ Y) ∪ (X ∩ Z) := by
  setext <;> intro x <;> constructor
  · intro h
    cases h.right with
    | inl g₃ => exact Or.inl ⟨h.left,g₃⟩
    | inr g₃ => exact Or.inr ⟨h.left,g₃⟩
  · intro h
    cases h with
    | inl g => exact ⟨g.left,Or.inl g.right⟩
    | inr g => exact ⟨g.left,Or.inr g.right⟩

theorem dist_union_inter : X ∪ (Y ∩ Z) = (X ∪ Y) ∩ (X ∪ Z) := by
  setext <;> intro x <;> constructor
  · intro h
    cases h with
    | inl g => exact ⟨ Or.inl g, Or.inl g⟩
    | inr g => exact ⟨ Or.inr g.left, Or.inr g.right ⟩
  · intro h
    have ⟨l,r⟩ := h
    cases l with
    | inl g₁ => exact Or.inl g₁
    | inr g₁ => cases r with
      | inl g₂ => exact Or.inl g₂
      | inr g₂ => exact Or.inr ⟨g₁,g₂⟩

example (h: X = Y) : X ∪ Z = Y ∪ Z := by
  rewrite [h]
  rfl

theorem sub_comp_super (h : X ⊆ Y) : Yᶜ ⊆ Xᶜ := by
  intro (x : α) (g : x ∈ Yᶜ) (n : x ∈ X)
  exact g (h x n)

example (h : X ⊆ Y) : Z \ Y ⊆ Z \ X := by
  intro (x:α) (g : x ∈ Z \ Y)
  have : x ∉ X := sub_comp_super h x g.right
  exact ⟨g.left,this⟩

end Set


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

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

@[simp]
lemma integral_pow : ∫ x in a..b, x ^ n = (b ^ (n + 1) - a ^ (n + 1)) / (n + 1) :=
begin
  have hderiv : deriv (λ x : ℝ, x ^ (n + 1) / (n + 1)) = λ x, x ^ n,
  { ext,
    have hne : (n + 1 : ℝ) ≠ 0 := by exact_mod_cast succ_ne_zero n,
    simp [mul_div_assoc, mul_div_cancel' _ hne] },
  rw integral_deriv_eq_sub' _ hderiv;
  norm_num [div_sub_div_same, continuous_on_pow],
end

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

@[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]

@[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_eq_neg_mul_symm, mul_neg_eq_neg_mul_symm]
      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) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.multiset.basic

/-!
# Sections of a multiset
-/

namespace multiset
variables {α : Type*}

section sections

/--
The sections of a multiset of multisets `s` consists of all those multisets
which can be put in bijection with `s`, so each element is an member of the corresponding multiset.
-/
def sections (s : multiset (multiset α)) : multiset (multiset α) :=
multiset.rec_on s {0} (λs _ c, s.bind $ λa, c.map (multiset.cons a))
  (assume a₀ a₁ s pi, by simp [map_bind, bind_bind a₀ a₁, cons_swap])

@[simp] lemma sections_zero : sections (0 : multiset (multiset α)) = {0} :=
rfl

@[simp] lemma sections_cons (s : multiset (multiset α)) (m : multiset α) :
  sections (m ::ₘ s) = m.bind (λa, (sections s).map (multiset.cons a)) :=
rec_on_cons m s

lemma coe_sections : ∀(l : list (list α)),
  sections ((l.map (λl:list α, (l : multiset α))) : multiset (multiset α)) =
    ((l.sections.map (λl:list α, (l : multiset α))) : multiset (multiset α))
| [] := rfl
| (a :: l) :=
  begin
    simp,
    rw [← cons_coe, sections_cons, bind_map_comm, coe_sections l],
    simp [list.sections, (∘), list.bind]
  end

@[simp] lemma sections_add (s t : multiset (multiset α)) :
  sections (s + t) = (sections s).bind (λm, (sections t).map ((+) m)) :=
multiset.induction_on s (by simp)
  (assume a s ih, by simp [ih, bind_assoc, map_bind, bind_map, -add_comm])

lemma mem_sections {s : multiset (multiset α)} :
  ∀{a}, a ∈ sections s ↔ s.rel (λs a, a ∈ s) a :=
multiset.induction_on s (by simp)
  (assume a s ih a',
    by simp [ih, rel_cons_left, -exists_and_distrib_left, exists_and_distrib_left.symm, eq_comm])

lemma card_sections {s : multiset (multiset α)} : card (sections s) = prod (s.map card) :=
multiset.induction_on s (by simp) (by simp {contextual := tt})

lemma prod_map_sum [comm_semiring α] {s : multiset (multiset α)} :
  prod (s.map sum) = sum ((sections s).map prod) :=
multiset.induction_on s (by simp)
  (assume a s ih, by simp [ih, map_bind, sum_map_mul_left, sum_map_mul_right])

end sections

end multiset


/-
Copyright (c) Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import data.complex.determinant
import data.complex.is_R_or_C

/-!
# Normed space structure on `ℂ`.

This file gathers basic facts on complex numbers of an analytic nature.

## Main results

This file registers `ℂ` as a normed field, expresses basic properties of the norm, and gives
tools on the real vector space structure of `ℂ`. Notably, in the namespace `complex`,
it defines functions:

* `re_clm`
* `im_clm`
* `of_real_clm`
* `conj_cle`

They are bundled versions of the real part, the imaginary part, the embedding of `ℝ` in `ℂ`, and
the complex conjugate as continuous `ℝ`-linear maps. The last two are also bundled as linear
isometries in `of_real_li` and `conj_lie`.

We also register the fact that `ℂ` is an `is_R_or_C` field.
-/
noncomputable theory

namespace complex

open_locale complex_conjugate

instance : has_norm ℂ := ⟨abs⟩

instance : normed_group ℂ :=
normed_group.of_core ℂ
{ norm_eq_zero_iff := λ z, abs_eq_zero,
  triangle := abs_add,
  norm_neg := abs_neg }

instance : normed_field ℂ :=
{ norm := abs,
  dist_eq := λ _ _, rfl,
  norm_mul' := abs_mul,
  .. complex.field }

instance : nondiscrete_normed_field ℂ :=
{ non_trivial := ⟨2, by simp [norm]; norm_num⟩ }

instance {R : Type*} [normed_field R] [normed_algebra R ℝ] : normed_algebra R ℂ :=
{ norm_algebra_map_eq := λ x, (abs_of_real $ algebra_map R ℝ x).trans (norm_algebra_map_eq ℝ x),
  to_algebra := complex.algebra }

/-- The module structure from `module.complex_to_real` is a normed space. -/
@[priority 900] -- see Note [lower instance priority]
instance _root_.normed_space.complex_to_real {E : Type*} [normed_group E] [normed_space ℂ E] :
  normed_space ℝ E :=
normed_space.restrict_scalars ℝ ℂ E

@[simp] lemma norm_eq_abs (z : ℂ) : ∥z∥ = abs z := rfl

lemma dist_eq (z w : ℂ) : dist z w = abs (z - w) := rfl

@[simp] lemma norm_real (r : ℝ) : ∥(r : ℂ)∥ = ∥r∥ := abs_of_real _

@[simp] lemma norm_rat (r : ℚ) : ∥(r : ℂ)∥ = |(r : ℝ)| :=
suffices ∥((r : ℝ) : ℂ)∥ = |r|, by simpa,
by rw [norm_real, real.norm_eq_abs]

@[simp] lemma norm_nat (n : ℕ) : ∥(n : ℂ)∥ = n := abs_of_nat _

@[simp] lemma norm_int {n : ℤ} : ∥(n : ℂ)∥ = |n| :=
suffices ∥((n : ℝ) : ℂ)∥ = |n|, by simpa,
by rw [norm_real, real.norm_eq_abs]

lemma norm_int_of_nonneg {n : ℤ} (hn : 0 ≤ n) : ∥(n : ℂ)∥ = n :=
by rw [norm_int, _root_.abs_of_nonneg]; exact int.cast_nonneg.2 hn

@[continuity] lemma continuous_abs : continuous abs := continuous_norm

@[continuity] lemma continuous_norm_sq : continuous norm_sq :=
by simpa [← norm_sq_eq_abs] using continuous_abs.pow 2

/-- The `abs` function on `ℂ` is proper. -/
lemma tendsto_abs_cocompact_at_top : filter.tendsto abs (filter.cocompact ℂ) filter.at_top :=
tendsto_norm_cocompact_at_top

/-- The `norm_sq` function on `ℂ` is proper. -/
lemma tendsto_norm_sq_cocompact_at_top :
  filter.tendsto norm_sq (filter.cocompact ℂ) filter.at_top :=
by simpa [mul_self_abs] using
  tendsto_abs_cocompact_at_top.at_top_mul_at_top tendsto_abs_cocompact_at_top

open continuous_linear_map

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def re_clm : ℂ →L[ℝ] ℝ := re_lm.mk_continuous 1 (λ x, by simp [real.norm_eq_abs, abs_re_le_abs])

@[continuity] lemma continuous_re : continuous re := re_clm.continuous

@[simp] lemma re_clm_coe : (coe (re_clm) : ℂ →ₗ[ℝ] ℝ) = re_lm := rfl

@[simp]

@[simp] lemma re_clm_norm : ∥re_clm∥ = 1 :=
le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _) $
calc 1 = ∥re_clm 1∥ : by simp
   ... ≤ ∥re_clm∥ : unit_le_op_norm _ _ (by simp)

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def im_clm : ℂ →L[ℝ] ℝ := im_lm.mk_continuous 1 (λ x, by simp [real.norm_eq_abs, abs_im_le_abs])

@[continuity] lemma continuous_im : continuous im := im_clm.continuous

@[simp] lemma im_clm_coe : (coe (im_clm) : ℂ →ₗ[ℝ] ℝ) = im_lm := rfl

@[simp] lemma im_clm_apply (z : ℂ) : (im_clm : ℂ → ℝ) z = z.im := rfl

@[simp] lemma im_clm_norm : ∥im_clm∥ = 1 :=
le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _) $
calc 1 = ∥im_clm I∥ : by simp
   ... ≤ ∥im_clm∥ : unit_le_op_norm _ _ (by simp)

lemma restrict_scalars_one_smul_right' {E : Type*} [normed_group E] [normed_space ℂ E] (x : E) :
  continuous_linear_map.restrict_scalars ℝ ((1 : ℂ →L[ℂ] ℂ).smul_right x : ℂ →L[ℂ] E) =
    re_clm.smul_right x + I • im_clm.smul_right x :=
by { ext ⟨a, b⟩, simp [mk_eq_add_mul_I, add_smul, mul_smul, smul_comm I] }

lemma restrict_scalars_one_smul_right (x : ℂ) :
  continuous_linear_map.restrict_scalars ℝ ((1 : ℂ →L[ℂ] ℂ).smul_right x : ℂ →L[ℂ] ℂ) = x • 1 :=
by { ext1 z, dsimp, apply mul_comm }

/-- The complex-conjugation function from `ℂ` to itself is an isometric linear equivalence. -/
def conj_lie : ℂ ≃ₗᵢ[ℝ] ℂ := ⟨conj_ae.to_linear_equiv, abs_conj⟩

@[simp] lemma conj_lie_apply (z : ℂ) : conj_lie z = conj z := rfl

lemma isometry_conj : isometry (conj : ℂ → ℂ) := conj_lie.isometry

/-- The determinant of `conj_lie`, as a linear map. -/
@[simp] lemma det_conj_lie : (conj_lie.to_linear_equiv : ℂ →ₗ[ℝ] ℂ).det = -1 :=
det_conj_ae

/-- The determinant of `conj_lie`, as a linear equiv. -/
@[simp] lemma linear_equiv_det_conj_lie : conj_lie.to_linear_equiv.det = -1 :=
linear_equiv_det_conj_ae

@[continuity] lemma continuous_conj : continuous (conj : ℂ → ℂ) := conj_lie.continuous

/-- Continuous linear equiv version of the conj function, from `ℂ` to `ℂ`. -/
def conj_cle : ℂ ≃L[ℝ] ℂ := conj_lie

@[simp] lemma conj_cle_coe : conj_cle.to_linear_equiv = conj_ae.to_linear_equiv := rfl

@[simp] lemma conj_cle_apply (z : ℂ) : conj_cle z = conj z := rfl

@[simp] lemma conj_cle_norm : ∥(conj_cle : ℂ →L[ℝ] ℂ)∥ = 1 :=
conj_lie.to_linear_isometry.norm_to_continuous_linear_map

/-- Linear isometry version of the canonical embedding of `ℝ` in `ℂ`. -/
def of_real_li : ℝ →ₗᵢ[ℝ] ℂ := ⟨of_real_am.to_linear_map, norm_real⟩

lemma isometry_of_real : isometry (coe : ℝ → ℂ) := of_real_li.isometry

@[continuity] lemma continuous_of_real : continuous (coe : ℝ → ℂ) := of_real_li.continuous

/-- Continuous linear map version of the canonical embedding of `ℝ` in `ℂ`. -/
def of_real_clm : ℝ →L[ℝ] ℂ := of_real_li.to_continuous_linear_map

@[simp] lemma of_real_clm_coe : (of_real_clm : ℝ →ₗ[ℝ] ℂ) = of_real_am.to_linear_map := rfl

@[simp] lemma of_real_clm_apply (x : ℝ) : of_real_clm x = x := rfl

@[simp] lemma of_real_clm_norm : ∥of_real_clm∥ = 1 := of_real_li.norm_to_continuous_linear_map

noncomputable instance : is_R_or_C ℂ :=
{ re := ⟨complex.re, complex.zero_re, complex.add_re⟩,
  im := ⟨complex.im, complex.zero_im, complex.add_im⟩,
  I := complex.I,
  I_re_ax := by simp only [add_monoid_hom.coe_mk, complex.I_re],
  I_mul_I_ax := by simp only [complex.I_mul_I, eq_self_iff_true, or_true],
  re_add_im_ax := λ z, by simp only [add_monoid_hom.coe_mk, complex.re_add_im,
                                     complex.coe_algebra_map, complex.of_real_eq_coe],
  of_real_re_ax := λ r, by simp only [add_monoid_hom.coe_mk, complex.of_real_re,
                                      complex.coe_algebra_map, complex.of_real_eq_coe],
  of_real_im_ax := λ r, by simp only [add_monoid_hom.coe_mk, complex.of_real_im,
                                      complex.coe_algebra_map, complex.of_real_eq_coe],
  mul_re_ax := λ z w, by simp only [complex.mul_re, add_monoid_hom.coe_mk],
  mul_im_ax := λ z w, by simp only [add_monoid_hom.coe_mk, complex.mul_im],
  conj_re_ax := λ z, rfl,
  conj_im_ax := λ z, rfl,
  conj_I_ax := by simp only [complex.conj_I, ring_hom.coe_mk],
  norm_sq_eq_def_ax := λ z, by simp only [←complex.norm_sq_eq_abs, ←complex.norm_sq_apply,
    add_monoid_hom.coe_mk, complex.norm_eq_abs],
  mul_im_I_ax := λ z, by simp only [mul_one, add_monoid_hom.coe_mk, complex.I_im],
  inv_def_ax := λ z, by simp only [complex.inv_def, complex.norm_sq_eq_abs, complex.coe_algebra_map,
    complex.of_real_eq_coe, complex.norm_eq_abs],
  div_I_ax := complex.div_I }

section

variables {α β γ : Type*}
  [add_comm_monoid α] [topological_space α] [add_comm_monoid γ] [topological_space γ]

/-- The natural `add_equiv` from `ℂ` to `ℝ × ℝ`. -/
@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }]
def equiv_real_prod_add_hom : ℂ ≃+ ℝ × ℝ :=
{ map_add' := by simp, .. equiv_real_prod }

/-- The natural `linear_equiv` from `ℂ` to `ℝ × ℝ`. -/
@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }]
def equiv_real_prod_add_hom_lm : ℂ ≃ₗ[ℝ] ℝ × ℝ :=
{ map_smul' := by simp [equiv_real_prod_add_hom], .. equiv_real_prod_add_hom }

/-- The natural `continuous_linear_equiv` from `ℂ` to `ℝ × ℝ`. -/
@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }]
def equiv_real_prodₗ : ℂ ≃L[ℝ] ℝ × ℝ :=
equiv_real_prod_add_hom_lm.to_continuous_linear_equiv

end

lemma has_sum_iff {α} (f : α → ℂ) (c : ℂ) :
  has_sum f c ↔ has_sum (λ x, (f x).re) c.re ∧ has_sum (λ x, (f x).im) c.im :=
begin
  -- For some reason, `continuous_linear_map.has_sum` is orders of magnitude faster than
  -- `has_sum.mapL` here:
  refine ⟨λ h, ⟨re_clm.has_sum h, im_clm.has_sum h⟩, _⟩,
  rintro ⟨h₁, h₂⟩,
  convert (h₁.prod_mk h₂).mapL equiv_real_prodₗ.symm.to_continuous_linear_map,
  { ext x; refl },
  { cases c, refl }
end

end complex

namespace is_R_or_C

local notation `reC` := @is_R_or_C.re ℂ _
local notation `imC` := @is_R_or_C.im ℂ _
local notation `IC` := @is_R_or_C.I ℂ _
local notation `absC` := @is_R_or_C.abs ℂ _
local notation `norm_sqC` := @is_R_or_C.norm_sq ℂ _

@[simp] lemma re_to_complex {x : ℂ} : reC x = x.re := rfl
@[simp] lemma im_to_complex {x : ℂ} : imC x = x.im := rfl
@[simp] lemma I_to_complex : IC = complex.I := rfl
@[simp] lemma norm_sq_to_complex {x : ℂ} : norm_sqC x = complex.norm_sq x :=
by simp [is_R_or_C.norm_sq, complex.norm_sq]
@[simp] lemma abs_to_complex {x : ℂ} : absC x = complex.abs x :=
by simp [is_R_or_C.abs, complex.abs]

end is_R_or_C


/-
Copyright (c) 2020 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro
-/
import data.set.basic

/-!
# Well-founded relations

A relation is well-founded if it can be used for induction: for each `x`, `(∀ y, r y x → P y) → P x`
implies `P x`. Well-founded relations can be used for induction and recursion, including
construction of fixed points in the space of dependent functions `Π x : α , β x`.

The predicate `well_founded` is defined in the core library. In this file we prove some extra lemmas
and provide a few new definitions: `well_founded.min`, `well_founded.sup`, and `well_founded.succ`.
-/

variables {α : Type*}

namespace well_founded
/-- If `r` is a well-founded relation, then any nonempty set has a minimal element
with respect to `r`. -/
theorem has_min {α} {r : α → α → Prop} (H : well_founded r)
  (s : set α) : s.nonempty → ∃ a ∈ s, ∀ x ∈ s, ¬ r x a
| ⟨a, ha⟩ := (acc.rec_on (H.apply a) $ λ x _ IH, not_imp_not.1 $ λ hne hx, hne $
  ⟨x, hx, λ y hy hyx, hne $ IH y hyx hy⟩) ha

/-- A minimal element of a nonempty set in a well-founded order -/
noncomputable def min {α} {r : α → α → Prop} (H : well_founded r)
  (p : set α) (h : p.nonempty) : α :=
classical.some (H.has_min p h)

theorem min_mem {α} {r : α → α → Prop} (H : well_founded r)
  (p : set α) (h : p.nonempty) : H.min p h ∈ p :=
let ⟨h, _⟩ := classical.some_spec (H.has_min p h) in h

theorem not_lt_min {α} {r : α → α → Prop} (H : well_founded r)
  (p : set α) (h : p.nonempty) {x} (xp : x ∈ p) : ¬ r x (H.min p h) :=
let ⟨_, h'⟩ := classical.some_spec (H.has_min p h) in h' _ xp

theorem well_founded_iff_has_min  {α} {r : α → α → Prop} : (well_founded r) ↔
  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, ¬ r x m :=
begin
  classical,
  split,
  { exact has_min, },
  { set counterexamples := { x : α | ¬ acc r x},
    intro exists_max,
    fconstructor,
    intro x,
    by_contra hx,
    obtain ⟨m, m_mem, hm⟩ := exists_max counterexamples ⟨x, hx⟩,
    refine m_mem (acc.intro _ ( λ y y_gt_m, _)),
    by_contra hy,
    exact hm y hy y_gt_m, },
end

lemma eq_iff_not_lt_of_le {α} [partial_order α] {x y : α} : x ≤ y → y = x ↔ ¬ x < y :=
begin
  split,
  { intros xle nge,
    cases le_not_le_of_lt nge,
    rw xle left at nge,
    exact lt_irrefl x nge },
  { intros ngt xle,
    contrapose! ngt,
    exact lt_of_le_of_ne xle (ne.symm ngt) }
end

theorem well_founded_iff_has_max' [partial_order α] : (well_founded ((>) : α → α → Prop) ↔
  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, m ≤ x → x = m) :=
by simp only [eq_iff_not_lt_of_le, well_founded_iff_has_min]

theorem well_founded_iff_has_min' [partial_order α] : (well_founded (has_lt.lt : α → α → Prop)) ↔
  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, x ≤ m → x = m :=
@well_founded_iff_has_max' (order_dual α) _

open set
/-- The supremum of a bounded, well-founded order -/
protected noncomputable def sup {α} {r : α → α → Prop} (wf : well_founded r) (s : set α)
  (h : bounded r s) : α :=
wf.min { x | ∀a ∈ s, r a x } h

protected lemma lt_sup {α} {r : α → α → Prop} (wf : well_founded r) {s : set α} (h : bounded r s)
  {x} (hx : x ∈ s) : r x (wf.sup s h) :=
min_mem wf { x | ∀a ∈ s, r a x } h x hx

section
open_locale classical
/-- A successor of an element `x` in a well-founded order is a minimal element `y` such that
`x < y` if one exists. Otherwise it is `x` itself. -/
protected noncomputable def succ {α} {r : α → α → Prop} (wf : well_founded r) (x : α) : α :=
if h : ∃y, r x y then wf.min { y | r x y } h else x

protected lemma lt_succ {α} {r : α → α → Prop} (wf : well_founded r) {x : α} (h : ∃y, r x y) :
  r x (wf.succ x) :=
by { rw [well_founded.succ, dif_pos h], apply min_mem }
end

protected lemma lt_succ_iff {α} {r : α → α → Prop} [wo : is_well_order α r] {x : α} (h : ∃y, r x y)
  (y : α) : r y (wo.wf.succ x) ↔ r y x ∨ y = x :=
begin
  split,
  { intro h', have : ¬r x y,
    { intro hy, rw [well_founded.succ, dif_pos] at h',
      exact wo.wf.not_lt_min _ h hy h' },
    rcases trichotomous_of r x y with hy | hy | hy,
    exfalso, exact this hy,
    right, exact hy.symm,
    left, exact hy },
  rintro (hy | rfl), exact trans hy (wo.wf.lt_succ h), exact wo.wf.lt_succ h
end

end well_founded


-- Pruebas de P, ¬¬(Q ∧ R) ⊢ ¬¬P ∧ R
-- =================================

-- ----------------------------------------------------
-- Ej. 1. (p. 5) Demostrar
--    P, ¬¬(Q ∧ R) ⊢ ¬¬P ∧ R
-- ----------------------------------------------------

import tactic

variables (P Q R : Prop)

open_locale classical

-- 1ª demostración
example
  (h1 : P)
  (h2 : ¬¬(Q ∧ R))
  : ¬¬P ∧ R :=
have h3 : ¬¬P,   from not_not_intro h1,
have h4 : Q ∧ R, from not_not.mp h2,
have h5 : R,     from and.elim_right h4,
show ¬¬P ∧ R,    from and.intro h3 h5

-- 2ª demostración
example
  (h1 : P)
  (h2 : ¬¬(Q ∧ R))
  : ¬¬P ∧ R :=
have h3 : ¬¬P,   from not_not_intro h1,
have h4 : Q ∧ R, from not_not.mp h2,
have h5 : R,     from and.elim_right h4,
and.intro h3 h5

-- 3ª demostración
example
  (h1 : P)
  (h2 : ¬¬(Q ∧ R))
  : ¬¬P ∧ R :=
have h3 : ¬¬P,   from not_not_intro h1,
have h4 : Q ∧ R, from not_not.mp h2,
have h5 : R,     from h4.2,
and.intro h3 h5

-- 5ª demostración
example
  (h1 : P)
  (h2 : ¬¬(Q ∧ R))
  : ¬¬P ∧ R :=
and.intro (not_not_intro h1) (not_not.mp h2).2

-- 6ª demostración
example
  (h1 : P)
  (h2 : ¬¬(Q ∧ R))
  : ¬¬P ∧ R :=
begin
  split,
  { exact not_not_intro h1, },
  { push_neg at h2,
    exact h2.2, },
end

-- 7ª demostración
example
  (h1 : P)
  (h2 : ¬¬(Q ∧ R))
  : ¬¬P ∧ R :=
-- by hint
by tauto

-- 8ª demostración
lemma aux
  (h1 : P)
  (h2 : ¬¬(Q ∧ R))
  : ¬¬P ∧ R :=
by finish

-- #print axioms aux


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers

/-!

# Doing algebra in the real numbers

The `ring` tactic will prove algebraic identities like
(x + y) ^ 2 = x ^ 2 + 2 * x * y + y ^ 2 in rings, and Lean
knows that the real numbers are a ring. See if you can use
`ring` to prove these theorems.

## New tactics you will need

* `ring`
* `intro` (new functionality: use on a goal of type `⊢ ∀ x, ...`)

-/

example (x y : ℝ) : (x + y) ^ 2  = x ^ 2 + 2 * x * y + y ^ 2 :=
begin
  ring,
end

example : ∀ (a b : ℝ), ∃ x,
  (a + b) ^ 3 = a ^ 3 + x * a ^ 2 * b + 3 * a * b ^ 2 + b ^ 3 :=
begin
  intros a b,
  use 3,
  ring,
end

example : ∃ (x : ℝ), ∀ y, y + y = x * y :=
begin
  use 2,
  intro y,
  ring,
end

example : ∀ (x : ℝ), ∃ y, x + y = 2 :=
begin
  intro x,
  use 2 - x,
  ring,
end

example : ∀ (x : ℝ), ∃ y, x + y ≠ 2 :=
begin
  intro x,
  use 3 - x,
  ring_nf,
  norm_num,
end


import data.list

universes u₀ u₁
variables {α : Type u₀}

def {u v} source {α : Type u}{R : α → α → Type v} {x y}: R x y → α := λ _, x
def {u v} target {α : Type u}{R : α → α → Type v} {x y}: R x y → α := λ _, y

inductive path (R : α → α → Sort u₁) : α → α → Type (max u₀ u₁)
| nil {} : Π {x}, path x x
| cons   : Π {x y z}, R x y → path y z → path x z

namespace path

variables {R : α → α → Sort u₁}

def singleton {x y} : R x y → path R x y := λ e, cons e nil

def length : Π{x y}, path R x y → ℕ
| _ _ nil := 0
| _ _ (cons _ p)  := 1 + length p

def append : Π {x y z}, path R x y → path R y z → path R x z
| _ _ _ nil p := p
| _ _ _ (cons e p₁) p₂ := cons e (append p₁ p₂)

lemma nil_append {x y}{p : path R x y} : append nil p = p := rfl

@[simp]
lemma append_nil : Π {x y}{p : path R x y}, append p nil = p
| _ ._ nil := rfl
| _ _ (cons _ p) := congr_arg (cons _) append_nil

@[simp]
lemma append_assoc : Π {w x y z}{p₁ : path R w x}{p₂ : path R x y}{p₃ : path R y z},
  append (append p₁ p₂) p₃ = append p₁ (append p₂ p₃)
| _ ._ _ _ nil p₂ p₃ := rfl
| _ _ _ _ (cons e p₁) p₂ p₃ := begin simp [append], apply append_assoc end

@[simp]
lemma length_append : Π {x y z}{p₁ : path R x y}{p₂ : path R y z}, length (append p₁ p₂) = p₁.length + p₂.length
| _ ._ _ nil _ := by simp [append, length]
| _ _ _ (cons e p₁) p₂ :=
begin
simp [append, length], rw length_append,
cc
end

def concat : Π {x y z}, path R x y → R y z → path R x z
| _ .(_) _ nil e := singleton e
| _ _ _ (cons e₁ p) e₂ := cons e₁ (concat p e₂)

lemma concat_append : Π {w x y z}{p₁ : path R w x}{p₂ : path R x y}{e : R y z}, concat (append p₁ p₂) e = append p₁ (concat p₂ e)
| _ ._ _ _ nil p₂ _ := rfl
| _ _ _ _ (cons e₁ p₁) p₂ e₂ :=
begin
simp [append, concat],
rw concat_append
end

@[reducible]
def targets : Π {x y}, path R x y → list α
| .(_) _ nil := []
| _ _ (@cons _ _ _ x _ _ p) := x :: targets p

@[reducible]
def sources : Π {x y}, path R x y → list α
| .(_) _ nil := []
| x _ (cons _ p) := x :: sources p

@[reducible,inline]
def occurrences {x y} : path R x y → list α := λ p, x :: targets p

lemma source_mem_occurrences {x y}(p : path R x y) : x ∈ occurrences p := list.mem_cons_self _ _

lemma target_mem_occurrences : Π{x y}(p : path R x y), y ∈ occurrences p
| _ ._ nil := list.mem_cons_self _ _
| _ _ (cons e p) := list.mem_cons_of_mem _ (target_mem_occurrences _)

lemma occurrences_eq_concat_sources : Π {x y}(p : path R x y), occurrences p = list.concat (sources p) y
| _ ._ nil := rfl
| x _ (cons e p) :=
  congr_arg (λ xs, x :: xs) (occurrences_eq_concat_sources p)

@[simp]
lemma occurrences_cons {x y z}(e : R x y)(p : path R y z) : occurrences (cons e p) = x :: occurrences p
:= rfl

lemma occurrences_concat : Π {x y z}(p : path R x y)(e : R y z), occurrences (concat p e) = list.concat (occurrences p) z
| x ._ z nil e := rfl
| x _ z (cons e₁ p) e₂ := congr_arg  (λ xs, x :: xs) (occurrences_concat p e₂)

lemma length_occurrences   : Π{x y}(p : path R x y), p.occurrences.length = 1 + p.length
| _ _ nil := by trivial
| _ _ (cons e p) := have iH : p.occurrences.length = 1 + p.length, from length_occurrences p, begin simp [length], simp at iH, assumption end

lemma occurrences_append_targets : Π {x y z}(p₁ : path R x y)(p₂ : path R y z), occurrences (append p₁ p₂) = occurrences p₁ ++ targets p₂
| _ ._ _ nil p := rfl
| x y z (@cons ._ ._ ._ w ._ e p₁) p₂ :=

begin
have iH : occurrences (append p₁ p₂) = occurrences p₁ ++ targets p₂, from occurrences_append_targets p₁ p₂,
simp at iH,
simp [targets, append],
assumption
end

lemma occurrences_append_sources {x y z}(p₁ : path R x y)(p₂ : path R y z) : occurrences (append p₁ p₂) = sources p₁ ++ occurrences p₂
:=
begin
simp [occurrences],
change occurrences (append p₁ p₂) = sources p₁ ++ ([y] ++ targets p₂),
rw ←list.append_assoc,
rw ←list.concat_eq_append,
rw ←occurrences_eq_concat_sources,
apply occurrences_append_targets
end

def rewind_path (R) : α → α → Type _ := function.swap (path (function.swap R))

def rewind : Π {x y}, path R x y → rewind_path R x y
| _ .(_) nil := nil
| _ _ (cons e p) := concat (rewind p) e

def occurrences_rewind : Π {x y} {p : path R x y}, p.rewind.occurrences = p.occurrences.reverse
| _ ._ nil := rfl
| x y (cons e p) :=
begin
unfold rewind,
rw occurrences_concat,
rw occurrences_rewind,
simp
end

lemma rewind_concat : Π {x y z}{p : path R x y}{e : R y z}, rewind (concat p e) = cons e (rewind p)
| _ ._ _ nil _        := rfl
| _ _ _ (cons e₁ p) e₂ :=
begin
unfold concat,
unfold rewind,
rw rewind_concat,
refl
end

lemma rewind_rewind : Π {x y}{p : path R x y}, p.rewind.rewind = p
| _ ._ nil := rfl
| _ _ (cons e p) :=
begin
unfold rewind,
rw rewind_concat,
rw rewind_rewind
end

lemma rewind_append : Π {x y z}{p₁ : path R x y}{p₂ : path R y z}, rewind (append p₁ p₂) = append p₂.rewind p₁.rewind
| _ ._ _ nil _ := by simp [rewind,append]
| _ _ _ (cons e p₁) p₂ :=
begin
unfold append,
unfold rewind,
rw rewind_append,
apply concat_append
end

def split [deq : decidable_eq α] : Π {x y z} {p : path R x y},
   z ∈ occurrences p →
     Σ' (p₁ : path R x z) (p₂ : path R z y), p = append p₁ p₂ ∧ z ∉ sources p₁ :=

  begin
  intros x y z p h,
  induction p with x x w y e p iH,
  {
    simp [occurrences, targets] at h,
    rw h,
    exact ⟨nil, nil, rfl, list.not_mem_nil _⟩
  },
  {
      cases (deq z x) with Hne Heq,
      {
          simp [occurrences, targets] at h,
          have H : z ∈ occurrences p, apply or.resolve_left h Hne,
          cases (iH H) with p₁ rest,
          cases rest with p₂ Hp,
          exact ⟨cons e p₁, p₂,
            begin rw Hp.left, refl end, list.not_mem_cons_of_ne_of_not_mem Hne Hp.right⟩

      },
      {
        rw Heq,
        exact ⟨nil, cons e p, rfl, list.not_mem_nil _⟩
      }
  }
  end

@[reducible]
def is_simple {x y}(p : path R x y) : Prop := list.nodup (occurrences p)

def simple_path (R) := λ x y : α, { p : path R x y // is_simple p}

instance {x y} : has_coe (simple_path R x y) (path R x y) := ⟨subtype.val⟩

lemma nil_is_simple {x : α} : is_simple (@nil _ R x) := list.nodup_singleton _

lemma is_simple_of_is_simple_append_left {x y z}{p₁ : path R x y}{p₂ : path R y z} : is_simple (append p₁ p₂) → is_simple p₁
:=
begin
unfold is_simple,
rw occurrences_append_targets,
apply list.nodup_of_nodup_append_left
end
lemma is_simple_of_is_simple_append_right {x y z}{p₁ : path R x y}{p₂ : path R y z} : is_simple (append p₁ p₂) → is_simple p₂
:=
begin
unfold is_simple,
rw occurrences_append_sources,
apply list.nodup_of_nodup_append_right
end

def is_simple_rewind_of_is_simple {x y} {p : path R x y} : is_simple p → is_simple p.rewind
:=
begin
intro H,
unfold is_simple at *,
rw [occurrences_rewind, list.nodup_reverse],
assumption
end

def reduce_cycle [decidable_eq α] : Π {x y} (p : path R x y), Σ' (sp : simple_path R x y), occurrences sp.val <+ occurrences p
| _ ._ nil := ⟨⟨nil, nil_is_simple⟩ , by trivial⟩
| x y (cons e p) :=
  let ⟨sp , sub_sp⟩ := reduce_cycle p in
  match list.decidable_mem x sp.1.occurrences with
  | is_false x_not_in_sp := ⟨⟨cons e sp.1 ,
     begin
      unfold is_simple, simp only [occurrences], simp at x_not_in_sp,
      rw list.nodup_cons,
      split,
       { simp, have H: list.nodup (sp.1.occurrences), apply sp.2, simp at H, trivial},
       {apply sp.2}
     end ⟩ ,
        begin
          apply list.sublist.cons2,
          assumption
        end ⟩
  | is_true x_in_sp :=
      let ⟨sp₁, sp₂ , Hsp, Hnmem ⟩  := split x_in_sp in
      have simple_sp₂ : is_simple sp₂,
        from
          begin
          apply is_simple_of_is_simple_append_right,
          rw ←Hsp,
          apply sp.2,
          end,
      let ret : simple_path R x y := ⟨sp₂, simple_sp₂⟩ in
      have sp₂_sub    : occurrences (ret.1) <+ occurrences (cons e p), from
        begin transitivity,
               { apply list.sublist_append_right, exact (sources sp₁), },
               {
                 rw ←occurrences_append_sources,
                 rw ←Hsp,
                 apply list.sublist.cons,
                 apply sub_sp
               } end,
      ⟨ret , sp₂_sub⟩
  end

def to_simple_path [decidable_eq α] {x y} : path R x y →  simple_path R x y := λ p, (reduce_cycle p).1

def is_nonempty : Π {x y}(p : path R x y ), Prop
| _ ._ nil := false
| _ _ _ := true

end path


import tactic --hide
variable X : Type --hide

/-
# Chapter 1 : Sets

## Level 7
-/

/-
In this level you continue working with sets, while learning some useful
Lean tactics, `by_contradiction` and `push_neg`.
You need to prove that the empty set is included in any set.
To do that, we'll follow the advice of P. Halmos in "Naive Set Theory".
That is, to prove something is true about the empty set, prove that it cannot be false.
-/

/- Hint : Empty set definition in mathlib:
theorem empty_def : (∅ : set α) = {x | false} := rfl
-/
-- begin hide
-- Is there a definition in Lean core that I'm missing?
-- end hide

/-
When starting this level, the goal is:
$$\forall (A : \textrm{set} \; X), \; \emptyset \subseteq A$$
To make progress, you'll need to instantiate a specific set $A$
with the well-known `intro` tactic.

Remember now the definition of set inclusion. The goal
$$ \emptyset \subseteq A$$
is the same as
$$ \forall x \in \emptyset, x \in A.$$
Thus, use `change ∀ x ∈ ∅, x ∈ A` on the line after `intro A`.
Time to switch to the meat of the proof. Type `by_contradiction hn` to introduce
the contradiction hypothesis `hn` and change the goal to `false`.

Next, it is helpful to further change this into the equivalent statement that there exists
a member of the empty set which does not belong to $A$.
This can be accomplished by
`push_neg at hn`. You sure can bring this home from here using `cases`.

-/

local attribute [instance] classical.prop_decidable --hide
/- Lemma
The empty set is included in any set $A$....
-/
theorem empty_set_subset : ∀ A : set X, ∅ ⊆ A :=
begin
    intro A,
    change ∀ x ∈ ∅, x ∈ A,
    by_contradiction hn,
    push_neg at hn,
    cases hn with x h1,
    cases h1 with hf ha,
    exact hf, done
end


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

import algebra.group.defs
import data.bracket

/-!
# The bracket on a group given by commutator.

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

/-- The commutator of two elements `g₁` and `g₂`. -/
instance commutator_element {G : Type*} [group G] : has_bracket G G :=
⟨λ g₁ g₂, g₁ * g₂ * g₁⁻¹ * g₂⁻¹⟩

lemma commutator_element_def  {G : Type*} [group G] (g₁ g₂ : G) :
  ⁅g₁, g₂⁆ = g₁ * g₂ * g₁⁻¹ * g₂⁻¹ := rfl