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

import data.polynomial.eval

/-!
# Multivariate polynomials

This file defines polynomial rings over a base ring (or even semiring),
with variables from a general type `σ` (which could be infinite).

## Important definitions

Let `R` be a commutative ring (or a semiring) and let `σ` be an arbitrary
type. This file creates the type `mv_polynomial σ R`, which mathematicians
might denote $R[X_i : i \in σ]$. It is the type of multivariate
(a.k.a. multivariable) polynomials, with variables
corresponding to the terms in `σ`, and coefficients in `R`.

### Notation

In the definitions below, we use the following notation:

+ `σ : Type*` (indexing the variables)

+ `R : Type*` `[comm_semiring R]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `a : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ R`

### Definitions

* `mv_polynomial σ R` : the type of polynomials with variables of type `σ` and coefficients
  in the commutative semiring `R`

* `monomial s a` : the monomial which mathematically would be denoted `a * X^s`

* `C a` : the constant polynomial with value `a`

* `X i` : the degree one monomial corresponding to i; mathematically this might be denoted `Xᵢ`.

* `coeff s p` : the coefficient of `s` in `p`.

* `eval₂ (f : R → S₁) (g : σ → S₁) p` : given a semiring homomorphism from `R` to another
  semiring `S₁`, and a map `σ → S₁`, evaluates `p` at this valuation, returning a term of type `S₁`.
  Note that `eval₂` can be made using `eval` and `map` (see below), and it has been suggested
  that sticking to `eval` and `map` might make the code less brittle.

* `eval (g : σ → R) p` : given a map `σ → R`, evaluates `p` at this valuation,
  returning a term of type `R`

* `map (f : R → S₁) p` : returns the multivariate polynomial obtained from `p` by the change of
  coefficient semiring corresponding to `f`

## Implementation notes

Recall that if `Y` has a zero, then `X →₀ Y` is the type of functions from `X` to `Y` with finite
support, i.e. such that only finitely many elements of `X` get sent to non-zero terms in `Y`.
The definition of `mv_polynomial σ R` is `(σ →₀ ℕ) →₀ R` ; here `σ →₀ ℕ` denotes the space of all
monomials in the variables, and the function to `R` sends a monomial to its coefficient in
the polynomial being represented.

## Tags

polynomial, multivariate polynomial, multivariable polynomial

-/

noncomputable theory

open_locale classical big_operators

open set function finsupp add_monoid_algebra
open_locale big_operators

universes u v w x
variables {R : Type u} {S₁ : Type v} {S₂ : Type w} {S₃ : Type x}

/-- Multivariate polynomial, where `σ` is the index set of the variables and
  `R` is the coefficient ring -/
def mv_polynomial (σ : Type*) (R : Type*) [comm_semiring R] := add_monoid_algebra R (σ →₀ ℕ)

namespace mv_polynomial
variables {σ : Type*} {a a' a₁ a₂ : R} {e : ℕ} {n m : σ} {s : σ →₀ ℕ}

section comm_semiring

section instances

instance decidable_eq_mv_polynomial [comm_semiring R] [decidable_eq σ] [decidable_eq R] :
  decidable_eq (mv_polynomial σ R) := finsupp.decidable_eq
instance [comm_semiring R] : comm_semiring (mv_polynomial σ R) := add_monoid_algebra.comm_semiring
instance [comm_semiring R] : inhabited (mv_polynomial σ R) := ⟨0⟩
instance [semiring R] [comm_semiring S₁] [module R S₁] : module R (mv_polynomial σ S₁) :=
add_monoid_algebra.module
instance [semiring R] [semiring S₁] [comm_semiring S₂]
  [has_scalar R S₁] [module R S₂] [module S₁ S₂] [is_scalar_tower R S₁ S₂] :
  is_scalar_tower R S₁ (mv_polynomial σ S₂) :=
add_monoid_algebra.is_scalar_tower
instance [semiring R] [semiring S₁][comm_semiring S₂]
  [module R S₂] [module S₁ S₂] [smul_comm_class R S₁ S₂] :
  smul_comm_class R S₁ (mv_polynomial σ S₂) :=
add_monoid_algebra.smul_comm_class
instance [comm_semiring R] [comm_semiring S₁] [algebra R S₁] : algebra R (mv_polynomial σ S₁) :=
add_monoid_algebra.algebra

end instances

variables [comm_semiring R] [comm_semiring S₁] {p q : mv_polynomial σ R}

/-- `monomial s a` is the monomial with coefficient `a` and exponents given by `s`  -/
def monomial (s : σ →₀ ℕ) (a : R) : mv_polynomial σ R := single s a

lemma single_eq_monomial (s : σ →₀ ℕ) (a : R) : single s a = monomial s a := rfl

lemma mul_def : (p * q) = p.sum (λ m a, q.sum $ λ n b, monomial (m + n) (a * b)) := rfl

/-- `C a` is the constant polynomial with value `a` -/
def C : R →+* mv_polynomial σ R :=
{ to_fun := monomial 0, ..single_zero_ring_hom }

variables (R σ)
theorem algebra_map_eq : algebra_map R (mv_polynomial σ R) = C := rfl
variables {R σ}

/-- `X n` is the degree `1` monomial $X_n$. -/
def X (n : σ) : mv_polynomial σ R := monomial (single n 1) 1

lemma C_apply : (C a : mv_polynomial σ R) = monomial 0 a := rfl

@[simp] lemma C_0 : C 0 = (0 : mv_polynomial σ R) := by simp [C_apply, monomial]

@[simp] lemma C_1 : C 1 = (1 : mv_polynomial σ R) := rfl

lemma C_mul_monomial : C a * monomial s a' = monomial s (a * a') :=
by simp [C_apply, monomial, single_mul_single]

@[simp] lemma C_add : (C (a + a') : mv_polynomial σ R) = C a + C a' := single_add

@[simp] lemma C_mul : (C (a * a') : mv_polynomial σ R) = C a * C a' := C_mul_monomial.symm

@[simp] lemma C_pow (a : R) (n : ℕ) : (C (a^n) : mv_polynomial σ R) = (C a)^n :=
by induction n; simp [pow_succ, *]

lemma C_injective (σ : Type*) (R : Type*) [comm_semiring R] :
  function.injective (C : R → mv_polynomial σ R) :=
finsupp.single_injective _

lemma C_surjective {R : Type*} [comm_semiring R] (σ : Type*) (hσ : ¬ nonempty σ) :
  function.surjective (C : R → mv_polynomial σ R) :=
begin
  refine λ p, ⟨p.to_fun 0, finsupp.ext (λ a, _)⟩,
  simpa [(finsupp.ext (λ x, absurd (nonempty.intro x) hσ) : a = 0), C_apply, monomial],
end

lemma C_surjective_fin_0 {R : Type*} [comm_ring R] :
  function.surjective (mv_polynomial.C : R → mv_polynomial (fin 0) R) :=
C_surjective (fin 0) (λ h, let ⟨n⟩ := h in fin_zero_elim n)

@[simp] lemma C_inj {σ : Type*} (R : Type*) [comm_semiring R] (r s : R) :
  (C r : mv_polynomial σ R) = C s ↔ r = s :=
(C_injective σ R).eq_iff

instance infinite_of_infinite (σ : Type*) (R : Type*) [comm_semiring R] [infinite R] :
  infinite (mv_polynomial σ R) :=
infinite.of_injective C (C_injective _ _)

instance infinite_of_nonempty (σ : Type*) (R : Type*) [nonempty σ] [comm_semiring R]
  [nontrivial R] :
  infinite (mv_polynomial σ R) :=
infinite.of_injective ((λ s : σ →₀ ℕ, monomial s 1) ∘ single (classical.arbitrary σ)) $
  function.injective.comp
    (λ m n, (finsupp.single_left_inj one_ne_zero).mp) (finsupp.single_injective _)

lemma C_eq_coe_nat (n : ℕ) : (C ↑n : mv_polynomial σ R) = n :=
by induction n; simp [nat.succ_eq_add_one, *]

theorem C_mul' : mv_polynomial.C a * p = a • p :=
(algebra.smul_def a p).symm

lemma smul_eq_C_mul (p : mv_polynomial σ R) (a : R) : a • p = C a * p := C_mul'.symm

lemma X_pow_eq_single : X n ^ e = monomial (single n e) (1 : R) :=
begin
  induction e,
  { simp [X], refl },
  { simp [pow_succ, e_ih],
    simp [X, monomial, single_mul_single, nat.succ_eq_add_one, add_comm] }
end

lemma monomial_add_single : monomial (s + single n e) a = (monomial s a * X n ^ e) :=
by rw [X_pow_eq_single, monomial, monomial, monomial, single_mul_single]; simp

lemma monomial_single_add : monomial (single n e + s) a = (X n ^ e * monomial s a) :=
by rw [X_pow_eq_single, monomial, monomial, monomial, single_mul_single]; simp

lemma single_eq_C_mul_X {s : σ} {a : R} {n : ℕ} :
  monomial (single s n) a = C a * (X s)^n :=
by rw [← zero_add (single s n), monomial_add_single, C_apply]

@[simp] lemma monomial_add {s : σ →₀ ℕ} {a b : R} :
  monomial s a + monomial s b = monomial s (a + b) :=
single_add.symm

@[simp] lemma monomial_mul {s s' : σ →₀ ℕ} {a b : R} :
  monomial s a * monomial s' b = monomial (s + s') (a * b) :=
add_monoid_algebra.single_mul_single

@[simp] lemma monomial_zero {s : σ →₀ ℕ}: monomial s (0 : R) = 0 :=
single_zero

@[simp] lemma sum_monomial  {A : Type*} [add_comm_monoid A]
  {u : σ →₀ ℕ} {r : R} {b : (σ →₀ ℕ) → R → A} (w : b u 0 = 0) :
  sum (monomial u r) b = b u r :=
sum_single_index w

@[simp] lemma sum_C {A : Type*} [add_comm_monoid A]
  {b : (σ →₀ ℕ) → R → A} (w : b 0 0 = 0) :
  sum (C a) b = b 0 a :=
by simp [C_apply, w]

lemma monomial_eq : monomial s a = C a * (s.prod $ λn e, X n ^ e : mv_polynomial σ R) :=
begin
  apply @finsupp.induction σ ℕ _ _ s,
  { simp only [C_apply, prod_zero_index]; exact (mul_one _).symm },
  { assume n e s hns he ih,
    rw [monomial_single_add, ih, prod_add_index, prod_single_index, mul_left_comm],
    { simp only [pow_zero], },
    { intro a, simp only [pow_zero], },
    { intros, rw pow_add, }, }
end

@[recursor 5]
lemma induction_on {M : mv_polynomial σ R → Prop} (p : mv_polynomial σ R)
  (h_C : ∀a, M (C a)) (h_add : ∀p q, M p → M q → M (p + q)) (h_X : ∀p n, M p → M (p * X n)) :
  M p :=
have ∀s a, M (monomial s a),
begin
  assume s a,
  apply @finsupp.induction σ ℕ _ _ s,
  { show M (monomial 0 a), from h_C a, },
  { assume n e p hpn he ih,
    have : ∀e:ℕ, M (monomial p a * X n ^ e),
    { intro e,
      induction e,
      { simp [ih] },
      { simp [ih, pow_succ', (mul_assoc _ _ _).symm, h_X, e_ih] } },
    simp [add_comm, monomial_add_single, this] }
end,
finsupp.induction p
  (by have : M (C 0) := h_C 0; rwa [C_0] at this)
  (assume s a p hsp ha hp, h_add _ _ (this s a) hp)

attribute [elab_as_eliminator]
theorem induction_on' {P : mv_polynomial σ R → Prop} (p : mv_polynomial σ R)
    (h1 : ∀ (u : σ →₀ ℕ) (a : R), P (monomial u a))
    (h2 : ∀ (p q : mv_polynomial σ R), P p → P q → P (p + q)) : P p :=
finsupp.induction p (suffices P (monomial 0 0), by rwa monomial_zero at this,
                     show P (monomial 0 0), from h1 0 0)
                    (λ a b f ha hb hPf, h2 _ _ (h1 _ _) hPf)

@[ext] lemma ring_hom_ext {A : Type*} [semiring A] {f g : mv_polynomial σ R →+* A}
  (hC : ∀ r, f (C r) = g (C r)) (hX : ∀ i, f (X i) = g (X i)) :
  f = g :=
by { ext, exacts [hC _, hX _] }

lemma hom_eq_hom [semiring S₂]
  (f g : mv_polynomial σ R →+* S₂)
  (hC : ∀a:R, f (C a) = g (C a)) (hX : ∀n:σ, f (X n) = g (X n)) (p : mv_polynomial σ R) :
  f p = g p :=
ring_hom.congr_fun (ring_hom_ext hC hX) p

lemma is_id (f : mv_polynomial σ R →+* mv_polynomial σ R)
  (hC : ∀a:R, f (C a) = (C a)) (hX : ∀n:σ, f (X n) = (X n)) (p : mv_polynomial σ R) :
  f p = p :=
hom_eq_hom f (ring_hom.id _) hC hX p

@[ext] lemma alg_hom_ext {A : Type*} [comm_semiring A] [algebra R A]
  {f g : mv_polynomial σ R →ₐ[R] A} (hf : ∀ i : σ, f (X i) = g (X i)) :
  f = g :=
by { ext, exact hf _ }

@[simp] lemma alg_hom_C (f : mv_polynomial σ R →ₐ[R] mv_polynomial σ R) (r : R) :
  f (C r) = C r :=
f.commutes r

section support

/--
The finite set of all `m : σ →₀ ℕ` such that `X^m` has a non-zero coefficient.
-/
def support (p : mv_polynomial σ R) : finset (σ →₀ ℕ) :=
p.support

lemma support_monomial [decidable (a = 0)] : (monomial s a).support = if a = 0 then ∅ else {s} :=
by convert rfl

lemma support_monomial_subset : (monomial s a).support ⊆ {s} :=
support_single_subset

lemma support_add : (p + q).support ⊆ p.support ∪ q.support := finsupp.support_add

lemma support_X [nontrivial R] : (X n : mv_polynomial σ R).support = {single n 1} :=
by rw [X, support_monomial, if_neg]; exact one_ne_zero

end support

section coeff

/-- The coefficient of the monomial `m` in the multi-variable polynomial `p`. -/
def coeff (m : σ →₀ ℕ) (p : mv_polynomial σ R) : R :=
@coe_fn _ (monoid_algebra.has_coe_to_fun _ _) p m

@[simp] lemma mem_support_iff {p : mv_polynomial σ R} {m : σ →₀ ℕ} :
  m ∈ p.support ↔ p.coeff m ≠ 0 :=
by simp [support, coeff]

lemma not_mem_support_iff {p : mv_polynomial σ R} {m : σ →₀ ℕ} :
  m ∉ p.support ↔ p.coeff m = 0 :=
by simp

lemma sum_def {A} [add_comm_monoid A] {p : mv_polynomial σ R} {b : (σ →₀ ℕ) → R → A} :
  p.sum b = ∑ m in p.support, b m (p.coeff m) :=
by simp [support, finsupp.sum, coeff]

lemma support_mul (p q : mv_polynomial σ R) :
  (p * q).support ⊆ p.support.bUnion (λ a, q.support.bUnion $ λ b, {a + b}) :=
by convert add_monoid_algebra.support_mul p q; ext; convert iff.rfl

@[ext] lemma ext (p q : mv_polynomial σ R) :
  (∀ m, coeff m p = coeff m q) → p = q := ext

lemma ext_iff (p q : mv_polynomial σ R) :
  p = q ↔ (∀ m, coeff m p = coeff m q) :=
⟨ λ h m, by rw h, ext p q⟩

@[simp] lemma coeff_add (m : σ →₀ ℕ) (p q : mv_polynomial σ R) :
  coeff m (p + q) = coeff m p + coeff m q := add_apply p q m

@[simp] lemma coeff_smul {S₁ : Type*} [semiring S₁] [module S₁ R]
  (m : σ →₀ ℕ) (c : S₁) (p : mv_polynomial σ R) :
  coeff m (c • p) = c • coeff m p := smul_apply c p m

@[simp] lemma coeff_zero (m : σ →₀ ℕ) :
  coeff m (0 : mv_polynomial σ R) = 0 := rfl

@[simp] lemma coeff_zero_X (i : σ) : coeff 0 (X i : mv_polynomial σ R) = 0 :=
single_eq_of_ne (λ h, by cases single_eq_zero.1 h)

instance coeff.is_add_monoid_hom (m : σ →₀ ℕ) :
  is_add_monoid_hom (coeff m : mv_polynomial σ R → R) :=
{ map_add := coeff_add m,
  map_zero := coeff_zero m }

lemma coeff_sum {X : Type*} (s : finset X) (f : X → mv_polynomial σ R) (m : σ →₀ ℕ) :
  coeff m (∑ x in s, f x) = ∑ x in s, coeff m (f x) :=
(s.sum_hom _).symm

lemma monic_monomial_eq (m) : monomial m (1:R) = (m.prod $ λn e, X n ^ e : mv_polynomial σ R) :=
by simp [monomial_eq]

@[simp] lemma coeff_monomial (m n) (a) :
  coeff m (monomial n a : mv_polynomial σ R) = if n = m then a else 0 :=
single_apply

@[simp] lemma coeff_C (m) (a) :
  coeff m (C a : mv_polynomial σ R) = if 0 = m then a else 0 :=
single_apply

lemma coeff_X_pow (i : σ) (m) (k : ℕ) :
  coeff m (X i ^ k : mv_polynomial σ R) = if single i k = m then 1 else 0 :=
begin
  have := coeff_monomial m (finsupp.single i k) (1:R),
  rwa [@monomial_eq _ _ (1:R) (finsupp.single i k) _,
    C_1, one_mul, finsupp.prod_single_index] at this,
  exact pow_zero _
end

lemma coeff_X' (i : σ) (m) :
  coeff m (X i : mv_polynomial σ R) = if single i 1 = m then 1 else 0 :=
by rw [← coeff_X_pow, pow_one]

@[simp] lemma coeff_X (i : σ) :
  coeff (single i 1) (X i : mv_polynomial σ R) = 1 :=
by rw [coeff_X', if_pos rfl]

@[simp] lemma coeff_C_mul (m) (a : R) (p : mv_polynomial σ R) :
  coeff m (C a * p) = a * coeff m p :=
begin
  rw [mul_def, sum_C],
  { simp [sum_def, coeff_sum] {contextual := tt} },
  simp
end

lemma coeff_mul (p q : mv_polynomial σ R) (n : σ →₀ ℕ) :
  coeff n (p * q) = ∑ x in (antidiagonal n).support, coeff x.1 p * coeff x.2 q :=
begin
  rw mul_def,
  -- We need to manipulate both sides into a shape to which we can apply `finset.sum_bij_ne_zero`,
  -- so we need to turn both sides into a sum over a product.
  have := @finset.sum_product (σ →₀ ℕ) R _ _ p.support q.support
    (λ x, if (x.1 + x.2 = n) then coeff x.1 p * coeff x.2 q else 0),
  convert this.symm using 1; clear this,
  { rw [coeff],
    iterate 2 { rw sum_apply, apply finset.sum_congr rfl, intros, dsimp only },
    exact single_apply },
  symmetry,
  -- We are now ready to show that both sums are equal using `finset.sum_bij_ne_zero`.
  apply finset.sum_bij_ne_zero (λ (x : (σ →₀ ℕ) × (σ →₀ ℕ)) _ _, (x.1, x.2)),
  { intros x hx hx',
    simp only [mem_antidiagonal_support, eq_self_iff_true, if_false, forall_true_iff],
    contrapose! hx',
    rw [if_neg hx'] },
  { rintros ⟨i, j⟩ ⟨k, l⟩ hij hij' hkl hkl',
    simpa only [and_imp, prod.mk.inj_iff, heq_iff_eq] using and.intro },
  { rintros ⟨i, j⟩ hij hij',
    refine ⟨⟨i, j⟩, _, _⟩,
    { simp only [mem_support_iff, finset.mem_product],
      contrapose! hij',
      exact mul_eq_zero_of_ne_zero_imp_eq_zero hij' },
    { rw [mem_antidiagonal_support] at hij,
      simp only [exists_prop, true_and, ne.def, if_pos hij, hij', not_false_iff] } },
  { intros x hx hx',
    simp only [ne.def] at hx' ⊢,
    split_ifs with H,
    { refl },
    { rw if_neg H at hx', contradiction } }
end

@[simp] lemma coeff_mul_X (m) (s : σ) (p : mv_polynomial σ R) :
  coeff (m + single s 1) (p * X s) = coeff m p :=
begin
  have : (m, single s 1) ∈ (m + single s 1).antidiagonal.support := mem_antidiagonal_support.2 rfl,
  rw [coeff_mul, ← finset.insert_erase this, finset.sum_insert (finset.not_mem_erase _ _),
      finset.sum_eq_zero, add_zero, coeff_X, mul_one],
  rintros ⟨i,j⟩ hij,
  rw [finset.mem_erase, mem_antidiagonal_support] at hij,
  by_cases H : single s 1 = j,
  { subst j, simpa using hij },
  { rw [coeff_X', if_neg H, mul_zero] },
end

lemma coeff_mul_X' (m) (s : σ) (p : mv_polynomial σ R) :
  coeff m (p * X s) = if s ∈ m.support then coeff (m - single s 1) p else 0 :=
begin
  nontriviality R,
  split_ifs with h h,
  { conv_rhs {rw ← coeff_mul_X _ s},
    congr' with  t,
    by_cases hj : s = t,
    { subst t, simp only [nat_sub_apply, add_apply, single_eq_same],
      refine (nat.sub_add_cancel $ nat.pos_of_ne_zero _).symm, rwa finsupp.mem_support_iff at h },
    { simp [single_eq_of_ne hj] } },
  { rw ← not_mem_support_iff, intro hm, apply h,
    have H := support_mul _ _ hm, simp only [finset.mem_bUnion] at H,
    rcases H with ⟨j, hj, i', hi', H⟩,
    rw [support_X, finset.mem_singleton] at hi', subst i',
    rw finset.mem_singleton at H, subst m,
    rw [finsupp.mem_support_iff, add_apply, single_apply, if_pos rfl],
    intro H, rw [_root_.add_eq_zero_iff] at H, exact one_ne_zero H.2 }
end

lemma eq_zero_iff {p : mv_polynomial σ R} :
  p = 0 ↔ ∀ d, coeff d p = 0 :=
by { rw ext_iff, simp only [coeff_zero], }

lemma ne_zero_iff {p : mv_polynomial σ R} :
  p ≠ 0 ↔ ∃ d, coeff d p ≠ 0 :=
by { rw [ne.def, eq_zero_iff], push_neg, }

lemma exists_coeff_ne_zero {p : mv_polynomial σ R} (h : p ≠ 0) :
  ∃ d, coeff d p ≠ 0 :=
ne_zero_iff.mp h

lemma C_dvd_iff_dvd_coeff (r : R) (φ : mv_polynomial σ R) :
  C r ∣ φ ↔ ∀ i, r ∣ φ.coeff i :=
begin
  split,
  { rintros ⟨φ, rfl⟩ c, rw coeff_C_mul, apply dvd_mul_right },
  { intro h,
    choose c hc using h,
    classical,
    let c' : (σ →₀ ℕ) → R := λ i, if i ∈ φ.support then c i else 0,
    let ψ : mv_polynomial σ R := ∑ i in φ.support, monomial i (c' i),
    use ψ,
    apply mv_polynomial.ext, intro i,
    simp only [coeff_C_mul, coeff_sum, coeff_monomial, finset.sum_ite_eq', c'],
    split_ifs with hi hi,
    { rw hc },
    { rw not_mem_support_iff at hi, rwa mul_zero } },
end

end coeff

section constant_coeff

/--
`constant_coeff p` returns the constant term of the polynomial `p`, defined as `coeff 0 p`.
This is a ring homomorphism.
-/
def constant_coeff : mv_polynomial σ R →+* R :=
{ to_fun := coeff 0,
  map_one' := by simp [coeff, add_monoid_algebra.one_def],
  map_mul' := by simp [coeff_mul, finsupp.support_single_ne_zero],
  map_zero' := coeff_zero _,
  map_add' := coeff_add _ }

lemma constant_coeff_eq : (constant_coeff : mv_polynomial σ R → R) = coeff 0 := rfl

@[simp]
lemma constant_coeff_C (r : R) :
  constant_coeff (C r : mv_polynomial σ R) = r :=
by simp [constant_coeff_eq]

@[simp]
lemma constant_coeff_X (i : σ) :
  constant_coeff (X i : mv_polynomial σ R) = 0 :=
by simp [constant_coeff_eq]

lemma constant_coeff_monomial (d : σ →₀ ℕ) (r : R) :
  constant_coeff (monomial d r) = if d = 0 then r else 0 :=
by rw [constant_coeff_eq, coeff_monomial]

variables (σ R)

@[simp] lemma constant_coeff_comp_C :
  constant_coeff.comp (C : R →+* mv_polynomial σ R) = ring_hom.id R :=
by { ext, apply constant_coeff_C }

@[simp] lemma constant_coeff_comp_algebra_map :
  constant_coeff.comp (algebra_map R (mv_polynomial σ R)) = ring_hom.id R :=
constant_coeff_comp_C _ _

end constant_coeff

section as_sum

@[simp] lemma support_sum_monomial_coeff (p : mv_polynomial σ R) :
  ∑ v in p.support, monomial v (coeff v p) = p :=
finsupp.sum_single p

lemma as_sum (p : mv_polynomial σ R) : p = ∑ v in p.support, monomial v (coeff v p) :=
(support_sum_monomial_coeff p).symm

end as_sum

section eval₂
variables (f : R →+* S₁) (g : σ → S₁)

/-- Evaluate a polynomial `p` given a valuation `g` of all the variables
  and a ring hom `f` from the scalar ring to the target -/
def eval₂ (p : mv_polynomial σ R) : S₁ :=
p.sum (λs a, f a * s.prod (λn e, g n ^ e))

lemma eval₂_eq (g : R →+* S₁) (x : σ → S₁) (f : mv_polynomial σ R) :
  f.eval₂ g x = ∑ d in f.support, g (f.coeff d) * ∏ i in d.support, x i ^ d i :=
rfl

lemma eval₂_eq' [fintype σ] (g : R →+* S₁) (x : σ → S₁) (f : mv_polynomial σ R) :
  f.eval₂ g x = ∑ d in f.support, g (f.coeff d) * ∏ i, x i ^ d i :=
by { simp only [eval₂_eq, ← finsupp.prod_pow], refl }

@[simp] lemma eval₂_zero : (0 : mv_polynomial σ R).eval₂ f g = 0 :=
finsupp.sum_zero_index

section

@[simp] lemma eval₂_add : (p + q).eval₂ f g = p.eval₂ f g + q.eval₂ f g :=
finsupp.sum_add_index
  (by simp [is_semiring_hom.map_zero f])
  (by simp [add_mul, is_semiring_hom.map_add f])

@[simp] lemma eval₂_monomial : (monomial s a).eval₂ f g = f a * s.prod (λn e, g n ^ e) :=
finsupp.sum_single_index (by simp [is_semiring_hom.map_zero f])

@[simp] lemma eval₂_C (a) : (C a).eval₂ f g = f a :=
by simp [eval₂_monomial, C, prod_zero_index]

@[simp] lemma eval₂_one : (1 : mv_polynomial σ R).eval₂ f g = 1 :=
(eval₂_C _ _ _).trans (is_semiring_hom.map_one f)

@[simp] lemma eval₂_X (n) : (X n).eval₂ f g = g n :=
by simp [eval₂_monomial,
  is_semiring_hom.map_one f, X, prod_single_index, pow_one]

lemma eval₂_mul_monomial :
  ∀{s a}, (p * monomial s a).eval₂ f g = p.eval₂ f g * f a * s.prod (λn e, g n ^ e) :=
begin
  apply mv_polynomial.induction_on p,
  { assume a' s a,
    simp [C_mul_monomial, eval₂_monomial, is_semiring_hom.map_mul f] },
  { assume p q ih_p ih_q, simp [add_mul, eval₂_add, ih_p, ih_q] },
  { assume p n ih s a,
    from calc (p * X n * monomial s a).eval₂ f g = (p * monomial (single n 1 + s) a).eval₂ f g :
        by simp [monomial_single_add, -add_comm, pow_one, mul_assoc]
      ... = (p * monomial (single n 1) 1).eval₂ f g * f a * s.prod (λn e, g n ^ e) :
        by simp [ih, prod_single_index, prod_add_index, pow_one, pow_add, mul_assoc, mul_left_comm,
          is_semiring_hom.map_one f, -add_comm] }
end

@[simp] lemma eval₂_mul : ∀{p}, (p * q).eval₂ f g = p.eval₂ f g * q.eval₂ f g :=
begin
  apply mv_polynomial.induction_on q,
  { simp [C, eval₂_monomial, eval₂_mul_monomial, prod_zero_index] },
  { simp [mul_add, eval₂_add] {contextual := tt} },
  { simp [X, eval₂_monomial, eval₂_mul_monomial, (mul_assoc _ _ _).symm] { contextual := tt} }
end

@[simp] lemma eval₂_pow {p:mv_polynomial σ R} : ∀{n:ℕ}, (p ^ n).eval₂ f g = (p.eval₂ f g)^n
| 0       := by { rw [pow_zero, pow_zero], exact eval₂_one _ _ }
| (n + 1) := by rw [pow_add, pow_one, pow_add, pow_one, eval₂_mul, eval₂_pow]

instance eval₂.is_semiring_hom : is_semiring_hom (eval₂ f g) :=
{ map_zero := eval₂_zero _ _,
  map_one := eval₂_one _ _,
  map_add := λ p q, eval₂_add _ _,
  map_mul := λ p q, eval₂_mul _ _ }

/-- `mv_polynomial.eval₂` as a `ring_hom`. -/
def eval₂_hom (f : R →+* S₁) (g : σ → S₁) : mv_polynomial σ R →+* S₁ := ring_hom.of (eval₂ f g)

@[simp] lemma coe_eval₂_hom (f : R →+* S₁) (g : σ → S₁) : ⇑(eval₂_hom f g) = eval₂ f g := rfl

lemma eval₂_hom_congr  {f₁ f₂ : R →+* S₁} {g₁ g₂ : σ → S₁} {p₁ p₂ : mv_polynomial σ R} :
  f₁ = f₂ → g₁ = g₂ → p₁ = p₂ →  eval₂_hom f₁ g₁ p₁ = eval₂_hom f₂ g₂ p₂ :=
by rintros rfl rfl rfl; refl
end

@[simp]

@[simp] lemma eval₂_hom_X' (f : R →+* S₁) (g : σ → S₁) (i : σ) :
  eval₂_hom f g (X i) = g i := eval₂_X f g i

@[simp] lemma comp_eval₂_hom [comm_semiring S₂] (f : R →+* S₁) (g : σ → S₁) (φ : S₁ →+* S₂) :
  φ.comp (eval₂_hom f g) = (eval₂_hom (φ.comp f) (λ i, φ (g i))) :=
begin
  apply mv_polynomial.ring_hom_ext,
  { intro r, rw [ring_hom.comp_apply, eval₂_hom_C, eval₂_hom_C, ring_hom.comp_apply] },
  { intro i, rw [ring_hom.comp_apply, eval₂_hom_X', eval₂_hom_X'] }
end

lemma map_eval₂_hom  [comm_semiring S₂] (f : R →+* S₁) (g : σ → S₁) (φ : S₁ →+* S₂)
  (p : mv_polynomial σ R) :
  φ (eval₂_hom f g p) = (eval₂_hom (φ.comp f) (λ i, φ (g i)) p) :=
by { rw ← comp_eval₂_hom, refl }

lemma eval₂_hom_monomial (f : R →+* S₁) (g : σ → S₁) (d : σ →₀ ℕ) (r : R) :
  eval₂_hom f g (monomial d r) = f r * d.prod (λ i k, g i ^ k) :=
by simp only [monomial_eq, ring_hom.map_mul, eval₂_hom_C, finsupp.prod,
  ring_hom.map_prod, ring_hom.map_pow, eval₂_hom_X']

section
local attribute [instance, priority 10] is_semiring_hom.comp
lemma eval₂_comp_left {S₂} [comm_semiring S₂]
  (k : S₁ →+* S₂) (f : R →+* S₁) (g : σ → S₁)
  (p) : k (eval₂ f g p) = eval₂ (k.comp f) (k ∘ g) p :=
by apply mv_polynomial.induction_on p; simp [
  eval₂_add, k.map_add,
  eval₂_mul, k.map_mul] {contextual := tt}
end

@[simp] lemma eval₂_eta (p : mv_polynomial σ R) : eval₂ C X p = p :=
by apply mv_polynomial.induction_on p;
   simp [eval₂_add, eval₂_mul] {contextual := tt}

lemma eval₂_congr (g₁ g₂ : σ → S₁)
  (h : ∀ {i : σ} {c : σ →₀ ℕ}, i ∈ c.support → coeff c p ≠ 0 → g₁ i = g₂ i) :
  p.eval₂ f g₁ = p.eval₂ f g₂ :=
begin
  apply finset.sum_congr rfl,
  intros c hc, dsimp, congr' 1,
  apply finset.prod_congr rfl,
  intros i hi, dsimp, congr' 1,
  apply h hi,
  rwa finsupp.mem_support_iff at hc
end

@[simp] lemma eval₂_prod (s : finset S₂) (p : S₂ → mv_polynomial σ R) :
  eval₂ f g (∏ x in s, p x) = ∏ x in s, eval₂ f g (p x) :=
(s.prod_hom _).symm

@[simp] lemma eval₂_sum (s : finset S₂) (p : S₂ → mv_polynomial σ R) :
  eval₂ f g (∑ x in s, p x) = ∑ x in s, eval₂ f g (p x) :=
(s.sum_hom _).symm

attribute [to_additive] eval₂_prod

lemma eval₂_assoc (q : S₂ → mv_polynomial σ R) (p : mv_polynomial S₂ R) :
  eval₂ f (λ t, eval₂ f g (q t)) p = eval₂ f g (eval₂ C q p) :=
begin
  show _ = eval₂_hom f g (eval₂ C q p),
  rw eval₂_comp_left (eval₂_hom f g), congr' with a, simp,
end

end eval₂

section eval
variables {f : σ → R}

/-- Evaluate a polynomial `p` given a valuation `f` of all the variables -/
def eval (f : σ → R) : mv_polynomial σ R →+* R := eval₂_hom (ring_hom.id _) f

lemma eval_eq (x : σ → R) (f : mv_polynomial σ R) :
  eval x f = ∑ d in f.support, f.coeff d * ∏ i in d.support, x i ^ d i :=
rfl

lemma eval_eq' [fintype σ] (x : σ → R) (f : mv_polynomial σ R) :
  eval x f = ∑ d in f.support, f.coeff d * ∏ i, x i ^ d i :=
eval₂_eq' (ring_hom.id R) x f

lemma eval_monomial : eval f (monomial s a) = a * s.prod (λn e, f n ^ e) :=
eval₂_monomial _ _

@[simp] lemma eval_C : ∀ a, eval f (C a) = a := eval₂_C _ _

@[simp] lemma eval_X : ∀ n, eval f (X n) = f n := eval₂_X _ _

@[simp] lemma smul_eval (x) (p : mv_polynomial σ R) (s) : eval x (s • p) = s * eval x p :=
by rw [smul_eq_C_mul, (eval x).map_mul, eval_C]

lemma eval_sum {ι : Type*} (s : finset ι) (f : ι → mv_polynomial σ R) (g : σ → R) :
  eval g (∑ i in s, f i) = ∑ i in s, eval g (f i) :=
(eval g).map_sum _ _

@[to_additive]
lemma eval_prod {ι : Type*} (s : finset ι) (f : ι → mv_polynomial σ R) (g : σ → R) :
  eval g (∏ i in s, f i) = ∏ i in s, eval g (f i) :=
(eval g).map_prod _ _

theorem eval_assoc {τ}
  (f : σ → mv_polynomial τ R) (g : τ → R)
  (p : mv_polynomial σ R) :
  eval (eval g ∘ f) p = eval g (eval₂ C f p) :=
begin
  rw eval₂_comp_left (eval g),
  unfold eval, simp only [coe_eval₂_hom],
  congr' with a, simp
end

end eval

section map
variables (f : R →+* S₁)

/-- `map f p` maps a polynomial `p` across a ring hom `f` -/
def map : mv_polynomial σ R →+* mv_polynomial σ S₁ := eval₂_hom (C.comp f) X

@[simp] theorem map_monomial (s : σ →₀ ℕ) (a : R) : map f (monomial s a) = monomial s (f a) :=
(eval₂_monomial _ _).trans monomial_eq.symm

@[simp] theorem map_C : ∀ (a : R), map f (C a : mv_polynomial σ R) = C (f a) := map_monomial _ _

@[simp] theorem map_X : ∀ (n : σ), map f (X n : mv_polynomial σ R) = X n := eval₂_X _ _

theorem map_id : ∀ (p : mv_polynomial σ R), map (ring_hom.id R) p = p := eval₂_eta

theorem map_map [comm_semiring S₂]
  (g : S₁ →+* S₂)
  (p : mv_polynomial σ R) :
  map g (map f p) = map (g.comp f) p :=
(eval₂_comp_left (map g) (C.comp f) X p).trans $
begin
  congr,
  { ext1 a, simp only [map_C, comp_app, ring_hom.coe_comp], },
  { ext1 n, simp only [map_X, comp_app], }
end

theorem eval₂_eq_eval_map (g : σ → S₁) (p : mv_polynomial σ R) :
  p.eval₂ f g = eval g (map f p) :=
begin
  unfold map eval, simp only [coe_eval₂_hom],
  have h := eval₂_comp_left (eval₂_hom _ g),
  dsimp at h,
  rw h,
  congr,
  { ext1 a, simp only [coe_eval₂_hom, ring_hom.id_apply, comp_app, eval₂_C, ring_hom.coe_comp], },
  { ext1 n, simp only [comp_app, eval₂_X], },
end

lemma eval₂_comp_right {S₂} [comm_semiring S₂]
  (k : S₁ →+* S₂) (f : R →+* S₁) (g : σ → S₁)
  (p) : k (eval₂ f g p) = eval₂ k (k ∘ g) (map f p) :=
begin
  apply mv_polynomial.induction_on p,
  { intro r, rw [eval₂_C, map_C, eval₂_C] },
  { intros p q hp hq, rw [eval₂_add, k.map_add, (map f).map_add, eval₂_add, hp, hq] },
  { intros p s hp,
    rw [eval₂_mul, k.map_mul, (map f).map_mul, eval₂_mul, map_X, hp, eval₂_X, eval₂_X] }
end

lemma map_eval₂ (f : R →+* S₁) (g : S₂ → mv_polynomial S₃ R) (p : mv_polynomial S₂ R) :
  map f (eval₂ C g p) = eval₂ C (map f ∘ g) (map f p) :=
begin
  apply mv_polynomial.induction_on p,
  { intro r, rw [eval₂_C, map_C, map_C, eval₂_C] },
  { intros p q hp hq, rw [eval₂_add, (map f).map_add, hp, hq, (map f).map_add, eval₂_add] },
  { intros p s hp,
    rw [eval₂_mul, (map f).map_mul, hp, (map f).map_mul, map_X, eval₂_mul, eval₂_X, eval₂_X] }
end

lemma coeff_map (p : mv_polynomial σ R) : ∀ (m : σ →₀ ℕ), coeff m (map f p) = f (coeff m p) :=
begin
  apply mv_polynomial.induction_on p; clear p,
  { intros r m, rw [map_C], simp only [coeff_C], split_ifs, {refl}, rw f.map_zero },
  { intros p q hp hq m, simp only [hp, hq, (map f).map_add, coeff_add], rw f.map_add },
  { intros p i hp m, simp only [hp, (map f).map_mul, map_X],
    simp only [hp, mem_support_iff, coeff_mul_X'],
    split_ifs, {refl},
    rw is_semiring_hom.map_zero f }
end

lemma map_injective (hf : function.injective f) :
  function.injective (map f : mv_polynomial σ R → mv_polynomial σ S₁) :=
begin
  intros p q h,
  simp only [ext_iff, coeff_map] at h ⊢,
  intro m,
  exact hf (h m),
end

@[simp] lemma eval_map (f : R →+* S₁) (g : σ → S₁) (p : mv_polynomial σ R) :
  eval g (map f p) = eval₂ f g p :=
by { apply mv_polynomial.induction_on p; { simp { contextual := tt } } }

@[simp] lemma eval₂_map [comm_semiring S₂] (f : R →+* S₁) (g : σ → S₂) (φ : S₁ →+* S₂)
  (p : mv_polynomial σ R) :
  eval₂ φ g (map f p) = eval₂ (φ.comp f) g p :=
by { rw [← eval_map, ← eval_map, map_map], }

@[simp] lemma eval₂_hom_map_hom [comm_semiring S₂] (f : R →+* S₁) (g : σ → S₂) (φ : S₁ →+* S₂)
  (p : mv_polynomial σ R) :
  eval₂_hom φ g (map f p) = eval₂_hom (φ.comp f) g p :=
eval₂_map f g φ p

@[simp] lemma constant_coeff_map (f : R →+* S₁) (φ : mv_polynomial σ R) :
  constant_coeff (mv_polynomial.map f φ) = f (constant_coeff φ) :=
coeff_map f φ 0

lemma constant_coeff_comp_map (f : R →+* S₁) :
  (constant_coeff : mv_polynomial σ S₁ →+* S₁).comp (mv_polynomial.map f) = f.comp constant_coeff :=
by { ext; simp }

lemma support_map_subset (p : mv_polynomial σ R) : (map f p).support ⊆ p.support :=
begin
  intro x,
  simp only [mem_support_iff],
  contrapose!,
  change p.coeff x = 0 → (map f p).coeff x = 0,
  rw coeff_map,
  intro hx,
  rw hx,
  exact ring_hom.map_zero f
end

lemma support_map_of_injective (p : mv_polynomial σ R) {f : R →+* S₁} (hf : injective f) :
  (map f p).support = p.support :=
begin
  apply finset.subset.antisymm,
  { exact mv_polynomial.support_map_subset _ _ },
  intros x hx,
  rw mem_support_iff,
  contrapose! hx,
  simp only [not_not, mem_support_iff],
  change (map f p).coeff x = 0 at hx,
  rw [coeff_map, ← f.map_zero] at hx,
  exact hf hx
end

lemma C_dvd_iff_map_hom_eq_zero
  (q : R →+* S₁) (r : R) (hr : ∀ r' : R, q r' = 0 ↔ r ∣ r')
  (φ : mv_polynomial σ R) :
  C r ∣ φ ↔ map q φ = 0 :=
begin
  rw [C_dvd_iff_dvd_coeff, mv_polynomial.ext_iff],
  simp only [coeff_map, ring_hom.coe_of, coeff_zero, hr],
end

lemma map_map_range_eq_iff (f : R →+* S₁) (g : S₁ → R) (hg : g 0 = 0) (φ : mv_polynomial σ S₁) :
  map f (finsupp.map_range g hg φ) = φ ↔ ∀ d, f (g (coeff d φ)) = coeff d φ :=
begin
  rw mv_polynomial.ext_iff,
  apply forall_congr, intro m,
  rw [coeff_map],
  apply eq_iff_eq_cancel_right.mpr,
  refl
end

end map

section aeval

/-! ### The algebra of multivariate polynomials -/

variables (f : σ → S₁)
variables [algebra R S₁] [comm_semiring S₂]

/-- A map `σ → S₁` where `S₁` is an algebra over `R` generates an `R`-algebra homomorphism
from multivariate polynomials over `σ` to `S₁`. -/
def aeval : mv_polynomial σ R →ₐ[R] S₁ :=
{ commutes' := λ r, eval₂_C _ _ _
  .. eval₂_hom (algebra_map R S₁) f }

theorem aeval_def (p : mv_polynomial σ R) : aeval f p = eval₂ (algebra_map R S₁) f p := rfl

lemma aeval_eq_eval₂_hom (p : mv_polynomial σ R) :
  aeval f p = eval₂_hom (algebra_map R S₁) f p := rfl

@[simp] lemma aeval_X (s : σ) : aeval f (X s : mv_polynomial _ R) = f s := eval₂_X _ _ _

@[simp] lemma aeval_C (r : R) : aeval f (C r) = algebra_map R S₁ r := eval₂_C _ _ _

theorem aeval_unique (φ : mv_polynomial σ R →ₐ[R] S₁) :
  φ = aeval (φ ∘ X) :=
by { ext i, simp }

lemma comp_aeval {B : Type*} [comm_semiring B] [algebra R B]
  (φ : S₁ →ₐ[R] B) :
  φ.comp (aeval f) = aeval (λ i, φ (f i)) :=
by { ext i, simp }

@[simp] lemma map_aeval {B : Type*} [comm_semiring B]
  (g : σ → S₁) (φ : S₁ →+* B) (p : mv_polynomial σ R) :
  φ (aeval g p) = (eval₂_hom (φ.comp (algebra_map R S₁)) (λ i, φ (g i)) p) :=
by { rw ← comp_eval₂_hom, refl }

@[simp] lemma eval₂_hom_zero (f : R →+* S₂) (p : mv_polynomial σ R) :
  eval₂_hom f (0 : σ → S₂) p = f (constant_coeff p) :=
begin
  suffices : eval₂_hom f (0 : σ → S₂) = f.comp constant_coeff,
    from ring_hom.congr_fun this p,
  ext; simp
end

@[simp] lemma eval₂_hom_zero' (f : R →+* S₂) (p : mv_polynomial σ R) :
  eval₂_hom f (λ _, 0 : σ → S₂) p = f (constant_coeff p) :=
eval₂_hom_zero f p

@[simp] lemma aeval_zero (p : mv_polynomial σ R) :
  aeval (0 : σ → S₁) p = algebra_map _ _ (constant_coeff p) :=
eval₂_hom_zero (algebra_map R S₁) p

@[simp] lemma aeval_zero' (p : mv_polynomial σ R) :
  aeval (λ _, 0 : σ → S₁) p = algebra_map _ _ (constant_coeff p) :=
aeval_zero p

lemma aeval_monomial (g : σ → S₁) (d : σ →₀ ℕ) (r : R) :
  aeval g (monomial d r) = algebra_map _ _ r * d.prod (λ i k, g i ^ k) :=
eval₂_hom_monomial _ _ _ _

lemma eval₂_hom_eq_zero (f : R →+* S₂) (g : σ → S₂) (φ : mv_polynomial σ R)
  (h : ∀ d, φ.coeff d ≠ 0 → ∃ i ∈ d.support, g i = 0) :
  eval₂_hom f g φ = 0 :=
begin
  rw [φ.as_sum, ring_hom.map_sum, finset.sum_eq_zero],
  intros d hd,
  obtain ⟨i, hi, hgi⟩ : ∃ i ∈ d.support, g i = 0 := h d (finsupp.mem_support_iff.mp hd),
  rw [eval₂_hom_monomial, finsupp.prod, finset.prod_eq_zero hi, mul_zero],
  rw [hgi, zero_pow],
  rwa [pos_iff_ne_zero, ← finsupp.mem_support_iff]
end

lemma aeval_eq_zero [algebra R S₂] (f : σ → S₂) (φ : mv_polynomial σ R)
  (h : ∀ d, φ.coeff d ≠ 0 → ∃ i ∈ d.support, f i = 0) :
  aeval f φ = 0 :=
eval₂_hom_eq_zero _ _ _ h

end aeval

end comm_semiring
end mv_polynomial


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan
-/
import ring_theory.witt_vector.teichmuller
import ring_theory.witt_vector.compare
import padic_int.properties
import dirichlet_character.properties

/-!
# Teichmuller character
This file defines the Teichmuller character and its properties.

## Main definitions
 * `teichmuller_character`
 * `teichmuller_character_mod_p`

## Tags
p-adic, Dirichlet character, Teichmuller character
-/

variables (p : ℕ) [fact p.prime]

/-- The Teichmuller character defined on `p`-adic units in terms of Witt vectors. -/
noncomputable abbreviation teichmuller_character : ℤ_[p]ˣ →* ℤ_[p] :=
(witt_vector.equiv p).to_monoid_hom.comp ((witt_vector.teichmuller p).comp
  ((padic_int.to_zmod).to_monoid_hom.comp (units.coe_hom (ℤ_[p]))))
-- is this just taking (a : ℤ_[p]) to (to_zmod a : ℤ_[p])?

variable {p}
lemma teichmuller_character_root_of_unity (a : units ℤ_[p]) :
  (teichmuller_character p a)^(p - 1) = 1 :=
begin
  rw [←monoid_hom.map_pow],
  simp only [monoid_hom.coe_comp, ring_hom.to_monoid_hom_eq_coe, ring_hom.coe_monoid_hom,
    function.comp_app, units.coe_hom_apply, units.coe_pow, ring_hom.map_pow,
    padic_int.unit_pow_eq_one a, monoid_hom.map_one],
end

/-- The Teichmuller character defined on 𝔽ₚ*. -/
noncomputable abbreviation teichmuller_character_mod_p (p : ℕ) [fact (nat.prime p)] :
  dirichlet_character ℤ_[p] p :=
units.map (((witt_vector.equiv p).to_monoid_hom).comp (witt_vector.teichmuller p))

namespace units
lemma map_injective {M N : Type*} [monoid M] [monoid N] (f : M →* N)
  (hf : function.injective f) : function.injective (units.map f) :=
λ a b h, units.eq_iff.1 (hf (units.eq_iff.2 h))
end units

lemma teichmuller_character_mod_p_injective (p : ℕ) [fact (nat.prime p)] :
  function.injective (teichmuller_character_mod_p p) :=
begin
  change function.injective (function.comp (units.map (witt_vector.equiv p).to_monoid_hom)
    (units.map (@witt_vector.teichmuller p (zmod p) _ _))),
  refine function.injective.comp (units.map_injective _
    (equiv.injective (witt_vector.equiv p).to_equiv))
    (units.map_injective _ (λ a b h, witt_vector.ext_iff.1 h 0)),
end

namespace teichmuller_character
lemma is_odd_or_is_even : ((teichmuller_character p)) (-1 : units (ℤ_[p])) = -1 ∨
  ((teichmuller_character p)) (-1 : units (ℤ_[p])) = 1 :=
begin
  suffices : ((teichmuller_character p) (-1))^2 = 1,
  { conv_rhs at this { rw ←one_pow 2 },
    rw [←sub_eq_zero, sq_sub_sq, mul_eq_zero, sub_eq_zero, add_eq_zero_iff_eq_neg] at this,
    apply this, },
  { rw [←monoid_hom.map_pow, ←monoid_hom.map_one (teichmuller_character p), neg_one_sq], },
end

open dirichlet_character
lemma eval_neg_one (hp : 2 < p) : (teichmuller_character_mod_p p (-1)) = -1 :=
begin
  cases dirichlet_character.is_odd_or_is_even (teichmuller_character_mod_p p),
  { exact h, },
  { rw [is_even, ←monoid_hom.map_one (teichmuller_character_mod_p p)] at h,
    have := teichmuller_character_mod_p_injective p h,
    rw [eq_comm, ←units.eq_iff, units.coe_one, units.coe_neg_one, eq_neg_iff_add_eq_zero,
      ←nat.cast_one, ←nat.cast_add, zmod.nat_coe_zmod_eq_zero_iff_dvd,
      nat.dvd_prime (nat.prime_two)] at this,
    exfalso, cases this,
    { apply nat.prime.ne_one (fact.out _) this, },
    { apply ne_of_lt hp this.symm, }, },
end
end teichmuller_character

variables {R : Type*} [normed_comm_ring R] {m : ℕ}
variables (p R)
/-- Returns ω⁻¹ : ℤ/pℤ* →* R*. -/
noncomputable abbreviation teichmuller_character_mod_p' [algebra ℚ_[p] R] :
  dirichlet_character R p :=
((units.map ((algebra_map ℚ_[p] R).comp (padic_int.coe.ring_hom)).to_monoid_hom).comp
(teichmuller_character_mod_p p) : dirichlet_character R p)⁻¹

lemma char_zero_of_nontrivial_of_normed_algebra [nontrivial R] [algebra ℚ_[p] R] : char_zero R :=
(ring_hom.char_zero_iff ((algebra_map ℚ_[p] R).injective)).1 infer_instance

variables {p R}
lemma change_level_eval_neg_one' [no_zero_divisors R] [algebra ℚ_[p] R] [nontrivial R]
  (hp : 2 < p) : (teichmuller_character_mod_p' p R) (-1 : (zmod p)ˣ) = (-1 : units R) :=
begin
  cases dirichlet_character.is_odd_or_is_even (teichmuller_character_mod_p' p R),
  { exact h, },
  { exfalso,
    suffices : ((units.map ((algebra_map ℚ_[p] R).comp padic_int.coe.ring_hom).to_monoid_hom).comp
      (teichmuller_character_mod_p p)⁻¹) (-1) = 1,
    { simp only [monoid_hom.comp_apply, monoid_hom.inv_apply, map_inv, inv_eq_one] at this,
      rw [teichmuller_character.eval_neg_one hp, ←units.eq_iff, units.coe_map] at this,
      simp only [ring_hom.to_monoid_hom_eq_coe, units.coe_neg_one, ring_hom.coe_monoid_hom,
        map_neg, map_one, units.coe_one] at this,
      apply @nat.cast_add_one_ne_zero R _ _ (char_zero_of_nontrivial_of_normed_algebra p R) 1,
      rw [←eq_neg_iff_add_eq_zero, nat.cast_one, this], },
    { convert h, }, },
end
-- maybe can be simplified

lemma change_level_pow_eval_neg_one' [algebra ℚ_[p] R] [nontrivial R] [no_zero_divisors R] (k : ℕ)
  (hp : 2 < p) : ((teichmuller_character_mod_p' p R ^ k) is_unit_one.neg.unit) = (-1) ^ k :=
begin
  have : (is_unit_one.neg.unit : (zmod p)ˣ) = -1,
  { rw [←units.eq_iff, is_unit.unit_spec, units.coe_neg_one], },
  rw [dirichlet_character.pow_apply, this, change_level_eval_neg_one' hp],
  any_goals { apply_instance, },
end

variables (p) (d : ℕ) (R m)
/-- Returns ω⁻¹ : ℤ/(d * p^m)ℤ* →* R*. -/
noncomputable abbreviation teichmuller_character_mod_p_change_level [algebra ℚ_[p] R]
  [fact (0 < m)] : dirichlet_character R (d * p^m) :=
dirichlet_character.change_level (dvd_mul_of_dvd_right (dvd_pow_self p (ne_of_gt (fact.out _))) d)
(((units.map ((algebra_map ℚ_[p] R).comp
(padic_int.coe.ring_hom)).to_monoid_hom).comp
(teichmuller_character_mod_p p) : dirichlet_character R p)⁻¹)

variables {p d R m}
open zmod

-- replaced `teichmuller_character_mod_p_change_level_eval_neg_one` with
-- `teichmuller_character.change_level_eval_neg_one`
lemma change_level_eval_neg_one [no_zero_divisors R] [algebra ℚ_[p] R] [nontrivial R]
  (hp : 2 < p) [fact (0 < m)] :
  ((teichmuller_character_mod_p_change_level p R m d)) (-1 : units (zmod (d * p^m))) =
  (-1 : units R) :=
begin
  cases dirichlet_character.is_odd_or_is_even (teichmuller_character_mod_p_change_level p R m d),
  { exact h, },
  { exfalso,
    suffices : ((units.map ((algebra_map ℚ_[p] R).comp padic_int.coe.ring_hom).to_monoid_hom).comp
      (teichmuller_character_mod_p p)⁻¹) (-1) = 1,
    { simp only [monoid_hom.comp_apply, monoid_hom.inv_apply, map_inv, inv_eq_one] at this,
      rw [teichmuller_character.eval_neg_one hp, ←units.eq_iff, units.coe_map] at this,
      simp only [ring_hom.to_monoid_hom_eq_coe, units.coe_neg_one, ring_hom.coe_monoid_hom,
        map_neg, map_one, units.coe_one] at this,
      apply @nat.cast_add_one_ne_zero R _ _ (char_zero_of_nontrivial_of_normed_algebra p R) 1,
      rw [←eq_neg_iff_add_eq_zero, nat.cast_one, this], },
    { convert h,
      simp only [units.map, monoid_hom.mk'_apply, ring_hom.coe_monoid_hom, units.coe_neg_one,
        units.val_eq_coe, units.inv_eq_coe_inv, zmod.cast_hom_apply, inv_neg', inv_one],
      have : ((-1 : zmod (d * p^m)) : zmod p) = -1,
      { rw [cast_neg_one, nat.cast_mul, nat.cast_pow, nat_cast_self _, zero_pow (fact.out _),
          mul_zero], rw zero_sub,
        apply_instance, },
      simp_rw [this], refl, }, },
end
.

-- `teichmuller_character_mod_p_change_level_pow_eval_neg_one` replaced with
-- `teichmuller_character.change_level_pow_eval_neg_one`
lemma change_level_pow_eval_neg_one [algebra ℚ_[p] R] [nontrivial R] [no_zero_divisors R]
  [fact (0 < m)] (k : ℕ) (hp : 2 < p) :
  ((teichmuller_character_mod_p_change_level p R m d ^ k) is_unit_one.neg.unit) = (-1) ^ k :=
begin
  have : (is_unit_one.neg.unit : (zmod (d * p^m))ˣ) = -1,
  { rw [←units.eq_iff, is_unit.unit_spec, units.coe_neg_one], },
  rw [dirichlet_character.pow_apply, this, change_level_eval_neg_one hp],
  any_goals { apply_instance, },
end


import set_category.category_set
import coalgebra.Coalgebra
import help_functions

universe u

namespace Bisimulation

open category_theory set category_set coalgebra function classical
    help_functions

local notation f ` ⊚ `:80 g:80 := category_struct.comp g f

variables {F : Type u ⥤ Type u}
        {𝔸 Β ℂ : Coalgebra F} {A B : Type u}

def rel_to_set (R : 𝔸 → Β → Prop) : set (𝔸 × Β) :=
    λ ⟨a, b⟩ , R a b

def is_bisimulation_rel (R : 𝔸 → Β → Prop) : Prop :=
    let S := rel_to_set R in
    ∃ ρ : S → F.obj S,
    let ℝ : Coalgebra F := ⟨S , ρ⟩ in
    let π₁ : ℝ → 𝔸 := λ r, r.val.1 in
    let π₂ : ℝ → Β := λ r, r.val.2 in
    is_coalgebra_homomorphism π₁ ∧ is_coalgebra_homomorphism π₂

def is_bisimulation (R : set (𝔸 × Β)) : Prop :=
    ∃ ρ : R → F.obj R,
    let ℝ : Coalgebra F := ⟨R , ρ⟩ in
    let π₁ : ℝ → 𝔸 := λ r, r.val.1 in
    let π₂ : ℝ → Β := λ r, r.val.2 in
    is_coalgebra_homomorphism π₁ ∧ is_coalgebra_homomorphism π₂

theorem homomorphism_iff_bisimulation (f : 𝔸 → Β):
    is_coalgebra_homomorphism f ↔ is_bisimulation (map_to_graph f)
    :=
    let R : set (𝔸 × Β) := map_to_graph f in
    let π₁ : R → 𝔸 := λ r, r.val.1 in
    let π₂ : R → Β := λ r, r.val.2 in
    begin
        have bij : bijective π₁ := bij_map_to_graph_fst f,

        let inv : 𝔸 → R := invrs π₁ bij,
        have elements : ∀ a , (π₂ ∘ inv) a = f a :=
            begin
                intro a,
                have inv_a : inv a = ⟨⟨a, f a⟩ , by tidy⟩ :=
                    bij.1 (by simp [invrs_id π₁ bij] : (π₁ ∘ inv) a = a),
                have π₂_r : π₂ ⟨⟨a, f a⟩ , by tidy⟩ = f a := rfl,
                simp[inv_a , π₂_r]
            end,
        have f_π₂_inv : (π₂ ∘ inv) = f := funext elements,
        split,
        intro hom,
        let ρ := (F.map inv) ∘ 𝔸.α ∘ π₁,
        use ρ,
        split,

        calc 𝔸.α ∘ π₁ = (𝟙 (F.obj 𝔸)) ∘ 𝔸.α ∘ π₁           : rfl
             ... = (F.map (𝟙 𝔸)) ∘ 𝔸.α ∘ π₁               : by rw ← (functor.map_id' F 𝔸)
             ... = (F.map (π₁ ⊚ inv)) ∘ 𝔸.α ∘ π₁         : by simp [invrs_id]
             ... = ((F.map π₁) ⊚ (F.map inv)) ∘ 𝔸.α ∘ π₁ : by rw functor.map_comp,

        calc Β.α ∘ (π₂)  = ((Β.α) ∘ f) ∘ π₁                         : by tidy
                ...      = ((F.map f) ∘ 𝔸.α) ∘ π₁                   : by rw ← (eq.symm hom)
                ...      = (F.map (π₂ ∘ inv)) ∘ 𝔸.α ∘ π₁            : by rw ← f_π₂_inv
                ...      = (F.map (π₂ ⊚ inv)) ∘ 𝔸.α ∘ π₁           : rfl
                ...      = ((F.map π₂) ⊚ (F.map inv)) ∘ 𝔸.α ∘ π₁   : by by rw functor.map_comp,

        intro bis,
        let ρ := some bis,
        let ℝ : Coalgebra F :=  ⟨R , ρ⟩,

        have hom_π := some_spec bis,
        let h_π₁ : ℝ ⟶ 𝔸 := ⟨π₁ , hom_π.1⟩,

        have hom_π₂_inv : is_coalgebra_homomorphism (π₂ ∘ inv) :=
            @comp_is_hom F 𝔸 ℝ Β
            ⟨inv, bij_inverse_of_hom_is_hom h_π₁ bij⟩ ⟨π₂ , hom_π.2⟩,

        rw ← f_π₂_inv,

        exact hom_π₂_inv
    end

theorem shape_of_bisimulation :
    (Π (P : Coalgebra F) (ϕ₁ : P ⟶ 𝔸) (ϕ₂ : P ⟶ Β),
        let R : set (𝔸 × Β) :=
            λ ab : 𝔸 × Β , ∃ p ,ϕ₁ p = ab.1 ∧ ϕ₂ p = ab.2 in
        is_bisimulation R)
    :=
    begin
        intros P ϕ₁ ϕ₂ R,
        let ϕ : P.carrier → R := λ p,
            let ϕ_p : 𝔸 × Β := ⟨ϕ₁ p,  ϕ₂ p⟩ in
            have ϕ_p_R : ϕ_p ∈ R := exists.intro p
                ⟨(by simp : ϕ₁ p = ϕ_p.1), (by simp : ϕ₂ p = ϕ_p.2)⟩,
            ⟨ϕ_p,  ϕ_p_R⟩,
        have sur : surjective ϕ := λ r, by tidy,
        let μ : R → P := surj_inv sur,
        let ρ : R → F.obj R := (F.map ϕ) ∘ P.α ∘ μ,
        use ρ,
        let π₁ : R → 𝔸 := λ r, r.val.1,
        let π₂ : R → Β := λ r, r.val.2,
        have hom_ϕ₁ : 𝔸.α ∘ ϕ₁ = (F.map ϕ₁) ∘ P.α := ϕ₁.property,
        have hom_ϕ₂ : Β.α ∘ ϕ₂ = (F.map ϕ₂) ∘ P.α := ϕ₂.property,
        have inv_id : ϕ ∘ μ = @id R := funext (surj_inv_eq sur),

        have hom_π₁ : (F.map π₁) ∘ ρ = 𝔸.α ∘ π₁ :=
            calc (F.map π₁) ∘ ρ =  ((F.map π₁) ⊚ (F.map ϕ)) ∘ P.α ∘ μ : rfl
                    ... = (F.map (π₁ ⊚ ϕ)) ∘ P.α ∘ μ              : by rw functor.map_comp
                    ... = ((F.map ϕ₁) ∘ P.α) ∘ μ                   : rfl
                    ... = 𝔸.α ∘ ϕ₁ ∘ μ                             : by rw ←hom_ϕ₁
                    ... = 𝔸.α ∘ π₁ ∘ ϕ ∘ μ                         : rfl
                    ... = 𝔸.α ∘ π₁ ∘ id                            : by rw inv_id,

        have hom_π₂ : (F.map π₂) ∘ ρ = Β.α ∘ π₂ :=
            calc (F.map π₂) ∘ ρ =  ((F.map π₂) ⊚ (F.map ϕ)) ∘ P.α ∘ μ   : rfl
                    ... = (F.map (π₂ ⊚ ϕ)) ∘ P.α ∘ μ              : by rw functor.map_comp
                    ... = ((F.map ϕ₂) ∘ P.α) ∘ μ                   : rfl
                    ... = Β.α ∘ ϕ₂ ∘ μ                             : by rw ← hom_ϕ₂
                    ... = Β.α ∘ π₂ ∘ ϕ ∘ μ                         : rfl
                    ... = Β.α ∘ π₂ ∘ id                            : by rw inv_id,

        exact ⟨(eq.symm hom_π₁), (eq.symm hom_π₂)⟩
    end

end Bisimulation


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

! This file was ported from Lean 3 source module data.set.accumulate
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Lattice

/-!
# Accumulate

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

The function `accumulate` takes a set `s` and returns `⋃ y ≤ x, s y`.
-/

variable {α β γ : Type _} {s : α → Set β} {t : α → Set γ}

namespace Set

#print Set.Accumulate /-
/-- `accumulate s` is the union of `s y` for `y ≤ x`. -/
def Accumulate [LE α] (s : α → Set β) (x : α) : Set β :=
  ⋃ y ≤ x, s y
#align set.accumulate Set.Accumulate
-/

variable {s}

/- warning: set.accumulate_def -> Set.accumulate_def is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s : α -> (Set.{u2} β)} [_inst_1 : LE.{u1} α] {x : α}, Eq.{succ u2} (Set.{u2} β) (Set.Accumulate.{u1, u2} α β _inst_1 s x) (Set.unionᵢ.{u2, succ u1} β α (fun (y : α) => Set.unionᵢ.{u2, 0} β (LE.le.{u1} α _inst_1 y x) (fun (H : LE.le.{u1} α _inst_1 y x) => s y)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s : α -> (Set.{u1} β)} [_inst_1 : LE.{u2} α] {x : α}, Eq.{succ u1} (Set.{u1} β) (Set.Accumulate.{u2, u1} α β _inst_1 s x) (Set.unionᵢ.{u1, succ u2} β α (fun (y : α) => Set.unionᵢ.{u1, 0} β (LE.le.{u2} α _inst_1 y x) (fun (H : LE.le.{u2} α _inst_1 y x) => s y)))
Case conversion may be inaccurate. Consider using '#align set.accumulate_def Set.accumulate_defₓ'. -/
theorem accumulate_def [LE α] {x : α} : Accumulate s x = ⋃ y ≤ x, s y :=
  rfl
#align set.accumulate_def Set.accumulate_def

/- warning: set.mem_accumulate -> Set.mem_accumulate is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s : α -> (Set.{u2} β)} [_inst_1 : LE.{u1} α] {x : α} {z : β}, Iff (Membership.Mem.{u2, u2} β (Set.{u2} β) (Set.hasMem.{u2} β) z (Set.Accumulate.{u1, u2} α β _inst_1 s x)) (Exists.{succ u1} α (fun (y : α) => Exists.{0} (LE.le.{u1} α _inst_1 y x) (fun (H : LE.le.{u1} α _inst_1 y x) => Membership.Mem.{u2, u2} β (Set.{u2} β) (Set.hasMem.{u2} β) z (s y))))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s : α -> (Set.{u1} β)} [_inst_1 : LE.{u2} α] {x : α} {z : β}, Iff (Membership.mem.{u1, u1} β (Set.{u1} β) (Set.instMembershipSet.{u1} β) z (Set.Accumulate.{u2, u1} α β _inst_1 s x)) (Exists.{succ u2} α (fun (y : α) => And (LE.le.{u2} α _inst_1 y x) (Membership.mem.{u1, u1} β (Set.{u1} β) (Set.instMembershipSet.{u1} β) z (s y))))
Case conversion may be inaccurate. Consider using '#align set.mem_accumulate Set.mem_accumulateₓ'. -/
@[simp]
theorem mem_accumulate [LE α] {x : α} {z : β} : z ∈ Accumulate s x ↔ ∃ y ≤ x, z ∈ s y :=
  mem_unionᵢ₂
#align set.mem_accumulate Set.mem_accumulate

/- warning: set.subset_accumulate -> Set.subset_accumulate is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s : α -> (Set.{u2} β)} [_inst_1 : Preorder.{u1} α] {x : α}, HasSubset.Subset.{u2} (Set.{u2} β) (Set.hasSubset.{u2} β) (s x) (Set.Accumulate.{u1, u2} α β (Preorder.toLE.{u1} α _inst_1) s x)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s : α -> (Set.{u1} β)} [_inst_1 : Preorder.{u2} α] {x : α}, HasSubset.Subset.{u1} (Set.{u1} β) (Set.instHasSubsetSet.{u1} β) (s x) (Set.Accumulate.{u2, u1} α β (Preorder.toLE.{u2} α _inst_1) s x)
Case conversion may be inaccurate. Consider using '#align set.subset_accumulate Set.subset_accumulateₓ'. -/
theorem subset_accumulate [Preorder α] {x : α} : s x ⊆ Accumulate s x := fun z => mem_bunionᵢ le_rfl
#align set.subset_accumulate Set.subset_accumulate

/- warning: set.monotone_accumulate -> Set.monotone_accumulate is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s : α -> (Set.{u2} β)} [_inst_1 : Preorder.{u1} α], Monotone.{u1, u2} α (Set.{u2} β) _inst_1 (PartialOrder.toPreorder.{u2} (Set.{u2} β) (CompleteSemilatticeInf.toPartialOrder.{u2} (Set.{u2} β) (CompleteLattice.toCompleteSemilatticeInf.{u2} (Set.{u2} β) (Order.Coframe.toCompleteLattice.{u2} (Set.{u2} β) (CompleteDistribLattice.toCoframe.{u2} (Set.{u2} β) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u2} (Set.{u2} β) (Set.completeBooleanAlgebra.{u2} β))))))) (Set.Accumulate.{u1, u2} α β (Preorder.toLE.{u1} α _inst_1) s)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s : α -> (Set.{u1} β)} [_inst_1 : Preorder.{u2} α], Monotone.{u2, u1} α (Set.{u1} β) _inst_1 (PartialOrder.toPreorder.{u1} (Set.{u1} β) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} β) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} β) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} β) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} β) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} β) (Set.instCompleteBooleanAlgebraSet.{u1} β))))))) (Set.Accumulate.{u2, u1} α β (Preorder.toLE.{u2} α _inst_1) s)
Case conversion may be inaccurate. Consider using '#align set.monotone_accumulate Set.monotone_accumulateₓ'. -/
theorem monotone_accumulate [Preorder α] : Monotone (Accumulate s) := fun x y hxy =>
  bunionᵢ_subset_bunionᵢ_left fun z hz => le_trans hz hxy
#align set.monotone_accumulate Set.monotone_accumulate

/- warning: set.bUnion_accumulate -> Set.bunionᵢ_accumulate is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s : α -> (Set.{u2} β)} [_inst_1 : Preorder.{u1} α] (x : α), Eq.{succ u2} (Set.{u2} β) (Set.unionᵢ.{u2, succ u1} β α (fun (y : α) => Set.unionᵢ.{u2, 0} β (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) y x) (fun (H : LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) y x) => Set.Accumulate.{u1, u2} α β (Preorder.toLE.{u1} α _inst_1) s y))) (Set.unionᵢ.{u2, succ u1} β α (fun (y : α) => Set.unionᵢ.{u2, 0} β (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) y x) (fun (H : LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) y x) => s y)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s : α -> (Set.{u1} β)} [_inst_1 : Preorder.{u2} α] (x : α), Eq.{succ u1} (Set.{u1} β) (Set.unionᵢ.{u1, succ u2} β α (fun (y : α) => Set.unionᵢ.{u1, 0} β (LE.le.{u2} α (Preorder.toLE.{u2} α _inst_1) y x) (fun (H : LE.le.{u2} α (Preorder.toLE.{u2} α _inst_1) y x) => Set.Accumulate.{u2, u1} α β (Preorder.toLE.{u2} α _inst_1) s y))) (Set.unionᵢ.{u1, succ u2} β α (fun (y : α) => Set.unionᵢ.{u1, 0} β (LE.le.{u2} α (Preorder.toLE.{u2} α _inst_1) y x) (fun (H : LE.le.{u2} α (Preorder.toLE.{u2} α _inst_1) y x) => s y)))
Case conversion may be inaccurate. Consider using '#align set.bUnion_accumulate Set.bunionᵢ_accumulateₓ'. -/
theorem bunionᵢ_accumulate [Preorder α] (x : α) : (⋃ y ≤ x, Accumulate s y) = ⋃ y ≤ x, s y :=
  by
  apply subset.antisymm
  · exact Union₂_subset fun y hy => monotone_accumulate hy
  · exact Union₂_mono fun y hy => subset_accumulate
#align set.bUnion_accumulate Set.bunionᵢ_accumulate

/- warning: set.Union_accumulate -> Set.unionᵢ_accumulate is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s : α -> (Set.{u2} β)} [_inst_1 : Preorder.{u1} α], Eq.{succ u2} (Set.{u2} β) (Set.unionᵢ.{u2, succ u1} β α (fun (x : α) => Set.Accumulate.{u1, u2} α β (Preorder.toLE.{u1} α _inst_1) s x)) (Set.unionᵢ.{u2, succ u1} β α (fun (x : α) => s x))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s : α -> (Set.{u1} β)} [_inst_1 : Preorder.{u2} α], Eq.{succ u1} (Set.{u1} β) (Set.unionᵢ.{u1, succ u2} β α (fun (x : α) => Set.Accumulate.{u2, u1} α β (Preorder.toLE.{u2} α _inst_1) s x)) (Set.unionᵢ.{u1, succ u2} β α (fun (x : α) => s x))
Case conversion may be inaccurate. Consider using '#align set.Union_accumulate Set.unionᵢ_accumulateₓ'. -/
theorem unionᵢ_accumulate [Preorder α] : (⋃ x, Accumulate s x) = ⋃ x, s x :=
  by
  apply subset.antisymm
  · simp only [subset_def, mem_Union, exists_imp, mem_accumulate]
    intro z x x' hx'x hz
    exact ⟨x', hz⟩
  · exact Union_mono fun i => subset_accumulate
#align set.Union_accumulate Set.unionᵢ_accumulate

end Set


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.algebra.subalgebra.basic
import topology.algebra.module.basic

/-!
# Topological (sub)algebras

A topological algebra over a topological semiring `R` is a topological semiring with a compatible
continuous scalar multiplication by elements of `R`. We reuse typeclass `has_continuous_smul` for
topological algebras.

## Results

This is just a minimal stub for now!

The topological closure of a subalgebra is still a subalgebra,
which as an algebra is a topological algebra.
-/

open classical set topological_space algebra
open_locale classical

universes u v w

section topological_algebra
variables (R : Type*) [topological_space R] [comm_semiring R]
variables (A : Type u) [topological_space A]
variables [semiring A]

lemma continuous_algebra_map_iff_smul [algebra R A] [topological_semiring A] :
  continuous (algebra_map R A) ↔ continuous (λ p : R × A, p.1 • p.2) :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { simp only [algebra.smul_def], exact (h.comp continuous_fst).mul continuous_snd },
  { rw algebra_map_eq_smul_one', exact h.comp (continuous_id.prod_mk continuous_const) }
end

@[continuity]
lemma continuous_algebra_map [algebra R A] [topological_semiring A] [has_continuous_smul R A] :
  continuous (algebra_map R A) :=
(continuous_algebra_map_iff_smul R A).2 continuous_smul

lemma has_continuous_smul_of_algebra_map [algebra R A] [topological_semiring A]
  (h : continuous (algebra_map R A)) :
  has_continuous_smul R A :=
⟨(continuous_algebra_map_iff_smul R A).1 h⟩

end topological_algebra

section topological_algebra
variables {R : Type*} [comm_semiring R]
variables {A : Type u} [topological_space A]
variables [semiring A]
variables [algebra R A] [topological_semiring A]

/-- The closure of a subalgebra in a topological algebra as a subalgebra. -/
def subalgebra.topological_closure (s : subalgebra R A) : subalgebra R A :=
{ carrier := closure (s : set A),
  algebra_map_mem' := λ r, s.to_subsemiring.subring_topological_closure (s.algebra_map_mem r),
  .. s.to_subsemiring.topological_closure }

@[simp] lemma subalgebra.topological_closure_coe (s : subalgebra R A) :
  (s.topological_closure : set A) = closure (s : set A) :=
rfl

instance subalgebra.topological_closure_topological_semiring (s : subalgebra R A) :
  topological_semiring (s.topological_closure) :=
s.to_subsemiring.topological_closure_topological_semiring

instance subalgebra.topological_closure_topological_algebra
  [topological_space R] [has_continuous_smul R A] (s : subalgebra R A) :
  has_continuous_smul R (s.topological_closure) :=
s.to_submodule.topological_closure_has_continuous_smul

lemma subalgebra.subalgebra_topological_closure (s : subalgebra R A) :
  s ≤ s.topological_closure :=
subset_closure

lemma subalgebra.is_closed_topological_closure (s : subalgebra R A) :
  is_closed (s.topological_closure : set A) :=
by convert is_closed_closure

lemma subalgebra.topological_closure_minimal
  (s : subalgebra R A) {t : subalgebra R A} (h : s ≤ t) (ht : is_closed (t : set A)) :
  s.topological_closure ≤ t :=
closure_minimal h ht

/-- If a subalgebra of a topological algebra is commutative, then so is its topological closure. -/
def subalgebra.comm_semiring_topological_closure [t2_space A] (s : subalgebra R A)
  (hs : ∀ (x y : s), x * y = y * x) : comm_semiring s.topological_closure :=
{ ..s.topological_closure.to_semiring,
  ..s.to_submonoid.comm_monoid_topological_closure hs }

/--
This is really a statement about topological algebra isomorphisms,
but we don't have those, so we use the clunky approach of talking about
an algebra homomorphism, and a separate homeomorphism,
along with a witness that as functions they are the same.
-/
lemma subalgebra.topological_closure_comap'_homeomorph
  (s : subalgebra R A)
  {B : Type*} [topological_space B] [ring B] [topological_ring B] [algebra R B]
  (f : B →ₐ[R] A) (f' : B ≃ₜ A) (w : (f : B → A) = f') :
  s.topological_closure.comap' f = (s.comap' f).topological_closure :=
begin
  apply set_like.ext',
  simp only [subalgebra.topological_closure_coe],
  simp only [subalgebra.coe_comap, subsemiring.coe_comap, alg_hom.coe_to_ring_hom],
  rw [w],
  exact f'.preimage_closure _,
end

end topological_algebra

section ring
variables {R : Type*} [comm_ring R]
variables {A : Type u} [topological_space A]
variables [ring A]
variables [algebra R A] [topological_ring A]

/-- If a subalgebra of a topological algebra is commutative, then so is its topological closure. -/
def subalgebra.comm_ring_topological_closure [t2_space A] (s : subalgebra R A)
  (hs : ∀ (x y : s), x * y = y * x) : comm_ring s.topological_closure :=
{ ..s.topological_closure.to_ring,
  ..s.to_submonoid.comm_monoid_topological_closure hs }

end ring


/-
Copyright (c) 2021 Aaron Anderson, Jesse Michael Han, Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn
-/
import data.finset.basic
import model_theory.syntax

/-!
# Basics on First-Order Semantics
This file defines the interpretations of first-order terms, formulas, sentences, and theories
in a style inspired by the [Flypitch project](https://flypitch.github.io/).

## Main Definitions
* `first_order.language.term.realize` is defined so that `t.realize v` is the term `t` evaluated at
variables `v`.
* `first_order.language.bounded_formula.realize` is defined so that `φ.realize v xs` is the bounded
formula `φ` evaluated at tuples of variables `v` and `xs`.
* `first_order.language.formula.realize` is defined so that `φ.realize v` is the formula `φ`
evaluated at variables `v`.
* `first_order.language.sentence.realize` is defined so that `φ.realize M` is the sentence `φ`
evaluated in the structure `M`. Also denoted `M ⊨ φ`.
* `first_order.language.Theory.model` is defined so that `T.model M` is true if and only if every
sentence of `T` is realized in `M`. Also denoted `T ⊨ φ`.

## Main Results
* `first_order.language.bounded_formula.realize_to_prenex` shows that the prenex normal form of a
formula has the same realization as the original formula.
* Several results in this file show that syntactic constructions such as `relabel`, `cast_le`,
`lift_at`, `subst`, and the actions of language maps commute with realization of terms, formulas,
sentences, and theories.

## Implementation Notes
* Formulas use a modified version of de Bruijn variables. Specifically, a `L.bounded_formula α n`
is a formula with some variables indexed by a type `α`, which cannot be quantified over, and some
indexed by `fin n`, which can. For any `φ : L.bounded_formula α (n + 1)`, we define the formula
`∀' φ : L.bounded_formula α n` by universally quantifying over the variable indexed by
`n : fin (n + 1)`.

