import GMLInit.Meta.Prelude

theorem eqRec_eq_cast {α} {a b : α} {motive : (b : α) → a = b → Sort _} (t : motive a rfl) (h : a = b) : Eq.rec t h = cast (show motive a rfl = motive b h by cases h; rfl) t := by cases h; rfl

theorem eqNdrec_eq_cast {α} {a b : α} {motive : α → Sort _} (t : motive a) (h : a = b) : Eq.ndrec t h = cast (h ▸ rfl) t := by cases h; rfl

theorem eqNdrec_symm {α} {motive : α → Sort _} {a b : α} (h : a = b) (x : motive a) (y : motive b) : Eq.ndrec x h = y ↔ x = Eq.ndrec y h.symm := by cases h; exact Iff.rfl

@[elim_casts] theorem cast_irrel {α β} (h₁ h₂ : α = β) (a : α) : cast h₁ a = cast h₂ a := rfl

@[elim_casts] theorem cast_refl {α} (a : α) : cast rfl a = a := rfl

@[elim_casts] theorem cast_trans {α β γ} (h₁ : α = β) (h₂ : β = γ) (a : α) : cast h₂ (cast h₁ a) = cast (Eq.trans h₁ h₂) a := by cases h₁; cases h₂; rfl

@[elim_casts] theorem cast_symm {α β} (h : α = β) (a : α) (b : β) : cast h a = b ↔ a = cast h.symm b := by cases h; exact Iff.rfl


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro, Anne Baanen,
  Frédéric Dupuis, Heather Macbeth

! This file was ported from Lean 3 source module algebra.module.linear_map
! leanprover-community/mathlib commit cc8e88c7c8c7bc80f91f84d11adb584bf9bd658f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.GroupAction
import Mathlib.Algebra.Module.Pi
import Mathlib.Algebra.Star.Basic
import Mathlib.Data.Set.Pointwise.SMul
import Mathlib.Algebra.Ring.CompTypeclasses

/-!
# (Semi)linear maps

In this file we define

* `LinearMap σ M M₂`, `M →ₛₗ[σ] M₂` : a semilinear map between two `Module`s. Here,
  `σ` is a `RingHom` from `R` to `R₂` and an `f : M →ₛₗ[σ] M₂` satisfies
  `f (c • x) = (σ c) • (f x)`. We recover plain linear maps by choosing `σ` to be `RingHom.id R`.
  This is denoted by `M →ₗ[R] M₂`. We also add the notation `M →ₗ⋆[R] M₂` for star-linear maps.

* `IsLinearMap R f` : predicate saying that `f : M → M₂` is a linear map. (Note that this
  was not generalized to semilinear maps.)

We then provide `LinearMap` with the following instances:

* `LinearMap.addCommMonoid` and `LinearMap.AddCommGroup`: the elementwise addition structures
  corresponding to addition in the codomain
* `LinearMap.distribMulAction` and `LinearMap.module`: the elementwise scalar action structures
  corresponding to applying the action in the codomain.
* `Module.End.semiring` and `Module.End.ring`: the (semi)ring of endomorphisms formed by taking the
  additive structure above with composition as multiplication.

## Implementation notes

To ensure that composition works smoothly for semilinear maps, we use the typeclasses
`RingHomCompTriple`, `RingHomInvPair` and `RingHomSurjective` from
`Mathlib.Algebra.Ring.CompTypeclasses`.

## Notation

* Throughout the file, we denote regular linear maps by `fₗ`, `gₗ`, etc, and semilinear maps
  by `f`, `g`, etc.

## TODO

* Parts of this file have not yet been generalized to semilinear maps (i.e. `CompatibleSMul`)

## Tags

linear map
-/

-- Porting note: `assert_not_exists` is not defined yet
/-
assert_not_exists Submonoid

assert_not_exists finset
-/

open Function

universe u u' v w x y z

variable {R : Type _} {R₁ : Type _} {R₂ : Type _} {R₃ : Type _}
variable {k : Type _} {S : Type _} {S₃ : Type _} {T : Type _}
variable {M : Type _} {M₁ : Type _} {M₂ : Type _} {M₃ : Type _}
variable {N₁ : Type _} {N₂ : Type _} {N₃ : Type _} {ι : Type _}

/-- A map `f` between modules over a semiring is linear if it satisfies the two properties
`f (x + y) = f x + f y` and `f (c • x) = c • f x`. The predicate `IsLinearMap R f` asserts this
property. A bundled version is available with `LinearMap`, and should be favored over
`IsLinearMap` most of the time. -/
structure IsLinearMap (R : Type u) {M : Type v} {M₂ : Type w} [Semiring R] [AddCommMonoid M]
  [AddCommMonoid M₂] [Module R M] [Module R M₂] (f : M → M₂) : Prop where
  /-- A linear map preserves addition. -/
  map_add : ∀ x y, f (x + y) = f x + f y
  /-- A linear map preserves scalar multiplication. -/
  map_smul : ∀ (c : R) (x), f (c • x) = c • f x
#align is_linear_map IsLinearMap

section

/-- A map `f` between an `R`-module and an `S`-module over a ring homomorphism `σ : R →+* S`
is semilinear if it satisfies the two properties `f (x + y) = f x + f y` and
`f (c • x) = (σ c) • f x`. Elements of `LinearMap σ M M₂` (available under the notation
`M →ₛₗ[σ] M₂`) are bundled versions of such maps. For plain linear maps (i.e. for which
`σ = RingHom.id R`), the notation `M →ₗ[R] M₂` is available. An unbundled version of plain linear
maps is available with the predicate `IsLinearMap`, but it should be avoided most of the time. -/
structure LinearMap {R : Type _} {S : Type _} [Semiring R] [Semiring S] (σ : R →+* S) (M : Type _)
    (M₂ : Type _) [AddCommMonoid M] [AddCommMonoid M₂] [Module R M] [Module S M₂] extends
    AddHom M M₂ where
  /-- A linear map preserves scalar multiplication.
  We prefer the spelling `_root_.map_smul` instead. -/
  map_smul' : ∀ (r : R) (x : M), toFun (r • x) = σ r • toFun x
#align linear_map LinearMap

/-- The `add_hom` underlying a `LinearMap`. -/
add_decl_doc LinearMap.toAddHom
#align linear_map.to_add_hom LinearMap.toAddHom

-- mathport name: «expr →ₛₗ[ ] »
/-- `M →ₛₗ[σ] N` is the type of `σ`-semilinear maps from `M` to `N`. -/
notation:25 M " →ₛₗ[" σ:25 "] " M₂:0 => LinearMap σ M M₂

/-- `M →ₗ[R] N` is the type of `R`-linear maps from `M` to `N`. -/
-- mathport name: «expr →ₗ[ ] »
notation:25 M " →ₗ[" R:25 "] " M₂:0 => LinearMap (RingHom.id R) M M₂

/-- `M →ₗ⋆[R] N` is the type of `R`-conjugate-linear maps from `M` to `N`. -/
-- mathport name: «expr →ₗ⋆[ ] »
notation:25 M " →ₗ⋆[" R:25 "] " M₂:0 => LinearMap (starRingEnd R) M M₂

/-- `SemilinearMapClass F σ M M₂` asserts `F` is a type of bundled `σ`-semilinear maps `M → M₂`.

See also `LinearMapClass F R M M₂` for the case where `σ` is the identity map on `R`.

A map `f` between an `R`-module and an `S`-module over a ring homomorphism `σ : R →+* S`
is semilinear if it satisfies the two properties `f (x + y) = f x + f y` and
`f (c • x) = (σ c) • f x`. -/
class SemilinearMapClass (F : Type _) {R S : outParam (Type _)} [Semiring R] [Semiring S]
  (σ : outParam (R →+* S)) (M M₂ : outParam (Type _)) [AddCommMonoid M] [AddCommMonoid M₂]
  [Module R M] [Module S M₂] extends AddHomClass F M M₂ where
  /-- A semilinear map preserves scalar multiplication up to some ring homomorphism `σ`.
  See also `_root_.map_smul` for the case where `σ` is the identity. -/
  map_smulₛₗ : ∀ (f : F) (r : R) (x : M), f (r • x) = σ r • f x
#align semilinear_map_class SemilinearMapClass

end

-- Porting note: `dangerousInstance` linter has become smarter about `outParam`s
-- `σ` becomes a metavariable but that's fine because it's an `outParam`
-- attribute [nolint dangerousInstance] SemilinearMapClass.toAddHomClass

export SemilinearMapClass (map_smulₛₗ)

attribute [simp] map_smulₛₗ

/-- `LinearMapClass F R M M₂` asserts `F` is a type of bundled `R`-linear maps `M → M₂`.

This is an abbreviation for `semilinear_map_class F (RingHom.id R) M M₂`.
-/
abbrev LinearMapClass (F : Type _) (R M M₂ : outParam (Type _)) [Semiring R] [AddCommMonoid M]
    [AddCommMonoid M₂] [Module R M] [Module R M₂] :=
  SemilinearMapClass F (RingHom.id R) M M₂
#align linear_map_class LinearMapClass

namespace SemilinearMapClass

variable (F : Type _)
variable {_ : Semiring R} {_ : Semiring S}
variable {_ : AddCommMonoid M} {_ : AddCommMonoid M₁} {_ : AddCommMonoid M₂} {_ : AddCommMonoid M₃}
variable {_ : AddCommMonoid N₁} {_ : AddCommMonoid N₂} {_ : AddCommMonoid N₃}
variable {_ : Module R M} {_ : Module R M₂} {_ : Module S M₃}
variable {σ : R →+* S}

-- Porting note: the `dangerousInstance` linter has become smarter about `outParam`s
-- @[nolint dangerousInstance] -- `σ` is an `outParam` so it's not dangerous
instance (priority := 100) addMonoidHomClass [SemilinearMapClass F σ M M₃] :
    AddMonoidHomClass F M M₃ :=
  { SemilinearMapClass.toAddHomClass with
    coe := fun f ↦ (f : M → M₃)
    map_zero := fun f ↦
      show f 0 = 0 by
        rw [← zero_smul R (0 : M), map_smulₛₗ]
        simp }

-- The `Semiring` should be an instance parameter but depends on outParams.
-- If Lean 4 gets better support for instance params depending on outParams,
-- we should be able to remove this nolint.
@[nolint dangerousInstance]
instance (priority := 100) distribMulActionHomClass [LinearMapClass F R M M₂] :
    DistribMulActionHomClass F R M M₂ :=
  { SemilinearMapClass.addMonoidHomClass F with
    coe := fun f ↦ (f : M → M₂)
    map_smul := fun f c x ↦ by rw [map_smulₛₗ, RingHom.id_apply] }

variable {F} (f : F) [i : SemilinearMapClass F σ M M₃]

