import analysis.normed_space.basic
import topology.instances.ennreal
import analysis.normed_space.basic
import topology.instances.ennreal
import algebra.archimedean algebra.geom_sum
import data.nat.choose data.complex.basic
import tactic.linarith
import analysis.calculus.deriv
import data.complex.exponential

open finset
open cau_seq
namespace complex
noncomputable theory

lemma is_cau_abs_cos (z : ℂ) : is_cau_seq _root_.abs
  (λ n, (range n).sum (λ m, abs (
      ((-1) ^ m) * z ^ (2 * m ) / nat.fact (2 * m )))) :=
begin
sorry,
end

lemma is_cau_abs_sin (z : ℂ) : is_cau_seq _root_.abs
  (λ n, (range n).sum (λ m, abs (
      ((-1) ^ m) * z ^ (2 * m + 1) / nat.fact (2 * m + 1)))) :=
begin
sorry,
/-
let ⟨n, hn⟩ := exists_nat_gt (abs z) in
have hn0 : (0 : ℝ) < n, from lt_of_le_of_lt (abs_nonneg _) hn,
series_ratio_test n (complex.abs z / n)
(div_nonneg_of_nonneg_of_pos (complex.abs_nonneg _) hn0)
  (by rwa [div_lt_iff hn0, one_mul])
  (λ m hm,
    by rw [abs_abs, abs_abs, nat.fact_succ, pow_succ,
      mul_comm m.succ, nat.cast_mul, ← div_div_eq_div_mul, mul_div_assoc,
      mul_div_right_comm, abs_mul, abs_div, abs_cast_nat];
    exact mul_le_mul_of_nonneg_right
      (div_le_div_of_le_left (abs_nonneg _) hn0
        (nat.cast_le.2 (le_trans hm (nat.le_succ _)))) (abs_nonneg _))
-/
end

lemma is_cau_sin (z : ℂ) :
 is_cau_seq abs (λ n, (range n).sum (λ m,
 ((-1) ^ m) * z ^ (2 * m + 1) / nat.fact (2 * m + 1)))
:=
begin
    exact is_cau_series_of_abv_cau (is_cau_abs_sin z),
end

lemma is_cau_cos (z : ℂ) :
 is_cau_seq abs (λ n, (range n).sum (λ m,
 ((-1) ^ m) * z ^ (2 * m ) / nat.fact (2 * m)))
:=
begin
    exact is_cau_series_of_abv_cau (is_cau_abs_cos z),
end

def sin' (z : ℂ) : cau_seq ℂ complex.abs :=
 ⟨λ n, (range n).sum
 (λ m, ((-1) ^ m) * z ^ (2 * m + 1) / nat.fact (2 * m + 1)),
 is_cau_sin z⟩
