import category_theory.action
       result

open_locale classical
noncomputable theory
open quotient_group is_free_group is_free_groupoid category_theory

universe u

def tree_equiv {G} [inhabited G] (T : quiver G) [is_arbor T] :
  T.total ⊕ unit ≃ G :=
{ to_fun := λ x, sum.rec_on x (λ tp, tp.target) (λ _, default G),
  inv_fun := λ g, match g, (default $ T.path (default G) g) with
                      | _, quiver.path.nil      := sum.inr ()
                      | _, quiver.path.cons p e := sum.inl ⟨_, _, e⟩
                      end,
  left_inv := begin
    intro x,
    rcases x with ⟨a, b, e⟩ | ⟨⟨⟩⟩,
    { dsimp, rw unique.default_eq ((default $ T.path (default G) a).cons e), refl },
    { dsimp, rw unique.default_eq quiver.path.nil, refl }
  end,
  right_inv := begin
    intro g,
    have : ∃ p, default (T.path (default G) g) = p := ⟨_, rfl⟩,
    rcases this with ⟨p, hp⟩,
    dsimp, rw hp,
    cases p; refl
  end }

lemma tree_not_both {G} [inhabited G] (T : quiver G) [is_arbor T] {a b : G} (e : T a b) (f : T b a) :
  false :=
begin
  set q : T.path (default G) a := default _,
  have : q = (q.cons e).cons f,
  { apply unique.default_eq },
  apply_fun quiver.path.length at this,
  change q.length = q.length + 2 at this,
  suffices : 2 = 0,
  { tauto },
  simpa only [self_eq_add_right] using this,
end

def tree_symmy_equiv {G} [inhabited G] {A : quiver G} (T : subquiver (symmy A)) [is_arbor ¡T] :
  tree_symmy T ≃ (¡T).total :=
{ to_fun := λ ht, if h : (sum.inl ht.val.edge) ∈ T ht.val.source ht.val.target
                  then ⟨_, _, sum.inl ht.val.edge, h⟩
                  else ⟨_, _, sum.inr ht.val.edge, or.resolve_left ht.property h⟩,
  inv_fun := λ t, match t with
          | ⟨a, b, sum.inl e, h⟩ := ⟨⟨_, _, e⟩, or.inl h⟩
          | ⟨b, a, sum.inr e, h⟩ := ⟨⟨_, _, e⟩, or.inr h⟩
          end,
  left_inv := begin
    rintro ⟨⟨a, b, e⟩, h⟩,
    cases h,
    { dsimp, rw dif_pos h, refl },
    { dsimp, rw dif_neg, { refl },
      intro h2, exact tree_not_both (¡T) ⟨sum.inl e, h2⟩ ⟨sum.inr e, h⟩ }
  end,
  right_inv := begin
    rintro ⟨a, b, e, h⟩,
    cases e,
    { dsimp, rw dif_pos, refl },
    { dsimp, rw dif_neg, { refl },
      intro hn, exact tree_not_both (¡T) ⟨sum.inl e, hn⟩ ⟨sum.inr e, h⟩ }
  end }

def action_gens_equiv {G X : Type u} [group G] [is_free_group G] [mul_action G X] :
  (gp_gens G) × X ≃ (gpd_gens : quiver (action_category G X)).total :=
{ to_fun := λ p, ⟨⟨(), p.snd⟩, ⟨(), ((gp_emb p.fst) • p.snd : X)⟩, p.fst, rfl⟩,
  inv_fun := λ t, (t.edge, t.source.snd),
  left_inv := by tidy,
  right_inv := begin -- ugh
    intro x, rcases x with ⟨⟨⟨⟩, x⟩, ⟨⟨⟩, y⟩, e, h⟩,
    dsimp, congr, { exact h }, { funext, congr, exact h },
    { exact proof_irrel_heq rfl h }
  end }

def index_formula {G} [group G] [is_free_group G] (H : subgroup G) :
  (gp_gens G) × (quotient H) ⊕ unit ≃ (gp_gens H) ⊕ (quotient H) :=
calc      (gp_gens G) × (quotient H) ⊕ unit
        ≃ (gpd_gens : quiver $ action_category G (quotient H)).total ⊕ unit
                : equiv.sum_congr action_gens_equiv (equiv.refl unit)
    ... ≃ ((gp_gens H) ⊕ tree_symmy _) ⊕ unit
                : equiv.sum_congr (compl_sum_set_equiv _).symm (equiv.refl unit)
    ... ≃ (gp_gens H) ⊕ (tree_symmy (geodesic_subgraph (symmy gpd_gens)) ⊕ unit)
                : equiv.sum_assoc _ _ _
    ... ≃ (gp_gens H) ⊕ ((quiver.total _) ⊕ unit)
                : equiv.sum_congr (equiv.refl _) (equiv.sum_congr (tree_symmy_equiv _) (equiv.refl unit))
    ... ≃ (gp_gens H) ⊕ action_category G (quotient H)
                : equiv.sum_congr (equiv.refl _) (tree_equiv _)
    ... ≃ (gp_gens H) ⊕ quotient H
                : equiv.sum_congr (equiv.refl _) (action_category.obj_equiv G (quotient H)).symm


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

! This file was ported from Lean 3 source module tactic.zify
! leanprover-community/mathlib commit ad7038e538b2112a0c88b985b925e64b3b022947
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.Cast.Lemmas
import Mathbin.Data.Int.CharZero
import Mathbin.Tactic.NormCast

/-!
# A tactic to shift `ℕ` goals to `ℤ`

It is often easier to work in `ℤ`, where subtraction is well behaved, than in `ℕ` where it isn't.
`zify` is a tactic that casts goals and hypotheses about natural numbers to ones about integers.
It makes use of `push_cast`, part of the `norm_cast` family, to simplify these goals.

## Implementation notes

`zify` is extensible, using the attribute `@[zify]` to label lemmas used for moving propositions
from `ℕ` to `ℤ`.
`zify` lemmas should have the form `∀ a₁ ... aₙ : ℕ, Pz (a₁ : ℤ) ... (aₙ : ℤ) ↔ Pn a₁ ... aₙ`.
For example, `int.coe_nat_le_coe_nat_iff : ∀ (m n : ℕ), ↑m ≤ ↑n ↔ m ≤ n` is a `zify` lemma.

`zify` is very nearly just `simp only with zify push_cast`. There are a few minor differences:
* `zify` lemmas are used in the opposite order of the standard simp form.
  E.g. we will rewrite with `int.coe_nat_le_coe_nat_iff` from right to left.
* `zify` should fail if no `zify` lemma applies (i.e. it was unable to shift any proposition to ℤ).
  However, once this succeeds, it does not necessarily need to rewrite with any `push_cast` rules.
-/

-- used by clients
-- used by clients
open Tactic

namespace Zify

/-- The `zify` attribute is used by the `zify` tactic. It applies to lemmas that shift propositions
between `nat` and `int`.