## References
For the Flypitch project:
- [J. Han, F. van Doorn, *A formal proof of the independence of the continuum hypothesis*]
[flypitch_cpp]
- [J. Han, F. van Doorn, *A formalization of forcing and the unprovability of
the continuum hypothesis*][flypitch_itp]

-/

universes u v w u' v'

namespace first_order
namespace language

variables {L : language.{u v}} {L' : language}
variables {M : Type w} {N P : Type*} [L.Structure M] [L.Structure N] [L.Structure P]
variables {α : Type u'} {β : Type v'}
open_locale first_order cardinal
open Structure cardinal fin

namespace term

/-- A term `t` with variables indexed by `α` can be evaluated by giving a value to each variable. -/
@[simp] def realize (v : α → M) :
  ∀ (t : L.term α), M
| (var k)         := v k
| (func f ts)     := fun_map f (λ i, (ts i).realize)

@[simp] lemma realize_relabel {t : L.term α} {g : α → β} {v : β → M} :
  (t.relabel g).realize v = t.realize (v ∘ g) :=
begin
  induction t with _ n f ts ih,
  { refl, },
  { simp [ih] }
end

@[simp] lemma realize_lift_at {n n' m : ℕ} {t : L.term (α ⊕ fin n)}
  {v : α ⊕ fin (n + n') → M} :
  (t.lift_at n' m).realize v = t.realize (v ∘
    (sum.map id (λ i, if ↑i < m then fin.cast_add n' i else fin.add_nat n' i))) :=
realize_relabel

@[simp] lemma realize_constants {c : L.constants} {v : α → M} :
  c.term.realize v = c :=
fun_map_eq_coe_constants

@[simp] lemma realize_functions_apply₁ {f : L.functions 1} {t : L.term α} {v : α → M} :
  (f.apply₁ t).realize v = fun_map f ![t.realize v] :=
begin
  rw [functions.apply₁, term.realize],
  refine congr rfl (funext (λ i, _)),
  simp only [matrix.cons_val_fin_one],
end

@[simp] lemma realize_functions_apply₂ {f : L.functions 2} {t₁ t₂ : L.term α} {v : α → M} :
  (f.apply₂ t₁ t₂).realize v = fun_map f ![t₁.realize v, t₂.realize v] :=
begin
  rw [functions.apply₂, term.realize],
  refine congr rfl (funext (fin.cases _ _)),
  { simp only [matrix.cons_val_zero], },
  { simp only [matrix.cons_val_succ, matrix.cons_val_fin_one, forall_const] }
end

lemma realize_con {A : set M} {a : A} {v : α → M} :
  (L.con a).term.realize v = a := rfl

@[simp] lemma realize_subst {t : L.term α} {tf : α → L.term β} {v : β → M} :
  (t.subst tf).realize v = t.realize (λ a, (tf a).realize v) :=
begin
  induction t with _ _ _ _ ih,
  { refl },
  { simp [ih] }
end

@[simp] lemma realize_restrict_var [decidable_eq α] {t : L.term α} {s : set α}
  (h : ↑t.var_finset ⊆ s) {v : α → M} :
  (t.restrict_var (set.inclusion h)).realize (v ∘ coe) = t.realize v :=
begin
  induction t with _ _ _ _ ih,
  { refl },
  { simp_rw [var_finset, finset.coe_bUnion, set.Union_subset_iff] at h,
    exact congr rfl (funext (λ i, ih i (h i (finset.mem_univ i)))) },
end

@[simp] lemma realize_restrict_var_left [decidable_eq α] {γ : Type*}
  {t : L.term (α ⊕ γ)} {s : set α}
  (h : ↑t.var_finset_left ⊆ s) {v : α → M} {xs : γ → M} :
  (t.restrict_var_left (set.inclusion h)).realize (sum.elim (v ∘ coe) xs) =
    t.realize (sum.elim v xs) :=
begin
  induction t with a _ _ _ ih,
  { cases a;
    refl },
  { simp_rw [var_finset_left, finset.coe_bUnion, set.Union_subset_iff] at h,
    exact congr rfl (funext (λ i, ih i (h i (finset.mem_univ i)))) },
end

@[simp] lemma realize_constants_to_vars [L[[α]].Structure M]
  [(Lhom_with_constants L α).is_expansion_on M]
  {t : L[[α]].term β} {v : β → M} :
  t.constants_to_vars.realize (sum.elim (λ a, ↑(L.con a)) v) = t.realize v :=
begin
  induction t with _ n f _ ih,
  { simp },
  { cases n,
    { cases f,
      { simp [ih], },
      { simp only [realize, constants_to_vars, sum.elim_inl, fun_map_eq_coe_constants],
        refl } },
    { cases f,
      { simp [ih] },
      { exact is_empty_elim f } } }
end

@[simp] lemma realize_vars_to_constants [L[[α]].Structure M]
  [(Lhom_with_constants L α).is_expansion_on M]
  {t : L.term (α ⊕ β)} {v : β → M} :
  t.vars_to_constants.realize v = t.realize (sum.elim (λ a, ↑(L.con a)) v) :=
begin
  induction t with ab n f ts ih,
  { cases ab;
    simp [language.con], },
  { simp [ih], }
end

lemma realize_constants_vars_equiv_left [L[[α]].Structure M]
  [(Lhom_with_constants L α).is_expansion_on M]
  {n} {t : L[[α]].term (β ⊕ fin n)} {v : β → M} {xs : fin n → M} :
  (constants_vars_equiv_left t).realize (sum.elim (sum.elim (λ a, ↑(L.con a)) v) xs) =
    t.realize (sum.elim v xs) :=
begin
  simp only [constants_vars_equiv_left, realize_relabel, equiv.coe_trans, function.comp_app,
    constants_vars_equiv_apply, relabel_equiv_symm_apply],
  refine trans _ (realize_constants_to_vars),
  rcongr,
  rcases x with (a | (b | i));
  simp,
end

end term

namespace Lhom

@[simp] lemma realize_on_term [L'.Structure M] (φ : L →ᴸ L') [φ.is_expansion_on M]
  (t : L.term α) (v : α → M) :
  (φ.on_term t).realize v = t.realize v :=
begin
  induction t with _ n f ts ih,
  { refl },
  { simp only [term.realize, Lhom.on_term, Lhom.map_on_function, ih] }
end

end Lhom

@[simp] lemma hom.realize_term (g : M →[L] N) {t : L.term α} {v : α → M} :
  t.realize (g ∘ v) = g (t.realize v) :=
begin
  induction t,
  { refl },
  { rw [term.realize, term.realize, g.map_fun],
    refine congr rfl _,
    ext x,
    simp [t_ih x], },
end

@[simp] lemma embedding.realize_term {v : α → M}
  (t : L.term α) (g : M ↪[L] N) :
  t.realize (g ∘ v) = g (t.realize v) :=
g.to_hom.realize_term

@[simp] lemma equiv.realize_term {v : α → M}
  (t : L.term α) (g : M ≃[L] N) :
  t.realize (g ∘ v) = g (t.realize v) :=
g.to_hom.realize_term

variables {L} {α} {n : ℕ}

namespace bounded_formula
open term

/-- A bounded formula can be evaluated as true or false by giving values to each free variable. -/
def realize :
  ∀ {l} (f : L.bounded_formula α l) (v : α → M) (xs : fin l → M), Prop
| _ falsum                        v xs := false
| _ (bounded_formula.equal t₁ t₂) v xs := t₁.realize (sum.elim v xs) = t₂.realize (sum.elim v xs)
| _ (bounded_formula.rel R ts)    v xs := rel_map R (λ i, (ts i).realize (sum.elim v xs))
| _ (bounded_formula.imp f₁ f₂)   v xs := realize f₁ v xs → realize f₂ v xs
| _ (bounded_formula.all f)       v xs := ∀(x : M), realize f v (snoc xs x)

variables {l : ℕ} {φ ψ : L.bounded_formula α l} {θ : L.bounded_formula α l.succ}
variables {v : α → M} {xs : fin l → M}

@[simp] lemma realize_bot :
  (⊥ : L.bounded_formula α l).realize v xs ↔ false :=
iff.rfl

@[simp] lemma realize_not :
  φ.not.realize v xs ↔ ¬ φ.realize v xs :=
iff.rfl

@[simp] lemma realize_bd_equal (t₁ t₂ : L.term (α ⊕ fin l)) :
  (t₁.bd_equal t₂).realize v xs ↔
    (t₁.realize (sum.elim v xs) = t₂.realize (sum.elim v xs)) :=
iff.rfl

@[simp] lemma realize_top :
  (⊤ : L.bounded_formula α l).realize v xs ↔ true :=
by simp [has_top.top]

@[simp] lemma realize_inf : (φ ⊓ ψ).realize v xs ↔ (φ.realize v xs ∧ ψ.realize v xs) :=
by simp [has_inf.inf, realize]

@[simp] lemma realize_foldr_inf (l : list (L.bounded_formula α n))
  (v : α → M) (xs : fin n → M) :
  (l.foldr (⊓) ⊤).realize v xs ↔ ∀ φ ∈ l, bounded_formula.realize φ v xs :=
begin
  induction l with φ l ih,
  { simp },
  { simp [ih] }
end

@[simp] lemma realize_imp : (φ.imp ψ).realize v xs ↔ (φ.realize v xs → ψ.realize v xs) :=
by simp only [realize]

@[simp] lemma realize_rel {k : ℕ} {R : L.relations k} {ts : fin k → L.term _} :
  (R.bounded_formula ts).realize v xs ↔ rel_map R (λ i, (ts i).realize (sum.elim v xs)) :=
iff.rfl

@[simp] lemma realize_rel₁ {R : L.relations 1} {t : L.term _} :
  (R.bounded_formula₁ t).realize v xs ↔ rel_map R ![t.realize (sum.elim v xs)] :=
begin
  rw [relations.bounded_formula₁, realize_rel, iff_eq_eq],
  refine congr rfl (funext (λ _, _)),
  simp only [matrix.cons_val_fin_one],
end

@[simp] lemma realize_rel₂ {R : L.relations 2} {t₁ t₂ : L.term _} :
  (R.bounded_formula₂ t₁ t₂).realize v xs ↔
    rel_map R ![t₁.realize (sum.elim v xs), t₂.realize (sum.elim v xs)] :=
begin
  rw [relations.bounded_formula₂, realize_rel, iff_eq_eq],
  refine congr rfl (funext (fin.cases _ _)),
  { simp only [matrix.cons_val_zero]},
  { simp only [matrix.cons_val_succ, matrix.cons_val_fin_one, forall_const] }
end

@[simp] lemma realize_sup : (φ ⊔ ψ).realize v xs ↔ (φ.realize v xs ∨ ψ.realize v xs) :=
begin
  simp only [realize, has_sup.sup, realize_not, eq_iff_iff],
  tauto,
end

@[simp] lemma realize_foldr_sup (l : list (L.bounded_formula α n))
  (v : α → M) (xs : fin n → M) :
  (l.foldr (⊔) ⊥).realize v xs ↔ ∃ φ ∈ l, bounded_formula.realize φ v xs :=
begin
  induction l with φ l ih,
  { simp },
  { simp_rw [list.foldr_cons, realize_sup, ih, exists_prop, list.mem_cons_iff,
      or_and_distrib_right, exists_or_distrib, exists_eq_left] }
end

@[simp] lemma realize_all : (all θ).realize v xs ↔ ∀ (a : M), (θ.realize v (fin.snoc xs a)) :=
iff.rfl

@[simp] lemma realize_ex : θ.ex.realize v xs ↔ ∃ (a : M), (θ.realize v (fin.snoc xs a)) :=
begin
  rw [bounded_formula.ex, realize_not, realize_all, not_forall],
  simp_rw [realize_not, not_not],
end

@[simp] lemma realize_iff : (φ.iff ψ).realize v xs ↔ (φ.realize v xs ↔ ψ.realize v xs) :=
by simp only [bounded_formula.iff, realize_inf, realize_imp, and_imp, ← iff_def]

lemma realize_cast_le_of_eq {m n : ℕ} (h : m = n) {h' : m ≤ n} {φ : L.bounded_formula α m}
  {v : α → M} {xs : fin n → M} :
  (φ.cast_le h').realize v xs ↔ φ.realize v (xs ∘ fin.cast h) :=
begin
  subst h,
  simp only [cast_le_rfl, cast_refl, order_iso.coe_refl, function.comp.right_id],
end

lemma realize_map_term_rel_id [L'.Structure M]
  {ft : ∀ n, L.term (α ⊕ fin n) → L'.term (β ⊕ fin n)}
  {fr : ∀ n, L.relations n → L'.relations n}
  {n} {φ : L.bounded_formula α n} {v : α → M} {v' : β → M} {xs : fin n → M}
  (h1 : ∀ n (t : L.term (α ⊕ fin n)) (xs : fin n → M),
    (ft n t).realize (sum.elim v' xs) = t.realize (sum.elim v xs))
  (h2 : ∀ n (R : L.relations n) (x : fin n → M), rel_map (fr n R) x = rel_map R x) :
  (φ.map_term_rel ft fr (λ _, id)).realize v' xs ↔ φ.realize v xs :=
begin
  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih,
  { refl },
  { simp [map_term_rel, realize, h1] },
  { simp [map_term_rel, realize, h1, h2] },
  { simp [map_term_rel, realize, ih1, ih2], },
  { simp only [map_term_rel, realize, ih, id.def] },
end

lemma realize_map_term_rel_add_cast_le [L'.Structure M]
  {k : ℕ}
  {ft : ∀ n, L.term (α ⊕ fin n) → L'.term (β ⊕ fin (k + n))}
  {fr : ∀ n, L.relations n → L'.relations n}
  {n} {φ : L.bounded_formula α n} (v : ∀ {n}, (fin (k + n) → M) → α → M) {v' : β → M}
  (xs : fin (k + n) → M)
  (h1 : ∀ n (t : L.term (α ⊕ fin n)) (xs' : fin (k + n) → M),
    (ft n t).realize (sum.elim v' xs') =
    t.realize (sum.elim (v xs') (xs' ∘ fin.nat_add _)))
  (h2 : ∀ n (R : L.relations n) (x : fin n → M), rel_map (fr n R) x = rel_map R x)
  (hv : ∀ n (xs : fin (k + n) → M) (x : M), @v (n+1) (snoc xs x : fin _ → M) = v xs):
  (φ.map_term_rel ft fr (λ n, cast_le (add_assoc _ _ _).symm.le)).realize v' xs ↔
    φ.realize (v xs) (xs ∘ fin.nat_add _) :=
begin
  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih,
  { refl },
  { simp [map_term_rel, realize, h1] },
  { simp [map_term_rel, realize, h1, h2] },
  { simp [map_term_rel, realize, ih1, ih2], },
  { simp [map_term_rel, realize, ih, hv] },
end

lemma realize_relabel {m n : ℕ}
  {φ : L.bounded_formula α n} {g : α → β ⊕ fin m} {v : β → M} {xs : fin (m + n) → M} :
  (φ.relabel g).realize v xs ↔
    φ.realize (sum.elim v (xs ∘ fin.cast_add n) ∘ g) (xs ∘ fin.nat_add m) :=
by rw [relabel, realize_map_term_rel_add_cast_le]; intros; simp

lemma realize_lift_at {n n' m : ℕ} {φ : L.bounded_formula α n}
  {v : α → M} {xs : fin (n + n') → M} (hmn : m + n' ≤ n + 1) :
  (φ.lift_at n' m).realize v xs ↔ φ.realize v (xs ∘
    (λ i, if ↑i < m then fin.cast_add n' i else fin.add_nat n' i)) :=
begin
  rw lift_at,
  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 k _ ih3,
  { simp [realize, map_term_rel], },
  { simp [realize, map_term_rel, realize_rel, realize_lift_at, sum.elim_comp_map], },
  { simp [realize, map_term_rel, realize_rel, realize_lift_at, sum.elim_comp_map], },
  { simp only [map_term_rel, realize, ih1 hmn, ih2 hmn] },
  { have h : k + 1 + n' = k + n'+ 1,
    { rw [add_assoc, add_comm 1 n', ← add_assoc], },
    simp only [map_term_rel, realize, realize_cast_le_of_eq h, ih3 (hmn.trans k.succ.le_succ)],
    refine forall_congr (λ x, iff_eq_eq.mpr (congr rfl (funext (fin.last_cases _ (λ i, _))))),
    { simp only [function.comp_app, coe_last, snoc_last],
      by_cases (k < m),
      { rw if_pos h,
        refine (congr rfl (ext _)).trans (snoc_last _ _),
        simp only [coe_cast, coe_cast_add, coe_last, self_eq_add_right],
        refine le_antisymm (le_of_add_le_add_left ((hmn.trans (nat.succ_le_of_lt h)).trans _))
          n'.zero_le,
        rw add_zero },
      { rw if_neg h,
        refine (congr rfl (ext _)).trans (snoc_last _ _),
        simp } },
    { simp only [function.comp_app, fin.snoc_cast_succ],
      refine (congr rfl (ext _)).trans (snoc_cast_succ _ _ _),
      simp only [cast_refl, coe_cast_succ, order_iso.coe_refl, id.def],
      split_ifs;
      simp } }
end

lemma realize_lift_at_one {n m : ℕ} {φ : L.bounded_formula α n}
  {v : α → M} {xs : fin (n + 1) → M} (hmn : m ≤ n) :
  (φ.lift_at 1 m).realize v xs ↔ φ.realize v (xs ∘
    (λ i, if ↑i < m then cast_succ i else i.succ)) :=
by simp_rw [realize_lift_at (add_le_add_right hmn 1), cast_succ, add_nat_one]

@[simp] lemma realize_lift_at_one_self {n : ℕ} {φ : L.bounded_formula α n}
  {v : α → M} {xs : fin (n + 1) → M} :
  (φ.lift_at 1 n).realize v xs ↔ φ.realize v (xs ∘ cast_succ) :=
begin
  rw [realize_lift_at_one (refl n), iff_eq_eq],
  refine congr rfl (congr rfl (funext (λ i, _))),
  rw [if_pos i.is_lt],
end

lemma realize_subst {φ : L.bounded_formula α n} {tf : α → L.term β} {v : β → M} {xs : fin n → M} :
  (φ.subst tf).realize v xs ↔ φ.realize (λ a, (tf a).realize v) xs :=
realize_map_term_rel_id (λ n t x, begin
  rw term.realize_subst,
  rcongr a,
  { cases a,
    { simp only [sum.elim_inl, term.realize_relabel, sum.elim_comp_inl] },
    { refl } }
end) (by simp)

@[simp] lemma realize_restrict_free_var [decidable_eq α] {n : ℕ} {φ : L.bounded_formula α n}
  {s : set α} (h : ↑φ.free_var_finset ⊆ s) {v : α → M} {xs : fin n → M} :
  (φ.restrict_free_var (set.inclusion h)).realize (v ∘ coe) xs ↔
    φ.realize v xs :=
begin
  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3,
  { refl },
  { simp [restrict_free_var, realize] },
  { simp [restrict_free_var, realize] },
  { simp [restrict_free_var, realize, ih1, ih2] },
  { simp [restrict_free_var, realize, ih3] },
end

lemma realize_constants_vars_equiv [L[[α]].Structure M]
  [(Lhom_with_constants L α).is_expansion_on M]
  {n} {φ : L[[α]].bounded_formula β n} {v : β → M} {xs : fin n → M} :
  (constants_vars_equiv φ).realize (sum.elim (λ a, ↑(L.con a)) v) xs ↔ φ.realize v xs :=
begin
  refine realize_map_term_rel_id (λ n t xs, realize_constants_vars_equiv_left) (λ n R xs, _),
  rw ← (Lhom_with_constants L α).map_on_relation (equiv.sum_empty (L.relations n)
    ((constants_on α).relations n) R) xs,
  rcongr,
  cases R,
  { simp, },
  { exact is_empty_elim R }
end

@[simp] lemma realize_relabel_equiv {g : α ≃ β} {k} {φ : L.bounded_formula α k}
  {v : β → M} {xs : fin k → M} :
  (relabel_equiv g φ).realize v xs ↔ φ.realize (v ∘ g) xs :=
begin
  simp only [relabel_equiv, map_term_rel_equiv_apply, equiv.coe_refl],
  refine realize_map_term_rel_id (λ n t xs, _) (λ _ _ _, rfl),
  simp only [relabel_equiv_apply, term.realize_relabel],
  refine congr (congr rfl _) rfl,
  ext (i | i);
  refl,
end

variables [nonempty M]

lemma realize_all_lift_at_one_self {n : ℕ} {φ : L.bounded_formula α n}
  {v : α → M} {xs : fin n → M} :
  (φ.lift_at 1 n).all.realize v xs ↔ φ.realize v xs :=
begin
  inhabit M,
  simp only [realize_all, realize_lift_at_one_self],
  refine ⟨λ h, _, λ h a, _⟩,
  { refine (congr rfl (funext (λ i, _))).mp (h default),
    simp, },
  { refine (congr rfl (funext (λ i, _))).mp h,
    simp }
end

lemma realize_to_prenex_imp_right {φ ψ : L.bounded_formula α n}
  (hφ : is_qf φ) (hψ : is_prenex ψ) {v : α → M} {xs : fin n → M} :
  (φ.to_prenex_imp_right ψ).realize v xs ↔ (φ.imp ψ).realize v xs :=
begin
  revert φ,
  induction hψ with _ _ hψ _ _ hψ ih _ _ hψ ih; intros φ hφ,
  { rw hψ.to_prenex_imp_right },
  { refine trans (forall_congr (λ _, ih hφ.lift_at)) _,
    simp only [realize_imp, realize_lift_at_one_self, snoc_comp_cast_succ, realize_all],
    exact ⟨λ h1 a h2, h1 h2 a, λ h1 h2 a, h1 a h2⟩, },
  { rw [to_prenex_imp_right, realize_ex],
    refine trans (exists_congr (λ _, ih hφ.lift_at)) _,
    simp only [realize_imp, realize_lift_at_one_self, snoc_comp_cast_succ, realize_ex],
    refine ⟨_, λ h', _⟩,
    { rintro ⟨a, ha⟩ h,
      exact ⟨a, ha h⟩ },
    { by_cases φ.realize v xs,
      { obtain ⟨a, ha⟩ := h' h,
        exact ⟨a, λ _, ha⟩ },
      { inhabit M,
        exact ⟨default, λ h'', (h h'').elim⟩ } } }
end

lemma realize_to_prenex_imp {φ ψ : L.bounded_formula α n}
  (hφ : is_prenex φ) (hψ : is_prenex ψ) {v : α → M} {xs : fin n → M} :
  (φ.to_prenex_imp ψ).realize v xs ↔ (φ.imp ψ).realize v xs :=
begin
  revert ψ,
  induction hφ with _ _ hφ _ _ hφ ih _ _ hφ ih; intros ψ hψ,
  { rw [hφ.to_prenex_imp],
    exact realize_to_prenex_imp_right hφ hψ, },
  { rw [to_prenex_imp, realize_ex],
    refine trans (exists_congr (λ _, ih hψ.lift_at)) _,
    simp only [realize_imp, realize_lift_at_one_self, snoc_comp_cast_succ, realize_all],
    refine ⟨_, λ h', _⟩,
    { rintro ⟨a, ha⟩ h,
      exact ha (h a) },
    { by_cases ψ.realize v xs,
      { inhabit M,
        exact ⟨default, λ h'', h⟩ },
      { obtain ⟨a, ha⟩ := not_forall.1 (h ∘ h'),
        exact ⟨a, λ h, (ha h).elim⟩ } } },
  { refine trans (forall_congr (λ _, ih hψ.lift_at)) _,
    simp, },
end

@[simp] lemma realize_to_prenex (φ : L.bounded_formula α n) {v : α → M} :
  ∀ {xs : fin n → M}, φ.to_prenex.realize v xs ↔ φ.realize v xs :=
begin
  refine bounded_formula.rec_on φ
    (λ _ _, iff.rfl)
    (λ _ _ _ _, iff.rfl)
    (λ _ _ _ _ _, iff.rfl)
    (λ _ f1 f2 h1 h2 _, _)
    (λ _ f h xs, _),
  { rw [to_prenex, realize_to_prenex_imp f1.to_prenex_is_prenex f2.to_prenex_is_prenex,
      realize_imp, realize_imp, h1, h2],
    apply_instance },
  { rw [realize_all, to_prenex, realize_all],
    exact forall_congr (λ a, h) },
end

end bounded_formula

attribute [protected] bounded_formula.falsum bounded_formula.equal bounded_formula.rel
attribute [protected] bounded_formula.imp bounded_formula.all

namespace Lhom
open bounded_formula

@[simp] lemma realize_on_bounded_formula [L'.Structure M] (φ : L →ᴸ L') [φ.is_expansion_on M]
  {n : ℕ} (ψ : L.bounded_formula α n) {v : α → M} {xs : fin n → M} :
  (φ.on_bounded_formula ψ).realize v xs ↔ ψ.realize v xs :=
begin
  induction ψ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3,
  { refl },
  { simp only [on_bounded_formula, realize_bd_equal, realize_on_term],
    refl, },
  { simp only [on_bounded_formula, realize_rel, realize_on_term, Lhom.map_on_relation],
    refl, },
  { simp only [on_bounded_formula, ih1, ih2, realize_imp], },
  { simp only [on_bounded_formula, ih3, realize_all], },
end

end Lhom

attribute [protected] bounded_formula.falsum bounded_formula.equal bounded_formula.rel
attribute [protected] bounded_formula.imp bounded_formula.all

namespace formula

/-- A formula can be evaluated as true or false by giving values to each free variable. -/
def realize (φ : L.formula α) (v : α → M) : Prop :=
φ.realize v default

variables {M} {φ ψ : L.formula α} {v : α → M}

@[simp] lemma realize_not :
  (φ.not).realize v ↔ ¬ φ.realize v :=
iff.rfl

@[simp] lemma realize_bot :
  (⊥ : L.formula α).realize v ↔ false :=
iff.rfl

@[simp] lemma realize_top :
  (⊤ : L.formula α).realize v ↔ true :=
bounded_formula.realize_top

@[simp] lemma realize_inf : (φ ⊓ ψ).realize v ↔ (φ.realize v ∧ ψ.realize v) :=
bounded_formula.realize_inf

@[simp] lemma realize_imp : (φ.imp ψ).realize v ↔ (φ.realize v → ψ.realize v) :=
bounded_formula.realize_imp

@[simp] lemma realize_rel {k : ℕ} {R : L.relations k} {ts : fin k → L.term α} :
  (R.formula ts).realize v ↔ rel_map R (λ i, (ts i).realize v) :=
bounded_formula.realize_rel.trans (by simp)

@[simp] lemma realize_rel₁ {R : L.relations 1} {t : L.term _} :
  (R.formula₁ t).realize v ↔ rel_map R ![t.realize v] :=
begin
  rw [relations.formula₁, realize_rel, iff_eq_eq],
  refine congr rfl (funext (λ _, _)),
  simp only [matrix.cons_val_fin_one],
end

@[simp] lemma realize_rel₂ {R : L.relations 2} {t₁ t₂ : L.term _} :
  (R.formula₂ t₁ t₂).realize v ↔
    rel_map R ![t₁.realize v, t₂.realize v] :=
begin
  rw [relations.formula₂, realize_rel, iff_eq_eq],
  refine congr rfl (funext (fin.cases _ _)),
  { simp only [matrix.cons_val_zero]},
  { simp only [matrix.cons_val_succ, matrix.cons_val_fin_one, forall_const] }
end

@[simp] lemma realize_sup : (φ ⊔ ψ).realize v ↔ (φ.realize v ∨ ψ.realize v) :=
bounded_formula.realize_sup

@[simp] lemma realize_iff : (φ.iff ψ).realize v ↔ (φ.realize v ↔ ψ.realize v) :=
bounded_formula.realize_iff

@[simp] lemma realize_relabel {φ : L.formula α} {g : α → β} {v : β → M} :
  (φ.relabel g).realize v ↔ φ.realize (v ∘ g) :=
begin
  rw [realize, realize, relabel, bounded_formula.realize_relabel,
    iff_eq_eq, fin.cast_add_zero],
  exact congr rfl (funext fin_zero_elim),
end

lemma realize_relabel_sum_inr (φ : L.formula (fin n)) {v : empty → M} {x : fin n → M} :
  (bounded_formula.relabel sum.inr φ).realize v x ↔ φ.realize x :=
by rw [bounded_formula.realize_relabel, formula.realize, sum.elim_comp_inr, fin.cast_add_zero,
    cast_refl, order_iso.coe_refl, function.comp.right_id,
    subsingleton.elim (x ∘ (nat_add n : fin 0 → fin n)) default]

@[simp]
lemma realize_equal {t₁ t₂ : L.term α} {x : α → M} :
  (t₁.equal t₂).realize x ↔ t₁.realize x = t₂.realize x :=
by simp [term.equal, realize]

@[simp]
lemma realize_graph {f : L.functions n} {x : fin n → M} {y : M} :
  (formula.graph f).realize (fin.cons y x : _ → M) ↔ fun_map f x = y :=
begin
  simp only [formula.graph, term.realize, realize_equal, fin.cons_zero, fin.cons_succ],
  rw eq_comm,
end

end formula

@[simp] lemma Lhom.realize_on_formula [L'.Structure M] (φ : L →ᴸ L') [φ.is_expansion_on M]
  (ψ : L.formula α) {v : α → M} :
  (φ.on_formula ψ).realize v ↔ ψ.realize v :=
φ.realize_on_bounded_formula ψ

@[simp] lemma Lhom.set_of_realize_on_formula [L'.Structure M] (φ : L →ᴸ L') [φ.is_expansion_on M]
  (ψ : L.formula α) :
  (set_of (φ.on_formula ψ).realize : set (α → M)) = set_of ψ.realize :=
by { ext, simp }

variable (M)

/-- A sentence can be evaluated as true or false in a structure. -/
def sentence.realize (φ : L.sentence) : Prop :=
φ.realize (default : _ → M)

-- input using \|= or \vDash, but not using \models
infix (name := sentence.realize) ` ⊨ `:51 := sentence.realize

@[simp] lemma sentence.realize_not {φ : L.sentence} :
  M ⊨ φ.not ↔ ¬ M ⊨ φ :=
iff.rfl

namespace formula

@[simp] lemma realize_equiv_sentence_symm_con
  [L[[α]].Structure M] [(L.Lhom_with_constants α).is_expansion_on M]
  (φ : L[[α]].sentence) :
  (equiv_sentence.symm φ).realize (λ a, (L.con a : M)) ↔ φ.realize M :=
begin
  simp only [equiv_sentence, equiv.symm_symm, equiv.coe_trans, realize,
    bounded_formula.realize_relabel_equiv],
  refine trans _ bounded_formula.realize_constants_vars_equiv,
  congr' with (i | i),
  { refl },
  { exact i.elim }
end

@[simp] lemma realize_equiv_sentence
  [L[[α]].Structure M] [(L.Lhom_with_constants α).is_expansion_on M]
  (φ : L.formula α) :
  (equiv_sentence φ).realize M ↔ φ.realize (λ a, (L.con a : M)) :=
by rw [← realize_equiv_sentence_symm_con M (equiv_sentence φ),
    _root_.equiv.symm_apply_apply]

lemma realize_equiv_sentence_symm (φ : L[[α]].sentence) (v : α → M) :
  (equiv_sentence.symm φ).realize v ↔ @sentence.realize _ M
    (@language.with_constants_Structure L M _ α (constants_on.Structure v)) φ :=
begin
  letI := constants_on.Structure v,
  exact realize_equiv_sentence_symm_con M φ,
end

end formula

@[simp] lemma Lhom.realize_on_sentence [L'.Structure M] (φ : L →ᴸ L') [φ.is_expansion_on M]
  (ψ : L.sentence) :
  M ⊨ φ.on_sentence ψ ↔ M ⊨ ψ :=
φ.realize_on_formula ψ

variables (L)

/-- The complete theory of a structure `M` is the set of all sentences `M` satisfies. -/
def complete_theory : L.Theory := { φ | M ⊨ φ }

variable (N)

/-- Two structures are elementarily equivalent when they satisfy the same sentences. -/
def elementarily_equivalent : Prop := L.complete_theory M = L.complete_theory N

localized "notation (name := elementarily_equivalent) A ` ≅[`:25 L `] ` B:50 :=
  first_order.language.elementarily_equivalent L A B" in first_order

variables {L} {M} {N}

@[simp] lemma mem_complete_theory {φ : sentence L} : φ ∈ L.complete_theory M ↔ M ⊨ φ := iff.rfl

lemma elementarily_equivalent_iff : M ≅[L] N ↔ ∀ φ : L.sentence, M ⊨ φ ↔ N ⊨ φ :=
by simp only [elementarily_equivalent, set.ext_iff, complete_theory, set.mem_set_of_eq]

variables (M)

/-- A model of a theory is a structure in which every sentence is realized as true. -/
class Theory.model (T : L.Theory) : Prop :=
(realize_of_mem : ∀ φ ∈ T, M ⊨ φ)

-- input using \|= or \vDash, but not using \models
infix (name := Theory.model) ` ⊨ `:51 := Theory.model

variables {M} (T : L.Theory)

@[simp]

lemma Theory.realize_sentence_of_mem [M ⊨ T] {φ : L.sentence} (h : φ ∈ T) :
  M ⊨ φ :=
Theory.model.realize_of_mem φ h

@[simp] lemma Lhom.on_Theory_model [L'.Structure M] (φ : L →ᴸ L') [φ.is_expansion_on M]
  (T : L.Theory) :
  M ⊨ φ.on_Theory T ↔ M ⊨ T :=
by simp [Theory.model_iff, Lhom.on_Theory]

variables {M} {T}

instance model_empty : M ⊨ (∅ : L.Theory) := ⟨λ φ hφ, (set.not_mem_empty φ hφ).elim⟩

namespace Theory

lemma model.mono {T' : L.Theory} (h : M ⊨ T') (hs : T ⊆ T') :
  M ⊨ T :=
⟨λ φ hφ, T'.realize_sentence_of_mem (hs hφ)⟩

lemma model.union {T' : L.Theory} (h : M ⊨ T) (h' : M ⊨ T') :
  M ⊨ T ∪ T' :=
begin
  simp only [model_iff, set.mem_union] at *,
  exact λ φ hφ, hφ.elim (h _) (h' _),
end

@[simp] lemma model_union_iff {T' : L.Theory} :
  M ⊨ T ∪ T' ↔ M ⊨ T ∧ M ⊨ T' :=
⟨λ h, ⟨h.mono (T.subset_union_left T'), h.mono (T.subset_union_right T')⟩, λ h, h.1.union h.2⟩

lemma model_singleton_iff {φ : L.sentence} :
  M ⊨ ({φ} : L.Theory) ↔ M ⊨ φ :=
by simp

theorem model_iff_subset_complete_theory :
  M ⊨ T ↔ T ⊆ L.complete_theory M :=
T.model_iff

theorem complete_theory.subset [MT : M ⊨ T] : T ⊆ L.complete_theory M :=
model_iff_subset_complete_theory.1 MT

end Theory

instance model_complete_theory : M ⊨ L.complete_theory M :=
Theory.model_iff_subset_complete_theory.2 (subset_refl _)

variables (M N)

theorem realize_iff_of_model_complete_theory [N ⊨ L.complete_theory M] (φ : L.sentence) :
  N ⊨ φ ↔ M ⊨ φ :=
begin
  refine ⟨λ h, _, (L.complete_theory M).realize_sentence_of_mem⟩,
  contrapose! h,
  rw [← sentence.realize_not] at *,
  exact (L.complete_theory M).realize_sentence_of_mem (mem_complete_theory.2 h)
end

variables {M N}

namespace bounded_formula

@[simp] lemma realize_alls {φ : L.bounded_formula α n} {v : α → M} :
  φ.alls.realize v ↔
    ∀ (xs : fin n → M), (φ.realize v xs) :=
begin
  induction n with n ih,
  { exact unique.forall_iff.symm },
  { simp only [alls, ih, realize],
    exact ⟨λ h xs, (fin.snoc_init_self xs) ▸ h _ _, λ h xs x, h (fin.snoc xs x)⟩ }
end

@[simp] lemma realize_exs {φ : L.bounded_formula α n} {v : α → M} :
  φ.exs.realize v ↔ ∃ (xs : fin n → M), (φ.realize v xs) :=
begin
  induction n with n ih,
  { exact unique.exists_iff.symm },
  { simp only [bounded_formula.exs, ih, realize_ex],
    split,
    { rintros ⟨xs, x, h⟩,
      exact ⟨_, h⟩ },
    { rintros ⟨xs, h⟩,
      rw ← fin.snoc_init_self xs at h,
      exact ⟨_, _, h⟩ } }
end

@[simp] lemma realize_to_formula (φ : L.bounded_formula α n) (v : α ⊕ fin n → M) :
  φ.to_formula.realize v ↔ φ.realize (v ∘ sum.inl) (v ∘ sum.inr) :=
begin
  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3 a8 a9 a0,
  { refl },
  { simp [bounded_formula.realize] },
  { simp [bounded_formula.realize] },
  { rw [to_formula, formula.realize, realize_imp, ← formula.realize, ih1, ← formula.realize, ih2,
      realize_imp], },
  { rw [to_formula, formula.realize, realize_all, realize_all],
    refine forall_congr (λ a, _),
    have h := ih3 (sum.elim (v ∘ sum.inl) (snoc (v ∘ sum.inr) a)),
    simp only [sum.elim_comp_inl, sum.elim_comp_inr] at h,
    rw [← h, realize_relabel, formula.realize],
    rcongr,
    { cases x,
      { simp },
      { refine fin.last_cases _ (λ i, _) x,
        { rw [sum.elim_inr, snoc_last, function.comp_app, sum.elim_inr, function.comp_app,
            fin_sum_fin_equiv_symm_last, sum.map_inr, sum.elim_inr, function.comp_app],
          exact (congr rfl (subsingleton.elim _ _)).trans (snoc_last _ _) },
        { simp only [cast_succ, function.comp_app, sum.elim_inr,
            fin_sum_fin_equiv_symm_apply_cast_add, sum.map_inl, sum.elim_inl],
          rw [← cast_succ, snoc_cast_succ] } } },
    { exact subsingleton.elim _ _ } }
end

end bounded_formula

namespace equiv

@[simp] lemma realize_bounded_formula (g : M ≃[L] N) (φ : L.bounded_formula α n)
  {v : α → M} {xs : fin n → M} :
  φ.realize (g ∘ v) (g ∘ xs) ↔ φ.realize v xs :=
begin
  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3,
  { refl },
  { simp only [bounded_formula.realize, ← sum.comp_elim, equiv.realize_term, g.injective.eq_iff] },
  { simp only [bounded_formula.realize, ← sum.comp_elim, equiv.realize_term, g.map_rel], },
  { rw [bounded_formula.realize, ih1, ih2, bounded_formula.realize] },
  { rw [bounded_formula.realize, bounded_formula.realize],
    split,
    { intros h a,
      have h' := h (g a),
      rw [← fin.comp_snoc, ih3] at h',
      exact h' },
    { intros h a,
      have h' := h (g.symm a),
      rw [← ih3, fin.comp_snoc, g.apply_symm_apply] at h',
      exact h' }}
end

@[simp] lemma realize_formula (g : M ≃[L] N) (φ : L.formula α) {v : α → M} :
  φ.realize (g ∘ v) ↔ φ.realize v :=
by rw [formula.realize, formula.realize, ← g.realize_bounded_formula φ,
    iff_eq_eq, unique.eq_default (g ∘ default)]

lemma realize_sentence (g : M ≃[L] N) (φ : L.sentence) :
  M ⊨ φ ↔ N ⊨ φ :=
by rw [sentence.realize, sentence.realize, ← g.realize_formula, unique.eq_default (g ∘ default)]

lemma Theory_model (g : M ≃[L] N) [M ⊨ T] : N ⊨ T :=
⟨λ φ hφ, (g.realize_sentence φ).1 (Theory.realize_sentence_of_mem T hφ)⟩

lemma elementarily_equivalent (g : M ≃[L] N) : M ≅[L] N :=
elementarily_equivalent_iff.2 g.realize_sentence

end equiv

namespace relations
open bounded_formula

variable {r : L.relations 2}

@[simp]
lemma realize_reflexive :
  M ⊨ r.reflexive ↔ reflexive (λ (x y : M), rel_map r ![x,y]) :=
forall_congr (λ _, realize_rel₂)

@[simp]
lemma realize_irreflexive :
  M ⊨ r.irreflexive ↔ irreflexive (λ (x y : M), rel_map r ![x,y]) :=
forall_congr (λ _, not_congr realize_rel₂)

@[simp]
lemma realize_symmetric :
  M ⊨ r.symmetric ↔ symmetric (λ (x y : M), rel_map r ![x,y]) :=
forall_congr (λ _, forall_congr (λ _, imp_congr realize_rel₂ realize_rel₂))

@[simp]
lemma realize_antisymmetric :
  M ⊨ r.antisymmetric ↔ anti_symmetric (λ (x y : M), rel_map r ![x,y]) :=
forall_congr (λ _, forall_congr (λ _, imp_congr realize_rel₂ (imp_congr realize_rel₂ iff.rfl)))

@[simp]
lemma realize_transitive :
  M ⊨ r.transitive ↔ transitive (λ (x y : M), rel_map r ![x,y]) :=
forall_congr (λ _, forall_congr (λ _, forall_congr
  (λ _, imp_congr realize_rel₂ (imp_congr realize_rel₂ realize_rel₂))))

@[simp]
lemma realize_total :
  M ⊨ r.total ↔ total (λ (x y : M), rel_map r ![x,y]) :=
forall_congr (λ _, forall_congr (λ _, realize_sup.trans (or_congr realize_rel₂ realize_rel₂)))

end relations

section cardinality

variable (L)

@[simp] lemma sentence.realize_card_ge (n) : M ⊨ (sentence.card_ge L n) ↔ ↑n ≤ (# M) :=
begin
  rw [← lift_mk_fin, ← lift_le, lift_lift, lift_mk_le, sentence.card_ge, sentence.realize,
    bounded_formula.realize_exs],
  simp_rw [bounded_formula.realize_foldr_inf],
  simp only [function.comp_app, list.mem_map, prod.exists, ne.def, list.mem_product,
    list.mem_fin_range, forall_exists_index, and_imp, list.mem_filter, true_and],
  refine ⟨_, λ xs, ⟨xs.some, _⟩⟩,
  { rintro ⟨xs, h⟩,
    refine ⟨⟨xs, λ i j ij, _⟩⟩,
    contrapose! ij,
    have hij := h _ i j ij rfl,
    simp only [bounded_formula.realize_not, term.realize, bounded_formula.realize_bd_equal,
      sum.elim_inr] at hij,
    exact hij },
  { rintro _ i j ij rfl,
    simp [ij] }
end

@[simp] lemma model_infinite_theory_iff : M ⊨ L.infinite_theory ↔ infinite M :=
by simp [infinite_theory, infinite_iff, aleph_0_le]

instance model_infinite_theory [h : infinite M] :
  M ⊨ L.infinite_theory :=
L.model_infinite_theory_iff.2 h

@[simp] lemma model_nonempty_theory_iff :
  M ⊨ L.nonempty_theory ↔ nonempty M :=
by simp only [nonempty_theory, Theory.model_iff, set.mem_singleton_iff, forall_eq,
    sentence.realize_card_ge, nat.cast_one, one_le_iff_ne_zero, mk_ne_zero_iff]

instance model_nonempty [h : nonempty M] :
  M ⊨ L.nonempty_theory :=
L.model_nonempty_theory_iff.2 h

lemma model_distinct_constants_theory {M : Type w} [L[[α]].Structure M] (s : set α) :
  M ⊨ L.distinct_constants_theory s ↔ set.inj_on (λ (i : α), (L.con i : M)) s :=
begin
  simp only [distinct_constants_theory, Theory.model_iff, set.mem_image,
    set.mem_inter, set.mem_prod, set.mem_compl, prod.exists, forall_exists_index, and_imp],
  refine ⟨λ h a as b bs ab, _, _⟩,
  { contrapose! ab,
    have h' := h _ a b ⟨⟨as, bs⟩, ab⟩ rfl,
    simp only [sentence.realize, formula.realize_not, formula.realize_equal,
      term.realize_constants] at h',
    exact h', },
  { rintros h φ a b ⟨⟨as, bs⟩, ab⟩ rfl,
    simp only [sentence.realize, formula.realize_not, formula.realize_equal,
      term.realize_constants],
    exact λ contra, ab (h as bs contra) }
end

lemma card_le_of_model_distinct_constants_theory (s : set α) (M : Type w) [L[[α]].Structure M]
  [h : M ⊨ L.distinct_constants_theory s] :
  cardinal.lift.{w} (# s) ≤ cardinal.lift.{u'} (# M) :=
lift_mk_le'.2 ⟨⟨_, set.inj_on_iff_injective.1 ((L.model_distinct_constants_theory s).1 h)⟩⟩

end cardinality

namespace elementarily_equivalent

@[symm] lemma symm (h : M ≅[L] N) : N ≅[L] M := h.symm

@[trans] lemma trans (MN : M ≅[L] N) (NP : N ≅[L] P) : M ≅[L] P := MN.trans NP

lemma complete_theory_eq (h : M ≅[L] N) : L.complete_theory M = L.complete_theory N := h

lemma realize_sentence (h : M ≅[L] N) (φ : L.sentence) : M ⊨ φ ↔ N ⊨ φ :=
(elementarily_equivalent_iff.1 h) φ

lemma Theory_model_iff (h : M ≅[L] N) : M ⊨ T ↔ N ⊨ T :=
by rw [Theory.model_iff_subset_complete_theory, Theory.model_iff_subset_complete_theory,
    h.complete_theory_eq]

lemma Theory_model [MT : M ⊨ T] (h : M ≅[L] N) : N ⊨ T :=
h.Theory_model_iff.1 MT

lemma nonempty_iff (h : M ≅[L] N) : nonempty M ↔ nonempty N :=
(model_nonempty_theory_iff L).symm.trans (h.Theory_model_iff.trans (model_nonempty_theory_iff L))

lemma nonempty [Mn : nonempty M] (h : M ≅[L] N) : nonempty N := h.nonempty_iff.1 Mn

lemma infinite_iff (h : M ≅[L] N) : infinite M ↔ infinite N :=
(model_infinite_theory_iff L).symm.trans (h.Theory_model_iff.trans (model_infinite_theory_iff L))

lemma infinite [Mi : infinite M] (h : M ≅[L] N) : infinite N := h.infinite_iff.1 Mi

end elementarily_equivalent

end language
end first_order