def sin1 (z : ℂ) : ℂ := lim (sin' z)

def cos' (z : ℂ) : cau_seq ℂ complex.abs :=
 ⟨λ n, (range n).sum
 (λ m, (-1) ^ m * z ^ (2 * m) / nat.fact (2 * m)),
 is_cau_cos z⟩
def cos1 (z : ℂ) : ℂ := lim (cos' z)

theorem euler : ∀ x, exp (x * I) = cos1 x + sin1 x * I
:=
begin
    intros,

    have partials: ∀ n:ℕ , (exp' (x*I)).1 (2*n+1) =
     (cos' x).1 (n+1) + ((sin' x).1 n) * I,
    {
        intros,
        rw exp',
        simp,
        rw cos',
        simp,
        rw sin',
        simp,

        induction n with n0 hn,
        { -- case n0=0
            simp,
--            simp,
        },
        { -- induction on n0

            rw sum_range_succ _ _, -- takes out last term in cos

            have lastSin :
            sum (range (nat.succ n0)) (λ (x_1 : ℕ), (-1) ^ x_1 * x ^ (1 + 2 * x_1) / ↑(nat.fact (1 + 2 * x_1)))
            =
            (-1) ^ n0 * x ^ (1 + 2 * n0) / ↑(nat.fact (1 + 2 * n0))
            +
            sum (range (n0)) (λ (x_1 : ℕ), (-1) ^ x_1 * x ^ (1 + 2 * x_1) / ↑(nat.fact (1 + 2 * x_1)))
            ,
            {
              rw sum_range_succ _ _,
            },

            have sinFactorial :
            sum (range (nat.succ n0)) (λ (x_1 : ℕ), (-1) ^ x_1 * x ^ (2 * x_1 + 1) / ((2 * ↑x_1 + 1) * ↑(nat.fact (2 * x_1))))
            =
            sum (range (nat.succ n0)) (λ (x_1 : ℕ), (-1) ^ x_1 * x ^ (1 + 2 * x_1) / ↑(nat.fact (1 + 2 * x_1))),
            {
              sorry,
              --lean should fuckin know this!
            },
            rw sinFactorial,
            rw lastSin,

            have twoFromExp:
            sum (range (nat.succ (2 * nat.succ n0))) (λ (x_1 : ℕ),
            (x * I) ^ x_1 / ↑(nat.fact x_1))
            =
            (x * I) ^ ( 2 * nat.succ n0) / ↑(nat.fact ( 2 * nat.succ n0))+
            sum (range ( 2 * nat.succ n0)) (λ (x_1 : ℕ),
            (x * I) ^ x_1 / ↑(nat.fact x_1))
            ,
            {
              rw sum_range_succ _ ( 2 * nat.succ n0),
            },
            have twoFromExpv1 :
            (x * I) ^ ( 2 * nat.succ n0) / ↑(nat.fact ( 2 * nat.succ n0))+sum (range ( 2 * nat.succ n0)) (λ (x_1 : ℕ), (x * I) ^ x_1 / ↑(nat.fact x_1))
            =
            sum (range (nat.succ (2 * nat.succ n0))) (λ (x_1 : ℕ),
            (x * I) ^ x_1 / ↑(nat.fact x_1)),
             {
               by exact eq.symm twoFromExp,
             },

            have twoNP1 : 1+ (2 * nat.succ n0) =nat.succ (2 * nat.succ n0)
            ,
            {
              exact add_comm 1 (2 * nat.succ n0),
            },

            have twoNP1v1 : nat.succ ( 2 * nat.succ n0) = 1 + (2 * nat.succ n0),
            {
              by exact eq.symm twoNP1,
            },

            --rw twoNP1v1,
            rw twoFromExpv1,

            have oneFromExp:
            sum (range (2 * nat.succ n0)) (λ (x_1 : ℕ), (x * I) ^ x_1 / ↑(nat.fact x_1))
            =
            (x * I) ^ (1+2 * n0) / ↑(nat.fact (1+2 * n0))
            +
            sum (range (1+ 2 * n0)) (λ (x_1 : ℕ), (x * I) ^ x_1 / ↑(nat.fact x_1))
            ,
            {
              have stupid : 2 * nat.succ n0 = nat.succ(1+2*n0),
              {
                have RRS : nat.succ(1+2*n0) = 1+(1+2*n0) ,
                {
                  sorry,
                },
                rw RRS,

                have realSt : 1+(1+2*n0) = 1+1+2*n0,
                {
                  simp,
                },
                rw realSt,
                exact nat.add_comm (nat.mul 2 n0) 2,
              },
              rw stupid,
              rw sum_range_succ _ (1 + 2 * n0),
            },
            --rw oneFromExp,
            --rw hn,
            --simp,

            --  need (x*I)^(2 n0 )= x^(2n0) (-1)^n0 etc, commutativity

            sorry,
            --ring,
        },
    },

    have partialExp : lim (exp' (x * I)) = exp (x*I),
    {
      sorry,
    },

    have pulled_outta_my_derriere : ∀ (n : ℕ), (cos' x).val (n + 1) = cos1 x,
    {
      sorry,
    },

    rw exp,
    rw partialExp,

    -- Now: need to take limits on both sides, they're same,
    -- but need to convince Lean that limit of exp' (2n+1) is same as
    -- limit of exp' (n) which is what exp is defined to be
end

end complex


/-
Authore: Andrea Delmastro
-/
import tactic.induction

/-!
# Semantica per IMP

Questo file definisce le semantiche big-step e small-step per il linguaggio di programmazione IMP e
ne dimostra l'equivalenza.

La semantica di un linguaggio di programmazione fornisce una descrizione computazionale delle
strutture sintattiche del linguaggio.

## Note di implementazione

Questo file utilizza i tattici `cases'` e `induction'` definiti in `tactic.induction`.
Nonostante le medesime dimostrazioni siano ottenibili tramite i tattici `cases` e `induction`
classici, le due versioni qui utilizzate meglio si prestano all'utilizzo con predicati induttivi e
sono più 'naturali' rispetto alla medesima dimostrazione svolta su carta.

## Notazione

* `vname` : nome di variabile, `string`
* `val` : valore di un'espressione, `ℕ`
* `pstate` : stato di programma, funzione da `vname` a `val`
* `emp` : stato vuoto, assegna ad ogni variabile il valore 0
* `s [ x  ↦  v ]` : aggiornamento dello stato `s`, con assegnazione di `v` a `x`
* `::=` : comando di assegnamento
* `;;` : concatenazione sequenziale di comandi
* `IF THEN ELSE` : comando ramificazione condizionale
* `WHILE DO` : comando di ciclo
* `conf` : configurazione, coppia `com × pstate`
* `⟹` : relazione big-step
* `∼` : equivalenza di comandi
* `↝` : riduzione small-step
* `↝*` : chiusura riflessiva e transitiva di `↝`

## Risultati principali

* `big_step.deterministic : ∀ {c : com} {s t r : pstate}, (c, s) ⟹ t → (c, s) ⟹ r → t = r`
* `small_step.deterministic : ∀ {c : com} {s : pstate} {cs₁ cs₂ : conf}, (c, s)↝cs₁ → (c, s)↝cs₂ → cs₁ = cs₂`
* `big_step_equiv_small_step : ∀ {c : com} {s t : pstate} (c, s) ⟹ t ↔ (c, s)↝*(SKIP, t)`

## Riferimenti

* [Nipkow, Klein, Concrete Semantics with Isabelle/HOL][Nipkow]
-/

abbreviation vname  := string
abbreviation val    := ℕ

/--
Uno stato è una rappresentazione astratta della memora che  associa ad ogni variabile un valore.
-/
abbreviation pstate := vname → val

/--
Aggiornamento dello stato: associa ad una variabile un nuovo valore entro uno stato.
-/
def state_update (s : pstate) (x : vname) (v : val) : pstate :=
  λ (y : vname), if (y = x) then v else s y

/--
Stato vuoto, associa ad ogni variabile il valore 0.
-/
def emp : pstate := (λ _, 0)

notation s `[` x ` ↦ ` v `]`:100 := state_update s x v
notation   `[` x ` ↦ ` v `]`     := emp [x ↦ v]

/--
Lemma tecnico utile all'utilizzo del tattico `simp` per l'applicazione degli stati.
-/
@[simp] lemma apply_state_update_pos {x y : vname} {s : pstate} {v : val} :
  (y = x) → s[x ↦ v] y = v :=
begin
  intro,
  dsimp[state_update],
  apply if_pos,
  assumption
end

/--
Lemma tecnico utile all'utilizzo del tattico `simp` per l'applicazione degli stati.
-/
@[simp] lemma apply_state_update_neg {x y : vname} {s : pstate} {v : val} :
  (y ≠ x) → s[x ↦ v] y = (s y) :=
begin
  intro,
  dsimp[state_update],
  apply if_neg,
  assumption
end

/-!
### Espressioni aritmetiche

Sintassi e valutazione
-/

inductive aexp : Type
| N    : ℕ → aexp
| V    : vname → aexp
| Plus : aexp → aexp → aexp

open aexp

/--
Funzione di valutazione di un'espressione aritmetica: associa ad ogni espressione il proprio valore.
Ogni espressione ha un valore ben definito.
-/
def aval : aexp → pstate → val
| (N n)        _ := n
| (V x)        s := s x
| (Plus a₁ a₂) s := (aval a₁ s) + (aval a₂ s)

/-!
### Espressioni booleane

Sintassi e valutazione
-/

inductive bexp : Type
| Bc   : bool → bexp
| Not  : bexp → bexp
| And  : bexp → bexp → bexp
| Less : aexp → aexp → bexp

open bexp

/--
Funzione di valutazione di un'espressione booleana: associa ad ogni espressione il proprio valore.
Ogni espressione ha un valore ben definito.
-/
def bval : bexp → pstate → bool
| (Bc v)       _ := v
| (Not b)      s := ¬(bval b s)
| (And b₁ b₂)  s := (bval b₁ s) ∧ (bval b₂ s)
| (Less a₁ a₂) s := (aval a₁ s) < (aval a₂ s)

/-!
### Sintassi per il linguaggio di programmazione IMP
-/

inductive com : Type
| SKIP   : com
| Assign : vname → aexp → com
| Seq    : com → com → com
| If     : bexp → com → com → com
| While  : bexp → com → com

infix ` ::= `:68                                    := com.Assign
infix ` ;; `:67                                     := com.Seq
notation `IF `:0 b ` THEN `:0 c₁ ` ELSE `:68 c₂:68  := com.If b c₁ c₂
notation `WHILE `:0 b ` DO `:68 c:68                := com.While b c

abbreviation conf := com × pstate

open com

/-!
### Semantica operazionale big-step di IMP

La semantica big-step ([Nipkow] Fig. 7.1) è una relazione a tre posti il cui significato è
`(c, s)⇒ t` se l'esecuzione del comando c nello stato iniziale s termina con lo stato  t. Gli stati
intermedi nell'esecuzione del programma non sono visibili nella relazione: la relazione in sé
considera il programma come se venisse eseguito in un unico grande step.
-/

inductive big_step : conf → pstate → Prop
| Skip {s : pstate} :
  big_step (SKIP, s) s

| Assign {s : pstate} {x : vname} {a : aexp} :
  big_step (x ::= a, s) (s[x ↦ aval a s])

| Seq {c₁ c₂ : com} {s₁ s₂ s₃ : pstate} :
  big_step (c₁, s₁) s₂ →
  big_step (c₂, s₂) s₃ →
  big_step (c₁ ;; c₂, s₁) s₃

| IfTrue {b : bexp} {c₁ c₂ : com} {s t : pstate}  :
  bval b s →
  big_step (c₁, s) t →
  big_step (IF b THEN c₁ ELSE c₂, s) t

| IfFalse {b : bexp}  {c₁ c₂ : com} {s t : pstate} :
  ¬ bval b s →
  big_step (c₂, s) t →
  big_step (IF b THEN c₁ ELSE c₂, s) t

| WhileFalse {b : bexp} {c : com} {s : pstate} :
  ¬ bval b s →
  big_step (WHILE b DO c, s) s

| WhileTrue {b : bexp} {c : com} {s₁ s₂ s₃ : pstate } :
  bval b s₁ →
  big_step (c, s₁) s₂ →
  big_step (WHILE b DO c, s₂) s₃ →
  big_step (WHILE b DO c, s₁) s₃

infix ` ⟹ `:70 := big_step

open big_step

namespace big_step

namespace rule_inversion

/-!
### Inversione delle regole

Le regole di inversione per la semantica big-step permettono di inferire informazioni a partire
da termini di tipo `(c, s)⇒ t`. Dipendono dal fatto che un predicato induttivo è vero solo se le
regole di inferenza lo permettono, ovvero esiste una derivazione per il predicato.
-/

/--
Regola di inversione per `Skip`: da `(SKIP, s) ⟹ t` è possibile inferire `s = t`.
-/
lemma skip {s t : pstate} (h : (SKIP, s) ⟹ t) :
  s = t :=
begin cases' ‹(SKIP, s) ⟹ t›, reflexivity end

/--
Regola di inversione per `Assign`: da `(x ::= a, s) ⟹ t` è possibile inferire
`s[x ↦ aval a s] = t`.
-/
lemma assign {x : vname} {a : aexp} {s t : pstate} (h : (x ::= a, s) ⟹ t) :
  s[x ↦ aval a s] = t :=
begin cases' ‹(x ::= a, s) ⟹ t›, reflexivity end

/--
Regola di inversione per `Seq`: da `(c₁ ;; c₂, s₁) ⟹ s₃` è possibile inferire l'esistenza di uno
stato intermedio `s₂` tale che `(c₁, s₁) ⟹ s₂` e `(c₂, s₂) ⟹ s₃`.
-/
lemma seq {c₁ c₂ : com} {s₁ s₃ : pstate} (h : (c₁ ;; c₂, s₁) ⟹ s₃) :
  ∃ (s₂ : pstate), (c₁, s₁) ⟹ s₂ ∧ (c₂, s₂) ⟹ s₃ :=
begin
  cases' ‹(c₁ ;; c₂, s₁) ⟹ s₃› with _ _ _ _ _ _ _ s₂,
  apply exists.intro,
  split,
    exact ‹(c₁, s₁) ⟹ s₂›,
    exact ‹(c₂, s₂) ⟹ s₃›
end

/--
Regola di inversione per `IfTrue` e `IfFalse`: da `(IF b THEN c₁ ELSE c₂, s) ⟹ t` è possibile
inferire `(bval b s ∧ (c₁, s) ⟹ t)`, corrispondente a una derivazione che termina in `IfTrue`
oppure `(¬bval b s ∧ (c₂, s) ⟹ t)`, corrispondente a una derivazione che termina in `IfFalse`
-/
lemma ifte {b : bexp} {c₁ c₂ : com} {s t : pstate} (h : (IF b THEN c₁ ELSE c₂, s) ⟹ t) :
  (bval b s ∧ (c₁, s) ⟹ t) ∨ (¬bval b s ∧ (c₂, s) ⟹ t) :=
begin
  cases ‹(IF b THEN c₁ ELSE c₂, s) ⟹ t›,
    case IfTrue : { exact or.inl ⟨‹↥(bval b s)›, ‹(c₁, s) ⟹ t›⟩ },
    case IfFalse : { exact or.inr ⟨‹¬↥(bval b s)›, ‹(c₂, s) ⟹ t›⟩ }
end

/--
Regola di inversione per `WhileTrue` e `WhileFalse`: da `(WHILE b DO c, s) ⟹ t` è possibile inferire
`(¬bval b s ∧ t = s)`, corrispondente a una derivazione che termina in `WhileFalse` oppure
`(bval b s ∧ ∃ (s₁ : pstate), (c, s) ⟹ s₁ ∧ (WHILE b DO c, s₁) ⟹ t)`, corrispondente a una
derivazione che termina in `WhileTrue`.
-/
lemma while {b : bexp} {c : com} {s t : pstate} (h : (WHILE b DO c, s) ⟹ t) :
  (¬bval b s ∧ t = s) ∨ (bval b s ∧ ∃ (s₁ : pstate), (c, s) ⟹ s₁ ∧ (WHILE b DO c, s₁) ⟹ t) :=
begin
  cases ‹(WHILE b DO c, s) ⟹ t›,
    case WhileTrue : _ _ _ s₂ _ _ _ _ {
      have : ∃ (s₁ : pstate), (c, s) ⟹ s₁ ∧ (WHILE b DO c, s₁) ⟹ t :=
        ⟨s₂, ⟨‹(c, s) ⟹ s₂›, ‹(WHILE b DO c, s₂) ⟹ t›⟩⟩,
      exact or.inr ⟨‹↥(bval b s)›, ‹∃ (s₁ : pstate), (c, s) ⟹ s₁ ∧ (WHILE b DO c, s₁) ⟹ t›⟩
    },
    case WhileFalse : { exact or.inl ⟨‹¬↥(bval b s)›, rfl⟩ }
end

end rule_inversion

/--
Associatività della composizione sequenziale.
-/
lemma seq_assoc {c₁ c₂ c₃ : com} {s t : pstate} :
  (c₁ ;; c₂ ;; c₃, s) ⟹ t ↔ (c₁ ;; (c₂ ;; c₃), s) ⟹ t :=
begin
  split,
    {
      assume : (c₁ ;; c₂ ;; c₃, s) ⟹ t,
      have : ∃ s₁, (c₁ ;; c₂, s) ⟹ s₁ ∧ (c₃, s₁) ⟹ t :=
        rule_inversion.seq ‹(c₁ ;; c₂ ;; c₃, s) ⟹ t›,
      cases ‹∃ s₁, (c₁ ;; c₂, s) ⟹ s₁ ∧ (c₃, s₁) ⟹ t› with s₁,
      cases ‹(c₁ ;; c₂, s) ⟹ s₁ ∧ (c₃, s₁) ⟹ t›,
      have : ∃ s₂, (c₁, s) ⟹ s₂ ∧ (c₂, s₂) ⟹ s₁ :=
        rule_inversion.seq ‹(c₁ ;; c₂, s) ⟹ s₁›,
      cases ‹∃ s₂, (c₁, s) ⟹ s₂ ∧ (c₂, s₂) ⟹ s₁› with s₂,
      cases ‹(c₁, s) ⟹ s₂ ∧ (c₂, s₂) ⟹ s₁›,
      show (c₁ ;; (c₂ ;; c₃), s) ⟹ t, from
        Seq ‹(c₁, s) ⟹ s₂› (Seq ‹(c₂, s₂) ⟹ s₁› ‹(c₃, s₁) ⟹ t›)
    },
    {
      assume : (c₁ ;; (c₂ ;; c₃), s) ⟹ t,
      have : ∃ s₁, (c₁, s) ⟹ s₁ ∧ (c₂ ;; c₃, s₁) ⟹ t :=
        rule_inversion.seq ‹(c₁ ;; (c₂ ;; c₃), s) ⟹ t›,
      cases ‹∃ s₁, (c₁, s) ⟹ s₁ ∧ (c₂ ;; c₃, s₁) ⟹ t› with s₁,
      cases ‹(c₁, s) ⟹ s₁ ∧ (c₂ ;; c₃, s₁) ⟹ t›,
      have : ∃ s₂, (c₂, s₁) ⟹ s₂ ∧ (c₃, s₂) ⟹ t :=
        rule_inversion.seq ‹(c₂ ;; c₃, s₁) ⟹ t›,
      cases ‹∃ s₂, (c₂, s₁) ⟹ s₂ ∧ (c₃, s₂) ⟹ t› with s₂,
      cases ‹(c₂, s₁) ⟹ s₂ ∧ (c₃, s₂) ⟹ t›,
      show (c₁ ;; c₂ ;; c₃, s) ⟹ t, from
        Seq (Seq ‹(c₁, s) ⟹ s₁› ‹(c₂, s₁) ⟹ s₂›) ‹(c₃, s₂) ⟹ t›
    }
end

namespace com_equivalence

/-!
### Equivalenza di comandi

Due comandi `c₁` e `c₂` sono definiti equivalenti se a partire dallo stesso s stato terminano nel
medesimo stato `t`.
-/

notation c₁ `∼` c₂ := ∀ {s t : pstate}, (c₁, s) ⟹ t = (c₂, s) ⟹ t

/--
Il comando `WHILE d DO c` è equivalente al suo unfolding in
`IF b THEN (c ;; WHILE b DO c) ELSE SKIP`.
-/
lemma eq_while_ifwhile {b : bexp} {c : com} :
  WHILE b DO c ∼ IF b THEN (c ;; WHILE b DO c) ELSE SKIP :=
begin
  intros,
  apply iff.to_eq,
  split,
    {
      intros,
      cases ‹(WHILE b DO c, s) ⟹ t›,
        case WhileFalse : {
          show  (IF b THEN (c ;; WHILE b DO c) ELSE SKIP, s) ⟹ s, from
            IfFalse ‹¬↥(bval b s)› Skip
        },
        case WhileTrue : _ _ _ s₁ _ _ _ _ {
          show (IF b THEN (c ;; WHILE b DO c) ELSE SKIP, s) ⟹ t, from
            IfTrue ‹↥(bval b s)› (Seq ‹(c, s) ⟹ s₁› ‹(WHILE b DO c, s₁) ⟹ t›)
        }
    },
    {
      intros,
      cases ‹(IF b THEN (c ;; WHILE b DO c) ELSE SKIP, s) ⟹ t›,
        case IfTrue : {
          cases ‹(c ;; WHILE b DO c, s) ⟹ t› with _ _ _ _ _ _ _ s₁,
          show (WHILE b DO c, s) ⟹ t, from
            WhileTrue ‹↥(bval b s)› ‹(c, s) ⟹ s₁› ‹(WHILE b DO c, s₁) ⟹ t›
        },
        case IfFalse : {
          cases ‹(SKIP, s) ⟹ t›,
          show (WHILE b DO c, s) ⟹ s, from
            WhileFalse ‹¬↥(bval b s)›
        }
    }
end

end com_equivalence

/--
Determinismo della semantica big-step.
Se l'esecuzione di `c` in `s` termina, allora esiste un unico `t` tale che `(c, s) ⟹ t`.
-/
theorem deterministic {c : com} {s t r : pstate} :
  (c, s) ⟹ t → (c, s) ⟹ r → (t = r) :=
begin
  intros,
  induction' ‹(c, s) ⟹ t›,
    case Skip : s {
      cases' ‹(SKIP, s) ⟹ r›,
      trivial
    },
    case Assign : s x a {
      cases' ‹(x ::= a, s) ⟹ r›,
      trivial
    },
    case Seq : _ _ s s₁ _ _ _ ih₁ ih₂ {
      cases' ‹(c₁ ;; c₂, s) ⟹ r› with _ _ _ _ _ _ s _ _,
      have : (s₁ = s₂) := ih₁ ‹(c₁, s) ⟹ s₂›,
      rw ‹s₁ = s₂› at *,
      show t = r, from  ih₂ ‹(c₂, s₂) ⟹ r›
    },
    case IfTrue : {
      cases' ‹(IF b THEN c₁ ELSE c₂, s) ⟹ r›,
        case IfTrue : { show t = r, from ih ‹(c₁, s) ⟹ r› },
        case IfFalse : { trivial }
    },
    case IfFalse : {
      cases' ‹(IF b THEN c₁ ELSE c₂, s) ⟹ r›,
        case IfTrue : { trivial },
        case IfFalse : { show t = r, from ih ‹(c₂, s) ⟹ r› }
    },
    case WhileTrue : _ _ s s₁ _ _ _ _ ih₁ ih₂ {
      cases' ‹(WHILE b DO c, s) ⟹ r›,
        case WhileTrue : _ _ s _ _ _ _ _ {
          have : (s₁ = s₂) := ih₁ ‹(c, s) ⟹ s₂›,
          rw ←‹s₁ = s₂› at *,
          show t = r, from ih₂ ‹(WHILE b DO c, s₁) ⟹ r›
        },
        case WhileFalse : { trivial }
    },
    case WhileFalse : _ _ s _ {
      cases' ‹(WHILE b DO c, s) ⟹ r›,
        case WhileTrue : { trivial },
        case WhileFalse : { trivial }
    }
end

end big_step

/-!
### Semantica operazionale small-step di IMP

La riduzione small-step ([Nipkow] Fig. 7.5)  `(c₁ , s₁)→(c₂ , s₂)` è una relazione tra due coppie
comando/stato che rappresenta l'esecuzione di un singolo passo di calcolo di `c₁` nello stato `s₁`
che produce lo stato `s₂`, mentre `c₂` é la continuazione (ciò che resta da eseguire) di `c₁`.
-/

inductive small_step : conf → conf → Prop
| Assign  {s : pstate} {x : vname} {a : aexp} :
  small_step (x ::= a, s) (SKIP, s[x ↦ aval a s])

| Seq1 {c₂ : com} {s : pstate} :
  small_step (SKIP ;; c₂, s) (c₂, s)

| Seq2 {c₁ c₁' c₂ : com} {s s' : pstate} :
  small_step (c₁, s) (c₁', s') →
  small_step (c₁ ;; c₂, s) (c₁' ;; c₂, s')

| IfTrue {b : bexp} {s : pstate} {c₁ c₂ : com}:
  bval b s →
  small_step (IF b THEN c₁ ELSE c₂, s) (c₁, s)

| IfFalse {b : bexp} {s : pstate} {c₁ c₂ : com}:
  ¬bval b s →
  small_step (IF b THEN c₁ ELSE c₂, s) (c₂, s)

| While {b : bexp} {c : com} {s : pstate} :
  small_step (WHILE b DO c, s) (IF b THEN (c ;; WHILE b DO c) ELSE SKIP, s)

infix `↝`:70 := small_step

open small_step

namespace small_step

inductive small_step_star : conf → conf → Prop
| refl {c : com} {s : pstate} : small_step_star (c, s) (c, s)

| step {c c₁ c₂ : com} {s s₁ s₂ : pstate}:
  small_step (c, s) (c₁, s₁) →
  small_step_star (c₁, s₁) (c₂, s₂) →
  small_step_star (c, s) (c₂, s₂)

infix `↝*`:70 := small_step_star

namespace trans

/-!
### Lemmi di transitività per ↝ e ↝*

I seguenti lemmi sono puramente tecnici e utili alla configurazione dell'ambiente `calc`.
-/

open small_step_star

@[trans] lemma small_step_star_small_step_star_trans {cf cf₁ cf₂: conf} :
  cf ↝* cf₁ → cf₁ ↝* cf₂ → cf ↝* cf₂ :=
begin
  cases cf with c s,
  cases cf₁ with c₁ s₁,
  cases cf₂ with c₂ s₂,
  intros,
  induction ‹(c, s)↝*(c₁, s₁)›,
    case refl : c s { exact ‹(c, s)↝*(c₂, s₂)› },
    case step : c c₃ c₁ s s₃ s₁  _ _ ih {
      have : (c₃, s₃)↝*(c₂, s₂) := ih ‹(c₁, s₁)↝*(c₂, s₂)›,
      show (c, s)↝*(c₂, s₂), from step ‹(c, s)↝(c₃, s₃)› ‹(c₃, s₃)↝*(c₂, s₂)›
    }
end

@[trans] lemma small_step_star_small_step_trans {cf cf₁ cf₂: conf} :
  cf ↝* cf₁ → cf₁ ↝ cf₂ → cf ↝* cf₂ :=
begin
  cases cf with c s,
  cases cf₁ with c₁ s₁,
  cases cf₂ with c₂ s₂,
  intros,
  induction ‹(c, s)↝*(c₁, s₁)›,
    case refl : c s { exact step ‹(c, s)↝(c₂, s₂)› refl },
    case step : c c₃ c₁ s s₃ s₁ _ _ ih {
      have : (c₃, s₃)↝*(c₂, s₂) := ih ‹(c₁, s₁)↝(c₂, s₂)›,
      show (c, s)↝*(c₂, s₂), from step ‹(c, s)↝(c₃, s₃)› ‹(c₃, s₃)↝*(c₂, s₂)›
    }
end

@[trans] lemma small_step_small_step_star_trans {cf cf₁ cf₂: conf} :
  cf ↝ cf₁ → cf₁ ↝* cf₂ → cf ↝* cf₂ :=
begin
  cases cf with c s,
  cases cf₁ with c₁ s₁,
  cases cf₂ with c₂ s₂,
  intros,
  show (c, s)↝*(c₂, s₂), from step ‹(c, s)↝(c₁, s₁)› ‹(c₁, s₁)↝*(c₂, s₂)›
end

@[trans] lemma small_step_small_step_trans {cf cf₁ cf₂: conf} :
  cf ↝ cf₁ → cf₁ ↝ cf₂ → cf ↝* cf₂ :=
begin
  cases cf with c s,
  cases cf₁ with c₁ s₁,
  cases cf₂ with c₂ s₂,
  intros,
  have : (c₁, s₁)↝*(c₁, s₁) := refl,
  have : (c, s)↝*(c₁, s₁) := step ‹(c, s)↝(c₁, s₁)› ‹(c₁, s₁)↝*(c₁, s₁)›,
  show (c, s)↝*(c₂, s₂), from
     small_step_star_small_step_trans ‹(c, s)↝*(c₁, s₁)› ‹(c₁, s₁)↝(c₂, s₂)›
end

end trans

/--
Determinismo della semantica small-step.
Se la configurazione `(c, s)` si riduce di un passo, allora esiste un'unica configurazione `cs` tale
che `(c, s)↝cs`.
-/
theorem deterministic {c : com} {s : pstate} {cs₁ cs₂ : conf} :
  (c, s)↝cs₁ → (c, s)↝cs₂ → cs₁ = cs₂ :=
begin
  intros,
  induction' ‹(c, s)↝cs₁›,
    case Assign : s x a {
      cases' ‹(x ::= a, s)↝cs₂›,
      trivial
    },
    case Seq1 : c₂ s {
      cases' ‹(SKIP ;; c₂, s)↝cs₂›,
        case Seq1 : { trivial },
        case Seq2 : c₁' _ _ s' { cases' ‹(SKIP, s)↝(c₁', s')› }
    },
    case Seq2 : c₁ c₁' c₂ s s' _ ih {
      cases' ‹(c₁ ;; c₂, s)↝cs₂›,
        case Seq1 : { cases ‹(SKIP, s)↝(c₁', s')› },
        case Seq2 : _ c₁'' _ _ s'' _ {
          have : (c₁', s') = (c₁'', s'') := ih ‹(c₁, s)↝(c₁'', s'')›,
          have : c₁' = c₁'' := by injection ‹(c₁', s') = (c₁'', s'')›,
          have : s' = s'' := by injection ‹(c₁', s') = (c₁'', s'')›,
          rw[‹c₁' = c₁''›, ‹s' = s''›]
        }
    },
    case IfTrue : b s c' c'' {
      cases' ‹(IF b THEN c' ELSE c'', s)↝cs₂›,
        case IfTrue : { trivial },
        case IfFalse : { trivial }
    },
    case IfFalse : b s c' c'' {
      cases' ‹(IF b THEN c' ELSE c'', s)↝cs₂›,
        case IfTrue : { trivial },
        case IfFalse : { trivial }
    },
    case While : b c s {
      cases' ‹(WHILE b DO c, s)↝cs₂›,
      trivial
    }
end

end small_step

namespace equivalence

open small_step.small_step_star

lemma seq_star {c c₁ c₂ : com} {s₁ s₂ : pstate} :
  (c₁, s₁)↝*(c, s₂) → (c₁ ;; c₂, s₁)↝*(c ;; c₂, s₂) :=
begin
  intro,
  induction' ‹(c₁, s₁)↝*(c, s₂)›,
    case refl : { exact refl },
    case step : c₁ c₃ c s₁ s₃ s₂ {
      show (c₁ ;; c₂, s₁)↝*(c ;; c₂, s₂), from
        calc
          (c₁ ;; c₂, s₁)↝ (c₃ ;; c₂, s₃) : Seq2 ‹(c₁, s₁)↝(c₃, s₃)›
          ...           ↝*(c ;; c₂, s₂)  : ih
    }
end

/--
La semantica big-step implica la semantica small-step.
Se l'esecuzione di `c` in `s` termina in uno stato `t`, allora `(c, s)` si riduce in zero o più
passi a `(SKIP, t)`.
-/
lemma big_step_imp_small_step {c : com} {s t : pstate} :
  (c, s) ⟹ t → (c, s)↝*(SKIP, t) :=
begin
  intro,
  induction' ‹(c, s) ⟹ t›,
    case Skip : { exact refl },
    case Assign : {
      calc
        (x ::= a, t)↝ (SKIP, t[x ↦ aval a t]) : Assign
        ...         ↝*(SKIP, t[x ↦ aval a t]) : refl

    },
    case Seq : _ _ s s₁ _ _ _ ih₁ ih₂ {
      calc
        (c₁ ;; c₂, s)↝*(SKIP ;; c₂, s₁) : seq_star ‹(c₁, s)↝*(SKIP, s₁)›
        ...          ↝ (c₂, s₁)         : Seq1
        ...          ↝*(SKIP, t)        : ih₂

    },
    case IfTrue : {
      calc
        (IF b THEN c₁ ELSE c₂, s)↝ (c₁, s)   : IfTrue ‹↥(bval b s)›
        ...                      ↝*(SKIP, t) : ih
    },
    case IfFalse : {
      calc
        (IF b THEN c₁ ELSE c₂, s)↝ (c₂, s)   : IfFalse ‹¬↥(bval b s)›
        ...                      ↝*(SKIP, t) : ih
    },
    case WhileTrue : _ _ s s₁ _ _ _ _ ih₁ ih₂ {
      calc
        (WHILE b DO c, s)↝ (IF b THEN c ;; WHILE b DO c ELSE SKIP, s) : While
        ...              ↝ (c ;; WHILE b DO c, s)                     : IfTrue ‹↥(bval b s)›
        ...              ↝*(SKIP ;; WHILE b DO c, s₁)                 : seq_star ih₁
        ...              ↝ (WHILE b DO c, s₁)                         : Seq1
        ...              ↝*(SKIP, t)                                  : ih₂
    },
    case WhileFalse : {
      calc
        (WHILE b DO c, t)↝(IF b THEN c ;; WHILE b DO c ELSE SKIP, t) : While
        ...              ↝(SKIP, t)                                  : IfFalse ‹¬↥(bval b t)›
    }
end

/--
Se la configurazione `(c, s)` si riduce in un passo a `(c₁, s₁)` e l'esecuzione di `c₁` in `s₁`
termina in `t`, allora l'esecuzione di `c` in `s` termina in `t`.
-/
lemma step_case {c c₁ : com} {s s₁ t : pstate} :
  (c, s)↝(c₁, s₁) → (c₁, s₁) ⟹ t → (c, s) ⟹ t :=
begin
  intros,
  induction' ‹(c, s)↝(c₁, s₁)›,
    case Assign : {
      cases' ‹(SKIP, s[x ↦ aval a s]) ⟹ t›,
      show (x ::= a, s) ⟹ s[x ↦ aval a s], from Assign
    },
    case Seq1 : {
      have : (SKIP, s) ⟹ s, from Skip,
      show (SKIP ;; c₂, s) ⟹ t, from Seq ‹(SKIP, s) ⟹ s› ‹(c₂, s) ⟹ t›
    },
    case Seq2 : {
      cases' ‹(c₁' ;; c₂, s') ⟹ t› with _ _ _ _ c₃ _ _ _ _,
      have : (c₁, s) ⟹ s₂, from ih ‹(c₃, s₁) ⟹ s₂›,
      show (c₁ ;; c₂, s) ⟹ t, from Seq ‹(c₁, s) ⟹ s₂› ‹(c₂, s₂) ⟹ t›
    },
    case IfTrue : {
      show (IF b THEN c₁ ELSE c₂, s) ⟹ t, from
        IfTrue ‹↥(bval b s)› ‹(c₁, s) ⟹ t›
    },
    case IfFalse : {
      show (IF b THEN c₁ ELSE c₂, s) ⟹ t, from
        IfFalse ‹¬↥(bval b s)› ‹(c₂, s) ⟹ t›
    },
    case While : {
      cases' ‹(IF b THEN (c ;; WHILE b DO c) ELSE SKIP, s) ⟹ t›,
        case IfTrue : {
          cases' ‹(c ;; WHILE b DO c, s) ⟹ t› with _ _ _ _ _ _ s s₁ _,
          show (WHILE b DO c₁, s) ⟹ t, from
            WhileTrue ‹↥(bval b s)› ‹(c₁, s) ⟹ s₁› ‹(WHILE b DO c₁, s₁) ⟹ t›
        },
        case IfFalse : {
          cases' ‹(SKIP, s) ⟹ t›,
          show (WHILE b DO c, t) ⟹ t, from  WhileFalse ‹¬↥(bval b t)›
        }
    }
end

/--
La semantica small-step implica la semantica big-step.
Se la configurazione `(c, s)` si riduce in zero o più passi a `(SKIP, t)`, allora l'esecuzione di
`c` in `s` termina nello stato `t`.
La dimostrazione per il caso `refl` é banale, mentre nel caso `step` segue immediatamente dal lemma
`step_case`.
-/
lemma small_step_imp_big_step {c : com} {s t : pstate} :
  (c, s)↝*(SKIP, t) → (c, s) ⟹ t :=
begin
  intros,
  induction' ‹(c, s)↝*(SKIP, t)›,
    case refl : t {
      show (SKIP, t) ⟹ t, from Skip
    },
    case step : _ _ _ _ t _ _ _ {
      show (c, s) ⟹ t, from step_case ‹(c, s)↝(c₁, s₁)› ‹(c₁, s₁) ⟹ t›
    }
end

/--
Equivalenza tra le due semantiche big-step e small-step.
Il teorema segue immediatamente dai lemmi `big_step_imp_small_step` e `small_step_imp_big_step`.
-/
theorem big_step_equiv_small_step {c : com} {s t : pstate} :
  (c, s) ⟹ t ↔ (c, s)↝*(SKIP, t) :=
begin
  intros,
  apply iff.intro,
    exact big_step_imp_small_step,
    exact small_step_imp_big_step
end

end equivalence


/-
Copyright (c) 2020 Aaron Anderson, Jalex Stark. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark
-/

import algebra.polynomial.big_operators
import data.matrix.char_p
import field_theory.finite.basic
import group_theory.perm.cycles
import linear_algebra.matrix.charpoly.basic
import linear_algebra.matrix.trace
import linear_algebra.matrix.to_lin
import ring_theory.polynomial.basic
import ring_theory.power_basis

/-!
# Characteristic polynomials

We give methods for computing coefficients of the characteristic polynomial.

## Main definitions

- `matrix.charpoly_degree_eq_dim` proves that the degree of the characteristic polynomial
  over a nonzero ring is the dimension of the matrix
- `matrix.det_eq_sign_charpoly_coeff` proves that the determinant is the constant term of the
  characteristic polynomial, up to sign.
- `matrix.trace_eq_neg_charpoly_coeff` proves that the trace is the negative of the (d-1)th
  coefficient of the characteristic polynomial, where d is the dimension of the matrix.
  For a nonzero ring, this is the second-highest coefficient.

-/

noncomputable theory

universes u v w z

open polynomial matrix
open_locale big_operators

variables {R : Type u} [comm_ring R]
variables {n G : Type v} [decidable_eq n] [fintype n]
variables {α β : Type v} [decidable_eq α]

open finset

variable {M : matrix n n R}

lemma charmatrix_apply_nat_degree [nontrivial R] (i j : n) :
  (charmatrix M i j).nat_degree = ite (i = j) 1 0 :=
by { by_cases i = j; simp [h, ← degree_eq_iff_nat_degree_eq_of_pos (nat.succ_pos 0)], }

lemma charmatrix_apply_nat_degree_le (i j : n) :
  (charmatrix M i j).nat_degree ≤ ite (i = j) 1 0 :=
by split_ifs; simp [h, nat_degree_X_sub_C_le]

namespace matrix

variable (M)
lemma charpoly_sub_diagonal_degree_lt :
(M.charpoly - ∏ (i : n), (X - C (M i i))).degree < ↑(fintype.card n - 1) :=
begin
  rw [charpoly, det_apply', ← insert_erase (mem_univ (equiv.refl n)),
    sum_insert (not_mem_erase (equiv.refl n) univ), add_comm],
  simp only [charmatrix_apply_eq, one_mul, equiv.perm.sign_refl, id.def, int.cast_one,
    units.coe_one, add_sub_cancel, equiv.coe_refl],
  rw ← mem_degree_lt, apply submodule.sum_mem (degree_lt R (fintype.card n - 1)),
  intros c hc, rw [← C_eq_int_cast, C_mul'],
  apply submodule.smul_mem (degree_lt R (fintype.card n - 1)) ↑↑(equiv.perm.sign c),
  rw mem_degree_lt, apply lt_of_le_of_lt degree_le_nat_degree _, rw with_bot.coe_lt_coe,
  apply lt_of_le_of_lt _ (equiv.perm.fixed_point_card_lt_of_ne_one (ne_of_mem_erase hc)),
  apply le_trans (polynomial.nat_degree_prod_le univ (λ i : n, (charmatrix M (c i) i))) _,
  rw card_eq_sum_ones, rw sum_filter, apply sum_le_sum,
  intros, apply charmatrix_apply_nat_degree_le,
end

lemma charpoly_coeff_eq_prod_coeff_of_le {k : ℕ} (h : fintype.card n - 1 ≤ k) :
  M.charpoly.coeff k = (∏ i : n, (X - C (M i i))).coeff k :=
begin
  apply eq_of_sub_eq_zero, rw ← coeff_sub, apply polynomial.coeff_eq_zero_of_degree_lt,
  apply lt_of_lt_of_le (charpoly_sub_diagonal_degree_lt M) _, rw with_bot.coe_le_coe, apply h,
end

lemma det_of_card_zero (h : fintype.card n = 0) (M : matrix n n R) : M.det = 1 :=
by { rw fintype.card_eq_zero_iff at h, suffices : M = 1, { simp [this] }, ext i, exact h.elim i }

theorem charpoly_degree_eq_dim [nontrivial R] (M : matrix n n R) :
M.charpoly.degree = fintype.card n :=
begin
  by_cases fintype.card n = 0,
  { rw h, unfold charpoly, rw det_of_card_zero, {simp}, {assumption} },
  rw ← sub_add_cancel M.charpoly (∏ (i : n), (X - C (M i i))),
  have h1 : (∏ (i : n), (X - C (M i i))).degree = fintype.card n,
  { rw degree_eq_iff_nat_degree_eq_of_pos, swap, apply nat.pos_of_ne_zero h,
    rw nat_degree_prod', simp_rw nat_degree_X_sub_C, unfold fintype.card, simp,
    simp_rw (monic_X_sub_C _).leading_coeff, simp, },
  rw degree_add_eq_right_of_degree_lt, exact h1, rw h1,
  apply lt_trans (charpoly_sub_diagonal_degree_lt M), rw with_bot.coe_lt_coe,
  rw ← nat.pred_eq_sub_one, apply nat.pred_lt, apply h,
end

theorem charpoly_nat_degree_eq_dim [nontrivial R] (M : matrix n n R) :
  M.charpoly.nat_degree = fintype.card n :=
nat_degree_eq_of_degree_eq_some (charpoly_degree_eq_dim M)

lemma charpoly_monic (M : matrix n n R) : M.charpoly.monic :=
begin
  nontriviality,
  by_cases fintype.card n = 0, {rw [charpoly, det_of_card_zero h], apply monic_one},
  have mon : (∏ (i : n), (X - C (M i i))).monic,
  { apply monic_prod_of_monic univ (λ i : n, (X - C (M i i))), simp [monic_X_sub_C], },
  rw ← sub_add_cancel (∏ (i : n), (X - C (M i i))) M.charpoly at mon,
  rw monic at *, rw leading_coeff_add_of_degree_lt at mon, rw ← mon,
  rw charpoly_degree_eq_dim, rw ← neg_sub, rw degree_neg,
  apply lt_trans (charpoly_sub_diagonal_degree_lt M), rw with_bot.coe_lt_coe,
  rw ← nat.pred_eq_sub_one, apply nat.pred_lt, apply h,
end

theorem trace_eq_neg_charpoly_coeff [nonempty n] (M : matrix n n R) :
  (trace n R R) M = -M.charpoly.coeff (fintype.card n - 1) :=
begin
  nontriviality,
  rw charpoly_coeff_eq_prod_coeff_of_le, swap, refl,
  rw [fintype.card, prod_X_sub_C_coeff_card_pred univ (λ i : n, M i i)], simp,
  rw [← fintype.card, fintype.card_pos_iff], apply_instance,
end

-- I feel like this should use polynomial.alg_hom_eval₂_algebra_map
lemma mat_poly_equiv_eval (M : matrix n n (polynomial R)) (r : R) (i j : n) :
  (mat_poly_equiv M).eval ((scalar n) r) i j = (M i j).eval r :=
begin
  unfold polynomial.eval, unfold eval₂,
  transitivity polynomial.sum (mat_poly_equiv M) (λ (e : ℕ) (a : matrix n n R),
    (a * (scalar n) r ^ e) i j),
  { unfold polynomial.sum, rw sum_apply, dsimp, refl },
  { simp_rw [←ring_hom.map_pow, ←(scalar.commute _ _).eq],
    simp only [coe_scalar, matrix.one_mul, ring_hom.id_apply,
      pi.smul_apply, smul_eq_mul, mul_eq_mul, algebra.smul_mul_assoc],
    have h : ∀ x : ℕ, (λ (e : ℕ) (a : R), r ^ e * a) x 0 = 0 := by simp,
    simp only [polynomial.sum, mat_poly_equiv_coeff_apply, mul_comm],
    apply (finset.sum_subset (support_subset_support_mat_poly_equiv _ _ _) _).symm,
    assume n hn h'n,
    rw not_mem_support_iff at h'n,
    simp only [h'n, zero_mul] }
end

lemma eval_det (M : matrix n n (polynomial R)) (r : R) :
  polynomial.eval r M.det = (polynomial.eval (scalar n r) (mat_poly_equiv M)).det :=
begin
  rw [polynomial.eval, ← coe_eval₂_ring_hom, ring_hom.map_det],
  apply congr_arg det, ext, symmetry, convert mat_poly_equiv_eval _ _ _ _,
end

theorem det_eq_sign_charpoly_coeff (M : matrix n n R) :
  M.det = (-1)^(fintype.card n) * M.charpoly.coeff 0:=
begin
  rw [coeff_zero_eq_eval_zero, charpoly, eval_det, mat_poly_equiv_charmatrix, ← det_smul],
  simp
end

end matrix

variables {p : ℕ} [fact p.prime]

lemma mat_poly_equiv_eq_X_pow_sub_C {K : Type*} (k : ℕ) [field K] (M : matrix n n K) :
  mat_poly_equiv
      ((expand K (k) : polynomial K →+* polynomial K).map_matrix (charmatrix (M ^ k))) =
    X ^ k - C (M ^ k) :=
begin
  ext m,
  rw [coeff_sub, coeff_C, mat_poly_equiv_coeff_apply, ring_hom.map_matrix_apply, matrix.map_apply,
    alg_hom.coe_to_ring_hom, dmatrix.sub_apply, coeff_X_pow],
  by_cases hij : i = j,
  { rw [hij, charmatrix_apply_eq, alg_hom.map_sub, expand_C, expand_X, coeff_sub, coeff_X_pow,
     coeff_C],
    split_ifs with mp m0;
    simp only [matrix.one_apply_eq, dmatrix.zero_apply] },
  { rw [charmatrix_apply_ne _ _ _ hij, alg_hom.map_neg, expand_C, coeff_neg, coeff_C],
    split_ifs with m0 mp;
    simp only [hij, zero_sub, dmatrix.zero_apply, sub_zero, neg_zero, matrix.one_apply_ne, ne.def,
      not_false_iff] }
end

@[simp] lemma finite_field.matrix.charpoly_pow_card {K : Type*} [field K] [fintype K]
  (M : matrix n n K) : (M ^ (fintype.card K)).charpoly = M.charpoly :=
begin
  casesI (is_empty_or_nonempty n).symm,
  { cases char_p.exists K with p hp, letI := hp,
    rcases finite_field.card K p with ⟨⟨k, kpos⟩, ⟨hp, hk⟩⟩,
    haveI : fact p.prime := ⟨hp⟩,
    dsimp at hk, rw hk at *,
    apply (frobenius_inj (polynomial K) p).iterate k,
    repeat { rw iterate_frobenius, rw ← hk },
    rw ← finite_field.expand_card,
    unfold charpoly, rw [alg_hom.map_det, ← coe_det_monoid_hom,
      ← (det_monoid_hom : matrix n n (polynomial K) →* polynomial K).map_pow],
    apply congr_arg det,
    refine mat_poly_equiv.injective _,
    rw [alg_equiv.map_pow, mat_poly_equiv_charmatrix, hk, sub_pow_char_pow_of_commute, ← C_pow],
    { exact (id (mat_poly_equiv_eq_X_pow_sub_C (p ^ k) M) : _) },
    { exact (C M).commute_X } },
  { -- TODO[gh-6025]: remove this `haveI` once `subsingleton_of_empty_right` is a global instance
    haveI : subsingleton (matrix n n K) := subsingleton_of_empty_right,
    exact congr_arg _ (subsingleton.elim _ _), },
end

@[simp] lemma zmod.charpoly_pow_card (M : matrix n n (zmod p)) :
  (M ^ p).charpoly = M.charpoly :=
by { have h := finite_field.matrix.charpoly_pow_card M, rwa zmod.card at h, }

lemma finite_field.trace_pow_card {K : Type*} [field K] [fintype K] [nonempty n]
  (M : matrix n n K) : trace n K K (M ^ (fintype.card K)) = (trace n K K M) ^ (fintype.card K) :=
by rw [matrix.trace_eq_neg_charpoly_coeff, matrix.trace_eq_neg_charpoly_coeff,
       finite_field.matrix.charpoly_pow_card, finite_field.pow_card]

lemma zmod.trace_pow_card {p:ℕ} [fact p.prime] [nonempty n] (M : matrix n n (zmod p)) :
  trace n (zmod p) (zmod p) (M ^ p) = (trace n (zmod p) (zmod p) M)^p :=
by { have h := finite_field.trace_pow_card M, rwa zmod.card at h, }

namespace matrix

theorem is_integral : is_integral R M := ⟨M.charpoly, ⟨charpoly_monic M, aeval_self_charpoly M⟩⟩

theorem minpoly_dvd_charpoly {K : Type*} [field K] (M : matrix n n K) :
  (minpoly K M) ∣ M.charpoly :=
minpoly.dvd _ _ (aeval_self_charpoly M)

end matrix

section power_basis

open algebra

/-- The characteristic polynomial of the map `λ x, a * x` is the minimal polynomial of `a`.

In combination with `det_eq_sign_charpoly_coeff` or `trace_eq_neg_charpoly_coeff`
and a bit of rewriting, this will allow us to conclude the
field norm resp. trace of `x` is the product resp. sum of `x`'s conjugates.
-/
lemma charpoly_left_mul_matrix {K S : Type*} [field K] [comm_ring S] [algebra K S]
  (h : power_basis K S) :
  (left_mul_matrix h.basis h.gen).charpoly = minpoly K h.gen :=
begin
  apply minpoly.unique,
  { apply matrix.charpoly_monic },
  { apply (left_mul_matrix _).injective_iff.mp (left_mul_matrix_injective h.basis),
    rw [← polynomial.aeval_alg_hom_apply, aeval_self_charpoly] },
  { intros q q_monic root_q,
    rw [matrix.charpoly_degree_eq_dim, fintype.card_fin, degree_eq_nat_degree q_monic.ne_zero],
    apply with_bot.some_le_some.mpr,
    exact h.dim_le_nat_degree_of_root q_monic.ne_zero root_q }
end

end power_basis


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Simon Hudon, Alice Laroche, Frédéric Dupuis, Jireh Loreaux
-/

import Lean
import Mathlib.Lean.Expr
import Mathlib.Logic.Basic
import Mathlib.Init.Algebra.Order
import Mathlib.Tactic.Conv

namespace Mathlib.Tactic.PushNeg

open Lean Meta Elab.Tactic Parser.Tactic

variable (p q : Prop) (s : α → Prop)

theorem not_not_eq : (¬ ¬ p) = p := propext not_not
theorem not_and_eq : (¬ (p ∧ q)) = (p → ¬ q) := propext not_and
theorem not_and_or_eq : (¬ (p ∧ q)) = (¬ p ∨ ¬ q) := propext not_and_or
theorem not_or_eq : (¬ (p ∨ q)) = (¬ p ∧ ¬ q) := propext not_or
theorem not_forall_eq : (¬ ∀ x, s x) = (∃ x, ¬ s x) := propext not_forall

variable {β : Type u} [LinearOrder β]
theorem not_le_eq (a b : β) : (¬ (a ≤ b)) = (b < a) := propext not_le
theorem not_lt_eq (a b : β) : (¬ (a < b)) = (b ≤ a) := propext not_lt

/-- Make `push_neg` use `not_and_distrib` rather than the default `not_and`. -/
register_option push_neg.use_distrib : Bool :=
  { defValue := false
    group := ""
    descr := "Make `push_neg` use `not_and_distrib` rather than the default `not_and`." }

/-- Push negations at the top level of the current expression. -/
def transformNegationStep (e : Expr) : SimpM (Option Simp.Step) := do
  let mkSimpStep (e : Expr) (pf : Expr) : Simp.Step :=
    Simp.Step.visit { expr := e, proof? := some pf }
  let e_whnf ← whnfR e
  let some ex := e_whnf.not? | return Simp.Step.visit { expr := e }
  match ex.getAppFnArgs with
  | (``Not, #[e]) =>
      return mkSimpStep e (← mkAppM ``not_not_eq #[e])
  | (``And, #[p, q]) =>
      match ← getBoolOption `push_neg.use_distrib with
      | false => return mkSimpStep (.forallE `_ p (mkNot q) default) (←mkAppM ``not_and_eq #[p, q])
      | true  => return mkSimpStep (mkOr (mkNot p) (mkNot q)) (←mkAppM ``not_and_or_eq #[p, q])
  | (``Or, #[p, q]) =>
      return mkSimpStep (mkAnd (mkNot p) (mkNot q)) (←mkAppM ``not_or_eq #[p, q])
  | (``Eq, #[_ty, e₁, e₂]) =>
      return Simp.Step.visit { expr := ← mkAppM ``Ne #[e₁, e₂] }
  | (``Ne, #[_ty, e₁, e₂]) =>
      return mkSimpStep (← mkAppM ``Eq #[e₁, e₂]) (← mkAppM ``not_ne_eq #[e₁, e₂])
  | (``LE.le, #[ty, _inst, e₁, e₂]) =>
      let linOrd ← synthInstance? (← mkAppM ``LinearOrder #[ty])
      match linOrd with
      | some _ => return mkSimpStep (← mkAppM ``LT.lt #[e₂, e₁]) (← mkAppM ``not_le_eq #[e₁, e₂])
      | none => return none
  | (``LT.lt, #[ty, _inst, e₁, e₂]) =>
      let linOrd ← synthInstance? (← mkAppM ``LinearOrder #[ty])
      match linOrd with
      | some _ => return mkSimpStep (← mkAppM ``LE.le #[e₂, e₁]) (← mkAppM ``not_lt_eq #[e₁, e₂])
      | none => return none
  | (``Exists, #[_, .lam n typ bo bi]) =>
      return mkSimpStep (.forallE n typ (mkNot bo) bi)
                        (← mkAppM ``not_exists_eq #[.lam n typ bo bi])
  | (``Exists, #[_, _]) =>
      return none
  | _ => match ex with
          | .forallE name ty body binfo => do
              if (← isProp ty) then
                return mkSimpStep (← mkAppM ``And #[ty, mkNot body])
                  (← mkAppM ``not_implies_eq #[ty, body])
              else
                let body' : Expr := .lam name ty (mkNot body) binfo
                let body'' : Expr := .lam name ty body binfo
                return mkSimpStep (← mkAppM ``Exists #[body']) (← mkAppM ``not_forall_eq #[body''])
          | _ => return none

/-- Recursively push negations at the top level of the current expression. This is needed
to handle e.g. triple negation. -/
partial def transformNegation (e : Expr) : SimpM Simp.Step := do
  let Simp.Step.visit r₁ ← transformNegationStep e | return Simp.Step.visit { expr := e }
  match r₁.proof? with
  | none => return Simp.Step.visit r₁
  | some _ => do
      let Simp.Step.visit r₂ ← transformNegation r₁.expr | return Simp.Step.visit r₁
      return Simp.Step.visit (← Simp.mkEqTrans r₁ r₂)

/-- Common entry point to `push_neg` as a conv. -/
def pushNegCore (tgt : Expr) : MetaM Simp.Result := do
  let myctx : Simp.Context :=
    { config := { eta := true },
      simpTheorems := #[ ]
      congrTheorems := (← getSimpCongrTheorems) }
  (·.1) <$> Simp.main tgt myctx (methods := { pre := transformNegation })

/--
Push negations into the conclusion of an expression.
For instance, an expression `¬ ∀ x, ∃ y, x ≤ y` will be transformed by `push_neg` into
`∃ x, ∀ y, y < x`. Variable names are conserved.
This tactic pushes negations inside expressions. For instance, given a hypothesis
```lean
| ¬ ∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - y₀| ≤ ε)
```
writing `push_neg` will turn the target into
```lean
| ∃ ε, ε > 0 ∧ ∀ δ, δ > 0 → (∃ x, |x - x₀| ≤ δ ∧ ε < |f x - y₀|),
```
(The pretty printer does *not* use the abreviations `∀ δ > 0` and `∃ ε > 0` but this issue
has nothing to do with `push_neg`).

Note that names are conserved by this tactic, contrary to what would happen with `simp`
using the relevant lemmas.

This tactic has two modes: in standard mode, it transforms `¬(p ∧ q)` into `p → ¬q`, whereas in
distrib mode it produces `¬p ∨ ¬q`. To use distrib mode, use `set_option push_neg.use_distrib true`.
-/
syntax (name := pushNegConv) "push_neg" : conv

/-- Execute `push_neg` as a conv tactic. -/
@[tactic pushNegConv] def elabPushNegConv : Tactic := fun _ ↦ withMainContext do
  Conv.applySimpResult (← pushNegCore (← instantiateMVars (← Conv.getLhs)))

/--
The syntax is `#push_neg e`, where `e` is an expression,
which will print the `push_neg` form of `e`.

`#push_neg` understands local variables, so you can use them to introduce parameters.
-/
macro (name := pushNeg) tk:"#push_neg " e:term : command => `(command| #conv%$tk push_neg => $e)

/-- Execute main loop of `push_neg` at the main goal. -/
def pushNegTarget : TacticM Unit := withMainContext do
  let goal ← getMainGoal
  let tgt ← instantiateMVars (← goal.getType)
  replaceMainGoal [← applySimpResultToTarget goal tgt (← pushNegCore tgt)]

/-- Execute main loop of `push_neg` at a local hypothesis. -/
def pushNegLocalDecl (fvarId : FVarId): TacticM Unit := withMainContext do
  let ldecl ← fvarId.getDecl
  if ldecl.isAuxDecl then return
  let tgt ← instantiateMVars ldecl.type
  let goal ← getMainGoal
  let myres ← pushNegCore tgt
  let some (_, newGoal) ← applySimpResultToLocalDecl goal fvarId myres False | failure
  replaceMainGoal [newGoal]

/--
Push negations into the conclusion of a hypothesis.
For instance, a hypothesis `h : ¬ ∀ x, ∃ y, x ≤ y` will be transformed by `push_neg at h` into
`h : ∃ x, ∀ y, y < x`. Variable names are conserved.
This tactic pushes negations inside expressions. For instance, given a hypothesis
```lean
h : ¬ ∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - y₀| ≤ ε)
```
writing `push_neg at h` will turn `h` into
```lean
h : ∃ ε, ε > 0 ∧ ∀ δ, δ > 0 → (∃ x, |x - x₀| ≤ δ ∧ ε < |f x - y₀|),
```
(The pretty printer does *not* use the abreviations `∀ δ > 0` and `∃ ε > 0` but this issue
has nothing to do with `push_neg`).

Note that names are conserved by this tactic, contrary to what would happen with `simp`
using the relevant lemmas. One can also use this tactic at the goal using `push_neg`,
at every hypothesis and the goal using `push_neg at *` or at selected hypotheses and the goal
using say `push_neg at h h' ⊢` as usual.

This tactic has two modes: in standard mode, it transforms `¬(p ∧ q)` into `p → ¬q`, whereas in
distrib mode it produces `¬p ∨ ¬q`. To use distrib mode, use `set_option push_neg.use_distrib true`.
-/
elab "push_neg" loc:(ppSpace location)? : tactic =>
  let loc := (loc.map expandLocation).getD (.targets #[] true)
  withLocation loc
    pushNegLocalDecl
    pushNegTarget
    (fun _ ↦ logInfo "push_neg couldn't find a negation to push")


namespace hidden
  variables {α : Type} (r : α → α → Prop)

  definition reflexive : Prop := ∀ (a : α), r a a
  definition symmetric : Prop := ∀ {a b : α}, r a b → r b a
  definition transitive : Prop := ∀ {a b c : α}, r a b → r b c → r a c
  definition euclidean : Prop := ∀ {a b c : α}, r a b → r a c → r b c

  variable {r}

  theorem th1 (reflr : reflexive r) (euclr : euclidean r) : symmetric r :=
    assume (a b : α), assume : (r a b),
    show r b a, from euclr this (reflr _)

  theorem th2 (symmr : symmetric r) (euclr : euclidean r) : transitive r :=
    assume (a b c : α), assume (rab : r a b) (rbc : r b c),
    euclr (symmr rab) rbc

  -- error:
  /-
  theorem th3 (reflr : reflexive r) (euclr : euclidean r) : transitive r :=
    th2 (th1 reflr euclr) euclr
  -/

  theorem th3 (reflr : reflexive r) (euclr : euclidean r) : transitive r :=
    @th2 _ _ (@th1 _ _ reflr @euclr) @euclr
end hidden


/- Author: E.W.Ayers -/

import category_theory.comma
import category_theory.limits.shapes.finite_limits
import category_theory.yoneda
import order.complete_lattice
import data.set.lattice
import .comma

universes u v
namespace category_theory

/-- A sieve on X is a set of morphisms to X that is closed under left composition. -/
structure sieve {C : Type u} [𝒞 : category.{v} C] (X : C) :=
(arrows : set (over X))
(subs : ∀ (f : over X) (_ : f ∈ arrows) (Z : C) (g : Z ⟶ f.left), (over.mk (g ≫ f.hom)) ∈ arrows)

namespace sieve

variables {C : Type u}
variables [𝒞 : category.{v} C]
include 𝒞
variables {X Y Z : C} {S R : sieve X}

instance mem_hom  : has_mem (Y ⟶ X) (sieve X) := ⟨λ f S, over.mk f ∈ S.arrows⟩
instance mem_over : has_mem (over X)  (sieve X) := ⟨λ f S, f ∈ S.arrows⟩

instance : has_subset (sieve X) := ⟨λ S R, S.arrows ⊆ R.arrows⟩

@[ext] def extensionality : Π {R S : sieve X}, R.arrows = S.arrows → R = S
|⟨Ra,_⟩ ⟨Sa, _⟩ rfl := rfl

open lattice

protected def Sup (𝒮 : set (sieve X)) : (sieve X) :=
{ arrows := ⋃ (S : {S : sieve X // S ∈ 𝒮}), sieve.arrows S.1
, subs :=
  begin
    rintros f ⟨R,⟨S,e⟩,h₁⟩ Z g,
    refine    ⟨R,⟨S,e⟩,_ ⟩,
    cases e,
    apply sieve.subs,
    assumption
  end
}

protected def Inf (𝒮 : set (sieve X)) : (sieve X) :=
{ arrows := ⋂ (S : {S // S ∈ 𝒮}), sieve.arrows S.1,
  subs :=
  begin
    rintros f h₁ Z g R h₂,
    have h₃, apply h₁, apply h₂,
    rcases h₂ with ⟨SS,rfl⟩,
    apply sieve.subs, assumption,
  end
}

protected def union (S R : sieve X) : sieve X :=
{ arrows := S.arrows ∪ R.arrows,
  subs :=
  begin
    rintros ⟨Z,f⟩ c Y g,cases c,
      left, apply sieve.subs, assumption,
      right, apply sieve.subs, assumption
  end
}

protected def inter (S R : sieve X) : sieve X :=
{ arrows := S.arrows ∩ R.arrows,
  subs := begin
    rintros f ⟨fS,fR⟩ Z g,
    split,
      apply sieve.subs, assumption,
      apply sieve.subs, assumption,
  end
}

instance : complete_lattice (sieve X) :=
{ le           := λ S R, S ⊆ R,
  le_refl      := λ S, set.subset.refl _,
  le_trans     := λ S R T, set.subset.trans,
  le_antisymm  := begin intros S R p q, apply sieve.extensionality, apply set.subset.antisymm; assumption end,
  top          := { arrows := set.univ, subs := λ a aa Z g, ⟨⟩ },
  bot          := { arrows := ∅, subs := λ a aa Z g, false.rec_on _ aa },
  sup          := sieve.union,
  inf          := sieve.inter,
  Sup          := sieve.Sup,
  Inf          := sieve.Inf,
  le_Sup       := begin intros 𝒮 S SS f fS, refine ⟨_,⟨⟨_,SS⟩,rfl⟩,fS⟩ end,
  Sup_le       := begin rintros 𝒮 S h f ⟨F,⟨⟨R,hR⟩,rfl⟩,fF⟩, apply h _ hR fF end,
  Inf_le       := begin intros 𝒮 S hS f hf, apply hf, refine ⟨⟨_,hS⟩,rfl⟩ end,
  le_Inf       := begin rintros 𝒮 S h f hf fs ⟨⟨R,hR⟩,rfl⟩, apply h _ hR hf  end,
  le_sup_left  := begin intros _ _ _ _, apply set.subset_union_left, assumption end,
  le_sup_right := begin intros _ _ _ _, apply set.subset_union_right, assumption end,
  sup_le       := begin intros _ _ _ _ _, apply set.union_subset; assumption  end,
  inf_le_left  := begin intros _ _ _ _, apply set.inter_subset_left, assumption end,
  inf_le_right := begin intros _ _ _ _, apply set.inter_subset_right, assumption end,
  le_inf       := begin intros _ _ _ _ _, apply set.subset_inter; assumption  end,
  le_top       := begin intros _ _ _, trivial end,
  bot_le       := begin intros _ _ h, exfalso, apply h end
}
instance : preorder      (sieve X) := by apply_instance
instance : partial_order (sieve X) := by apply_instance

inductive generate_sets (𝒢 : set (over X)) : over X → Prop
|basic : Π {f : over X}, f ∈ 𝒢 → generate_sets f
|subs  : Π {f : over X} {Y} (g : Y ⟶ f.1), generate_sets f → generate_sets (over.mk $ g ≫ f.hom)

def generate (𝒢 : set (over X)) : sieve X :=
{ arrows := generate_sets 𝒢,
  subs   := λ f h Z g, generate_sets.subs _ h
}

open order lattice

lemma sets_iff_generate {𝒢 : set (over X)}: generate 𝒢 ≤ S ↔ 𝒢 ⊆ S.arrows :=
iff.intro
    (λ H _ H2, H $ generate_sets.basic H2 )
    (λ ss g f, begin induction f, apply ss f_a, apply sieve.subs, apply f_ih end)

/-- Show that there is a galois insertion (generate, .arrows).
    -/
def gi_generate :
  @galois_insertion (set (over X)) (sieve X) (by apply_instance) _ generate sieve.arrows :=
  { gc        := λ s f, sets_iff_generate,
    choice    := λ 𝒢 f, generate 𝒢,
    choice_eq := λ 𝒢 h, rfl,
    le_l_u    := λ S _, generate_sets.basic
  }

/-- Given a morhpism `h : Y ⟶ X`, send a sieve S on X to a sieve on Y
    as the inverse image of S with `_ ≫ h`.
    That is, `sieve.pullback S h := (≫ h) '⁻¹ S`. -/
def pullback (S : sieve X) (h : Y ⟶ X) :  sieve Y :=
{ arrows := {sl | (over.mk $ sl.hom ≫ h) ∈ S },
  subs :=
  begin
    intros, suffices : over.mk ((g ≫ f.hom) ≫ h) ∈ S, by assumption,
    let j := over.mk (f.hom ≫ h),
    have jS : j ∈ S, by assumption,
    suffices : over.mk (g ≫ j.hom) ∈ S, by simpa,
    apply sieve.subs S j jS,
  end
}
def comp (R : sieve Y) (f : Y ⟶ X) : sieve X :=
{ arrows := λ gf, ∃ (g : gf.1 ⟶ Y) (_ : over.mk g ∈ R), gf.hom = g ≫ f
, subs :=
  begin
    rintros ⟨Z,g⟩ ⟨j,ir,e⟩ W h, refine ⟨h ≫ j,_,_⟩,
    refine sieve.subs R _ ir _ _,
    simp, simp at e, rw e
  end
}

def comps
  (R : Π (f : over X), sieve f.left)
  (S : sieve X) : sieve X :=
  ⨆ (f ∈ S), comp (R f) f.hom

@[simp] lemma pullback_def (h : Y ⟶ X) {f : Z ⟶ Y}
: ((over.mk f) ∈ (pullback S h)) = ((over.mk $ f ≫ h) ∈ S) := rfl

@[simp] lemma pullback_def2 (h : Y ⟶ X)  {f : over Y}
: (f ∈ (pullback S h)) = ((over.mk $ f.hom ≫ h) ∈ S) := rfl

lemma pullback_le_map {S R : sieve X} (Hss : S ≤ R) (f : Y ⟶ X) : pullback S f ≤ pullback R f :=
begin rintros ⟨Z,g⟩ H, apply Hss, apply H end

lemma pullback_top {f : Y ⟶ X} : pullback ⊤ f = ⊤ :=
begin apply top_unique, rintros g Hg, trivial end

lemma le_pullback_comp {R : sieve Y} {f : Y ⟶ X} :
  R ≤ pullback (comp R f) f :=
begin rintros g b, refine ⟨_,_,rfl⟩, simp, assumption end

lemma top_of_has_id : over.mk (𝟙 X) ∈ S → S = ⊤ :=
begin
  intro h,
  apply top_unique,
  rintros f ⟨⟩,
  suffices : over.mk (f.hom ≫ (𝟙 _)) ∈ S,
    simp at this, exact this,
  refine @sieve.subs _ _ _ S (over.mk (𝟙 _)) _ _ _,
  apply h,
end

lemma comp_le_comps
  (R : Π (f : over X), sieve f.1)
  (S : sieve X)
  (f : over X)
  (H : f ∈ S) :
  comp (R f) f.hom ≤ comps R S  :=
calc comp (R f) f.hom ≤  ⨆ (_ : f ∈ S), comp (R f) f.hom : lattice.le_supr _ H
                  ... ≤  comps R S                        : lattice.le_supr _ f

lemma comps_le
  (R : Π (f : over X), sieve f.left)
  (S : sieve X) :
  comps R S ≤ S :=
begin
  apply lattice.supr_le _,
  rintros f,
  apply lattice.supr_le _,
  rintros H g ⟨a,b,e⟩,
  suffices : over.mk (g.hom) ∈ S, simp at this, apply this,
  rw e,
  apply sieve.subs,
  apply H,
end

def as_functor (S : sieve X) : Cᵒᵖ ⥤ Type v :=
{ obj := λ Y, {g : Y.unop ⟶ X // over.mk g ∈ S},
  map := λ Y Z f g, subtype.mk (f.unop ≫ g.1) (begin
    cases g with g gS,
    apply sieve.subs S (over.mk g) gS _ f.unop,
  end)
}

/-- The natural inclusion from the functor induced by a sieve to the yoneda embedding. -/
def functor_inclusion (S : sieve X) : S.as_functor ⟶ yoneda.obj X :=
nat_trans.mk (λ Y f, f.1) (λ Y Z g, rfl)

def functor_inclusion_is_mono : mono (functor_inclusion S) :=
begin
    refine ⟨_⟩,
    intros Z f g h,
    ext Y y,
    apply subtype.ext.2,
    have : (f ≫ functor_inclusion S).app Y y = (g ≫ functor_inclusion S).app Y y,
      rw h,
    apply this
end

end sieve
end category_theory


import data.matrix.notation

example (x : ℕ) (h : x = 3)  : x + x + x = 9 :=
begin
  set y := x with ←h_xy,
  guard_hyp y : ℕ := x,
  guard_hyp h_xy : x = y,
  guard_hyp h : y = 3,
  guard_target y + y + y = 9,
  set! z : ℕ := y,
  guard_target y + y + y = 9,
  simp [h]
end

example : true :=
let X1 := (![![1, 0], ![0, 0]] : matrix (fin 2) (fin 2) ℕ), -- X1 : fin 1.succ → fin 2 → ℕ
    X2 : matrix (fin 2) (fin 2) ℕ := ![![1, 0], ![0, 0]] in -- X2 : matrix (fin 2) (fin 2) ℕ
begin
  set Y1 := (![![1, 0], ![0, 0]] : matrix (fin 2) (fin 2) ℕ),
  set Y2 : matrix (fin 2) (fin 2) ℕ := ![![1, 0], ![0, 0]],
  let Z1 := (![![1, 0], ![0, 0]] : matrix (fin 2) (fin 2) ℕ),
  let Z2 : matrix (fin 2) (fin 2) ℕ := ![![1, 0], ![0, 0]],
  guard_hyp Y2 : matrix (fin 2) (fin 2) ℕ := (![![1, 0], ![0, 0]] : matrix (fin 2) (fin 2) ℕ),
  trivial
end

def T {α : Type} := ℕ
def v : @T ℕ := nat.zero

def S := @T ℕ
def u : S := nat.zero

def p : true :=
begin
  set a : T := v,
  set b : T := u, -- the type `T` can't be fully elaborated without the body but this is fine
  trivial
end


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan
-/
import norm_properties
import nat_properties

/-!
# Miscellaneous assisting lemmas
This file describes several miscellaneous lemmas that are written specifically
for proving the main results of this project. It includes specific properties of
`smul` which are used frequently.
-/

open dirichlet_character zmod
variables {p d m : nat} [fact (nat.prime p)] {R : Type*} [normed_comm_ring R]
  (χ : dirichlet_character R (d * p^m))

-- replaced `neg_one_pow_eq_neg_one` with `neg_one_pow_prime_sub_two_eq_neg_one`
lemma neg_one_pow_prime_sub_two_eq_neg_one (hp : 2 < p) : (-1 : units R)^(p - 2) = -1 :=
begin
  rw ←units.eq_iff,
  simp only [units.coe_neg_one, units.coe_pow],
  rw neg_one_pow_eq_pow_mod_two,
  cases @nat.prime.eq_two_or_odd p (fact.out _),
  { exfalso, apply ne_of_gt hp h, },
  { rw [←nat.mod_eq_sub_mod (le_of_lt hp), h, pow_one], },
end

variable (p)
-- `two_mul_eq_inv_two_smul` replaced with `helper_6`
-- can be generalized to n : ℕ and z : ℤ, possibly more
lemma helper_6 [algebra ℚ_[p] R] {a b : R} (h : (2 : R) * a = b) : a = (2 : ℚ_[p])⁻¹ • b :=
begin
  symmetry,
  rw inv_smul_eq_iff₀ _,
  { rw [←h, ←nat.cast_two, ←map_nat_cast (algebra_map ℚ_[p] R) 2, ←smul_eq_mul, algebra_map_smul,
      nat.cast_two], },
  { apply two_ne_zero', },
end

--variables (d R)
variables {p d R} (χ)
-- `exists_mul_mul_mul_lt` replaced with `helper_10`
lemma helper_10 [normed_algebra ℚ_[p] R] [norm_one_class R] {k : ℕ} {ε : ℝ} (hk : 1 < k)
  (hp : 2 < p) (hε : 0 < ε) : ∃ x : ℕ,
  ∥(2⁻¹ : ℚ_[p])∥ * (↑k - 1 + ∥((d * p ^ x : ℕ) : R)^(k - 2) * (1 + 1)∥) *
  (∥(((d * p ^ x) : ℕ) : R)∥ * (χ.mul (teichmuller_character_mod_p' p R ^ k)).bound) < ε :=
begin
  have one_div_lt_one : 1 / (p : ℝ) < 1,
  { refine (one_div_lt _ _).2 _,
    { refine nat.cast_pos.2 (nat.prime.pos (fact.out _)), },
    { refine zero_lt_one, },
    { rw one_div_one, refine nat.one_lt_cast.2 (nat.prime.one_lt (fact.out _)), }, },
  have pos' : 0 < ↑k * (χ.mul (teichmuller_character_mod_p' p R ^ k)).bound,
  { apply mul_pos (nat.cast_pos.2 (lt_trans zero_lt_one hk)) (dirichlet_character.bound_pos _), },
  have pos : 0 < ε / (↑k * (χ.mul (teichmuller_character_mod_p' p R ^ k)).bound) := div_pos hε pos',
  refine ⟨classical.some (exists_pow_lt_of_lt_one pos one_div_lt_one), lt_of_le_of_lt (mul_le_mul
    (helper_9 hk hp _) le_rfl (mul_nonneg (norm_nonneg _)
    (le_of_lt (dirichlet_character.bound_pos _))) (nat.cast_nonneg _)) _⟩,
  rw mul_left_comm,
  refine lt_of_le_of_lt (mul_le_mul (norm_mul_pow_le_one_div_pow p d R _) le_rfl
    (le_of_lt pos') _) _,
  { rw ←one_div_pow,
    refine pow_nonneg (div_nonneg zero_le_one (nat.cast_nonneg _)) _, },
  { rw ←one_div_pow,
    have := classical.some_spec (exists_pow_lt_of_lt_one pos one_div_lt_one),
    apply lt_of_lt_of_le (mul_lt_mul this le_rfl pos' (div_nonneg (le_of_lt hε) (le_of_lt pos'))) _,
    rw [div_mul_eq_mul_div, mul_div_assoc, div_self (λ h, _), mul_one],
    rw mul_eq_zero at h,
    cases h,
    { rw (nat.cast_eq_zero.1 h) at hk,
      simp only [not_lt_zero'] at hk,
      apply hk, },
    { have := (χ.mul (teichmuller_character_mod_p' p R ^ k)).bound_pos,
      rw h at this,
      simp only [lt_self_iff_false] at this,
      exact this, }, },
end

namespace filter
lemma tendsto_zero_of_tendsto_const_smul_zero [algebra ℚ_[p] R] {f : ℕ → R} {x : filter ℕ}
  {c : ℚ_[p]} (hc : c ≠ 0) (hf : tendsto (λ y, c • f y) x (nhds 0)) :
  tendsto (λ x, f x) x (nhds 0) :=
begin
  rw ←smul_zero c⁻¹,
  conv { congr, funext, rw [←one_smul _ (f x), ←inv_mul_cancel hc, ←smul_smul], },
  { apply tendsto.const_smul hf _, apply_instance, },
end
end filter

open_locale big_operators
lemma sum_odd_fn_eq_zero {G G' : Type*} {s : finset G} [has_involutive_neg G]
  [non_assoc_ring G'] [no_zero_divisors G'] [char_zero G'] {f : G → G'}
  (h1 : ∀ x ∈ s, -x ∈ s) (h2 : ∀ x ∈ s, f (-x) = - f x) : ∑ (x : G) in s, f x = 0 :=
begin
  have h : ∑ (x : G) in s, f x = ∑ (x : G) in s, f (-x) :=
  finset.sum_bij (λ a ha, -a) (λ a ha, h1 a ha) (λ a ha, by {rw neg_neg})
    (λ a₁ a₂ ha₁ ha₂ h, neg_inj.1 h) (λ b hb, ⟨-b, h1 b hb, by {rw neg_neg}⟩),
  conv_rhs at h { apply_congr, skip, rw h2 x H, },
  rw [finset.sum_neg_distrib, eq_neg_self_iff] at h,
  rw h,
end

lemma finset.neg_sum {α β : Type*} [ring β] (s : finset α) (f : α → β) :
  ∑ x in s, - (f x) = - ∑ x in s, f x :=
begin
  conv_lhs { apply_congr, skip, rw neg_eq_neg_one_mul, },
  rw ← finset.mul_sum, rw ← neg_eq_neg_one_mul,
end

lemma inv_smul_self [algebra ℚ R] {n : ℕ} (hn : n ≠ 0) :
  (n : ℚ)⁻¹ • (n : R) = 1 :=
begin
  rw ← one_mul (n : R), rw ← smul_mul_assoc, rw ← algebra.algebra_map_eq_smul_one,
  have : (algebra_map ℚ R) (n : ℚ) = (n : R), simp only [map_nat_cast],
  conv_lhs { congr, skip, rw ← this, }, rw ← (algebra_map ℚ R).map_mul, rw inv_mul_cancel _,
  simp only [ring_hom.map_one],
  { norm_cast, apply hn, },
end

lemma int.exists_int_eq_fract_mul_self (a : ℕ) {b : ℕ} (hb : b ≠ 0) : ∃ z : ℤ, (z : ℚ) = int.fract (a / b : ℚ) * b :=
begin
  obtain ⟨z, hz⟩ := int.fract_mul_nat (a / b : ℚ) b,
  refine ⟨z, _⟩,
  have : (b : ℚ) ≠ 0,
  { norm_cast, apply hb, },
  simp_rw [div_mul_cancel (a : ℚ) this] at hz,
  rw ← hz,
  rw sub_eq_self,
  change int.fract ((a : ℤ) : ℚ) = 0, rw int.fract_coe,
end

variable (R)
lemma one_div_smul_self [algebra ℚ R] {n : ℕ} (hn : n ≠ 0) :
  (1 / (n : ℚ)) • (n : R) = 1 :=
by { rw [← inv_eq_one_div, inv_smul_self hn], }

variables (p d)
lemma div_smul_eq_div_smul [algebra ℚ_[p] R] [algebra ℚ R] [is_scalar_tower ℚ ℚ_[p] R] (a : ℕ)
  (x : R) : (1 / a : ℚ) • x = (1 / a : ℚ_[p]) • x :=
begin
  rw ←is_scalar_tower.algebra_map_smul ℚ_[p] (1 / a : ℚ) x,
  congr,
  simp only [one_div],
  rw [ring_hom.map_inv, map_nat_cast],
end

lemma helper_14 [algebra ℚ R] [algebra ℚ_[p] R] [is_scalar_tower ℚ ℚ_[p] R] (a : ℚ) (r : R) :
  a • r = (algebra_map ℚ ℚ_[p]) a • r := by { simp }

-- generalize
lemma inv_smul_self' [algebra ℚ_[p] R] [algebra ℚ R] [is_scalar_tower ℚ ℚ_[p] R] {n : ℕ} (hn : n ≠ 0) :
  (n : ℚ_[p])⁻¹ • (n : R) = 1 :=
begin
  have : (n : ℚ_[p]) = (algebra_map ℚ ℚ_[p]) n, simp only [map_nat_cast],
  rw this, rw ←ring_hom.map_inv,
  rw ←helper_14, rw inv_smul_self, apply hn,
end

open filter
variables (p d R)

lemma nat_cast_mul_prime_pow_tendsto_zero [normed_algebra ℚ_[p] R] [norm_one_class R] :
  tendsto (λ x : nat, ((d * p^x : nat) : R)) at_top (nhds 0) :=
begin
  have : |(1 / p : ℝ)| < 1,
  { rw [←inv_eq_one_div, ←padic_norm_e.norm_p, abs_norm_eq_norm],
    apply padic_norm_e.norm_p_lt_one, },
  have f1 := tendsto_pow_const_mul_const_pow_of_abs_lt_one 0 this,
  conv at f1 { congr, funext, rw [pow_zero, one_mul, ←inv_eq_one_div, ←zpow_coe_nat, inv_zpow,
    ←zpow_neg, ←padic_int.norm_p_pow], },
  conv { congr, funext, rw nat.cast_mul, skip, skip, rw ←mul_zero (d : R), },
  refine tendsto.const_mul _ (tendsto_zero_iff_norm_tendsto_zero.2 _),
  convert f1,
  ext,
  rw [←nat.cast_pow, norm_coe_nat_eq_norm_ring_hom_map p R],
  simp,
end


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/

import data.fintype.order
import field_theory.fixed
import from_mathlib.normed_space

/-!
# alg_norm_of_auto and alg_norm_of_galois

In the section `supr` we prove some lemmas about indexed supremums, which will be PRd to the
appropriate files in mathlib.

For the rest of the file, we let `K` be a nonarchimedean normed field and `L/K` be a finite
algebraic extension. In the comments, `‖ ⬝ ‖` denotes any power-multiplicative algebra norm on `L`
extending the norm  on `K`.

## Main Definitions

* `alg_norm_of_auto` : given `σ : L ≃ₐ[K] L`, the function `L → ℝ` sending `x : L` to `‖ σ x ‖` is
  an algebra norm on `K`.
* `alg_norm_of_galois` : the function `L → ℝ` sending `x : L` to the maximum of `‖ σ x ‖` over
  all `σ : L ≃ₐ[K] L` is an algebra norm on `L`.

## Main Results
* `alg_norm_of_auto_is_pow_mul` : `alg_norm_of_auto` is power-multiplicative.
* `alg_norm_of_auto_is_nonarchimedean` : `alg_norm_of_auto` is nonarchimedean.
* `alg_norm_of_auto_extends` : `alg_norm_of_auto` extends the norm on `K`.
* `alg_norm_of_galois_is_pow_mul` : `alg_norm_of_galois` is power-multiplicative.
* `alg_norm_of_galois_is_nonarchimedean` : `alg_norm_of_galois` is nonarchimedean.
* `alg_norm_of_galois_extends` : `alg_norm_of_galois` extends the norm on `K`.

## References
* [S. Bosch, U. Güntzer, R. Remmert, *Non-Archimedean Analysis*][bosch-guntzer-remmert]

## Tags

alg_norm_of_auto, alg_norm_of_galois, norm, nonarchimedean
-/

open_locale nnreal

noncomputable theory

/-! ## supr
In this section we prove some lemmas about `supr`, most of them for real-valued functions. -/
section supr

/-- If the function `f : ι → α` is bounded above and `a < f i` for some `i : ι`, then `a < supr f` -/
lemma lt_csupr_of_lt {α : Type*} {ι : Sort*} [conditionally_complete_lattice α] {a : α} {f : ι → α}
  (H : bdd_above (set.range f)) (i : ι) (h : a < f i) : a < supr f :=
lt_of_lt_of_le h (le_csupr H i)

lemma csupr_univ {α β : Type*} [fintype β] [conditionally_complete_lattice α] {f : β → α} :
  (⨆ (x : β) (H : x ∈ (finset.univ : finset β)), f x) = ⨆ (x : β), f x :=
by simp only [finset.mem_univ, csupr_pos]

lemma csupr₂_le {ι : Sort*} [nonempty ι] {κ : ι → Prop} {α : Type*}
  [conditionally_complete_linear_order_bot α] {f : Π i, κ i →  α} {a : α} (h : ∀ i j, f i j ≤ a) :
  (⨆ i j, f i j) ≤ a :=
begin
  apply csupr_le,
  intro x,
  by_cases hx : κ x,
  { haveI : nonempty (κ x) := ⟨hx⟩,
    exact csupr_le (λ hx',  h _ _),  },
  {  simp only [(iff_false _).mpr hx, csupr_false, bot_le], },
end

lemma le_csupr₂_of_le' {ι : Sort*} [finite ι] {κ : ι → Prop} {α : Type*}
  [conditionally_complete_linear_order_bot α] {f : Π i, κ i → α} {a : α} (i : ι) (j : κ i)
  (h : a ≤ f i j) : a ≤ ⨆ i j, f i j :=
begin
  apply le_csupr_of_le _ i,
  { apply le_csupr_of_le (set.finite.bdd_above (set.finite_range (λ (j : κ i), f i j))) j h, },
  { exact set.finite.bdd_above (set.finite_range _) },
end

lemma le_csupr₂_of_le {ι : Sort*} {κ : ι → Prop} {α : Type*}
  [conditionally_complete_linear_order_bot α] {f : Π i, κ i → α}
  (h_fin : (set.range (λ (i : ι), ⨆ (j : κ i), f i j)).finite)
  {a : α} (i : ι) (j : κ i)
  (h : a ≤ f i j) : a ≤ ⨆ i j, f i j :=
begin
  apply le_csupr_of_le _ i,
  { apply le_csupr_of_le (set.finite.bdd_above (set.finite_range (λ (j : κ i), f i j))) j h, },
  { apply set.finite.bdd_above h_fin }
end

theorem finset.sup_eq_csupr {α  β : Type*} [nonempty α] [conditionally_complete_linear_order_bot β]
  (s : finset α) (f : α → β) : s.sup f = ⨆ (a : α) (H : a ∈ s), f a :=
begin
  apply le_antisymm,
  { apply finset.sup_le,
    intros a ha,
    apply le_csupr₂_of_le _ a ha (le_refl _),
    have hrange: set.range (λ (a : α), ⨆ (H : a ∈ s), f a) ⊆ set.range (λ (a : s), f a) ∪ {⊥},
    { rintros y ⟨x, hxy⟩,
      simp only [set.mem_range, bot_eq_zero', set.union_singleton, set.mem_insert_iff] at y ⊢,
      by_cases hx : x ∈ s,
      { right, simp only [hx, csupr_pos] at hxy, exact ⟨⟨x, hx⟩, hxy⟩, },
      { left, simp only [hx, csupr_false] at hxy, exact hxy.symm }},
    exact set.finite.subset (set.range (λ (a : ↥s), f ↑a) ∪ {⊥}).to_finite hrange,  },
  { exact csupr₂_le (λ x, finset.le_sup) }
end

/-- Given `f : ι → ℝ≥0` and `n : ℕ`, we have `(supr f)^n = supr (f^n)`. -/
lemma nnreal.supr_pow {ι : Type*} [nonempty ι] [finite ι] (f : ι → ℝ≥0) (n : ℕ) :
  (⨆ (i : ι), f i)^n = ⨆ (i : ι), (f i)^n :=
begin
  casesI nonempty_fintype ι,
  induction n with n hn,
  { simp only [pow_zero, csupr_const], },
  { rw [pow_succ, hn],
    apply le_antisymm,
    { apply nnreal.supr_mul_supr_le,
      intros i j,
      by_cases hij : f i < f j,
      { have hj : f i * f j ^ n ≤ f j ^ n.succ,
        { rw pow_succ, apply mul_le_mul' (le_of_lt hij) (le_refl _) },
        exact le_trans hj (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) j
          (le_refl _)), },
      { have hi : f i * f j ^ n ≤ f i ^ n.succ,
        { rw pow_succ, exact mul_le_mul' (le_refl _) (pow_le_pow_of_le_left' (not_lt.mp hij) n) },
        exact le_trans hi (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) i
          (le_refl _)), }},
    { haveI : nonempty (finset.univ : finset ι),
      { exact finset.nonempty_coe_sort.mpr finset.univ_nonempty },
      simp only [← csupr_univ, ← finset.sup_eq_csupr, pow_succ],
      apply finset.sup_mul_le_mul_sup_of_nonneg;
      rintros i -; exact zero_le _ }},
end

/-- The supr of a non-negative function `f : ι → ℝ` is non-negative. -/
lemma real.supr_nonneg {ι : Type*} [nonempty ι] {f : ι → ℝ} (hf_nn : ∀ i, 0 ≤ f i) :
  0 ≤ supr f :=
begin
  by_cases hf : bdd_above (set.range f),
  { set i : ι := nonempty.some (by apply_instance),
    exact le_csupr_of_le hf i (hf_nn i), },
  { simp only [supr, Sup],
    rw dif_neg (not_and_of_not_right _ hf) }
end

/-- If `f : ι → ℝ` and `g : ι → ℝ` are non-negative and `∀ i j, f i * g j ≤ a`, then
 `supr f * supr g ≤ a`. -/
lemma real.supr_mul_supr_le {ι : Type*} [nonempty ι] {a : ℝ} {f g : ι → ℝ} (hf_nn : ∀ i, 0 ≤ f i)
  (hg_nn : ∀ i, 0 ≤ g i) (H : ∀ i j, f i * g j ≤ a) : supr f * supr g ≤ a :=
begin
  rw real.supr_mul_of_nonneg (real.supr_nonneg hg_nn),
  apply csupr_le,
  intro i,
  rw real.mul_supr_of_nonneg (hf_nn _),
  exact csupr_le (λ j, H i j),
end

/-- If `f : ι → ℝ` and `g : ι → ℝ` are non-negative, then `supr (f*g) ≤ supr f * supr g`. -/
lemma real.supr_mul_le_mul_supr_of_nonneg {ι : Type*} [nonempty ι] [finite ι] {f g : ι → ℝ}
  (hf_nn : ∀ i, 0 ≤ f i) (hg_nn : ∀ i, 0 ≤ g i) : (⨆ (i : ι), f i * g i) ≤ supr f * supr g :=
begin
  casesI nonempty_fintype ι,
  have hf : bdd_above (set.range f) := fintype.bdd_above_range f,
  have hg : bdd_above (set.range g) := fintype.bdd_above_range g,
  exact csupr_le (λ x, mul_le_mul (le_csupr hf x) (le_csupr hg x) (hg_nn x)
      (real.supr_nonneg hf_nn)),
end

/-- Given a non-negative `f : ι → ℝ` and `n : ℕ`, we have `(supr f)^n = supr (f^n)`. -/
lemma real.supr_pow {ι : Type*} [nonempty ι] [finite ι] {f : ι → ℝ} (hf_nn : ∀ i, 0 ≤ f i)
  (n : ℕ) : (⨆ (i : ι), f i)^n = ⨆ (i : ι), (f i)^n :=
begin
  casesI nonempty_fintype ι,
  induction n with n hn,
  { simp only [pow_zero, csupr_const], },
  { rw [pow_succ, hn],
    apply le_antisymm,
    { refine real.supr_mul_supr_le hf_nn (λ x, pow_nonneg (hf_nn x) n) _,
      intros i j,
      by_cases hij : f i < f j,
      { have hj : f i * f j ^ n ≤ f j ^ n.succ,
        { rw pow_succ,
          exact mul_le_mul (le_of_lt hij) (le_refl _) (pow_nonneg (hf_nn _) _) (hf_nn _) },
        exact le_trans hj (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) j
          (le_refl _)), },
      { have hi : f i * f j ^ n ≤ f i ^ n.succ,
        { rw pow_succ,
          exact mul_le_mul (le_refl _) (pow_le_pow_of_le_left (hf_nn _) (not_lt.mp hij) _)
            (pow_nonneg (hf_nn _) _) (hf_nn _) },
        exact le_trans hi (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) i
          (le_refl _)), }},
    { simp_rw [pow_succ],
      exact real.supr_mul_le_mul_supr_of_nonneg hf_nn (λ x, pow_nonneg (hf_nn x) n) }},
end

end supr

variables {K : Type*} [normed_field K] {L : Type*} [field L] [algebra K L]
  (h_alg : algebra.is_algebraic K L) (h_fin : finite_dimensional K L)

section alg_norm_of_auto

/-- Given a normed field `K`, a finite algebraic extension `L/K` and `σ : L ≃ₐ[K] L`, the function
`L → ℝ` sending `x : L` to `‖ σ x ‖`, where `‖ ⬝ ‖` is any power-multiplicative algebra norm on `L`
extending the norm on `K`, is an algebra norm on `K`. -/
def alg_norm_of_auto (hna : is_nonarchimedean (norm : K → ℝ)) (σ : L ≃ₐ[K] L) :
  algebra_norm K L :=
{ to_fun    := λ x, classical.some (finite_extension_pow_mul_seminorm h_fin hna) (σ x),
  map_zero' := by simp only [map_zero],
  add_le'   := λ x y, by simp only [map_add σ, map_add_le_add],
  neg'      := λ x, by simp only [map_neg σ, map_neg_eq_map],
  mul_le'   := λ x y, by simp only [map_mul σ, map_mul_le_mul],
  smul'     := λ x y, by simp only [map_smul σ, map_smul_eq_mul],
  eq_zero_of_map_eq_zero' := λ x hx,
    (add_equiv_class.map_eq_zero_iff _).mp (eq_zero_of_map_eq_zero _ hx), }

lemma alg_norm_of_auto_apply (σ : L ≃ₐ[K] L) (hna : is_nonarchimedean (norm : K → ℝ)) (x : L) :
  alg_norm_of_auto h_fin hna σ x =
  classical.some (finite_extension_pow_mul_seminorm h_fin hna) (σ x) := rfl

/-- The algebra norm `alg_norm_of_auto` is power-multiplicative. -/
lemma alg_norm_of_auto_is_pow_mul (σ : L ≃ₐ[K] L) (hna : is_nonarchimedean (norm : K → ℝ)) :
  is_pow_mul (alg_norm_of_auto h_fin hna σ) :=
begin
  intros x n hn,
  simp only [alg_norm_of_auto_apply, map_pow σ x n],
  exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).1 _ hn,
end

/-- The algebra norm `alg_norm_of_auto` is nonarchimedean. -/
lemma alg_norm_of_auto_is_nonarchimedean (σ : L ≃ₐ[K] L)
  (hna : is_nonarchimedean (norm : K → ℝ)) :
  is_nonarchimedean (alg_norm_of_auto h_fin hna σ):=
begin
  intros x y,
  simp only [alg_norm_of_auto_apply, map_add σ],
  exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).2.2 _ _,
end

/-- The algebra norm `alg_norm_of_auto` extends the norm on `K`. -/
lemma alg_norm_of_auto_extends (σ : L ≃ₐ[K] L) (hna : is_nonarchimedean (norm : K → ℝ)) :
  function_extends (norm : K → ℝ) (alg_norm_of_auto h_fin hna σ) :=
begin
  intro r, simp only [alg_norm_of_auto_apply, alg_equiv.commutes],
  exact (classical.some_spec (finite_extension_pow_mul_seminorm h_fin hna)).2.1 _,
end

end alg_norm_of_auto

section alg_norm_of_galois

/-- The function `L → ℝ` sending `x : L` to the maximum of `alg_norm_of_auto h_fin hna σ` over
  all `σ : L ≃ₐ[K] L` is an algebra norm on `L`. -/
def alg_norm_of_galois (hna : is_nonarchimedean (norm : K → ℝ)) :
  algebra_norm K L :=
{ to_fun    := λ x, (supr (λ (σ : L ≃ₐ[K] L), alg_norm_of_auto h_fin hna σ x)),
  map_zero' := by simp only [map_zero,  csupr_const],
  add_le'   := λ x y, csupr_le (λ σ, le_trans (map_add_le_add (alg_norm_of_auto h_fin hna σ) x y)
    (add_le_add (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))
      (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _)))),
  neg' := λ x, by simp only [map_neg_eq_map],
  mul_le'     := λ x y, csupr_le $ λ σ, le_trans (map_mul_le_mul (alg_norm_of_auto h_fin hna σ) x y)
     (mul_le_mul (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))
        (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _)) (map_nonneg _ _)
        (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (map_nonneg _ _))),
  eq_zero_of_map_eq_zero' := λ x,
  begin
    contrapose!,
    exact λ hx, ne_of_gt (lt_csupr_of_lt  (set.finite.bdd_above (set.range (λ (σ : L ≃ₐ[K] L),
      alg_norm_of_auto h_fin hna σ x)).to_finite) (alg_equiv.refl) (map_pos_of_ne_zero _ hx)),
  end,
  smul'    := λ r x, by simp only [algebra_norm_class.map_smul_eq_mul,
    normed_ring.to_ring_norm_apply, real.mul_supr_of_nonneg (norm_nonneg _)] }

@[simp] lemma alg_norm_of_galois_apply (hna : is_nonarchimedean (norm : K → ℝ)) (x : L) :
  alg_norm_of_galois h_fin hna x = (supr (λ (σ : L ≃ₐ[K] L), alg_norm_of_auto h_fin hna σ x)) :=
rfl

/-- The algebra norm `alg_norm_of_galois` is power-multiplicative. -/
lemma alg_norm_of_galois_is_pow_mul (hna : is_nonarchimedean (norm : K → ℝ)) :
  is_pow_mul (alg_norm_of_galois h_fin hna) :=
begin
  intros x n hn,
  simp only [alg_norm_of_galois_apply],
  rw real.supr_pow,
  exact supr_congr (λ σ, alg_norm_of_auto_is_pow_mul h_fin σ hna _ hn),
  { exact λ σ, map_nonneg (alg_norm_of_auto h_fin hna σ) x }
end

/-- The algebra norm `alg_norm_of_galois` is nonarchimedean. -/
lemma alg_norm_of_galois_is_nonarchimedean (hna : is_nonarchimedean (norm : K → ℝ)) :
  is_nonarchimedean (alg_norm_of_galois h_fin hna)  :=
λ x y, csupr_le (λ σ, le_trans ((alg_norm_of_auto_is_nonarchimedean h_fin σ hna) x y)
  (max_le_max (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))
    (le_csupr_of_le (set.finite.bdd_above (set.finite_range _)) σ (le_refl _))))

/-- The algebra norm `alg_norm_of_galois` extends the norm on `K`. -/
lemma alg_norm_of_galois_extends (hna : is_nonarchimedean (norm : K → ℝ)) :
  function_extends (norm : K → ℝ) (alg_norm_of_galois h_fin hna) :=
λ r, begin
  rw [alg_norm_of_galois, ← algebra_norm.to_fun_eq_coe],
  simp only [algebra_norm.to_fun_eq_coe, alg_norm_of_auto_extends h_fin _ hna r, csupr_const],
end

end alg_norm_of_galois


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

! This file was ported from Lean 3 source module group_theory.semidirect_product
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Aut
import Mathlib.Logic.Function.Basic
import Mathlib.GroupTheory.Subgroup.Basic

/-!
# Semidirect product

This file defines semidirect products of groups, and the canonical maps in and out of the
semidirect product. The semidirect product of `N` and `G` given a hom `φ` from
`G` to the automorphism group of `N` is the product of sets with the group
`⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩`

## Key definitions

There are two homs into the semidirect product `inl : N →* N ⋊[φ] G` and
`inr : G →* N ⋊[φ] G`, and `lift` can be used to define maps `N ⋊[φ] G →* H`
out of the semidirect product given maps `f₁ : N →* H` and `f₂ : G →* H` that satisfy the
condition `∀ n g, f₁ (φ g n) = f₂ g * f₁ n * f₂ g⁻¹`

## Notation

This file introduces the global notation `N ⋊[φ] G` for `semidirect_product N G φ`

## Tags
group, semidirect product
-/

variable (N : Type _) (G : Type _) {H : Type _} [Group N] [Group G] [Group H]

/-- The semidirect product of groups `N` and `G`, given a map `φ` from `G` to the automorphism
  group of `N`. It the product of sets with the group operation
  `⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩` -/
@[ext]
structure SemidirectProduct (φ : G →* MulAut N) where
  /-- The element of N -/
  left : N
  /-- The element of G -/
  right : G
  deriving DecidableEq
#align semidirect_product SemidirectProduct

-- Porting note: these lemmas are autogenerated by the inductive definition and are not
-- in simple form due to the existence of mk_eq_inl_mul_inr
attribute [nolint simpNF] SemidirectProduct.mk.injEq
attribute [nolint simpNF] SemidirectProduct.mk.sizeOf_spec

-- Porting note: unknown attribute
-- attribute [pp_using_anonymous_constructor] SemidirectProduct

@[inherit_doc]
notation:35 N " ⋊[" φ:35 "] " G:35 => SemidirectProduct N G φ

namespace SemidirectProduct

variable {N G}
variable {φ : G →* MulAut N}

instance : Mul (SemidirectProduct N G φ) where
  mul a b := ⟨a.1 * φ a.2 b.1, a.2 * b.2⟩

lemma mul_def (a b : SemidirectProduct N G φ) :
  a * b = ⟨a.1 * φ a.2 b.1, a.2 * b.2⟩ := rfl

@[simp]
theorem mul_left (a b : N ⋊[φ] G) : (a * b).left = a.left * φ a.right b.left := rfl
#align semidirect_product.mul_left SemidirectProduct.mul_left

@[simp]
theorem mul_right (a b : N ⋊[φ] G) : (a * b).right = a.right * b.right := rfl
#align semidirect_product.mul_right SemidirectProduct.mul_right

instance : One (SemidirectProduct N G φ) where one := ⟨1, 1⟩

@[simp]
theorem one_left : (1 : N ⋊[φ] G).left = 1 := rfl
#align semidirect_product.one_left SemidirectProduct.one_left

@[simp]
theorem one_right : (1 : N ⋊[φ] G).right = 1 := rfl
#align semidirect_product.one_right SemidirectProduct.one_right

instance : Inv (SemidirectProduct N G φ) where
  inv x := ⟨φ x.2⁻¹ x.1⁻¹, x.2⁻¹⟩

@[simp]

@[simp]
theorem inv_right (a : N ⋊[φ] G) : a⁻¹.right = a.right⁻¹ := rfl
#align semidirect_product.inv_right SemidirectProduct.inv_right

instance : Group (N ⋊[φ] G) where
  mul_assoc a b c := SemidirectProduct.ext _ _ (by simp [mul_assoc]) (by simp [mul_assoc])
  one_mul a := SemidirectProduct.ext _ _ (by simp) (one_mul a.2)
  mul_one a := SemidirectProduct.ext _ _ (by simp) (mul_one _)
  mul_left_inv a := SemidirectProduct.ext _ _ (by simp) (by simp)

instance : Inhabited (N ⋊[φ] G) := ⟨1⟩

/-- The canonical map `N →* N ⋊[φ] G` sending `n` to `⟨n, 1⟩` -/
def inl : N →* N ⋊[φ] G where
  toFun n := ⟨n, 1⟩
  map_one' := rfl
  map_mul' := by intros ; ext <;>
    simp only [mul_left, map_one, MulAut.one_apply, mul_right, mul_one]
#align semidirect_product.inl SemidirectProduct.inl

@[simp]
theorem left_inl (n : N) : (inl n : N ⋊[φ] G).left = n := rfl
#align semidirect_product.left_inl SemidirectProduct.left_inl

@[simp]
theorem right_inl (n : N) : (inl n : N ⋊[φ] G).right = 1 := rfl
#align semidirect_product.right_inl SemidirectProduct.right_inl

theorem inl_injective : Function.Injective (inl : N → N ⋊[φ] G) :=
  Function.injective_iff_hasLeftInverse.2 ⟨left, left_inl⟩
#align semidirect_product.inl_injective SemidirectProduct.inl_injective

@[simp]
theorem inl_inj {n₁ n₂ : N} : (inl n₁ : N ⋊[φ] G) = inl n₂ ↔ n₁ = n₂ :=
  inl_injective.eq_iff
#align semidirect_product.inl_inj SemidirectProduct.inl_inj

/-- The canonical map `G →* N ⋊[φ] G` sending `g` to `⟨1, g⟩` -/
def inr : G →* N ⋊[φ] G where
  toFun g := ⟨1, g⟩
  map_one' := rfl
  map_mul' := by intros ; ext <;> simp
#align semidirect_product.inr SemidirectProduct.inr

@[simp]
theorem left_inr (g : G) : (inr g : N ⋊[φ] G).left = 1 := rfl
#align semidirect_product.left_inr SemidirectProduct.left_inr

@[simp]
theorem right_inr (g : G) : (inr g : N ⋊[φ] G).right = g := rfl
#align semidirect_product.right_inr SemidirectProduct.right_inr

theorem inr_injective : Function.Injective (inr : G → N ⋊[φ] G) :=
  Function.injective_iff_hasLeftInverse.2 ⟨right, right_inr⟩
#align semidirect_product.inr_injective SemidirectProduct.inr_injective

@[simp]
theorem inr_inj {g₁ g₂ : G} : (inr g₁ : N ⋊[φ] G) = inr g₂ ↔ g₁ = g₂ :=
  inr_injective.eq_iff
#align semidirect_product.inr_inj SemidirectProduct.inr_inj

theorem inl_aut (g : G) (n : N) : (inl (φ g n) : N ⋊[φ] G) = inr g * inl n * inr g⁻¹ := by
  ext <;> simp
#align semidirect_product.inl_aut SemidirectProduct.inl_aut

theorem inl_aut_inv (g : G) (n : N) : (inl ((φ g)⁻¹ n) : N ⋊[φ] G) = inr g⁻¹ * inl n * inr g := by
  rw [← MonoidHom.map_inv, inl_aut, inv_inv]
#align semidirect_product.inl_aut_inv SemidirectProduct.inl_aut_inv

@[simp]
theorem mk_eq_inl_mul_inr (g : G) (n : N) : (⟨n, g⟩ : N ⋊[φ] G) = inl n * inr g := by ext <;> simp
#align semidirect_product.mk_eq_inl_mul_inr SemidirectProduct.mk_eq_inl_mul_inr

@[simp]
theorem inl_left_mul_inr_right (x : N ⋊[φ] G) : inl x.left * inr x.right = x := by ext <;> simp
#align semidirect_product.inl_left_mul_inr_right SemidirectProduct.inl_left_mul_inr_right

/-- The canonical projection map `N ⋊[φ] G →* G`, as a group hom. -/
def rightHom : N ⋊[φ] G →* G where
  toFun := SemidirectProduct.right
  map_one' := rfl
  map_mul' _ _ := rfl
#align semidirect_product.right_hom SemidirectProduct.rightHom

@[simp]
theorem rightHom_eq_right : (rightHom : N ⋊[φ] G → G) = right := rfl
#align semidirect_product.right_hom_eq_right SemidirectProduct.rightHom_eq_right

@[simp]
theorem rightHom_comp_inl : (rightHom : N ⋊[φ] G →* G).comp inl = 1 := by ext ; simp [rightHom]
#align semidirect_product.right_hom_comp_inl SemidirectProduct.rightHom_comp_inl

@[simp]
theorem rightHom_comp_inr : (rightHom : N ⋊[φ] G →* G).comp inr = MonoidHom.id _ := by
  ext ; simp [rightHom]
#align semidirect_product.right_hom_comp_inr SemidirectProduct.rightHom_comp_inr

@[simp]
theorem rightHom_inl (n : N) : rightHom (inl n : N ⋊[φ] G) = 1 := by simp [rightHom]
#align semidirect_product.right_hom_inl SemidirectProduct.rightHom_inl

@[simp]
theorem rightHom_inr (g : G) : rightHom (inr g : N ⋊[φ] G) = g := by simp [rightHom]
#align semidirect_product.right_hom_inr SemidirectProduct.rightHom_inr

theorem rightHom_surjective : Function.Surjective (rightHom : N ⋊[φ] G → G) :=
  Function.surjective_iff_hasRightInverse.2 ⟨inr, rightHom_inr⟩
#align semidirect_product.right_hom_surjective SemidirectProduct.rightHom_surjective

theorem range_inl_eq_ker_rightHom : (inl : N →* N ⋊[φ] G).range = rightHom.ker :=
  le_antisymm (fun _ ↦ by simp (config := { contextual := true }) [MonoidHom.mem_ker, eq_comm])
    fun x hx ↦ ⟨x.left, by ext <;> simp_all [MonoidHom.mem_ker]⟩
#align semidirect_product.range_inl_eq_ker_right_hom SemidirectProduct.range_inl_eq_ker_rightHom

section lift

variable (f₁ : N →* H) (f₂ : G →* H)
  (h : ∀ g, f₁.comp (φ g).toMonoidHom = (MulAut.conj (f₂ g)).toMonoidHom.comp f₁)

/-- Define a group hom `N ⋊[φ] G →* H`, by defining maps `N →* H` and `G →* H`  -/
def lift (f₁ : N →* H) (f₂ : G →* H)
    (h : ∀ g, f₁.comp (φ g).toMonoidHom = (MulAut.conj (f₂ g)).toMonoidHom.comp f₁) : N ⋊[φ] G →* H
    where
  toFun a := f₁ a.1 * f₂ a.2
  map_one' := by simp
  map_mul' a b := by
    have := fun n g ↦ FunLike.ext_iff.1 (h n) g
    simp only [MulAut.conj_apply, MonoidHom.comp_apply, MulEquiv.coe_toMonoidHom] at this
    simp only [mul_left, mul_right, map_mul, this, mul_assoc, inv_mul_cancel_left]
#align semidirect_product.lift SemidirectProduct.lift

@[simp]
theorem lift_inl (n : N) : lift f₁ f₂ h (inl n) = f₁ n := by simp [lift]
#align semidirect_product.lift_inl SemidirectProduct.lift_inl

@[simp]
theorem lift_comp_inl : (lift f₁ f₂ h).comp inl = f₁ := by ext ; simp
#align semidirect_product.lift_comp_inl SemidirectProduct.lift_comp_inl

@[simp]
theorem lift_inr (g : G) : lift f₁ f₂ h (inr g) = f₂ g := by simp [lift]
#align semidirect_product.lift_inr SemidirectProduct.lift_inr

@[simp]
theorem lift_comp_inr : (lift f₁ f₂ h).comp inr = f₂ := by ext ; simp
#align semidirect_product.lift_comp_inr SemidirectProduct.lift_comp_inr

theorem lift_unique (F : N ⋊[φ] G →* H) :
    F = lift (F.comp inl) (F.comp inr) fun _ ↦ by ext ; simp [inl_aut] := by
  rw [FunLike.ext_iff]
  simp only [lift, MonoidHom.comp_apply, MonoidHom.coe_mk, OneHom.coe_mk, ← map_mul,
    inl_left_mul_inr_right, forall_const]
#align semidirect_product.lift_unique SemidirectProduct.lift_unique

/-- Two maps out of the semidirect product are equal if they're equal after composition
  with both `inl` and `inr` -/
theorem hom_ext {f g : N ⋊[φ] G →* H} (hl : f.comp inl = g.comp inl)
    (hr : f.comp inr = g.comp inr) : f = g := by
  rw [lift_unique f, lift_unique g]
  simp only [*]
#align semidirect_product.hom_ext SemidirectProduct.hom_ext

end lift

section Map

variable {N₁ : Type _} {G₁ : Type _} [Group N₁] [Group G₁] {φ₁ : G₁ →* MulAut N₁}

/-- Define a map from `N ⋊[φ] G` to `N₁ ⋊[φ₁] G₁` given maps `N →* N₁` and `G →* G₁` that
  satisfy a commutativity condition `∀ n g, f₁ (φ g n) = φ₁ (f₂ g) (f₁ n)`.  -/
def map (f₁ : N →* N₁) (f₂ : G →* G₁)
    (h : ∀ g : G, f₁.comp (φ g).toMonoidHom = (φ₁ (f₂ g)).toMonoidHom.comp f₁) :
    N ⋊[φ] G →* N₁ ⋊[φ₁] G₁ where
  toFun x := ⟨f₁ x.1, f₂ x.2⟩
  map_one' := by simp
  map_mul' x y := by
    replace h := FunLike.ext_iff.1 (h x.right) y.left
    ext <;> simp_all
#align semidirect_product.map SemidirectProduct.map

variable (f₁ : N →* N₁) (f₂ : G →* G₁)
  (h : ∀ g : G, f₁.comp (φ g).toMonoidHom = (φ₁ (f₂ g)).toMonoidHom.comp f₁)

@[simp]
theorem map_left (g : N ⋊[φ] G) : (map f₁ f₂ h g).left = f₁ g.left := rfl
#align semidirect_product.map_left SemidirectProduct.map_left

@[simp]
theorem map_right (g : N ⋊[φ] G) : (map f₁ f₂ h g).right = f₂ g.right := rfl
#align semidirect_product.map_right SemidirectProduct.map_right

@[simp]
theorem rightHom_comp_map : rightHom.comp (map f₁ f₂ h) = f₂.comp rightHom := rfl
#align semidirect_product.right_hom_comp_map SemidirectProduct.rightHom_comp_map

@[simp]
theorem map_inl (n : N) : map f₁ f₂ h (inl n) = inl (f₁ n) := by simp [map]
#align semidirect_product.map_inl SemidirectProduct.map_inl

@[simp]
theorem map_comp_inl : (map f₁ f₂ h).comp inl = inl.comp f₁ := by ext <;> simp
#align semidirect_product.map_comp_inl SemidirectProduct.map_comp_inl

@[simp]
theorem map_inr (g : G) : map f₁ f₂ h (inr g) = inr (f₂ g) := by simp [map]
#align semidirect_product.map_inr SemidirectProduct.map_inr

@[simp]
theorem map_comp_inr : (map f₁ f₂ h).comp inr = inr.comp f₂ := by ext <;> simp [map]
#align semidirect_product.map_comp_inr SemidirectProduct.map_comp_inr

end Map

end SemidirectProduct