`zify` lemmas should have the form `∀ a₁ ... aₙ : ℕ, Pz (a₁ : ℤ) ... (aₙ : ℤ) ↔ Pn a₁ ... aₙ`.
For example, `int.coe_nat_le_coe_nat_iff : ∀ (m n : ℕ), ↑m ≤ ↑n ↔ m ≤ n` is a `zify` lemma.
-/
@[user_attribute]
unsafe def zify_attr : user_attribute simp_lemmas Unit
    where
  Name := `zify
  descr := "Used to tag lemmas for use in the `zify` tactic"
  cache_cfg :=
    { mk_cache := fun ns =>
        mapM
            (fun n => do
              let c ← mk_const n
              return (c, tt))
            ns >>=
          simp_lemmas.mk.append_with_symm
      dependencies := [] }
#align zify.zify_attr zify.zify_attr

/-- Given an expression `e`, `lift_to_z e` looks for subterms of `e` that are propositions "about"
natural numbers and change them to propositions about integers.

Returns an expression `e'` and a proof that `e = e'`.

Includes `ge_iff_le` and `gt_iff_lt` in the simp set. These can't be tagged with `zify` as we
want to use them in the "forward", not "backward", direction.
-/
unsafe def lift_to_z (e : expr) : tactic (expr × expr) := do
  let sl ← zify_attr.get_cache
  let sl ← sl.add_simp `ge_iff_le
  let sl ← sl.add_simp `gt_iff_lt
  let (e', prf, _) ← simplify sl [] e
  return (e', prf)
#align zify.lift_to_z zify.lift_to_z

attribute [zify] Int.ofNat_le Int.ofNat_lt Int.ofNat_inj

end Zify

@[zify]
theorem Int.coe_nat_ne_coe_nat_iff (a b : ℕ) : (a : ℤ) ≠ b ↔ a ≠ b := by simp
#align int.coe_nat_ne_coe_nat_iff Int.coe_nat_ne_coe_nat_iff

/-- `zify extra_lems e` is used to shift propositions in `e` from `ℕ` to `ℤ`.
This is often useful since `ℤ` has well-behaved subtraction.

The list of extra lemmas is used in the `push_cast` step.

Returns an expression `e'` and a proof that `e = e'`.-/
unsafe def tactic.zify (extra_lems : List simp_arg_type) : expr → tactic (expr × expr) := fun z =>
  do
  let (z1, p1) ← zify.lift_to_z z <|> fail "failed to find an applicable zify lemma"
  let (z2, p2) ← norm_cast.derive_push_cast extra_lems z1
  Prod.mk z2 <$> mk_eq_trans p1 p2
#align tactic.zify tactic.zify

/-- A variant of `tactic.zify` that takes `h`, a proof of a proposition about natural numbers,
and returns a proof of the zified version of that propositon.
-/
unsafe def tactic.zify_proof (extra_lems : List simp_arg_type) (h : expr) : tactic expr := do
  let (_, pf) ← infer_type h >>= tactic.zify extra_lems
  mk_eq_mp pf h
#align tactic.zify_proof tactic.zify_proof

section

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- The `zify` tactic is used to shift propositions from `ℕ` to `ℤ`.
This is often useful since `ℤ` has well-behaved subtraction.

```lean
example (a b c x y z : ℕ) (h : ¬ x*y*z < 0) : c < a + 3*b :=
begin
  zify,
  zify at h,
  /-
  h : ¬↑x * ↑y * ↑z < 0
  ⊢ ↑c < ↑a + 3 * ↑b
  -/
end
```

`zify` can be given extra lemmas to use in simplification. This is especially useful in the
presence of nat subtraction: passing `≤` arguments will allow `push_cast` to do more work.
```
example (a b c : ℕ) (h : a - b < c) (hab : b ≤ a) : false :=
begin
  zify [hab] at h,
  /- h : ↑a - ↑b < ↑c -/
end
```

`zify` makes use of the `@[zify]` attribute to move propositions,
and the `push_cast` tactic to simplify the `ℤ`-valued expressions.

`zify` is in some sense dual to the `lift` tactic. `lift (z : ℤ) to ℕ` will change the type of an
integer `z` (in the supertype) to `ℕ` (the subtype), given a proof that `z ≥ 0`;
propositions concerning `z` will still be over `ℤ`. `zify` changes propositions about `ℕ` (the
subtype) to propositions about `ℤ` (the supertype), without changing the type of any variable.
-/
unsafe def tactic.interactive.zify (sl : parse simp_arg_list) (l : parse location) : tactic Unit :=
  do
  let locs ← l.get_locals
  replace_at (tactic.zify sl) locs l >>= guardb
#align tactic.interactive.zify tactic.interactive.zify

end

add_tactic_doc
  { Name := "zify"
    category := DocCategory.attr
    declNames := [`zify.zify_attr]
    tags := ["coercions", "transport"] }

add_tactic_doc
  { Name := "zify"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.zify]
    tags := ["coercions", "transport"] }


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

Type of linear functions
-/
import linear_algebra.basic
  linear_algebra.prod_module
  linear_algebra.quotient_module
  linear_algebra.subtype_module
noncomputable theory
local attribute [instance] classical.prop_decidable

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

/-- The type of linear maps `β → γ` between α-modules β and γ -/
def linear_map {α : Type u} (β : Type v) (γ : Type w) [ring α] [module α β] [module α γ] :=
subtype (@is_linear_map α β γ _ _ _)

namespace linear_map
variables [ring α] [module α β] [module α γ]
variables {r : α} {A B C : linear_map β γ} {x y : β}
include α

instance : has_coe_to_fun (linear_map β γ) := ⟨_, subtype.val⟩

theorem ext (h : ∀ x, A x = B x) : A = B := subtype.eq $ funext h

lemma is_linear_map_coe : is_linear_map A := A.property

@[simp] lemma map_add  : A (x + y) = A x + A y := is_linear_map_coe.add x y
@[simp] lemma map_smul : A (r • x) = r • A x := is_linear_map_coe.smul r x
@[simp] lemma map_zero : A 0 = 0 := is_linear_map_coe.zero
@[simp] lemma map_neg  : A (-x) = -A x := is_linear_map_coe.neg _
@[simp] lemma map_sub  : A (x - y) = A x - A y := is_linear_map_coe.sub _ _

/- kernel -/

/-- Kernel of a linear map, i.e. the set of vectors mapped to zero by the map -/
def ker (A : linear_map β γ) : set β := {y | A y = 0}

section ker

@[simp] lemma mem_ker : x ∈ A.ker ↔ A x = 0 := iff.rfl

theorem ker_of_map_eq_map (h : A x = A y) : x - y ∈ A.ker :=
by rw [mem_ker, map_sub]; exact sub_eq_zero_of_eq h

theorem inj_of_trivial_ker (H : A.ker ⊆ {0}) (h : A x = A y) : x = y :=
eq_of_sub_eq_zero $ set.eq_of_mem_singleton $ H $ ker_of_map_eq_map h

variables (α A)

instance ker.is_submodule : is_submodule A.ker :=
{ zero_ := map_zero,
  add_ := λ x y HU HV, by rw mem_ker at *; simp [HU, HV, mem_ker],
  smul := λ r x HV, by rw mem_ker at *; simp [HV] }

theorem sub_ker (HU : x ∈ A.ker) (HV : y ∈ A.ker) : x - y ∈ A.ker :=
is_submodule.sub HU HV

end ker

/- image -/

/-- Image of a linear map, the set of vectors of the form `A x` for some β -/
def im (A : linear_map β γ) : set γ := {x | ∃ y, A y = x}

@[simp] lemma mem_im {A : linear_map β γ} {z : γ} :
  z ∈ A.im ↔ ∃ y, A y = z := iff.rfl

instance im.is_submodule : is_submodule A.im :=
{ zero_ := ⟨0, map_zero⟩,
  add_ := λ a b ⟨x, hx⟩ ⟨y, hy⟩, ⟨x + y, by simp [hx, hy]⟩,
  smul := λ r a ⟨x, hx⟩, ⟨r • x, by simp [hx]⟩ }

/- equivalences -/
section
open is_submodule quotient_module

/-- first isomorphism law -/
def quot_ker_equiv_im (f : linear_map β γ) : (quotient β f.ker) ≃ₗ f.im :=
{ to_fun     := quotient_module.quotient.lift _
    (is_linear_map_subtype_mk f.1 f.2 $ assume b, ⟨b, rfl⟩) (assume b eq, subtype.eq eq),
  inv_fun    := λb, @quotient.mk _ (quotient_rel _) (classical.some b.2),
  left_inv   := assume b', @quotient.induction_on _ (quotient_rel _) _ b' $
    begin
      assume b,
      apply quotient.sound,
      apply classical.some_spec2 (λa, f (a - b) = 0),
      show (∀a, f a = f b → f (a - b) = 0), simp {contextual := tt}
    end,
  right_inv  := assume c, subtype.eq $ classical.some_spec2 (λa, f a = c) $ assume b, id,
  linear_fun :=
    is_linear_map_quotient_lift _ $ @is_linear_map_subtype_mk _ _ _ _ _ _ f.im _ f f.2 _ }

lemma is_submodule.add_left_iff {s : set β} [is_submodule s] {b₁ b₂ : β} (h₂ : b₂ ∈ s) :
  b₁ + b₂ ∈ s ↔ b₁ ∈ s :=
iff.intro
  (assume h,
    have b₁ + b₂ - b₂ ∈ s, from is_submodule.sub h h₂,
    by rwa [add_sub_cancel] at this)
  (assume h₁, is_submodule.add h₁ h₂)

lemma is_submodule.neg_iff {s : set β} [is_submodule s] {b : β} :
  - b ∈ s ↔ b ∈ s :=
iff.intro
  (assume h,
    have - - b ∈ s, from is_submodule.neg h,
    by rwa [neg_neg] at this)
  is_submodule.neg