theorem map_smul_inv {σ' : S →+* R} [RingHomInvPair σ σ'] (c : S) (x : M) :
    c • f x = f (σ' c • x) := by simp
#align semilinear_map_class.map_smul_inv SemilinearMapClass.map_smul_inv

end SemilinearMapClass

namespace LinearMap

section AddCommMonoid

variable [Semiring R] [Semiring S]

section

variable [AddCommMonoid M] [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid M₃]

variable [AddCommMonoid N₁] [AddCommMonoid N₂] [AddCommMonoid N₃]

variable [Module R M] [Module R M₂] [Module S M₃]

variable {σ : R →+* S}

instance : SemilinearMapClass (M →ₛₗ[σ] M₃) σ M M₃ where
  coe f := f.toFun
  coe_injective' f g h := by
    cases f
    cases g
    congr
    apply FunLike.coe_injective'
    exact h
  map_add f := f.map_add'
  map_smulₛₗ := LinearMap.map_smul'

-- Porting note: we don't port specialized `CoeFun` instances if there is `FunLike` instead
#noalign LinearMap.has_coe_to_fun

-- Porting note: adding this instance prevents a timeout in `ext_ring_op`
instance {σ : R →+* S} : FunLike (M →ₛₗ[σ] M₃) M (λ _ ↦ M₃) :=
  { AddHomClass.toFunLike with }

/-- The `DistribMulActionHom` underlying a `LinearMap`. -/
def toDistribMulActionHom (f : M →ₗ[R] M₂) : DistribMulActionHom R M M₂ :=
  { f with map_zero' := show f 0 = 0 from map_zero f }
#align linear_map.to_distrib_mul_action_hom LinearMap.toDistribMulActionHom

@[simp]
theorem coe_toAddHom (f : M →ₛₗ[σ] M₃) : ⇑f.toAddHom = f := rfl

-- porting note: no longer a `simp`
theorem toFun_eq_coe {f : M →ₛₗ[σ] M₃} : f.toFun = (f : M → M₃) := rfl
#align linear_map.to_fun_eq_coe LinearMap.toFun_eq_coe

@[ext]
theorem ext {f g : M →ₛₗ[σ] M₃} (h : ∀ x, f x = g x) : f = g :=
  FunLike.ext f g h
#align linear_map.ext LinearMap.ext

/-- Copy of a `LinearMap` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : M →ₛₗ[σ] M₃) (f' : M → M₃) (h : f' = ⇑f) : M →ₛₗ[σ] M₃
    where
  toFun := f'
  map_add' := h.symm ▸ f.map_add'
  map_smul' := h.symm ▸ f.map_smul'
#align linear_map.copy LinearMap.copy

@[simp]
theorem coe_copy (f : M →ₛₗ[σ] M₃) (f' : M → M₃) (h : f' = ⇑f) : ⇑(f.copy f' h) = f' :=
  rfl
#align linear_map.coe_copy LinearMap.coe_copy

theorem copy_eq (f : M →ₛₗ[σ] M₃) (f' : M → M₃) (h : f' = ⇑f) : f.copy f' h = f :=
  FunLike.ext' h
#align linear_map.copy_eq LinearMap.copy_eq

initialize_simps_projections LinearMap (toFun → apply)

@[simp]
theorem coe_mk {σ : R →+* S} (f : AddHom M M₃) (h) :
    ((LinearMap.mk f h : M →ₛₗ[σ] M₃) : M → M₃) = f :=
  rfl
#align linear_map.coe_mk LinearMap.coe_mk

-- Porting note: This theorem is new.
@[simp]
theorem coe_addHom_mk {σ : R →+* S} (f : AddHom M M₃) (h) :
    ((LinearMap.mk f h : M →ₛₗ[σ] M₃) : AddHom M M₃) = f :=
  rfl

/-- Identity map as a `LinearMap` -/
def id : M →ₗ[R] M :=
  { DistribMulActionHom.id R with toFun := _root_.id }
#align linear_map.id LinearMap.id

theorem id_apply (x : M) : @id R M _ _ _ x = x :=
  rfl
#align linear_map.id_apply LinearMap.id_apply

@[simp, norm_cast]
theorem id_coe : ((LinearMap.id : M →ₗ[R] M) : M → M) = _root_.id :=
  rfl
#align linear_map.id_coe LinearMap.id_coe

end

section

variable [AddCommMonoid M] [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid M₃]

variable [AddCommMonoid N₁] [AddCommMonoid N₂] [AddCommMonoid N₃]

variable [Module R M] [Module R M₂] [Module S M₃]

variable (σ : R →+* S)

variable (fₗ gₗ : M →ₗ[R] M₂) (f g : M →ₛₗ[σ] M₃)

theorem isLinear : IsLinearMap R fₗ :=
  ⟨fₗ.map_add', fₗ.map_smul'⟩
#align linear_map.is_linear LinearMap.isLinear

variable {fₗ gₗ f g σ}

theorem coe_injective : Injective (FunLike.coe : (M →ₛₗ[σ] M₃) → _) :=
  FunLike.coe_injective
#align linear_map.coe_injective LinearMap.coe_injective

protected theorem congr_arg {x x' : M} : x = x' → f x = f x' :=
  FunLike.congr_arg f
#align linear_map.congr_arg LinearMap.congr_arg

/-- If two linear maps are equal, they are equal at each point. -/
protected theorem congr_fun (h : f = g) (x : M) : f x = g x :=
  FunLike.congr_fun h x
#align linear_map.congr_fun LinearMap.congr_fun

theorem ext_iff : f = g ↔ ∀ x, f x = g x :=
  FunLike.ext_iff
#align linear_map.ext_iff LinearMap.ext_iff

@[simp]
theorem mk_coe (f : M →ₛₗ[σ] M₃) (h) : (LinearMap.mk f h : M →ₛₗ[σ] M₃) = f :=
  ext fun _ ↦ rfl
#align linear_map.mk_coe LinearMap.mk_coe

variable (fₗ gₗ f g)

protected theorem map_add (x y : M) : f (x + y) = f x + f y :=
  map_add f x y
#align linear_map.map_add LinearMap.map_add

protected theorem map_zero : f 0 = 0 :=
  map_zero f
#align linear_map.map_zero LinearMap.map_zero

-- Porting note: `simp` wasn't picking up `map_smulₛₗ` for `LinearMap`s without specifying
-- `map_smulₛₗ f`, so we marked this as `@[simp]` in Mathlib3.
-- For Mathlib4, let's try without the `@[simp]` attribute and hope it won't need to be re-enabled.
protected theorem map_smulₛₗ (c : R) (x : M) : f (c • x) = σ c • f x :=
  map_smulₛₗ f c x
#align linear_map.map_smulₛₗ LinearMap.map_smulₛₗ

protected theorem map_smul (c : R) (x : M) : fₗ (c • x) = c • fₗ x :=
  map_smul fₗ c x
#align linear_map.map_smul LinearMap.map_smul

protected theorem map_smul_inv {σ' : S →+* R} [RingHomInvPair σ σ'] (c : S) (x : M) :
    c • f x = f (σ' c • x) := by simp
#align linear_map.map_smul_inv LinearMap.map_smul_inv

@[simp]
theorem map_eq_zero_iff (h : Function.Injective f) {x : M} : f x = 0 ↔ x = 0 :=
  _root_.map_eq_zero_iff f h
#align linear_map.map_eq_zero_iff LinearMap.map_eq_zero_iff

section Pointwise

open Pointwise

variable (M M₃ σ) {F : Type _} (h : F)

@[simp]
theorem _root_.image_smul_setₛₗ [SemilinearMapClass F σ M M₃] (c : R) (s : Set M) :
    h '' (c • s) = σ c • h '' s := by
  apply Set.Subset.antisymm
  · rintro x ⟨y, ⟨z, zs, rfl⟩, rfl⟩
    exact ⟨h z, Set.mem_image_of_mem _ zs, (map_smulₛₗ _ _ _).symm⟩
  · rintro x ⟨y, ⟨z, hz, rfl⟩, rfl⟩
    exact (Set.mem_image _ _ _).2 ⟨c • z, Set.smul_mem_smul_set hz, map_smulₛₗ _ _ _⟩
#align image_smul_setₛₗ image_smul_setₛₗ

theorem _root_.preimage_smul_setₛₗ [SemilinearMapClass F σ M M₃] {c : R} (hc : IsUnit c)
    (s : Set M₃) :
    h ⁻¹' (σ c • s) = c • h ⁻¹' s := by
  apply Set.Subset.antisymm
  · rintro x ⟨y, ys, hy⟩
    refine' ⟨(hc.unit.inv : R) • x, _, _⟩
    ·
      simp only [← hy, smul_smul, Set.mem_preimage, Units.inv_eq_val_inv, map_smulₛₗ h, ← map_mul,
        IsUnit.val_inv_mul, one_smul, map_one, ys]
    · simp only [smul_smul, IsUnit.mul_val_inv, one_smul, Units.inv_eq_val_inv]
  · rintro x ⟨y, hy, rfl⟩
    refine' ⟨h y, hy, by simp only [RingHom.id_apply, map_smulₛₗ h]⟩
#align preimage_smul_setₛₗ preimage_smul_setₛₗ

variable (R M₂)

theorem _root_.image_smul_set [LinearMapClass F R M M₂] (c : R) (s : Set M) :
    h '' (c • s) = c • h '' s :=
  image_smul_setₛₗ _ _ _ h c s
#align image_smul_set image_smul_set

theorem _root_.preimage_smul_set [LinearMapClass F R M M₂] {c : R} (hc : IsUnit c) (s : Set M₂) :
    h ⁻¹' (c • s) = c • h ⁻¹' s :=
  preimage_smul_setₛₗ _ _ _ h hc s
#align preimage_smul_set preimage_smul_set

end Pointwise

variable (M M₂)

/-- A typeclass for `has_smul` structures which can be moved through a `LinearMap`.
This typeclass is generated automatically from a `IsScalarTower` instance, but exists so that
we can also add an instance for `AddCommGroup.intModule`, allowing `z •` to be moved even if
`R` does not support negation.
-/
class CompatibleSMul (R S : Type _) [Semiring S] [SMul R M] [Module S M] [SMul R M₂]
  [Module S M₂] where
  /-- Scalar multiplication by `R` of `M` can be moved through linear maps. -/
  map_smul : ∀ (fₗ : M →ₗ[S] M₂) (c : R) (x : M), fₗ (c • x) = c • fₗ x
#align linear_map.compatible_smul LinearMap.CompatibleSMul

variable {M M₂}

instance (priority := 100) IsScalarTower.compatibleSMul {R S : Type _} [Semiring S] [SMul R S]
    [SMul R M] [Module S M] [IsScalarTower R S M] [SMul R M₂] [Module S M₂] [IsScalarTower R S M₂] :
    CompatibleSMul M M₂ R S :=
  ⟨fun fₗ c x ↦ by rw [← smul_one_smul S c x, ← smul_one_smul S c (fₗ x), map_smul]⟩
#align linear_map.is_scalar_tower.compatible_smul LinearMap.IsScalarTower.compatibleSMul

@[simp]
theorem map_smul_of_tower {R S : Type _} [Semiring S] [SMul R M] [Module S M] [SMul R M₂]
    [Module S M₂] [CompatibleSMul M M₂ R S] (fₗ : M →ₗ[S] M₂) (c : R) (x : M) :
    fₗ (c • x) = c • fₗ x :=
  CompatibleSMul.map_smul fₗ c x
#align linear_map.map_smul_of_tower LinearMap.map_smul_of_tower

/-- convert a linear map to an additive map -/
def toAddMonoidHom : M →+ M₃ where
  toFun := f
  map_zero' := f.map_zero
  map_add' := f.map_add
#align linear_map.to_add_monoid_hom LinearMap.toAddMonoidHom

@[simp]
theorem toAddMonoidHom_coe : ⇑f.toAddMonoidHom = f :=
  rfl
#align linear_map.to_add_monoid_hom_coe LinearMap.toAddMonoidHom_coe

section RestrictScalars

variable (R)
variable [Module S M] [Module S M₂] [CompatibleSMul M M₂ R S]

/-- If `M` and `M₂` are both `R`-modules and `S`-modules and `R`-module structures
are defined by an action of `R` on `S` (formally, we have two scalar towers), then any `S`-linear
map from `M` to `M₂` is `R`-linear.

See also `LinearMap.map_smul_of_tower`. -/
@[coe] def restrictScalars (fₗ : M →ₗ[S] M₂) : M →ₗ[R] M₂ where
  toFun := fₗ
  map_add' := fₗ.map_add
  map_smul' := fₗ.map_smul_of_tower
#align linear_map.restrict_scalars LinearMap.restrictScalars

-- porting note: generalized from `Algebra` to `Compatible SMul`
instance coeIsScalarTower : CoeHTCT (M →ₗ[S] M₂) (M →ₗ[R] M₂) :=
  ⟨restrictScalars R⟩
#align linear_map.coe_is_scalar_tower LinearMap.coeIsScalarTower

@[simp, norm_cast]
theorem coe_restrictScalars (f : M →ₗ[S] M₂) : ((f : M →ₗ[R] M₂) : M → M₂) = f :=
  rfl
#align linear_map.coe_restrict_scalars LinearMap.coe_restrictScalars

theorem restrictScalars_apply (fₗ : M →ₗ[S] M₂) (x) : restrictScalars R fₗ x = fₗ x :=
  rfl
#align linear_map.restrict_scalars_apply LinearMap.restrictScalars_apply

theorem restrictScalars_injective :
    Function.Injective (restrictScalars R : (M →ₗ[S] M₂) → M →ₗ[R] M₂) := fun _ _ h ↦
  ext (LinearMap.congr_fun h : _)
#align linear_map.restrict_scalars_injective LinearMap.restrictScalars_injective

@[simp]
theorem restrictScalars_inj (fₗ gₗ : M →ₗ[S] M₂) :
    fₗ.restrictScalars R = gₗ.restrictScalars R ↔ fₗ = gₗ :=
  (restrictScalars_injective R).eq_iff
#align linear_map.restrict_scalars_inj LinearMap.restrictScalars_inj

end RestrictScalars

theorem toAddMonoidHom_injective :
    Function.Injective (toAddMonoidHom : (M →ₛₗ[σ] M₃) → M →+ M₃) := fun fₗ gₗ h ↦
  ext <| (FunLike.congr_fun h : ∀ x, fₗ.toAddMonoidHom x = gₗ.toAddMonoidHom x)
#align linear_map.to_add_monoid_hom_injective LinearMap.toAddMonoidHom_injective

/-- If two `σ`-linear maps from `R` are equal on `1`, then they are equal. -/
@[ext high]
theorem ext_ring {f g : R →ₛₗ[σ] M₃} (h : f 1 = g 1) : f = g :=
  ext fun x ↦ by rw [← mul_one x, ← smul_eq_mul, f.map_smulₛₗ, g.map_smulₛₗ, h]
#align linear_map.ext_ring LinearMap.ext_ring

theorem ext_ring_iff {σ : R →+* R} {f g : R →ₛₗ[σ] M} : f = g ↔ f 1 = g 1 :=
  ⟨fun h ↦ h ▸ rfl, ext_ring⟩
#align linear_map.ext_ring_iff LinearMap.ext_ring_iff

@[ext high]
theorem ext_ring_op {σ : Rᵐᵒᵖ →+* S} {f g : R →ₛₗ[σ] M₃} (h : f (1 : R) = g (1 : R)) :
    f = g :=
  ext fun x ↦ by
    -- Porting note: replaced the oneliner `rw` proof with a partially term-mode proof
    -- because `rw` was giving "motive is type incorrect" errors
    rw [← one_mul x, ← op_smul_eq_mul]
    refine (f.map_smulₛₗ (MulOpposite.op x) 1).trans ?_
    rw [h]
    exact (g.map_smulₛₗ (MulOpposite.op x) 1).symm
#align linear_map.ext_ring_op LinearMap.ext_ring_op

end

/-- Interpret a `RingHom` `f` as an `f`-semilinear map. -/
@[simps]
def _root_.RingHom.toSemilinearMap (f : R →+* S) : R →ₛₗ[f] S :=
  { f with
    toFun := f
    map_smul' := f.map_mul }
#align ring_hom.to_semilinear_map RingHom.toSemilinearMap
#align ring_hom.to_semilinear_map_apply RingHom.toSemilinearMap_apply

section

variable [Semiring R₁] [Semiring R₂] [Semiring R₃]
variable [AddCommMonoid M] [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid M₃]
variable {module_M₁ : Module R₁ M₁} {module_M₂ : Module R₂ M₂} {module_M₃ : Module R₃ M₃}
variable {σ₁₂ : R₁ →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R₁ →+* R₃}
variable [RingHomCompTriple σ₁₂ σ₂₃ σ₁₃]
variable (f : M₂ →ₛₗ[σ₂₃] M₃) (g : M₁ →ₛₗ[σ₁₂] M₂)

/-- Composition of two linear maps is a linear map -/
def comp : M₁ →ₛₗ[σ₁₃] M₃ where
  toFun := f ∘ g
  map_add' := by simp only [map_add, forall_const, Function.comp_apply]
  map_smul' r x := by simp only [Function.comp_apply, map_smulₛₗ, RingHomCompTriple.comp_apply]
#align linear_map.comp LinearMap.comp

-- mathport name: «expr ∘ₗ »
set_option quotPrecheck false in -- Porting note: error message suggested to do this
/-- `∘ₗ` is notation for composition of two linear (not semilinear!) maps into a linear map.
This is useful when Lean is struggling to infer the `RingHomCompTriple` instance. -/
infixr:80 " ∘ₗ " =>
  @LinearMap.comp _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ (RingHom.id _) (RingHom.id _) (RingHom.id _)
    RingHomCompTriple.ids

theorem comp_apply (x : M₁) : f.comp g x = f (g x) :=
  rfl
#align linear_map.comp_apply LinearMap.comp_apply

@[simp, norm_cast]
theorem coe_comp : (f.comp g : M₁ → M₃) = f ∘ g :=
  rfl
#align linear_map.coe_comp LinearMap.coe_comp

@[simp]
theorem comp_id : f.comp id = f :=
  LinearMap.ext fun _ ↦ rfl
#align linear_map.comp_id LinearMap.comp_id

@[simp]
theorem id_comp : id.comp f = f :=
  LinearMap.ext fun _ ↦ rfl
#align linear_map.id_comp LinearMap.id_comp

variable {f g} {f' : M₂ →ₛₗ[σ₂₃] M₃} {g' : M₁ →ₛₗ[σ₁₂] M₂}

theorem cancel_right (hg : Function.Surjective g) : f.comp g = f'.comp g ↔ f = f' :=
  ⟨fun h ↦ ext <| hg.forall.2 (ext_iff.1 h), fun h ↦ h ▸ rfl⟩
#align linear_map.cancel_right LinearMap.cancel_right

theorem cancel_left (hf : Function.Injective f) : f.comp g = f.comp g' ↔ g = g' :=
  ⟨fun h ↦ ext fun x ↦ hf <| by rw [← comp_apply, h, comp_apply], fun h ↦ h ▸ rfl⟩
#align linear_map.cancel_left LinearMap.cancel_left

end

variable [AddCommMonoid M] [AddCommMonoid M₁] [AddCommMonoid M₂] [AddCommMonoid M₃]

/-- If a function `g` is a left and right inverse of a linear map `f`, then `g` is linear itself. -/
def inverse [Module R M] [Module S M₂] {σ : R →+* S} {σ' : S →+* R} [RingHomInvPair σ σ']
    (f : M →ₛₗ[σ] M₂) (g : M₂ → M) (h₁ : LeftInverse g f) (h₂ : RightInverse g f) : M₂ →ₛₗ[σ'] M :=
  by
  dsimp [LeftInverse, Function.RightInverse] at h₁ h₂
  exact
    { toFun := g
      map_add' := fun x y ↦ by rw [← h₁ (g (x + y)), ← h₁ (g x + g y)] ; simp [h₂]
      map_smul' := fun a b ↦ by
        dsimp only
        rw [← h₁ (g (a • b)), ← h₁ (σ' a • g b)]
        simp [h₂] }
#align linear_map.inverse LinearMap.inverse

end AddCommMonoid

section AddCommGroup

variable [Semiring R] [Semiring S] [AddCommGroup M] [AddCommGroup M₂]

variable {module_M : Module R M} {module_M₂ : Module S M₂} {σ : R →+* S}

variable (f : M →ₛₗ[σ] M₂)

protected theorem map_neg (x : M) : f (-x) = -f x :=
  map_neg f x
#align linear_map.map_neg LinearMap.map_neg

protected theorem map_sub (x y : M) : f (x - y) = f x - f y :=
  map_sub f x y
#align linear_map.map_sub LinearMap.map_sub

instance CompatibleSMul.intModule {S : Type _} [Semiring S] [Module S M] [Module S M₂] :
    CompatibleSMul M M₂ ℤ S :=
  ⟨fun fₗ c x ↦ by
    induction c using Int.induction_on
    case hz => simp
    case hp n ih => simp [add_smul, ih]
    case hn n ih => simp [sub_smul, ih]⟩
#align linear_map.compatible_smul.int_module LinearMap.CompatibleSMul.intModule

instance CompatibleSMul.units {R S : Type _} [Monoid R] [MulAction R M] [MulAction R M₂]
    [Semiring S] [Module S M] [Module S M₂] [CompatibleSMul M M₂ R S] : CompatibleSMul M M₂ Rˣ S :=
  ⟨fun fₗ c x ↦ (CompatibleSMul.map_smul fₗ (c : R) x : _)⟩
#align linear_map.compatible_smul.units LinearMap.CompatibleSMul.units

end AddCommGroup

end LinearMap

namespace Module

/-- `g : R →+* S` is `R`-linear when the module structure on `S` is `module.comp_hom S g` . -/
@[simps]
def compHom.toLinearMap {R S : Type _} [Semiring R] [Semiring S] (g : R →+* S) :
    letI := compHom S g; R →ₗ[R] S :=
letI := compHom S g
{ toFun := (g : R → S)
  map_add' := g.map_add
  map_smul' := g.map_mul }
#align module.comp_hom.to_linear_map Module.compHom.toLinearMap
#align module.comp_hom.to_linear_map_apply Module.compHom.toLinearMap_apply

end Module

namespace DistribMulActionHom

variable [Semiring R] [AddCommMonoid M] [AddCommMonoid M₂] [Module R M] [Module R M₂]

/-- A `DistribMulActionHom` between two modules is a linear map. -/
@[coe]
def toLinearMap (fₗ : M →+[R] M₂) : M →ₗ[R] M₂ :=
  { fₗ with }
#align distrib_mul_action_hom.to_linear_map DistribMulActionHom.toLinearMap

instance : Coe (M →+[R] M₂) (M →ₗ[R] M₂) :=
  ⟨toLinearMap⟩

-- Porting note: because coercions get unfolded, there is no need for this rewrite
#noalign distrib_mul_action_hom.to_linear_map_eq_coe

-- Porting note: removed @[norm_cast] attribute due to error:
-- norm_cast: badly shaped lemma, rhs can't start with coe
@[simp]
theorem coe_toLinearMap (f : M →+[R] M₂) : ((f : M →ₗ[R] M₂) : M → M₂) = f :=
  rfl
#align distrib_mul_action_hom.coe_to_linear_map DistribMulActionHom.coe_toLinearMap

theorem toLinearMap_injective {f g : M →+[R] M₂} (h : (f : M →ₗ[R] M₂) = (g : M →ₗ[R] M₂)) :
    f = g := by
  ext m
  exact LinearMap.congr_fun h m
#align distrib_mul_action_hom.to_linear_map_injective DistribMulActionHom.toLinearMap_injective

end DistribMulActionHom

namespace IsLinearMap

section AddCommMonoid

variable [Semiring R] [AddCommMonoid M] [AddCommMonoid M₂]
variable [Module R M] [Module R M₂]

/-- Convert an `IsLinearMap` predicate to a `LinearMap` -/
def mk' (f : M → M₂) (H : IsLinearMap R f) : M →ₗ[R] M₂
    where
  toFun := f
  map_add' := H.1
  map_smul' := H.2
#align is_linear_map.mk' IsLinearMap.mk'

@[simp]
theorem mk'_apply {f : M → M₂} (H : IsLinearMap R f) (x : M) : mk' f H x = f x :=
  rfl
#align is_linear_map.mk'_apply IsLinearMap.mk'_apply

theorem isLinearMap_smul {R M : Type _} [CommSemiring R] [AddCommMonoid M] [Module R M] (c : R) :
    IsLinearMap R fun z : M ↦ c • z :=
  by
  refine' IsLinearMap.mk (smul_add c) _
  intro _ _
  simp only [smul_smul, mul_comm]
#align is_linear_map.is_linear_map_smul IsLinearMap.isLinearMap_smul

theorem isLinearMap_smul' {R M : Type _} [Semiring R] [AddCommMonoid M] [Module R M] (a : M) :
    IsLinearMap R fun c : R ↦ c • a :=
  IsLinearMap.mk (fun x y ↦ add_smul x y a) fun x y ↦ mul_smul x y a
#align is_linear_map.is_linear_map_smul' IsLinearMap.isLinearMap_smul'

variable {f : M → M₂} (lin : IsLinearMap R f)

theorem map_zero : f (0 : M) = (0 : M₂) :=
  (lin.mk' f).map_zero
#align is_linear_map.map_zero IsLinearMap.map_zero

end AddCommMonoid

section AddCommGroup

variable [Semiring R] [AddCommGroup M] [AddCommGroup M₂]
variable [Module R M] [Module R M₂]

theorem isLinearMap_neg : IsLinearMap R fun z : M ↦ -z :=
  IsLinearMap.mk neg_add fun x y ↦ (smul_neg x y).symm
#align is_linear_map.is_linear_map_neg IsLinearMap.isLinearMap_neg

variable {f : M → M₂} (lin : IsLinearMap R f)

theorem map_neg (x : M) : f (-x) = -f x :=
  (lin.mk' f).map_neg x
#align is_linear_map.map_neg IsLinearMap.map_neg

theorem map_sub (x y) : f (x - y) = f x - f y :=
  (lin.mk' f).map_sub x y
#align is_linear_map.map_sub IsLinearMap.map_sub

end AddCommGroup

end IsLinearMap

/-- Linear endomorphisms of a module, with associated ring structure
`Module.End.semiring` and algebra structure `Module.End.algebra`. -/
abbrev Module.End (R : Type u) (M : Type v) [Semiring R] [AddCommMonoid M] [Module R M] :=
  M →ₗ[R] M
#align module.End Module.End

/-- Reinterpret an additive homomorphism as a `ℕ`-linear map. -/
def AddMonoidHom.toNatLinearMap [AddCommMonoid M] [AddCommMonoid M₂] (f : M →+ M₂) : M →ₗ[ℕ] M₂
    where
  toFun := f
  map_add' := f.map_add
  map_smul' := map_nsmul f
#align add_monoid_hom.to_nat_linear_map AddMonoidHom.toNatLinearMap

theorem AddMonoidHom.toNatLinearMap_injective [AddCommMonoid M] [AddCommMonoid M₂] :
    Function.Injective (@AddMonoidHom.toNatLinearMap M M₂ _ _) :=
  by
  intro f g h
  ext x
  exact LinearMap.congr_fun h x
#align add_monoid_hom.to_nat_linear_map_injective AddMonoidHom.toNatLinearMap_injective

/-- Reinterpret an additive homomorphism as a `ℤ`-linear map. -/
def AddMonoidHom.toIntLinearMap [AddCommGroup M] [AddCommGroup M₂] (f : M →+ M₂) : M →ₗ[ℤ] M₂
    where
  toFun := f
  map_add' := f.map_add
  map_smul' := map_zsmul f
#align add_monoid_hom.to_int_linear_map AddMonoidHom.toIntLinearMap

theorem AddMonoidHom.toIntLinearMap_injective [AddCommGroup M] [AddCommGroup M₂] :
    Function.Injective (@AddMonoidHom.toIntLinearMap M M₂ _ _) :=
  by
  intro f g h
  ext x
  exact LinearMap.congr_fun h x
#align add_monoid_hom.to_int_linear_map_injective AddMonoidHom.toIntLinearMap_injective

@[simp]
theorem AddMonoidHom.coe_toIntLinearMap [AddCommGroup M] [AddCommGroup M₂] (f : M →+ M₂) :
    ⇑f.toIntLinearMap = f :=
  rfl
#align add_monoid_hom.coe_to_int_linear_map AddMonoidHom.coe_toIntLinearMap

/-- Reinterpret an additive homomorphism as a `ℚ`-linear map. -/
def AddMonoidHom.toRatLinearMap [AddCommGroup M] [Module ℚ M] [AddCommGroup M₂] [Module ℚ M₂]
    (f : M →+ M₂) : M →ₗ[ℚ] M₂ :=
  { f with map_smul' := map_rat_smul f }
#align add_monoid_hom.to_rat_linear_map AddMonoidHom.toRatLinearMap

theorem AddMonoidHom.toRatLinearMap_injective [AddCommGroup M] [Module ℚ M] [AddCommGroup M₂]
    [Module ℚ M₂] : Function.Injective (@AddMonoidHom.toRatLinearMap M M₂ _ _ _ _) :=
  by
  intro f g h
  ext x
  exact LinearMap.congr_fun h x
#align add_monoid_hom.to_rat_linear_map_injective AddMonoidHom.toRatLinearMap_injective

@[simp]
theorem AddMonoidHom.coe_toRatLinearMap [AddCommGroup M] [Module ℚ M] [AddCommGroup M₂]
    [Module ℚ M₂] (f : M →+ M₂) : ⇑f.toRatLinearMap = f :=
  rfl
#align add_monoid_hom.coe_to_rat_linear_map AddMonoidHom.coe_toRatLinearMap

namespace LinearMap

section SMul

variable [Semiring R] [Semiring R₂] [Semiring R₃]
variable [AddCommMonoid M] [AddCommMonoid M₂] [AddCommMonoid M₃]
variable [Module R M] [Module R₂ M₂] [Module R₃ M₃]
variable {σ₁₂ : R →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R →+* R₃} [RingHomCompTriple σ₁₂ σ₂₃ σ₁₃]
variable [Monoid S] [DistribMulAction S M₂] [SMulCommClass R₂ S M₂]
variable [Monoid S₃] [DistribMulAction S₃ M₃] [SMulCommClass R₃ S₃ M₃]
variable [Monoid T] [DistribMulAction T M₂] [SMulCommClass R₂ T M₂]

instance : SMul S (M →ₛₗ[σ₁₂] M₂) :=
  ⟨fun a f ↦
    { toFun := a • (f : M → M₂)
      map_add' := fun x y ↦ by simp only [Pi.smul_apply, f.map_add, smul_add]
      map_smul' := fun c x ↦ by simp [Pi.smul_apply, smul_comm] }⟩

@[simp]
theorem smul_apply (a : S) (f : M →ₛₗ[σ₁₂] M₂) (x : M) : (a • f) x = a • f x :=
  rfl
#align linear_map.smul_apply LinearMap.smul_apply

theorem coe_smul (a : S) (f : M →ₛₗ[σ₁₂] M₂) : (a • f : M →ₛₗ[σ₁₂] M₂) = a • (f : M → M₂) :=
  rfl
#align linear_map.coe_smul LinearMap.coe_smul

instance [SMulCommClass S T M₂] : SMulCommClass S T (M →ₛₗ[σ₁₂] M₂) :=
  ⟨fun _ _ _ ↦ ext fun _ ↦ smul_comm _ _ _⟩

-- example application of this instance: if S -> T -> R are homomorphisms of commutative rings and
-- M and M₂ are R-modules then the S-module and T-module structures on Hom_R(M,M₂) are compatible.
instance [SMul S T] [IsScalarTower S T M₂] : IsScalarTower S T (M →ₛₗ[σ₁₂] M₂)
    where smul_assoc _ _ _ := ext fun _ ↦ smul_assoc _ _ _

instance [DistribMulAction Sᵐᵒᵖ M₂] [SMulCommClass R₂ Sᵐᵒᵖ M₂] [IsCentralScalar S M₂] :
    IsCentralScalar S (M →ₛₗ[σ₁₂] M₂) where op_smul_eq_smul _ _ := ext fun _ ↦ op_smul_eq_smul _ _

end SMul

/-! ### Arithmetic on the codomain -/

section Arithmetic

variable [Semiring R₁] [Semiring R₂] [Semiring R₃]
variable [AddCommMonoid M] [AddCommMonoid M₂] [AddCommMonoid M₃]
variable [AddCommGroup N₁] [AddCommGroup N₂] [AddCommGroup N₃]
variable [Module R₁ M] [Module R₂ M₂] [Module R₃ M₃]
variable [Module R₁ N₁] [Module R₂ N₂] [Module R₃ N₃]
variable {σ₁₂ : R₁ →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R₁ →+* R₃} [RingHomCompTriple σ₁₂ σ₂₃ σ₁₃]

/-- The constant 0 map is linear. -/
instance : Zero (M →ₛₗ[σ₁₂] M₂) :=
  ⟨{  toFun := 0
      map_add' := by simp
      map_smul' := by simp }⟩

@[simp]
theorem zero_apply (x : M) : (0 : M →ₛₗ[σ₁₂] M₂) x = 0 :=
  rfl
#align linear_map.zero_apply LinearMap.zero_apply

@[simp]
theorem comp_zero (g : M₂ →ₛₗ[σ₂₃] M₃) : (g.comp (0 : M →ₛₗ[σ₁₂] M₂) : M →ₛₗ[σ₁₃] M₃) = 0 :=
  ext fun c ↦ by rw [comp_apply, zero_apply, zero_apply, g.map_zero]
#align linear_map.comp_zero LinearMap.comp_zero

@[simp]
theorem zero_comp (f : M →ₛₗ[σ₁₂] M₂) : ((0 : M₂ →ₛₗ[σ₂₃] M₃).comp f : M →ₛₗ[σ₁₃] M₃) = 0 :=
  rfl
#align linear_map.zero_comp LinearMap.zero_comp

instance : Inhabited (M →ₛₗ[σ₁₂] M₂) :=
  ⟨0⟩

@[simp]
theorem default_def : (default : M →ₛₗ[σ₁₂] M₂) = 0 :=
  rfl
#align linear_map.default_def LinearMap.default_def

/-- The sum of two linear maps is linear. -/
instance : Add (M →ₛₗ[σ₁₂] M₂) :=
  ⟨fun f g ↦
    { toFun := f + g
      map_add' := by simp [add_comm, add_left_comm]
      map_smul' := by simp [smul_add] }⟩

@[simp]

theorem add_comp (f : M →ₛₗ[σ₁₂] M₂) (g h : M₂ →ₛₗ[σ₂₃] M₃) :
    ((h + g).comp f : M →ₛₗ[σ₁₃] M₃) = h.comp f + g.comp f :=
  rfl
#align linear_map.add_comp LinearMap.add_comp

theorem comp_add (f g : M →ₛₗ[σ₁₂] M₂) (h : M₂ →ₛₗ[σ₂₃] M₃) :
    (h.comp (f + g) : M →ₛₗ[σ₁₃] M₃) = h.comp f + h.comp g :=
  ext fun _ ↦ h.map_add _ _
#align linear_map.comp_add LinearMap.comp_add

/-- The type of linear maps is an additive monoid. -/
instance addCommMonoid : AddCommMonoid (M →ₛₗ[σ₁₂] M₂) :=
  FunLike.coe_injective.addCommMonoid _ rfl (fun _ _ ↦ rfl) fun _ _ ↦ rfl

/-- The negation of a linear map is linear. -/
instance : Neg (M →ₛₗ[σ₁₂] N₂) :=
  ⟨fun f ↦
    { toFun := -f
      map_add' := by simp [add_comm]
      map_smul' := by simp }⟩

@[simp]
theorem neg_apply (f : M →ₛₗ[σ₁₂] N₂) (x : M) : (-f) x = -f x :=
  rfl
#align linear_map.neg_apply LinearMap.neg_apply

@[simp]
theorem neg_comp (f : M →ₛₗ[σ₁₂] M₂) (g : M₂ →ₛₗ[σ₂₃] N₃) : (-g).comp f = -g.comp f :=
  rfl
#align linear_map.neg_comp LinearMap.neg_comp

@[simp]
theorem comp_neg (f : M →ₛₗ[σ₁₂] N₂) (g : N₂ →ₛₗ[σ₂₃] N₃) : g.comp (-f) = -g.comp f :=
  ext fun _ ↦ g.map_neg _
#align linear_map.comp_neg LinearMap.comp_neg

/-- The subtraction of two linear maps is linear. -/
instance : Sub (M →ₛₗ[σ₁₂] N₂) :=
  ⟨fun f g ↦
    { toFun := f - g
      map_add' := fun x y ↦ by simp only [Pi.sub_apply, map_add, add_sub_add_comm]
      map_smul' := fun r x ↦ by simp [Pi.sub_apply, map_smul, smul_sub] }⟩

@[simp]
theorem sub_apply (f g : M →ₛₗ[σ₁₂] N₂) (x : M) : (f - g) x = f x - g x :=
  rfl
#align linear_map.sub_apply LinearMap.sub_apply

theorem sub_comp (f : M →ₛₗ[σ₁₂] M₂) (g h : M₂ →ₛₗ[σ₂₃] N₃) :
    (g - h).comp f = g.comp f - h.comp f :=
  rfl
#align linear_map.sub_comp LinearMap.sub_comp

theorem comp_sub (f g : M →ₛₗ[σ₁₂] N₂) (h : N₂ →ₛₗ[σ₂₃] N₃) :
    h.comp (g - f) = h.comp g - h.comp f :=
  ext fun _ ↦ h.map_sub _ _
#align linear_map.comp_sub LinearMap.comp_sub

/-- The type of linear maps is an additive group. -/
instance addCommGroup : AddCommGroup (M →ₛₗ[σ₁₂] N₂) :=
  FunLike.coe_injective.addCommGroup _ rfl (fun _ _ ↦ rfl) (fun _ ↦ rfl) (fun _ _ ↦ rfl)
    (fun _ _ ↦ rfl) fun _ _ ↦ rfl

end Arithmetic

section Actions

variable [Semiring R] [Semiring R₂] [Semiring R₃]
variable [AddCommMonoid M] [AddCommMonoid M₂] [AddCommMonoid M₃]
variable [Module R M] [Module R₂ M₂] [Module R₃ M₃]
variable {σ₁₂ : R →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R →+* R₃} [RingHomCompTriple σ₁₂ σ₂₃ σ₁₃]

section SMul

variable [Monoid S] [DistribMulAction S M₂] [SMulCommClass R₂ S M₂]
variable [Monoid S₃] [DistribMulAction S₃ M₃] [SMulCommClass R₃ S₃ M₃]
variable [Monoid T] [DistribMulAction T M₂] [SMulCommClass R₂ T M₂]

instance : DistribMulAction S (M →ₛₗ[σ₁₂] M₂)
    where
  one_smul _ := ext fun _ ↦ one_smul _ _
  mul_smul _ _ _ := ext fun _ ↦ mul_smul _ _ _
  smul_add _ _ _ := ext fun _ ↦ smul_add _ _ _
  smul_zero _ := ext fun _ ↦ smul_zero _

theorem smul_comp (a : S₃) (g : M₂ →ₛₗ[σ₂₃] M₃) (f : M →ₛₗ[σ₁₂] M₂) :
    (a • g).comp f = a • g.comp f :=
  rfl
#align linear_map.smul_comp LinearMap.smul_comp

-- TODO: generalize this to semilinear maps
theorem comp_smul [Module R M₂] [Module R M₃] [SMulCommClass R S M₂] [DistribMulAction S M₃]
    [SMulCommClass R S M₃] [CompatibleSMul M₃ M₂ S R] (g : M₃ →ₗ[R] M₂) (a : S) (f : M →ₗ[R] M₃) :
    g.comp (a • f) = a • g.comp f :=
  ext fun _ ↦ g.map_smul_of_tower _ _
#align linear_map.comp_smul LinearMap.comp_smul

end SMul

section Module

variable [Semiring S] [Module S M₂] [SMulCommClass R₂ S M₂]

instance : Module S (M →ₛₗ[σ₁₂] M₂)
    where
  add_smul _ _ _ := ext fun _ ↦ add_smul _ _ _
  zero_smul _ := ext fun _ ↦ zero_smul _ _

instance [NoZeroSMulDivisors S M₂] : NoZeroSMulDivisors S (M →ₛₗ[σ₁₂] M₂) :=
  coe_injective.noZeroSMulDivisors _ rfl coe_smul

end Module

end Actions

/-!
### Monoid structure of endomorphisms

Lemmas about `pow` such as `LinearMap.pow_apply` appear in later files.
-/

section Endomorphisms

variable [Semiring R] [AddCommMonoid M] [AddCommGroup N₁] [Module R M] [Module R N₁]

instance : One (Module.End R M) :=
  ⟨LinearMap.id⟩

instance : Mul (Module.End R M) :=
  ⟨LinearMap.comp⟩

theorem one_eq_id : (1 : Module.End R M) = id :=
  rfl
#align linear_map.one_eq_id LinearMap.one_eq_id

theorem mul_eq_comp (f g : Module.End R M) : f * g = f.comp g :=
  rfl
#align linear_map.mul_eq_comp LinearMap.mul_eq_comp

@[simp]
theorem one_apply (x : M) : (1 : Module.End R M) x = x :=
  rfl
#align linear_map.one_apply LinearMap.one_apply

@[simp]
theorem mul_apply (f g : Module.End R M) (x : M) : (f * g) x = f (g x) :=
  rfl
#align linear_map.mul_apply LinearMap.mul_apply

theorem coe_one : ⇑(1 : Module.End R M) = _root_.id :=
  rfl
#align linear_map.coe_one LinearMap.coe_one

theorem coe_mul (f g : Module.End R M) : ⇑(f * g) = f ∘ g :=
  rfl
#align linear_map.coe_mul LinearMap.coe_mul

instance _root_.Module.End.monoid : Monoid (Module.End R M)
    where
  mul := (· * ·)
  one := (1 : M →ₗ[R] M)
  mul_assoc f g h := LinearMap.ext fun x ↦ rfl
  mul_one := comp_id
  one_mul := id_comp
#align module.End.monoid Module.End.monoid

instance _root_.Module.End.semiring : Semiring (Module.End R M) :=
  { AddMonoidWithOne.unary, Module.End.monoid, LinearMap.addCommMonoid with
    mul := (· * ·)
    one := (1 : M →ₗ[R] M)
    zero := (0 : M →ₗ[R] M)
    add := (· + ·)
    mul_zero := comp_zero
    zero_mul := zero_comp
    left_distrib := fun _ _ _ ↦ comp_add _ _ _
    right_distrib := fun _ _ _ ↦ add_comp _ _ _
    natCast := fun n ↦ n • (1 : M →ₗ[R] M)
    natCast_zero := zero_smul ℕ (1 : M →ₗ[R] M)
    natCast_succ := fun n ↦ (AddMonoid.nsmul_succ n (1 : M →ₗ[R] M)).trans (add_comm _ _) }
#align module.End.semiring Module.End.semiring

/-- See also `Module.End.natCast_def`. -/
@[simp]
theorem _root_.Module.End.natCast_apply (n : ℕ) (m : M) : (↑n : Module.End R M) m = n • m :=
  rfl
#align module.End.nat_cast_apply Module.End.natCast_apply

-- *TODO*: why are you still timing out?
set_option maxHeartbeats 300000 in
instance _root_.Module.End.ring : Ring (Module.End R N₁) :=
  { Module.End.semiring, LinearMap.addCommGroup with
    mul := (· * ·)
    one := (1 : N₁ →ₗ[R] N₁)
    zero := (0 : N₁ →ₗ[R] N₁)
    add := (· + ·)
    intCast := fun z ↦ z • (1 : N₁ →ₗ[R] N₁)
    intCast_ofNat := ofNat_zsmul _
    intCast_negSucc := negSucc_zsmul _ }
#align module.End.ring Module.End.ring

/-- See also `Module.End.intCast_def`. -/
@[simp]
theorem _root_.Module.End.intCast_apply (z : ℤ) (m : N₁) : (z : Module.End R N₁) m = z • m :=
  rfl
#align module.End.int_cast_apply Module.End.intCast_apply

section

variable [Monoid S] [DistribMulAction S M] [SMulCommClass R S M]

instance _root_.Module.End.isScalarTower :
    IsScalarTower S (Module.End R M) (Module.End R M) :=
  ⟨smul_comp⟩
#align module.End.is_scalar_tower Module.End.isScalarTower

instance _root_.Module.End.smulCommClass [SMul S R] [IsScalarTower S R M] :
    SMulCommClass S (Module.End R M) (Module.End R M) :=
  ⟨fun s _ _ ↦ (comp_smul _ s _).symm⟩
#align module.End.smul_comm_class Module.End.smulCommClass

instance _root_.Module.End.smulCommClass' [SMul S R] [IsScalarTower S R M] :
    SMulCommClass (Module.End R M) S (Module.End R M) :=
  SMulCommClass.symm _ _ _
#align module.End.smul_comm_class' Module.End.smulCommClass'

end

/-! ### Action by a module endomorphism. -/

/-- The tautological action by `module.End R M` (aka `M →ₗ[R] M`) on `M`.

This generalizes `Function.End.applyMulAction`. -/
instance applyModule : Module (Module.End R M) M
    where
  smul := (· <| ·)
  smul_zero := LinearMap.map_zero
  smul_add := LinearMap.map_add
  add_smul := LinearMap.add_apply
  zero_smul := (LinearMap.zero_apply : ∀ m, (0 : M →ₗ[R] M) m = 0)
  one_smul _ := rfl
  mul_smul _ _ _ := rfl
#align linear_map.apply_module LinearMap.applyModule

@[simp]
protected theorem smul_def (f : Module.End R M) (a : M) : f • a = f a :=
  rfl
#align linear_map.smul_def LinearMap.smul_def

/-- `LinearMap.applyModule` is faithful. -/
instance apply_faithfulSMul : FaithfulSMul (Module.End R M) M :=
  ⟨LinearMap.ext⟩
#align linear_map.apply_has_faithful_smul LinearMap.apply_faithfulSMul

instance apply_smulCommClass : SMulCommClass R (Module.End R M) M
    where smul_comm r e m := (e.map_smul r m).symm
#align linear_map.apply_smul_comm_class LinearMap.apply_smulCommClass

instance apply_smulCommClass' : SMulCommClass (Module.End R M) R M
    where smul_comm := LinearMap.map_smul
#align linear_map.apply_smul_comm_class' LinearMap.apply_smulCommClass'

instance apply_isScalarTower {R M : Type _} [CommSemiring R] [AddCommMonoid M] [Module R M] :
    IsScalarTower R (Module.End R M) M :=
  ⟨fun _ _ _ ↦ rfl⟩
#align linear_map.apply_is_scalar_tower LinearMap.apply_isScalarTower

end Endomorphisms

end LinearMap

/-! ### Actions as module endomorphisms -/

namespace DistribMulAction

variable (R M) [Semiring R] [AddCommMonoid M] [Module R M]

variable [Monoid S] [DistribMulAction S M] [SMulCommClass S R M]

/-- Each element of the monoid defines a linear map.

This is a stronger version of `DistribMulAction.toAddMonoidHom`. -/
@[simps]
def toLinearMap (s : S) : M →ₗ[R] M where
  toFun := SMul.smul s
  map_add' := smul_add s
  map_smul' _ _ := smul_comm _ _ _
#align distrib_mul_action.to_linear_map DistribMulAction.toLinearMap
#align distrib_mul_action.to_linear_map_apply DistribMulAction.toLinearMap_apply

/-- Each element of the monoid defines a module endomorphism.

This is a stronger version of `DistribMulAction.toAddMonoidEnd`. -/
@[simps]
def toModuleEnd : S →* Module.End R M
    where
  toFun := toLinearMap R M
  map_one' := LinearMap.ext <| one_smul _
  map_mul' _ _ := LinearMap.ext <| mul_smul _ _
#align distrib_mul_action.to_module_End DistribMulAction.toModuleEnd
#align distrib_mul_action.to_module_End_apply DistribMulAction.toModuleEnd_apply

end DistribMulAction

namespace Module

variable (R M) [Semiring R] [AddCommMonoid M] [Module R M]

variable [Semiring S] [Module S M] [SMulCommClass S R M]

/-- Each element of the semiring defines a module endomorphism.

This is a stronger version of `DistribMulAction.toModuleEnd`. -/
@[simps]
def toModuleEnd : S →+* Module.End R M :=
  {
    DistribMulAction.toModuleEnd R
      M with
    toFun := DistribMulAction.toLinearMap R M
    map_zero' := LinearMap.ext <| zero_smul _
    map_add' := fun _ _ ↦ LinearMap.ext <| add_smul _ _ }
#align module.to_module_End Module.toModuleEnd
#align module.to_module_End_apply Module.toModuleEnd_apply

/-- The canonical (semi)ring isomorphism from `Rᵐᵒᵖ` to `Module.End R R` induced by the right
multiplication. -/
@[simps]
def moduleEndSelf : Rᵐᵒᵖ ≃+* Module.End R R :=
  { Module.toModuleEnd R R with
    toFun := DistribMulAction.toLinearMap R R
    invFun := fun f ↦ MulOpposite.op (f 1)
    left_inv := mul_one
    right_inv := fun _ ↦ LinearMap.ext_ring <| one_mul _ }
#align module.module_End_self Module.moduleEndSelf
#align module.module_End_self_apply Module.moduleEndSelf_apply

/-- The canonical (semi)ring isomorphism from `R` to `Module.End Rᵐᵒᵖ R` induced by the left
multiplication. -/
@[simps]
def moduleEndSelfOp : R ≃+* Module.End Rᵐᵒᵖ R :=
  { Module.toModuleEnd _ _ with
    toFun := DistribMulAction.toLinearMap _ _
    invFun := fun f ↦ f 1
    left_inv := mul_one
    right_inv := fun _ ↦ LinearMap.ext_ring_op <| mul_one _ }
#align module.module_End_self_op Module.moduleEndSelfOp
#align module.module_End_self_op_symm_apply Module.moduleEndSelfOp_symm_apply
#align module.module_End_self_op_apply Module.moduleEndSelfOp_apply

theorem End.natCast_def (n : ℕ) [AddCommMonoid N₁] [Module R N₁] :
    (↑n : Module.End R N₁) = Module.toModuleEnd R N₁ n :=
  rfl
#align module.End.nat_cast_def Module.End.natCast_def

theorem End.intCast_def (z : ℤ) [AddCommGroup N₁] [Module R N₁] :
    (z : Module.End R N₁) = Module.toModuleEnd R N₁ z :=
  rfl
#align module.End.int_cast_def Module.End.intCast_def

end Module


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

universes u_1

namespace Mathlib

/-!
## The Frobenius operator

If `R` has characteristic `p`, then there is a ring endomorphism `frobenius R p`
that raises `r : R` to the power `p`.
By applying `witt_vector.map` to `frobenius R p`, we obtain a ring endomorphism `𝕎 R →+* 𝕎 R`.
It turns out that this endomorphism can be described by polynomials over `ℤ`
that do not depend on `R` or the fact that it has characteristic `p`.
In this way, we obtain a Frobenius endomorphism `witt_vector.frobenius_fun : 𝕎 R → 𝕎 R`
for every commutative ring `R`.

Unfortunately, the aforementioned polynomials can not be obtained using the machinery
of `witt_structure_int` that was developed in `structure_polynomial.lean`.
We therefore have to define the polynomials by hand, and check that they have the required property.

In case `R` has characteristic `p`, we show in `frobenius_fun_eq_map_frobenius`
that `witt_vector.frobenius_fun` is equal to `witt_vector.map (frobenius R p)`.

### Main definitions and results

* `frobenius_poly`: the polynomials that describe the coefficients of `frobenius_fun`;
* `frobenius_fun`: the Frobenius endomorphism on Witt vectors;
* `frobenius_fun_is_poly`: the tautological assertion that Frobenius is a polynomial function;
* `frobenius_fun_eq_map_frobenius`: the fact that in characteristic `p`, Frobenius is equal to
  `witt_vector.map (frobenius R p)`.

TODO: Show that `witt_vector.frobenius_fun` is a ring homomorphism,
and bundle it into `witt_vector.frobenius`.

-/

namespace witt_vector

/-- The rational polynomials that give the coefficients of `frobenius x`,
in terms of the coefficients of `x`.
These polynomials actually have integral coefficients,
see `frobenius_poly` and `map_frobenius_poly`. -/
def frobenius_poly_rat (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : mv_polynomial ℕ ℚ :=
  coe_fn (mv_polynomial.bind₁ (witt_polynomial p ℚ ∘ fun (n : ℕ) => n + 1)) (X_in_terms_of_W p ℚ n)

theorem bind₁_frobenius_poly_rat_witt_polynomial (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : coe_fn (mv_polynomial.bind₁ (frobenius_poly_rat p)) (witt_polynomial p ℚ n) = witt_polynomial p ℚ (n + 1) := sorry

/-- An auxilliary definition, to avoid an excessive amount of finiteness proofs
for `multiplicity p n`. -/
/-- An auxilliary polynomial over the integers, that satisfies
`(frobenius_poly_aux p n - X n ^ p) / p = frobenius_poly p n`.
This makes it easy to show that `frobenius_poly p n` is congruent to `X n ^ p`
modulo `p`. -/
def frobenius_poly_aux (p : ℕ) [hp : fact (nat.prime p)] : ℕ → mv_polynomial ℕ ℤ :=
  sorry

theorem frobenius_poly_aux_eq (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : frobenius_poly_aux p n =
  mv_polynomial.X (n + 1) -
    finset.sum (finset.range n)
      fun (i : ℕ) =>
        finset.sum (finset.range (p ^ (n - i)))
          fun (j : ℕ) =>
            (mv_polynomial.X i ^ p) ^ (p ^ (n - i) - (j + 1)) * frobenius_poly_aux p i ^ (j + 1) *
              coe_fn mv_polynomial.C
                ↑(nat.choose (p ^ (n - i)) (j + 1) /
                      p ^ (n - i - pnat_multiplicity p { val := j + 1, property := nat.succ_pos j }) *
                    ↑p ^ (j - pnat_multiplicity p { val := j + 1, property := nat.succ_pos j })) := sorry

/-- The polynomials that give the coefficients of `frobenius x`,
in terms of the coefficients of `x`. -/
def frobenius_poly (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : mv_polynomial ℕ ℤ :=
  mv_polynomial.X n ^ p + coe_fn mv_polynomial.C ↑p * frobenius_poly_aux p n

/-
Our next goal is to prove
```
lemma map_frobenius_poly (n : ℕ) :
  mv_polynomial.map (int.cast_ring_hom ℚ) (frobenius_poly p n) = frobenius_poly_rat p n
```
This lemma has a rather long proof, but it mostly boils down to applying induction,
and then using the following two key facts at the right point.
-/

/-- A key divisibility fact for the proof of `witt_vector.map_frobenius_poly`. -/
theorem map_frobenius_poly.key₁ (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) (j : ℕ) (hj : j < p ^ n) : p ^ (n - pnat_multiplicity p { val := j + 1, property := nat.succ_pos j }) ∣ nat.choose (p ^ n) (j + 1) := sorry

/-- A key numerical identity needed for the proof of `witt_vector.map_frobenius_poly`. -/
theorem map_frobenius_poly.key₂ (p : ℕ) [hp : fact (nat.prime p)] {n : ℕ} {i : ℕ} {j : ℕ} (hi : i < n) (hj : j < p ^ (n - i)) : j - pnat_multiplicity p { val := j + 1, property := nat.succ_pos j } + n =
  i + j + (n - i - pnat_multiplicity p { val := j + 1, property := nat.succ_pos j }) := sorry

theorem map_frobenius_poly (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : coe_fn (mv_polynomial.map (int.cast_ring_hom ℚ)) (frobenius_poly p n) = frobenius_poly_rat p n := sorry

theorem frobenius_poly_zmod (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : coe_fn (mv_polynomial.map (int.cast_ring_hom (zmod p))) (frobenius_poly p n) = mv_polynomial.X n ^ p := sorry

@[simp] theorem bind₁_frobenius_poly_witt_polynomial (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : coe_fn (mv_polynomial.bind₁ (frobenius_poly p)) (witt_polynomial p ℤ n) = witt_polynomial p ℤ (n + 1) := sorry

/-- `frobenius_fun` is the function underlying the ring endomorphism
`frobenius : 𝕎 R →+* frobenius 𝕎 R`. -/
def frobenius_fun {p : ℕ} {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] (x : witt_vector p R) : witt_vector p R :=
  mk p fun (n : ℕ) => coe_fn (mv_polynomial.aeval (coeff x)) (frobenius_poly p n)

theorem coeff_frobenius_fun {p : ℕ} {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] (x : witt_vector p R) (n : ℕ) : coeff (frobenius_fun x) n = coe_fn (mv_polynomial.aeval (coeff x)) (frobenius_poly p n) := sorry

/-- `frobenius_fun` is tautologically a polynomial function.

See also `frobenius_is_poly`. -/
theorem frobenius_fun_is_poly (p : ℕ) [hp : fact (nat.prime p)] : is_poly p fun (R : Type u_1) (_Rcr : comm_ring R) => frobenius_fun :=
  Exists.intro (frobenius_poly p)
    fun (R : Type u_1) (_inst_4 : comm_ring R) (x : witt_vector p R) => funext fun (n : ℕ) => coeff_frobenius_fun x n

theorem ghost_component_frobenius_fun {p : ℕ} {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] (n : ℕ) (x : witt_vector p R) : coe_fn (ghost_component n) (frobenius_fun x) = coe_fn (ghost_component (n + 1)) x := sorry

/--
If `R` has characteristic `p`, then there is a ring endomorphism
that raises `r : R` to the power `p`.
By applying `witt_vector.map` to this endomorphism,
we obtain a ring endomorphism `frobenius R p : 𝕎 R →+* 𝕎 R`.

The underlying function of this morphism is `witt_vector.frobenius_fun`.
-/
def frobenius {p : ℕ} {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] : witt_vector p R →+* witt_vector p R :=
  ring_hom.mk frobenius_fun sorry sorry sorry sorry

theorem coeff_frobenius {p : ℕ} {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] (x : witt_vector p R) (n : ℕ) : coeff (coe_fn frobenius x) n = coe_fn (mv_polynomial.aeval (coeff x)) (frobenius_poly p n) :=
  coeff_frobenius_fun x n

theorem ghost_component_frobenius {p : ℕ} {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] (n : ℕ) (x : witt_vector p R) : coe_fn (ghost_component n) (coe_fn frobenius x) = coe_fn (ghost_component (n + 1)) x :=
  ghost_component_frobenius_fun n x

/-- `frobenius` is tautologically a polynomial function. -/
theorem frobenius_is_poly (p : ℕ) [hp : fact (nat.prime p)] : is_poly p fun (R : Type u_1) (_Rcr : comm_ring R) => ⇑frobenius :=
  frobenius_fun_is_poly p

@[simp] theorem coeff_frobenius_char_p (p : ℕ) {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] [char_p R p] (x : witt_vector p R) (n : ℕ) : coeff (coe_fn frobenius x) n = coeff x n ^ p := sorry

theorem frobenius_eq_map_frobenius (p : ℕ) {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] [char_p R p] : frobenius = map (frobenius R p) := sorry

@[simp] theorem frobenius_zmodp (p : ℕ) [hp : fact (nat.prime p)] (x : witt_vector p (zmod p)) : coe_fn frobenius x = x := sorry


import tactic
import tactic.induction
import data.int.basic
import data.set.basic
import logic.function.iterate
import data.list

import .base .point .dist .board .state .player

noncomputable theory
open_locale classical

def Game.set_A {pw pw₁ : ℕ} (g : Game pw) (a₁ : A pw₁) : Game pw₁ :=
{g with a := a₁}

def Game.set_D {pw : ℕ} (g : Game pw) (d₁ : D) : Game pw :=
{g with d := d₁}

def Game.set_players {pw pw₁ : ℕ} (g : Game pw)
  (a₁ : A pw₁) (d₁ : D) : Game pw₁ :=
(g.set_A a₁).set_D d₁

def Game.set_prev_moves {pw : ℕ} (g : Game pw)
  (fa : A_prev_moves pw g.s)
  (fd : D_prev_moves g.s) : Game pw :=
g.set_players (g.a.set_prev_moves g.s fa) (g.d.set_prev_moves g.s fd)

def Game.D_wins {pw : ℕ} (g : Game pw) :=
∃ (n : ℕ), ¬(g.play n).act

def D_hws_at (pw : ℕ) (s : State) :=
∃ (d : D), ∀ (a : A pw), (init_game a d s).D_wins

def D_hws (pw : ℕ) := D_hws_at pw state₀

-----

def simulate {pw : ℕ} (a : A pw) (d : D) (n : ℕ) : Game pw :=
(init_game a d state₀).play n

def all_s {pw : ℕ} (a : A pw) (d : D) (P : State → Prop) :=
∀ (n : ℕ), P (simulate a d n).s

def all_b {pw : ℕ} (a : A pw) (d : D) (P : Board → Prop) :=
all_s a d (λ s, P s.board)

def any_s {pw : ℕ} (a : A pw) (d : D) (P : State → Prop) :=
¬all_s a d (λ s, ¬P s)

def any_b {pw : ℕ} (a : A pw) (d : D) (P : Board → Prop) :=
any_s a d (λ s, P s.board)

def D_wins_in {pw : ℕ} (a : A pw) (d : D) (n : ℕ) :=
∀ (k : ℕ), n ≤ k → ¬(simulate a d k).act

def valid_A_state (pw : ℕ) (s : State) :=
∃ (a : A pw) (d : D) (n : ℕ) hs, (play_D_move_at (simulate a d n) hs).s = s

def valid_D_state (pw : ℕ) (s : State) :=
∃ (a : A pw) (d : D) (n : ℕ), (simulate a d n).s = s

def valid_state (pw : ℕ) (s : State) :=
valid_D_state pw s

-----

lemma not_A_wins_at {pw : ℕ} {g : Game pw} :
  ¬g.A_wins ↔ g.D_wins :=
by simp [Game.A_wins, Game.D_wins]

lemma not_D_wins_at {pw : ℕ} {g : Game pw} :
  ¬g.D_wins ↔ g.A_wins :=
by simp [Game.A_wins, Game.D_wins]

lemma play_at_succ {pw n : ℕ} {g : Game pw} :
  g.play n.succ = g.play_move.play n :=
function.iterate_succ_apply _ _ _

lemma play_at_succ' {pw n : ℕ} {g : Game pw} :
  g.play n.succ = (g.play n).play_move :=
function.iterate_succ_apply' _ _ _

-----

lemma A_wins_at_play_of {pw : ℕ} {g : Game pw}
  (h : g.A_wins) {n : ℕ} : (g.play n).A_wins :=
begin
  intro k, specialize h (k + n),
  rw [Game.play, function.iterate_add] at h, exact h,
end

lemma A_wins_at_play_move_of {pw : ℕ} {g : Game pw}
  (h : g.A_wins) : g.play_move.A_wins :=
@A_wins_at_play_of _ _ h 1

lemma play_A_move_at_players_eq {pw : ℕ} {g : Game pw} :
  (play_A_move_at g).a = g.a ∧ (play_A_move_at g).d = g.d :=
by { rw [play_A_move_at], split_ifs; exact ⟨rfl, rfl⟩ }

lemma play_D_move_at_players_eq {pw : ℕ} {g : Game pw} {hs} :
  (play_D_move_at g hs).a = g.a ∧ (play_D_move_at g hs).d = g.d :=
by { rw [play_D_move_at], exact ⟨rfl, rfl⟩ }

lemma play_move_at_players_eq {pw : ℕ} {g : Game pw} :
  g.play_move.a = g.a ∧ g.play_move.d = g.d :=
begin
  rw [Game.play_move], split_ifs, swap, exact ⟨rfl, rfl⟩,
  rw [play_A_move_at_players_eq.1, play_A_move_at_players_eq.2],
  rw [play_D_move_at_players_eq.1, play_D_move_at_players_eq.2],
  exact ⟨rfl, rfl⟩,
end

lemma play_move_at_players_eq' {pw : ℕ} {g : Game pw} {hs} :
  (play_A_move_at (play_D_move_at g hs)).a = g.a ∧
  (play_A_move_at (play_D_move_at g hs)).d = g.d :=
by { rw play_A_move_at, split_ifs; exact ⟨rfl, rfl⟩ }

lemma play_at_players_eq {pw n : ℕ} {g : Game pw} :
  (g.play n).a = g.a ∧ (g.play n).d = g.d :=
begin
  induction n with n ih,
  { exact ⟨rfl, rfl⟩ },
  { simp_rw play_at_succ',
    rwa [play_move_at_players_eq.1, play_move_at_players_eq.2] },
end

lemma play_move_at_act {pw : ℕ} {g : Game pw}
  (h : g.act) :
  g.play_move = play_A_move_at (play_D_move_at g h) :=
dif_pos h

lemma play_move_at_not_act {pw : ℕ} {g : Game pw}
  (h : ¬g.act) :
  g.play_move = g :=
dif_neg h

lemma play_A_move_hvm {pw : ℕ} {g : Game pw} (hs)
  (h : A_has_valid_move pw g.s.board) :
  ∃ h, play_A_move_at g = play_A_move_at' g.a g hs h :=
by exact ⟨_, dif_pos ⟨hs, h⟩⟩

lemma play_A_move_at_set_D {pw : ℕ}
  {g : Game pw} {d₁ : D} :
  play_A_move_at (g.set_D d₁) = (play_A_move_at g).set_D d₁ :=
by { simp_rw play_A_move_at, split_ifs; refl }

lemma play_D_move_at_set_A {pw pw₁ : ℕ}
  {g : Game pw} {a₁ : A pw₁} {hs} :
  play_D_move_at (g.set_A a₁) hs =
  (play_D_move_at g hs).set_A a₁ :=
rfl

lemma A_has_valid_move_at_play_D_move {pw : ℕ} {g : Game pw} {hs}
  (h : g.A_wins) :
  A_has_valid_move pw (play_D_move_at g hs).s.board :=
begin
  specialize h 1, change g.play_move.act at h,
  rw play_move_at_act hs at h, rw play_A_move_at at h,
  split_ifs at h with h₁,
  { exact h₁.2 },
  { cases h },
end

-----

lemma act_of_act_play_move {pw : ℕ} {g : Game pw}
  (h : g.play_move.act) : g.act :=
by { rw Game.play_move at h, split_ifs at h with h₁; assumption }

lemma act_play_of_act_play_succ {pw n : ℕ} {g : Game pw}
  (h : (g.play n.succ).act) : (g.play n).act :=
by { rw play_at_succ' at h, exact act_of_act_play_move h }

lemma act_play_le {pw n m : ℕ} {g : Game pw}
  (h₁ : n ≤ m) (h₂ : (g.play m).act) : (g.play n).act :=
begin
  induction' h₁,
  { exact h₂ },
  { rw play_at_succ' at h₂, exact ih (act_of_act_play_move h₂) },
end

lemma hist_len_play_A_move_at' {pw pw₁ : ℕ} {g : Game pw}
  {a₁ : A pw₁} {h₁ h₂} :
  (play_A_move_at' a₁ g h₁ h₂).s.len = g.s.len.succ :=
hist_len_apply_A_move

lemma hist_len_play_D_move_at {pw : ℕ} {g : Game pw} {hs} :
  (play_D_move_at g hs).s.len = g.s.len.succ :=
hist_len_apply_D_move

lemma play_A_move_at_hist_len_ge {pw : ℕ} {g : Game pw} :
  g.s.len ≤ (play_A_move_at g).s.len :=
begin
  rw play_A_move_at, split_ifs, swap, { refl },
  rw hist_len_play_A_move_at',
  exact nat.le_of_lt (nat.lt_succ_self _),
end

lemma play_D_move_at_hist_len_ge {pw : ℕ} {g : Game pw} {hs} :
  g.s.len ≤ (play_D_move_at g hs).s.len :=
by { rw hist_len_play_D_move_at, exact nat.le_of_lt (nat.lt_succ_self _) }

lemma play_D_move_at_hist_len_eq {pw : ℕ} {g : Game pw} {hs} :
  (play_D_move_at g hs).s.len = g.s.len.succ :=
by rw hist_len_play_D_move_at

lemma play_move_at_hist_len_ge {pw : ℕ} {g : Game pw} :
  g.s.len ≤ g.play_move.s.len :=
begin
  rw Game.play_move, split_ifs with hs, swap, { refl },
  rw play_A_move_at, split_ifs with h₁,
  { change (play_D_move_at g hs).a with g.a,
    transitivity (play_D_move_at g hs).s.len,
    { exact play_D_move_at_hist_len_ge },
    { rw hist_len_play_A_move_at',
      exact nat.le_of_lt (nat.lt_succ_self _) }},
  { change _ ≤ (play_D_move_at g hs).s.len,
    rw hist_len_play_D_move_at,
    exact nat.le_of_lt (nat.lt_succ_self _) },
end

lemma play_at_hist_len_ge {pw n : ℕ} {g : Game pw} :
  g.s.len ≤ (g.play n).s.len :=
begin
  induction n with n ih,
  { refl },
  { apply le_trans ih, clear ih, rw play_at_succ',
    exact play_move_at_hist_len_ge },
end

lemma set_players_flip {pw pw₁ : ℕ} {g : Game pw}
  {a₁ : A pw₁} {d₁ : D} :
  (g.set_A a₁).set_D d₁ = (g.set_D d₁).set_A a₁ :=
rfl

lemma play_move_eq_set_state_of_act_next {pw : ℕ} {g : Game pw}
  (h : g.play_move.act) :
  g.play_move = g.set_state g.play_move.s :=
begin
  ext,
  { exact play_move_at_players_eq.1 },
  { exact play_move_at_players_eq.2 },
  { refl },
end

lemma play_D_move_eq {pw : ℕ} {g : Game pw} {hs} :
  play_D_move_at g hs =
  g.set_state (apply_D_move g.s (g.d.f g.s hs).m) :=
rfl

-----

lemma set_prev_moves_A_wins_iff {pw : ℕ} {g : Game pw}
  {fa : A_prev_moves pw g.s}
  {fd : D_prev_moves g.s} :
  (g.set_prev_moves fa fd).A_wins ↔ g.A_wins :=
begin
  let a := g.a, let d := g.d,
  let a' := a.set_prev_moves g.s fa,
  let d' := d.set_prev_moves g.s fd,
  let g' : Game pw := _,
  change (∀ n, (g'.play n).act) ↔ (∀ n, ((g.play n).set_players a' d').act),
  suffices h : ∀ {n}, g'.play n = (g.play n).set_players a' d', simp_rw h,
  intro n, induction n with n ih, { refl },
  let g₁ := g.play n,
  let g₁' := g₁.set_players a' d',
  simp_rw play_at_succ', rw ih, clear ih,
  change (g₁.set_players a' d').play_move = g₁.play_move.set_players a' d',
  simp_rw Game.play_move,
  split_ifs, swap, { refl },
  have h₁ : play_D_move_at (g₁.set_players a' d') h =
    (play_D_move_at g₁ h).set_players a' d',
  { simp_rw [Game.set_players, set_players_flip, play_D_move_at_set_A],
    congr, simp_rw play_D_move_at,
    change (g₁.set_D d').d with d',
    ext; try { refl }, change _ = apply_D_move _ _,
    simp [apply_D_move, apply_move], simp_rw Game.set_state,
    refine ⟨_, snoc_eq_snoc_iff.mpr ⟨rfl, rfl⟩, rfl⟩,
    change (g₁.set_D d').s with g₁.s,
    congr' 1, generalize_proofs, change d'.f g₁.s h with dite _ _ _,
    split_ifs with h₂,
    { exfalso, contrapose! h₂, clear h₂,
      transitivity (g.play n).s.len,
      { exact play_at_hist_len_ge },
      { refl }},
    { congr, exact play_at_players_eq.2.symm }},
  rw h₁, clear h₁,
  let g₂ : Game pw := _, change (play_D_move_at g₁ h) with g₂,
  have h₁ : play_A_move_at (g₂.set_A a') =
    (play_A_move_at g₂).set_A a',
  { simp_rw play_A_move_at,
    change dite (g₂.act ∧ A_has_valid_move pw g₂.s.board) _ _ = _,
    split_ifs with hx, swap, { refl },
    change (g₂.set_A a').a with a',
    simp_rw play_A_move_at', ext; try {refl},
    simp_rw Game.set_state,
    change (g₂.set_A a').s with g₂.s at hx ⊢,
    change _ = apply_A_move _ _,
    simp [apply_A_move, apply_move],
    generalize_proofs hy hz,
    change a'.f g₂.s h hy with dite _ _ _,
    split_ifs with h₂,
    { exfalso, contrapose! h₂, clear h₂,
      transitivity (g.play n).s.len,
      { exact play_at_hist_len_ge },
      { exact play_D_move_at_hist_len_ge }},
    { congr, exact play_at_players_eq.1.symm }},
  simp_rw [Game.set_players, play_A_move_at_set_D, h₁],
end

lemma A_set_move_A_wins_iff {pw : ℕ} {g : Game pw}
  {s : State} {m : Valid_A_move pw s.board}
  (h : s.len < g.s.len) :
  (g.set_A (g.a.set_move s m)).A_wins ↔ g.A_wins :=
begin
  convert set_prev_moves_A_wins_iff, ext,
  { change _ = g.a.prev_moves_set g.s s m h, rw A_prev_moves_set_eq, refl },
  repeat { refl }, change _ = g.d.prev_moves_id g.s,
  rw D_prev_moves_id_eq, refl,
end

lemma D_set_move_A_wins_iff {pw : ℕ} {g : Game pw}
  {s : State} {m : Valid_D_move s.board}
  (h : s.len < g.s.len) :
  (g.set_D (g.d.set_move s m)).A_wins ↔ g.A_wins :=
begin
  convert set_prev_moves_A_wins_iff, ext,
  { change _ = g.a.prev_moves_id g.s, rw A_prev_moves_id_eq, },
  repeat { refl }, change _ = g.d.prev_moves_set g.s s m h,
  rw D_prev_moves_set_eq,
end

lemma play_1 {pw : ℕ} {g : Game pw} : g.play 1 = g.play_move := rfl

-----

@[simp]
lemma init_game_act {pw : ℕ}
  {a : A pw} {d : D} {s : State} :
  (init_game a d s).act ↔ s.act := by refl

lemma init_game_play_move {pw : ℕ}
  {a : A pw} {d : D} {s : State} (hs) :
  (init_game a d s).play_move =
  play_A_move_at (play_D_move_at (init_game a d s) hs) :=
dif_pos (init_game_act.mp hs)

lemma hist_len_game_finish {pw : ℕ} {g : Game pw} :
  g.finish.s.len = g.s.len := rfl

lemma hist_len_le_play_move {pw : ℕ} {g : Game pw} :
  g.s.len ≤ g.play_move.s.len :=
begin
  rw Game.play_move, split_ifs with hs, swap, { refl },
  rw play_A_move_at, split_ifs with h,
  { rw [hist_len_play_A_move_at', hist_len_play_D_move_at],
    apply nat.le_succ_of_le (nat.le_succ _) },
  { rw [hist_len_game_finish, hist_len_play_D_move_at],
    apply nat.le_succ },
end

lemma hist_len_le_play {pw n : ℕ} {g : Game pw} :
  g.s.len ≤ (g.play n).s.len :=
begin
  induction n with n ih, { refl }, rw play_at_succ',
  exact ih.trans hist_len_le_play_move,
end

lemma play_add {pw n k} {g : Game pw} :
  g.play (n + k) = (g.play n).play k :=
by { rw add_comm, apply function.iterate_add_apply }

lemma play_add' {pw n k} {g : Game pw} :
  g.play (n + k) = (g.play k).play n :=
by { apply function.iterate_add_apply }

@[simp]
lemma init_game_s {pw : ℕ} {a : A pw} {d : D} {s : State} :
  (init_game a d s).s = s := rfl

lemma play_move_state_eq_of_act_play_move {pw : ℕ} {g : Game pw}
  (h : g.play_move.act) :
  ∃ s' hs hs' hvm, s' = apply_D_move g.s (g.d.f g.s hs).m ∧
  g.play_move.s = apply_A_move s' (g.a.f s' hs' hvm).m :=
begin
  have hs := act_of_act_play_move h,
  let s' := apply_D_move g.s (g.d.f g.s hs).m,
  have hvm : A_has_valid_move pw s'.board,
  { rw [play_move_at_act hs, play_A_move_at] at h,
    split_ifs at h with h₁,
    { exact h₁.2 },
    { cases h }},
  use [s', hs, hs, hvm, rfl],
  rw [play_move_at_act hs, play_A_move_at, dif_pos],
  swap, { exact ⟨hs, hvm⟩ }, refl,
end

lemma act_play_move_of_A_hvm {pw : ℕ} {g : Game pw} {hs}
  (h : A_has_valid_move pw (apply_D_move g.s (g.d.f g.s hs).m).board) :
  g.play_move.act :=
by { rw [play_move_at_act hs, play_A_move_at], split_ifs with h₁; tauto }

@[simp] lemma init_game_a_eq {pw : ℕ} {a : A pw} {d : D} {s : State} :
  (init_game a d s).a = a := rfl

@[simp] lemma init_game_d_eq {pw : ℕ} {a : A pw} {d : D} {s : State} :
  (init_game a d s).d = d := rfl

@[simp] lemma init_game_s_eq {pw : ℕ} {a : A pw} {d : D} {s : State} :
  (init_game a d s).s = s := rfl

@[simp] lemma set_state_s {pw : ℕ} {g : Game pw} {s : State} :
  (g.set_state s).s = s := rfl

-----

lemma valid_state₀ {pw : ℕ} : valid_state pw state₀ :=
⟨default, default, 0, rfl⟩

lemma valid_A_state_play_D_move {pw : ℕ} {g : Game pw} {hs}
  (h : valid_state pw g.s) :
  valid_A_state pw (play_D_move_at g hs).s :=
begin
  rcases h with ⟨a, d, n, h⟩,
  let d₁ := d.set_move g.s (g.d.f g.s hs),
  refine ⟨a, d₁, n, _⟩,
  have h₂ : (simulate a d₁ n).s = g.s,
  {
    revert hs,
    rw ←h, clear h,
    let s : State := _,
    change (simulate a d n).s with s,
    rintro hs d₁,
    change s with (simulate a d n).s,
    sorry
  },
  sorry {
    simp [h, h₂],
    use hs,
    generalize_proofs h₃,
    simp_rw [play_D_move_eq, set_state_s],
    rw (_ : (simulate a d₁ n).d = d₁),
    swap,
    {
      exact play_at_players_eq.2,
    },
    congr' 2,
    {
      rw h₂,
    },
    {
      revert h₃,
      rw h₂,
      exact λ _, heq_of_eq D_set_move_eq,
    },
  },
end

lemma valid_state_play_A_move {pw : ℕ} {g : Game pw}
  (h : valid_A_state pw g.s) :
  valid_state pw (play_A_move_at g).s :=
begin
  sorry
end

-- #exit

lemma valid_state_play_move {pw : ℕ} {g : Game pw}
  (h : valid_state pw g.s) :
  valid_state pw g.play_move.s :=
begin
  rw Game.play_move, split_ifs with h₁,
  { exact valid_state_play_A_move (valid_A_state_play_D_move h) },
  { exact h },
end

@[simp]
lemma play_D_move_act {pw : ℕ} {g : Game pw} {hs} :
  (play_D_move_at g hs).act ↔ g.act := by refl

@[simp]
lemma play_D_move_s {pw : ℕ} {g : Game pw} {hs} :
  (play_D_move_at g hs).s = apply_D_move g.s (g.d.f g.s hs).m := rfl