/-- second isomorphism law -/
def union_quotient_equiv_quotient_inter {s t : set β} [is_submodule s] [is_submodule t] :
  quotient s ((coe : s → β) ⁻¹' (s ∩ t)) ≃ₗ quotient (span (s ∪ t)) ((coe : span (s ∪ t) → β) ⁻¹' t) :=
let sel₁ : s → span (s ∪ t) := λb, ⟨(b : β), subset_span $ or.inl b.2⟩ in
have sel₁_val : ∀b:s, (sel₁ b : β) = b, from assume b, rfl,
have ∀b'∈span (s ∪ t), ∃x:s, ∃y∈t, b' = x.1 + y,
  by simp [span_union, span_eq_of_is_submodule, _inst_4, _inst_5] {contextual := tt},
let sel₂ : span (s ∪ t) → s := λb', classical.some (this b'.1 b'.2) in
have sel₂_spec : ∀b':span (s ∪ t), ∃y∈t, (b' : β) = (sel₂ b' : β) + y,
  from assume b', classical.some_spec (this b'.1 b'.2),
{ to_fun :=
  begin
    intro b,
    fapply quotient.lift_on' b,
    { intro b', exact sel₁ b' },
    { assume b₁ b₂ h,
      change b₁ - b₂ ∈ coe ⁻¹' (s ∩ t) at h,
      apply quotient_module.eq.2, simp * at * }
  end,
  inv_fun :=
  begin
    intro b,
    fapply quotient.lift_on' b,
    { intro b', exact sel₂ b' },
    { intros b₁ b₂ h,
      change b₁ - b₂ ∈ _ at h,
      rcases (sel₂_spec b₁) with ⟨c₁, hc₁, eq_c₁⟩,
      rcases (sel₂_spec b₂) with ⟨c₂, hc₂, eq_c₂⟩,
      have : ((sel₂ b₁ : β) - (sel₂ b₂ : β)) + (c₁ - c₂) ∈ t,
      { simpa [eq_c₁, eq_c₂, add_comm, add_left_comm, add_assoc] using h, },
      have ht : (sel₂ b₁ : β) - (sel₂ b₂ : β) ∈ t,
      { rwa [is_submodule.add_left_iff (is_submodule.sub hc₁ hc₂)] at this },
      have hs : (sel₂ b₁ : β) - (sel₂ b₂ : β) ∈ s,
      { from is_submodule.sub (sel₂ b₁).2 (sel₂ b₂).2 },
      apply quotient_module.eq.2,
      simp * at * }
  end,
  right_inv := assume b', quotient.induction_on' b'
  begin
    intro b, apply quotient_module.eq.2,
    rcases (sel₂_spec b) with ⟨c, hc, eq_c⟩,
    simp [eq_c, hc, is_submodule.neg_iff]
  end,
  left_inv := assume b', @quotient.induction_on _ (quotient_rel _) _ b'
  begin
    intro b, apply quotient_module.eq.2,
    rcases (sel₂_spec (sel₁ b)) with ⟨c, hct, eq⟩,
    have b_eq : (b : β) = c + (sel₂ (sel₁ b)),
    { simpa [sel₁_val] using eq },
    have : (b : β) ∈ s, from b.2,
    have hcs : c ∈ s,
    { rwa [b_eq, is_submodule.add_left_iff (sel₂ (sel₁ b)).mem] at this },
    show (sel₂ (sel₁ b) - b : β) ∈ s ∩ t, { simp [b_eq, hct, hcs, is_submodule.neg_iff] }
  end,
  linear_fun :=  is_linear_map_quotient_lift _ $ (is_linear_map_quotient_mk _).comp $
    is_linear_map_subtype_mk _ (is_submodule.is_linear_map_coe s) _ }

end

section add_comm_group

instance : has_add (linear_map β γ) := ⟨λhf hg, ⟨_, hf.2.map_add hg.2⟩⟩
instance : has_zero (linear_map β γ) := ⟨⟨_, is_linear_map.map_zero⟩⟩
instance : has_neg (linear_map β γ) := ⟨λhf, ⟨_, hf.2.map_neg⟩⟩

@[simp] lemma add_app : (A + B) x = A x + B x := rfl
@[simp] lemma zero_app : (0 : linear_map β γ) x = 0 := rfl
@[simp] lemma neg_app : (-A) x = -A x := rfl

instance : add_comm_group (linear_map β γ) :=
by refine {add := (+), zero := 0, neg := has_neg.neg, ..}; { intros, apply ext, simp }

end add_comm_group

end linear_map

namespace linear_map
variables [comm_ring α] [module α β] [module α γ]

instance : has_scalar α (linear_map β γ) := ⟨λr f, ⟨λb, r • f b, f.2.map_smul_right⟩⟩

@[simp] lemma smul_app {r : α} {x : β} {A : linear_map β γ} : (r • A) x = r • (A x) := rfl

variables (α β γ)

instance : module α (linear_map β γ) :=
by refine {smul := (•), ..linear_map.add_comm_group, ..};
  { intros, apply ext, simp [smul_add, add_smul, mul_smul] }

end linear_map

namespace module
variables [ring α] [module α β]
include α β

instance : has_one (linear_map β β) := ⟨⟨id, is_linear_map.id⟩⟩
instance : has_mul (linear_map β β) := ⟨λf g, ⟨_, is_linear_map.comp f.2 g.2⟩⟩

@[simp] lemma one_app (x : β) : (1 : linear_map β β) x = x := rfl
@[simp] lemma mul_app (A B : linear_map β β) (x : β) : (A * B) x = A (B x) := rfl

variables (α β)

-- declaring this an instance breaks `real.lean` with reaching max. instance resolution depth
def endomorphism_ring : ring (linear_map β β) :=
by refine {mul := (*), one := 1, ..linear_map.add_comm_group, ..};
  { intros, apply linear_map.ext, simp }

/-- The group of invertible linear maps from `β` to itself -/
def general_linear_group :=
by haveI := endomorphism_ring α β; exact units (linear_map β β)

end module


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis, Leonardo de Moura, Johannes Hölzl, Mario Carneiro

! This file was ported from Lean 3 source module algebra.field.basic
! leanprover-community/mathlib commit 05101c3df9d9cfe9430edc205860c79b6d660102
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Field.Defs
import Mathlib.Algebra.GroupWithZero.Units.Lemmas
import Mathlib.Algebra.Hom.Ring
import Mathlib.Algebra.Ring.Commute

/-!
# Lemmas about division (semi)rings and (semi)fields

-/

open Function OrderDual Set

universe u

variable {α β K : Type _}

section DivisionSemiring

variable [DivisionSemiring α] {a b c d : α}

theorem add_div (a b c : α) : (a + b) / c = a / c + b / c := by simp_rw [div_eq_mul_inv, add_mul]
#align add_div add_div

@[field_simps]
theorem div_add_div_same (a b c : α) : a / c + b / c = (a + b) / c :=
  (add_div _ _ _).symm
#align div_add_div_same div_add_div_same

theorem same_add_div (h : b ≠ 0) : (b + a) / b = 1 + a / b := by rw [← div_self h, add_div]
#align same_add_div same_add_div

theorem div_add_same (h : b ≠ 0) : (a + b) / b = a / b + 1 := by rw [← div_self h, add_div]
#align div_add_same div_add_same

theorem one_add_div (h : b ≠ 0) : 1 + a / b = (b + a) / b :=
  (same_add_div h).symm
#align one_add_div one_add_div

theorem div_add_one (h : b ≠ 0) : a / b + 1 = (a + b) / b :=
  (div_add_same h).symm
#align div_add_one div_add_one

theorem one_div_mul_add_mul_one_div_eq_one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) :
    1 / a * (a + b) * (1 / b) = 1 / a + 1 / b := by
  rw [mul_add, one_div_mul_cancel ha, add_mul, one_mul, mul_assoc, mul_one_div_cancel hb, mul_one,
    add_comm]
#align one_div_mul_add_mul_one_div_eq_one_div_add_one_div one_div_mul_add_mul_one_div_eq_one_div_add_one_div

theorem add_div_eq_mul_add_div (a b : α) (hc : c ≠ 0) : a + b / c = (a * c + b) / c :=
  (eq_div_iff_mul_eq hc).2 <| by rw [right_distrib, div_mul_cancel _ hc]
#align add_div_eq_mul_add_div add_div_eq_mul_add_div

@[field_simps]
theorem add_div' (a b c : α) (hc : c ≠ 0) : b + a / c = (b * c + a) / c := by
  rw [add_div, mul_div_cancel _ hc]
#align add_div' add_div'

@[field_simps]
theorem div_add' (a b c : α) (hc : c ≠ 0) : a / c + b = (a + b * c) / c := by
  rwa [add_comm, add_div', add_comm]
#align div_add' div_add'

protected theorem Commute.div_add_div (hbc : Commute b c) (hbd : Commute b d) (hb : b ≠ 0)
    (hd : d ≠ 0) : a / b + c / d = (a * d + b * c) / (b * d) := by
  rw [add_div, mul_div_mul_right _ b hd, hbc.eq, hbd.eq, mul_div_mul_right c d hb]
#align commute.div_add_div Commute.div_add_div

protected theorem Commute.one_div_add_one_div (hab : Commute a b) (ha : a ≠ 0) (hb : b ≠ 0) :
    1 / a + 1 / b = (a + b) / (a * b) := by
  rw [(Commute.one_right a).div_add_div hab ha hb, one_mul, mul_one, add_comm]
#align commute.one_div_add_one_div Commute.one_div_add_one_div

protected theorem Commute.inv_add_inv (hab : Commute a b) (ha : a ≠ 0) (hb : b ≠ 0) :
    a⁻¹ + b⁻¹ = (a + b) / (a * b) := by
  rw [inv_eq_one_div, inv_eq_one_div, hab.one_div_add_one_div ha hb]
#align commute.inv_add_inv Commute.inv_add_inv

end DivisionSemiring

section DivisionMonoid

variable [DivisionMonoid K] [HasDistribNeg K] {a b : K}

theorem one_div_neg_one_eq_neg_one : (1 : K) / -1 = -1 :=
  have : -1 * -1 = (1 : K) := by rw [neg_mul_neg, one_mul]
  Eq.symm (eq_one_div_of_mul_eq_one_right this)
#align one_div_neg_one_eq_neg_one one_div_neg_one_eq_neg_one

theorem one_div_neg_eq_neg_one_div (a : K) : 1 / -a = -(1 / a) :=
  calc
    1 / -a = 1 / (-1 * a) := by rw [neg_eq_neg_one_mul]
    _ = 1 / a * (1 / -1) := by rw [one_div_mul_one_div_rev]
    _ = 1 / a * -1 := by rw [one_div_neg_one_eq_neg_one]
    _ = -(1 / a) := by rw [mul_neg, mul_one]
#align one_div_neg_eq_neg_one_div one_div_neg_eq_neg_one_div

theorem div_neg_eq_neg_div (a b : K) : b / -a = -(b / a) :=
  calc
    b / -a = b * (1 / -a) := by rw [← inv_eq_one_div, division_def]
    _ = b * -(1 / a) := by rw [one_div_neg_eq_neg_one_div]
    _ = -(b * (1 / a)) := by rw [neg_mul_eq_mul_neg]
    _ = -(b / a) := by rw [mul_one_div]
#align div_neg_eq_neg_div div_neg_eq_neg_div

theorem neg_div (a b : K) : -b / a = -(b / a) := by
  rw [neg_eq_neg_one_mul, mul_div_assoc, ← neg_eq_neg_one_mul]
#align neg_div neg_div

@[field_simps]
theorem neg_div' (a b : K) : -(b / a) = -b / a := by simp [neg_div]
#align neg_div' neg_div'

theorem neg_div_neg_eq (a b : K) : -a / -b = a / b := by rw [div_neg_eq_neg_div, neg_div, neg_neg]
#align neg_div_neg_eq neg_div_neg_eq

theorem neg_inv : -a⁻¹ = (-a)⁻¹ := by rw [inv_eq_one_div, inv_eq_one_div, div_neg_eq_neg_div]
#align neg_inv neg_inv

theorem div_neg (a : K) : a / -b = -(a / b) := by rw [← div_neg_eq_neg_div]
#align div_neg div_neg

theorem inv_neg : (-a)⁻¹ = -a⁻¹ := by rw [neg_inv]
#align inv_neg inv_neg

theorem inv_neg_one : (-1 : K)⁻¹ = -1 := by rw [← neg_inv, inv_one]

end DivisionMonoid

section DivisionRing

variable [DivisionRing K] {a b c d : K}

@[simp]
theorem div_neg_self {a : K} (h : a ≠ 0) : a / -a = -1 := by rw [div_neg_eq_neg_div, div_self h]
#align div_neg_self div_neg_self

@[simp]
theorem neg_div_self {a : K} (h : a ≠ 0) : -a / a = -1 := by rw [neg_div, div_self h]
#align neg_div_self neg_div_self

theorem div_sub_div_same (a b c : K) : a / c - b / c = (a - b) / c := by
  rw [sub_eq_add_neg, ← neg_div, div_add_div_same, sub_eq_add_neg]
#align div_sub_div_same div_sub_div_same

theorem same_sub_div {a b : K} (h : b ≠ 0) : (b - a) / b = 1 - a / b := by
  simpa only [← @div_self _ _ b h] using (div_sub_div_same b a b).symm
#align same_sub_div same_sub_div

theorem one_sub_div {a b : K} (h : b ≠ 0) : 1 - a / b = (b - a) / b :=
  (same_sub_div h).symm
#align one_sub_div one_sub_div

theorem div_sub_same {a b : K} (h : b ≠ 0) : (a - b) / b = a / b - 1 := by
  simpa only [← @div_self _ _ b h] using (div_sub_div_same a b b).symm
#align div_sub_same div_sub_same

theorem div_sub_one {a b : K} (h : b ≠ 0) : a / b - 1 = (a - b) / b :=
  (div_sub_same h).symm
#align div_sub_one div_sub_one

theorem sub_div (a b c : K) : (a - b) / c = a / c - b / c :=
  (div_sub_div_same _ _ _).symm
#align sub_div sub_div

/-- See `inv_sub_inv` for the more convenient version when `K` is commutative. -/
theorem inv_sub_inv' {a b : K} (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ - b⁻¹ = a⁻¹ * (b - a) * b⁻¹ := by
  rw [mul_sub, sub_mul, mul_inv_cancel_right₀ hb, inv_mul_cancel ha, one_mul]
#align inv_sub_inv' inv_sub_inv'

theorem one_div_mul_sub_mul_one_div_eq_one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) :
    1 / a * (b - a) * (1 / b) = 1 / a - 1 / b := by
  rw [mul_sub_left_distrib (1 / a), one_div_mul_cancel ha, mul_sub_right_distrib, one_mul,
    mul_assoc, mul_one_div_cancel hb, mul_one]
#align one_div_mul_sub_mul_one_div_eq_one_div_add_one_div one_div_mul_sub_mul_one_div_eq_one_div_add_one_div

-- see Note [lower instance priority]
instance (priority := 100) DivisionRing.isDomain : IsDomain K :=
  NoZeroDivisors.to_isDomain _
#align division_ring.is_domain DivisionRing.isDomain

protected theorem Commute.div_sub_div (hbc : Commute b c) (hbd : Commute b d) (hb : b ≠ 0)
    (hd : d ≠ 0) : a / b - c / d = (a * d - b * c) / (b * d) := by
  simpa only [mul_neg, neg_div, ← sub_eq_add_neg] using hbc.neg_right.div_add_div hbd hb hd
#align commute.div_sub_div Commute.div_sub_div

protected theorem Commute.inv_sub_inv (hab : Commute a b) (ha : a ≠ 0) (hb : b ≠ 0) :
    a⁻¹ - b⁻¹ = (b - a) / (a * b) := by
  simp only [inv_eq_one_div, (Commute.one_right a).div_sub_div hab ha hb, one_mul, mul_one]
#align commute.inv_sub_inv Commute.inv_sub_inv

end DivisionRing

section Semifield

variable [Semifield α] {a b c d : α}

theorem div_add_div (a : α) (c : α) (hb : b ≠ 0) (hd : d ≠ 0) :
    a / b + c / d = (a * d + b * c) / (b * d) :=
  (Commute.all b _).div_add_div (Commute.all _ _) hb hd
#align div_add_div div_add_div

theorem one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) :=
  (Commute.all a _).one_div_add_one_div ha hb
#align one_div_add_one_div one_div_add_one_div

theorem inv_add_inv (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ + b⁻¹ = (a + b) / (a * b) :=
  (Commute.all a _).inv_add_inv ha hb
#align inv_add_inv inv_add_inv

end Semifield

section Field

variable [Field K]

attribute [local simp] mul_assoc mul_comm mul_left_comm

@[field_simps]
theorem div_sub_div (a : K) {b : K} (c : K) {d : K} (hb : b ≠ 0) (hd : d ≠ 0) :
    a / b - c / d = (a * d - b * c) / (b * d) :=
  (Commute.all b _).div_sub_div (Commute.all _ _) hb hd
#align div_sub_div div_sub_div

theorem inv_sub_inv {a b : K} (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ - b⁻¹ = (b - a) / (a * b) := by
  rw [inv_eq_one_div, inv_eq_one_div, div_sub_div _ _ ha hb, one_mul, mul_one]
#align inv_sub_inv inv_sub_inv

@[field_simps]
theorem sub_div' (a b c : K) (hc : c ≠ 0) : b - a / c = (b * c - a) / c := by
  simpa using div_sub_div b a one_ne_zero hc
#align sub_div' sub_div'

@[field_simps]
theorem div_sub' (a b c : K) (hc : c ≠ 0) : a / c - b = (a - c * b) / c := by
  simpa using div_sub_div a b hc one_ne_zero
#align div_sub' div_sub'

-- see Note [lower instance priority]
instance (priority := 100) Field.isDomain : IsDomain K :=
  { DivisionRing.isDomain with }
#align field.is_domain Field.isDomain

end Field

namespace RingHom

protected theorem injective [DivisionRing α] [Semiring β] [Nontrivial β] (f : α →+* β) :
    Injective f :=
  (injective_iff_map_eq_zero f).2 fun _ ↦ (map_eq_zero f).1
#align ring_hom.injective RingHom.injective

end RingHom

section NoncomputableDefs

variable {R : Type _} [Nontrivial R]

/-- Constructs a `DivisionRing` structure on a `Ring` consisting only of units and 0. -/
noncomputable def divisionRingOfIsUnitOrEqZero [hR : Ring R] (h : ∀ a : R, IsUnit a ∨ a = 0) :
    DivisionRing R :=
  { groupWithZeroOfIsUnitOrEqZero h, hR with }
#align division_ring_of_is_unit_or_eq_zero divisionRingOfIsUnitOrEqZero

/-- Constructs a `Field` structure on a `CommRing` consisting only of units and 0.
See note [reducible non-instances]. -/
@[reducible]
noncomputable def fieldOfIsUnitOrEqZero [hR : CommRing R] (h : ∀ a : R, IsUnit a ∨ a = 0) :
    Field R :=
  { groupWithZeroOfIsUnitOrEqZero h, hR with }
#align field_of_is_unit_or_eq_zero fieldOfIsUnitOrEqZero

end NoncomputableDefs

-- See note [reducible non-instances]
/-- Pullback a `DivisionSemiring` along an injective function. -/
@[reducible]
protected def Function.Injective.divisionSemiring [DivisionSemiring β] [Zero α] [Mul α] [Add α]
    [One α] [Inv α] [Div α] [SMul ℕ α] [Pow α ℕ] [Pow α ℤ] [NatCast α] (f : α → β)
    (hf : Injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y)
    (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹)
    (div : ∀ x y, f (x / y) = f x / f y) (nsmul : ∀ (x) (n : ℕ), f (n • x) = n • f x)
    (npow : ∀ (x) (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ (x) (n : ℤ), f (x ^ n) = f x ^ n)
    (nat_cast : ∀ n : ℕ, f n = n) : DivisionSemiring α :=
  { hf.groupWithZero f zero one mul inv div npow zpow,
    hf.semiring f zero one add mul nsmul npow nat_cast with }
#align function.injective.division_semiring Function.Injective.divisionSemiring

/-- Pullback a `DivisionSemiring` along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def Function.Injective.divisionRing [DivisionRing K] {K'} [Zero K'] [One K'] [Add K']
    [Mul K'] [Neg K'] [Sub K'] [Inv K'] [Div K'] [SMul ℕ K'] [SMul ℤ K'] [SMul ℚ K']
    [Pow K' ℕ] [Pow K' ℤ] [NatCast K'] [IntCast K'] [RatCast K'] (f : K' → K) (hf : Injective f)
    (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y)
    (mul : ∀ x y, f (x * y) = f x * f y) (neg : ∀ x, f (-x) = -f x)
    (sub : ∀ x y, f (x - y) = f x - f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹)
    (div : ∀ x y, f (x / y) = f x / f y) (nsmul : ∀ (x) (n : ℕ), f (n • x) = n • f x)
    (zsmul : ∀ (x) (n : ℤ), f (n • x) = n • f x) (qsmul : ∀ (x) (n : ℚ), f (n • x) = n • f x)
    (npow : ∀ (x) (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ (x) (n : ℤ), f (x ^ n) = f x ^ n)
    (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) (rat_cast : ∀ n : ℚ, f n = n) :
    DivisionRing K' :=
  { hf.groupWithZero f zero one mul inv div npow zpow,
    hf.ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast with
    ratCast := Rat.cast,
    ratCast_mk := fun a b h1 h2 ↦
      hf
        (by
          erw [rat_cast, mul, inv, int_cast, nat_cast]
          exact DivisionRing.ratCast_mk a b h1 h2),
    qsmul := (· • ·), qsmul_eq_mul' := fun a x ↦ hf (by erw [qsmul, mul, Rat.smul_def, rat_cast]) }
#align function.injective.division_ring Function.Injective.divisionRing

-- See note [reducible non-instances]
/-- Pullback a `Field` along an injective function. -/
@[reducible]
protected def Function.Injective.semifield [Semifield β] [Zero α] [Mul α] [Add α] [One α] [Inv α]
    [Div α] [SMul ℕ α] [Pow α ℕ] [Pow α ℤ] [NatCast α] (f : α → β) (hf : Injective f)
    (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y)
    (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹)
    (div : ∀ x y, f (x / y) = f x / f y) (nsmul : ∀ (x) (n : ℕ), f (n • x) = n • f x)
    (npow : ∀ (x) (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ (x) (n : ℤ), f (x ^ n) = f x ^ n)
    (nat_cast : ∀ n : ℕ, f n = n) : Semifield α :=
  { hf.commGroupWithZero f zero one mul inv div npow zpow,
    hf.commSemiring f zero one add mul nsmul npow nat_cast with }
#align function.injective.semifield Function.Injective.semifield

/-- Pullback a `Field` along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def Function.Injective.field [Field K] {K'} [Zero K'] [Mul K'] [Add K'] [Neg K'] [Sub K']
    [One K'] [Inv K'] [Div K'] [SMul ℕ K'] [SMul ℤ K'] [SMul ℚ K'] [Pow K' ℕ] [Pow K' ℤ]
    [NatCast K'] [IntCast K'] [RatCast K'] (f : K' → K) (hf : Injective f) (zero : f 0 = 0)
    (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
    (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹)
    (div : ∀ x y, f (x / y) = f x / f y) (nsmul : ∀ (x) (n : ℕ), f (n • x) = n • f x)
    (zsmul : ∀ (x) (n : ℤ), f (n • x) = n • f x) (qsmul : ∀ (x) (n : ℚ), f (n • x) = n • f x)
    (npow : ∀ (x) (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ (x) (n : ℤ), f (x ^ n) = f x ^ n)
    (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) (rat_cast : ∀ n : ℚ, f n = n) :
    Field K' :=
  { hf.commGroupWithZero f zero one mul inv div npow zpow,
    hf.commRing f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast with
    ratCast := Rat.cast,
    ratCast_mk := fun a b h1 h2 ↦
      hf
        (by
          erw [rat_cast, mul, inv, int_cast, nat_cast]
          exact DivisionRing.ratCast_mk a b h1 h2),
    qsmul := (· • ·), qsmul_eq_mul' := fun a x ↦ hf (by erw [qsmul, mul, Rat.smul_def, rat_cast]) }
#align function.injective.field Function.Injective.field

/-! ### Order dual -/

instance [h : RatCast α] : RatCast αᵒᵈ :=
  h

instance [h : DivisionSemiring α] : DivisionSemiring αᵒᵈ :=
  h

instance [h : DivisionRing α] : DivisionRing αᵒᵈ :=
  h

instance [h : Semifield α] : Semifield αᵒᵈ :=
  h

instance [h : Field α] : Field αᵒᵈ :=
  h

@[simp]
theorem toDual_rat_cast [RatCast α] (n : ℚ) : toDual (n : α) = n :=
  rfl
#align to_dual_rat_cast toDual_rat_cast

@[simp]
theorem ofDual_rat_cast [RatCast α] (n : ℚ) : (ofDual n : α) = n :=
  rfl
#align of_dual_rat_cast ofDual_rat_cast

/-! ### Lexicographic order -/

instance [h : RatCast α] : RatCast (Lex α) :=
  h

instance [h : DivisionSemiring α] : DivisionSemiring (Lex α) :=
  h

instance [h : DivisionRing α] : DivisionRing (Lex α) :=
  h

instance [h : Semifield α] : Semifield (Lex α) :=
  h

instance [h : Field α] : Field (Lex α) :=
  h

@[simp]
theorem toLex_rat_cast [RatCast α] (n : ℚ) : toLex (n : α) = n :=
  rfl
#align to_lex_rat_cast toLex_rat_cast

@[simp]
theorem ofLex_rat_cast [RatCast α] (n : ℚ) : (ofLex n : α) = n :=
  rfl
#align of_lex_rat_cast ofLex_rat_cast


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan
-/
import data.zmod.quotient
import ring_theory.roots_of_unity
import zmod.properties
/-!
# Dirichlet characters
This file defines Dirichlet characters over (ℤ/nℤ)* and then relates them
to multiplicative homomorphisms over ℤ/nℤ for any n divisible by the conductor.

## Main definitions
 * `dirichlet_character`
 * `asso_dirichlet_character`
 * `change_level`
 * `conductor`

## Tags
p-adic, L-function, Bernoulli measure, Dirichlet character
-/

lemma is_unit.unit_mul {α : Type*} [monoid α] {x y : α} (hx : is_unit x) (hy : is_unit y) :
  hx.unit * hy.unit = (hx.mul hy).unit :=
  by { rw ←units.eq_iff, simp [is_unit.unit_spec] }

/-- A Dirichlet character is defined as a monoid homomorphism which is periodic. -/
abbreviation dirichlet_character (R : Type*) [monoid R] (n : ℕ) := units (zmod n) →* units R

open_locale classical

lemma extend_eq_char {R : Type*} [monoid_with_zero R] {n : ℕ}
  (χ : dirichlet_character R n) {x : zmod n} (hx : is_unit x) :
  function.extend (units.coe_hom (zmod n)) ((units.coe_hom R) ∘ χ) 0 x = χ hx.unit :=
begin
  conv_lhs { congr, skip, skip, skip, rw ←is_unit.unit_spec hx, },
  rw ←units.coe_hom_apply, rw function.extend_apply _,
  { simp only [units.coe_hom_apply, function.comp_app], },
  { exact units.ext, },
end

lemma extend_eq_zero {R : Type*} [monoid_with_zero R] {n : ℕ}
  (χ : dirichlet_character R n) {x : zmod n} (hx : ¬ is_unit x) :
  function.extend (units.coe_hom (zmod n)) ((units.coe_hom R) ∘ χ) 0 x = 0 :=
begin
  rw [function.extend_def, dif_neg],
  { simp only [pi.zero_apply], },
  { contrapose hx, rw not_not at *, cases hx with a ha, rw ←ha, apply units.is_unit, },
end

/-- The Dirichlet character on ℤ/nℤ →* R determined by χ, 0 on non-units. -/
noncomputable abbreviation asso_dirichlet_character {R : Type*} [monoid_with_zero R] {n : ℕ}
  (χ : dirichlet_character R n) : zmod n →* R :=
{ to_fun := function.extend (units.coe_hom (zmod n)) ((units.coe_hom R) ∘ χ) 0,
  map_one' := begin
    rw [extend_eq_char _ is_unit_one, units.coe_eq_one],
    convert χ.map_one',
    rw [←units.eq_iff, is_unit.unit_spec, units.coe_one],
  end,
  map_mul' := λ x y, begin
    by_cases is_unit x ∧ is_unit y,
    { rw [extend_eq_char _ (is_unit.mul h.1 h.2), extend_eq_char _ h.1, extend_eq_char _ h.2],
      change (units.coe_hom R) (χ _) = (units.coe_hom R) (χ _) * (units.coe_hom R) (χ _),
      repeat { rw ←monoid_hom.comp_apply _ χ, },
      convert ←monoid_hom.map_mul' (monoid_hom.comp (units.coe_hom R) χ) _ _,
      rw is_unit.unit_mul, },
    { have : ¬ (is_unit (x * y)),
      { contrapose h, rw not_not at *, rw ←is_unit.mul_iff, assumption, },
      rw extend_eq_zero _ this,
      push_neg at h,
      by_cases h' : is_unit x,
      { rw [extend_eq_zero _ (h h'), mul_zero], },
      { rw [extend_eq_zero _ h', zero_mul], }, },
  end, }
-- is it possible to construct monoid_hom.extend?

lemma asso_dirichlet_character_eq_char {R : Type*} [monoid_with_zero R] {n : ℕ}
  (χ : dirichlet_character R n) (a : units (zmod n)) : asso_dirichlet_character χ a = χ a :=
by { convert extend_eq_char χ a.is_unit, rw [←units.eq_iff, (a.is_unit).unit_spec], }

lemma asso_dirichlet_character_eq_char' {R : Type*} [monoid_with_zero R] {n : ℕ}
  (χ : dirichlet_character R n) {a : zmod n} (ha : is_unit a) :
  asso_dirichlet_character χ a = χ ha.unit :=
by { convert extend_eq_char χ ha, }

lemma asso_dirichlet_character_eq_zero {R : Type*} [monoid_with_zero R] {n : ℕ}
  (χ : dirichlet_character R n) {a : zmod n} (ha : ¬ is_unit a) :
  asso_dirichlet_character χ a = 0 :=
by { convert extend_eq_zero χ ha, }

lemma asso_dirichlet_character_eq_iff {R : Type*} [monoid_with_zero R] {n : ℕ}
  (χ : dirichlet_character R n) (ψ : dirichlet_character R n) :
  χ = ψ ↔ asso_dirichlet_character χ = asso_dirichlet_character ψ :=
⟨λ h, begin
  ext, by_cases hx : is_unit x,
  { simp_rw asso_dirichlet_character_eq_char' _ hx, rw h, },
  { rw asso_dirichlet_character_eq_zero _ hx, rw asso_dirichlet_character_eq_zero _ hx, },
  end,
λ h, begin
  ext,
  repeat { rw ←asso_dirichlet_character_eq_char _ x, }, rw h,
  end⟩

namespace dirichlet_character

variables {R : Type*} [comm_monoid_with_zero R] {n : ℕ} (χ : dirichlet_character R n)
--commutativity is needed to define mul, not before that

lemma asso_dirichlet_character_eval_sub (x : zmod n) :
  asso_dirichlet_character χ (n - x) = asso_dirichlet_character χ (-x) :=
by { congr, simp, }

lemma is_periodic (m : ℕ) (hm : n ∣ m) (a : ℤ) :
  asso_dirichlet_character χ (a + m) = asso_dirichlet_character χ a :=
begin
  rw ← zmod.nat_coe_zmod_eq_zero_iff_dvd at hm,
  simp only [hm, add_zero],
end

/-- Extends the Dirichlet character χ of level n to level m, where n ∣ m. -/
def change_level {m : ℕ} (hm : n ∣ m) : dirichlet_character R n →* dirichlet_character R m :=
{ to_fun := λ ψ, ψ.comp (units.map (zmod.cast_hom hm (zmod n))),
  map_one' := by simp,
  map_mul' := λ ψ₁ ψ₂, monoid_hom.mul_comp _ _ _, }

lemma change_level_def {m : ℕ} (hm : n ∣ m) : change_level hm χ = χ.comp (units.map (zmod.cast_hom hm (zmod n))) := rfl

namespace change_level
lemma self : change_level (dvd_refl n) χ = χ := by { rw change_level_def, simp, }

lemma dvd {m d : ℕ} (hm : n ∣ m) (hd : m ∣ d) :
  change_level (dvd_trans hm hd) χ = change_level hd (change_level hm χ) :=
begin
  repeat { rw change_level_def, },
  rw [monoid_hom.comp_assoc, ←units.map_comp],
  change _ = χ.comp (units.map ↑((zmod.cast_hom hm (zmod n)).comp (zmod.cast_hom hd (zmod m)))),
  congr,
end

lemma asso_dirichlet_character_eq {m : ℕ} (hm : n ∣ m) (a : units (zmod m)) :
  asso_dirichlet_character (change_level hm χ) a = asso_dirichlet_character χ a :=
begin
  rw asso_dirichlet_character_eq_char' _,
  swap, { apply (units.is_unit a), },
  { rw asso_dirichlet_character_eq_char' _,
    swap, { change is_unit ((a : zmod m) : zmod n),
      rw ←zmod.cast_hom_apply (a : zmod m),
      swap 3, { apply zmod.char_p _, },
      swap, { assumption, },
      rw [←ring_hom.coe_monoid_hom, ←units.coe_map _ _],
      apply units.is_unit, },
    { rw [units.eq_iff, change_level_def],
      simp only [function.comp_app, monoid_hom.coe_comp, coe_coe], congr,
      rw [←units.eq_iff, units.coe_map, is_unit.unit_spec _, is_unit.unit_spec _], refl, }, },
end

lemma asso_dirichlet_character_eq' {m : ℕ} (hm : n ∣ m) {a : zmod m}
  (ha : is_unit a) : asso_dirichlet_character (change_level hm χ) a =
  asso_dirichlet_character χ a :=
begin
  rw [←is_unit.unit_spec ha, asso_dirichlet_character_eq], congr,
end
end change_level

/-- χ₀ of level d factors through χ of level n if d ∣ n and χ₀ = χ ∘ (zmod n → zmod d). -/
structure factors_through (d : ℕ) : Prop :=
(dvd : d ∣ n)
(ind_char : ∃ χ₀ : dirichlet_character R d, χ = change_level dvd χ₀)

namespace factors_through
lemma spec {d : ℕ} (h : factors_through χ d) :
  χ = change_level h.1 (classical.some (h.ind_char)) := classical.some_spec (h.ind_char)
end factors_through

/-- The set of natural numbers for which a Dirichlet character is periodic. -/
def conductor_set : set ℕ := {x : ℕ | χ.factors_through x}

lemma mem_conductor_set_iff {x : ℕ} : x ∈ χ.conductor_set ↔ χ.factors_through x := iff.refl _

lemma level_mem_conductor_set : n ∈ conductor_set χ := (mem_conductor_set_iff _).2
{ dvd := dvd_rfl,
  ind_char := ⟨χ, (change_level.self χ).symm⟩, }

lemma mem_conductor_set_dvd {x : ℕ} (hx : x ∈ χ.conductor_set) : x ∣ n := hx.1

lemma mem_conductor_set_factors_through {x : ℕ} (hx : x ∈ χ.conductor_set) : χ.factors_through x := hx

/-- The minimum natural number n for which a Dirichlet character is periodic.
  The Dirichlet character χ can then alternatively be reformulated on ℤ/nℤ. -/
noncomputable def conductor : ℕ := Inf (conductor_set χ)

lemma nat.le_one {n : ℕ} (h : n ≤ 1) : n = 0 ∨ n = 1 :=
by { cases n, { left, refl, },
  { right, rw nat.succ_le_succ_iff at h, rw nat.le_zero_iff at h, rw h, }, }

namespace conductor
lemma mem_conductor_set : conductor χ ∈ conductor_set χ := Inf_mem (set.nonempty_of_mem χ.level_mem_conductor_set)

lemma dvd_lev : χ.conductor ∣ n := (mem_conductor_set χ).1

lemma factors_through : χ.factors_through χ.conductor := mem_conductor_set χ

lemma eq_one (hχ : χ.conductor = 1) : χ = 1 :=
begin
  obtain ⟨h', χ₀, h⟩ := factors_through χ,
  rw h, ext, rw units.eq_iff, rw change_level_def,
  simp only [function.comp_app, monoid_hom.one_apply, monoid_hom.coe_comp],
  convert χ₀.map_one',
  apply subsingleton.elim _ _,
  rw hχ,
  refine fintype.card_le_one_iff_subsingleton.mp _,
  rw [zmod.card_units_eq_totient _, nat.totient_one], exact succ_pos'' 0,
end

lemma one (hn : 0 < n) : (1 : dirichlet_character R n).conductor = 1 :=
begin
  suffices : (1 : dirichlet_character R n).conductor ≤ 1,
  { cases nat.le_one this,
    { rw h, exfalso,
      have := factors_through.dvd (factors_through (1 : dirichlet_character R n)),
      rw [h, zero_dvd_iff] at this,
      rw this at hn,
      apply lt_irrefl _ hn, },
    { exact h, }, },
  { refine nat.Inf_le ⟨one_dvd _, 1, _⟩,
    ext,
    rw [units.eq_iff, change_level_def],
    simp only [monoid_hom.one_comp], },
end

variable {χ}
lemma eq_one_iff (hn : 0 < n) : χ = 1 ↔ χ.conductor = 1 :=
⟨λ h, by { rw [h, one hn], }, λ h, by {rw eq_one χ h}⟩

lemma eq_zero_iff_level_eq_zero : χ.conductor = 0 ↔ n = 0 :=
⟨λ h, by {rw ←zero_dvd_iff, convert dvd_lev χ, rw h, },
  λ h, by {rw [conductor, nat.Inf_eq_zero], left, refine ⟨zero_dvd_iff.2 h,
  ⟨change_level (by {rw h}) χ, by { rw [←change_level.dvd _ _ _, change_level.self _], }⟩, ⟩, }⟩
end conductor

/-- A character is primitive if its level is equal to its conductor. -/
def is_primitive : Prop := χ.conductor = n

lemma is_primitive_def : χ.is_primitive ↔ χ.conductor = n := ⟨λ h, h, λ h, h⟩

namespace is_primitive
lemma one : is_primitive (1 : dirichlet_character R 1) := nat.dvd_one.1 (conductor.dvd_lev _)

lemma one_lev_zero : (1 : dirichlet_character R 0).is_primitive :=
begin
  rw [is_primitive_def, conductor, nat.Inf_eq_zero],
  left, rw conductor_set,
  simp only [set.mem_set_of_eq], fconstructor,
  simp only [true_and, zmod.cast_id', id.def, monoid_hom.coe_mk, dvd_zero, coe_coe],
  refine ⟨1, rfl⟩,
end
end is_primitive

lemma conductor_one_dvd (n : ℕ) : conductor (1 : dirichlet_character R 1) ∣ n :=
by { rw (is_primitive_def _).1 is_primitive.one, apply one_dvd _, }

/-- If m = n are positive natural numbers, then zmod m ≃ zmod n. -/
def zmod.mul_equiv {a b : ℕ} (h : a = b) : zmod a ≃* zmod b :=
by { rw h }

/-- If m = n are positive natural numbers, then their Dirichlet character spaces are the same. -/
def equiv {a b : ℕ} (h : a = b) : dirichlet_character R a ≃* dirichlet_character R b := by { rw h, }

/-- The primitive character associated to a Dirichlet character. -/
noncomputable def asso_primitive_character : dirichlet_character R χ.conductor :=
  classical.some (conductor.factors_through χ).ind_char

lemma mem_conductor_set_eq_conductor {d : ℕ} (hd : d ∈ χ.conductor_set) :
  χ.conductor ≤ (classical.some hd.2).conductor :=
begin
  apply nat.Inf_le,
  rw conductor_set, simp only [set.mem_set_of_eq, monoid_hom.coe_mk],
  refine ⟨dvd_trans (conductor.dvd_lev _) hd.1, (conductor.factors_through (classical.some hd.2)).2.some, _⟩,
  convert factors_through.spec χ hd using 1,
  have : (zmod.cast_hom (dvd_trans (conductor.dvd_lev hd.2.some) hd.1)
    (zmod (classical.some hd.2).conductor) : monoid_hom (zmod n)
    (zmod (classical.some hd.2).conductor)) = ((zmod.cast_hom (conductor.dvd_lev hd.2.some)
    (zmod (classical.some hd.2).conductor)) : monoid_hom (zmod d)
    (zmod (classical.some hd.2).conductor)).comp (zmod.cast_hom hd.1
    (zmod d) : monoid_hom (zmod n) (zmod d)),
  { suffices : (zmod.cast_hom (dvd_trans (conductor.dvd_lev hd.2.some) hd.1)
    (zmod (classical.some hd.2).conductor)) = ((zmod.cast_hom (conductor.dvd_lev hd.2.some)
    (zmod (classical.some hd.2).conductor))).comp (zmod.cast_hom hd.1
    (zmod d)),
    { rw this, refl, },
    { convert ring_hom.ext_zmod _ _, }, },
  rw [change_level_def, this, units.map_comp, ←monoid_hom.comp_assoc],
  congr,
  change change_level _ _ = _,
  convert (factors_through.spec _ _).symm,
end

lemma asso_primitive_character_is_primitive : (χ.asso_primitive_character).is_primitive :=
begin
  by_cases χ.conductor = 0,
  { rw is_primitive_def, conv_rhs { rw h, },
    rw conductor.eq_zero_iff_level_eq_zero, rw h, },
  refine le_antisymm (nat.le_of_dvd (nat.pos_of_ne_zero h) (conductor.dvd_lev _))
  (mem_conductor_set_eq_conductor _ (conductor.mem_conductor_set _)),
end

lemma asso_primitive_character_one (hn : 0 < n) :
  (1 : dirichlet_character R n).asso_primitive_character = 1 :=
begin
  rw conductor.eq_one_iff _,
  { convert (1 : dirichlet_character R n).asso_primitive_character_is_primitive,
    rw conductor.one hn, },
  { rw conductor.one hn, apply nat.one_pos, },
end

lemma asso_dirichlet_character_mul (ψ : dirichlet_character R n) :
  asso_dirichlet_character (χ * ψ) = (asso_dirichlet_character χ) * (asso_dirichlet_character ψ) :=
begin
  ext,
  simp only [monoid_hom.mul_apply],
  by_cases is_unit x,
  { repeat { rw asso_dirichlet_character_eq_char' _ h, },
    simp only [monoid_hom.mul_apply, units.coe_mul], },
  { repeat { rw asso_dirichlet_character_eq_zero _ h, }, rw zero_mul, },
end

-- `mul_eq_asso_pri_char` changed to `asso_primitive_conductor_eq`
lemma asso_primitive_conductor_eq {n : ℕ} (χ : dirichlet_character R n) :
  χ.asso_primitive_character.conductor = χ.conductor :=
(is_primitive_def χ.asso_primitive_character).1 (asso_primitive_character_is_primitive χ)

/-- Similar to multiplication of Dirichlet characters, without needing the characters to be
  primitive. -/
noncomputable def mul {m : ℕ} (χ₁ : dirichlet_character R n) (χ₂ : dirichlet_character R m) :=
asso_primitive_character (change_level (dvd_lcm_left n m) χ₁ * change_level (dvd_lcm_right n m) χ₂)

lemma mul_def {n m : ℕ} {χ : dirichlet_character R n} {ψ : dirichlet_character R m} :
  χ.mul ψ = (change_level _ χ * change_level _ ψ).asso_primitive_character := rfl

namespace is_primitive
lemma mul {m : ℕ} (ψ : dirichlet_character R m) : (mul χ ψ).is_primitive :=
asso_primitive_character_is_primitive _
end is_primitive

/-- Composition of a Dirichlet character with a multiplicative homomorphism of units. -/
--abbreviation comp {S : Type*} [comm_monoid_with_zero S] (f : units R →* units S) : dirichlet_character S n := f.comp χ

variables {S : Type*} [comm_ring S] {m : ℕ} (ψ : dirichlet_character S m)

/-- A Dirichlet character is odd if its value at -1 is -1. -/
def is_odd : Prop := ψ (-1) = -1

/-- A Dirichlet character is even if its value at -1 is 1. -/
def is_even : Prop := ψ (-1) = 1

lemma is_odd_or_is_even [no_zero_divisors S] : ψ.is_odd ∨ ψ.is_even :=
begin
  suffices : (ψ (-1))^2 = 1,
  { rw ←units.eq_iff at this,
    conv_rhs at this { rw ←one_pow 2 },
    rw ←sub_eq_zero at this,
    simp only [units.coe_one, units.coe_pow] at this,
    rw [sq_sub_sq, mul_eq_zero, sub_eq_zero, add_eq_zero_iff_eq_neg] at this,
    cases this,
    { left, rw [is_odd, ←units.eq_iff], simp only [this, units.coe_neg_one], },
    { right, rw [is_even, ←units.eq_iff], simp only [this, units.coe_one], }, },
  { rw [←monoid_hom.map_pow, ←monoid_hom.map_one ψ],
    congr, rw units.ext_iff,
    simp only [units.coe_one, units.coe_neg_one, units.coe_pow], rw neg_one_sq, },
end
-- can conditions on S be relaxed? comm needed for sq_sub_sq, and no_divisors needed for mul_eq_zero

lemma asso_odd_dirichlet_character_eval_neg_one (hψ : ψ.is_odd) :
  asso_dirichlet_character ψ (-1) = -1 :=
begin
  rw is_odd at hψ,
  convert asso_dirichlet_character_eq_char _ (-1),
  rw hψ, simp,
end

lemma asso_even_dirichlet_character_eval_neg_one (hψ : ψ.is_even) :
  asso_dirichlet_character ψ (-1) = 1 :=
begin
  rw is_even at hψ,
  convert asso_dirichlet_character_eq_char _ (-1),
  rw hψ, simp,
end

lemma asso_odd_dirichlet_character_eval_sub (x : zmod m) (hψ : ψ.is_odd) :
  asso_dirichlet_character ψ (m - x) = -(asso_dirichlet_character ψ x) :=
begin
  rw [asso_dirichlet_character_eval_sub, ←neg_one_mul, monoid_hom.map_mul,
    asso_odd_dirichlet_character_eval_neg_one _ hψ],
  simp,
end

lemma asso_even_dirichlet_character_eval_sub (x : zmod m) (hψ : ψ.is_even) :
  asso_dirichlet_character ψ (m - x) = asso_dirichlet_character ψ x :=
begin
  rw [asso_dirichlet_character_eval_sub, ←neg_one_mul, monoid_hom.map_mul,
    asso_even_dirichlet_character_eval_neg_one _ hψ],
  simp,
end

end dirichlet_character


/-
This example demonstrates why allowing types such as

inductive D : Type :=
| intro : (D → D) → D

would make the system inconsistent
-/

/- If we were allowed to form the inductive type

     inductive D : Type :=
     | intro : (D → D) → D

   we would get the following
-/
universe l
-- The new type A
axiom D : Type.{l}
-- The constructor
axiom introD : (D → D) → D
-- The eliminator
axiom recD   : Π {C : D → Type}, (Π (f : D → D) (r : Π d, C (f d)), C (introD f)) → (Π (d : D), C d)
-- We would also get a computational rule for the eliminator, but we don't need it for deriving the inconsistency.

noncomputable definition id' : D → D := λd, d
noncomputable definition v  : D     := introD id'

theorem inconsistent : false :=
recD (λ f ih, ih v) v


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.witt_vector.is_poly
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
## Multiplication by `n` in the ring of Witt vectors

In this file we show that multiplication by `n` in the ring of Witt vectors
is a polynomial function. We then use this fact to show that the composition of Frobenius
and Verschiebung is equal to multiplication by `p`.

### Main declarations

* `mul_n_is_poly`: multiplication by `n` is a polynomial function

-/

namespace witt_vector

/-- `witt_mul_n p n` is the family of polynomials that computes
the coefficients of `x * n` in terms of the coefficients of the Witt vector `x`. -/
def witt_mul_n (p : ℕ) [hp : fact (nat.prime p)] : ℕ → ℕ → mv_polynomial ℕ ℤ :=
  sorry

theorem mul_n_coeff {p : ℕ} {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] (n : ℕ) (x : witt_vector p R) (k : ℕ) : coeff (x * ↑n) k = coe_fn (mv_polynomial.aeval (coeff x)) (witt_mul_n p n k) := sorry

/-- Multiplication by `n` is a polynomial function. -/
theorem mul_n_is_poly (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : is_poly p fun (R : Type u_1) (_Rcr : comm_ring R) (x : witt_vector p R) => x * ↑n :=
  Exists.intro (witt_mul_n p n)
    fun (R : Type u_1) (_Rcr : comm_ring R) (x : witt_vector p R) => funext fun (k : ℕ) => mul_n_coeff n x k

@[simp] theorem bind₁_witt_mul_n_witt_polynomial (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) (k : ℕ) : coe_fn (mv_polynomial.bind₁ (witt_mul_n p n)) (witt_polynomial p ℤ k) = ↑n * witt_polynomial p ℤ k := sorry