/-
Copyright (c) 2022 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.complex.abs_max
import analysis.locally_convex.with_seminorms
import geometry.manifold.mfderiv
import topology.locally_constant.basic

/-! # Holomorphic functions on complex manifolds

Thanks to the rigidity of complex-differentiability compared to real-differentiability, there are
many results about complex manifolds with no analogue for manifolds over a general normed field. For
now, this file contains just two (closely related) such results:

## Main results

* `mdifferentiable.is_locally_constant`: A complex-differentiable function on a compact complex
  manifold is locally constant.
* `mdifferentiable.exists_eq_const_of_compact_space`: A complex-differentiable function on a compact
  preconnected complex manifold is constant.

## TODO

There is a whole theory to develop here.  Maybe a next step would be to develop a theory of
holomorphic vector/line bundles, including:
* the finite-dimensionality of the space of sections of a holomorphic vector bundle
* Siegel's theorem: for any `n + 1` formal ratios `g 0 / h 0`, `g 1 / h 1`, .... `g n / h n` of
  sections of a fixed line bundle `L` over a complex `n`-manifold, there exists a polynomial
  relationship `P (g 0 / h 0, g 1 / h 1, .... g n / h n) = 0`

Another direction would be to develop the relationship with sheaf theory, building the sheaves of
holomorphic and meromorphic functions on a complex manifold and proving algebraic results about the
stalks, such as the Weierstrass preparation theorem.

-/

open_locale manifold topology
open complex

namespace mdifferentiable

variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E]
variables {F : Type*} [normed_add_comm_group F] [normed_space ℂ F] [strict_convex_space ℝ F]

variables {M : Type*} [topological_space M] [compact_space M] [charted_space E M]
  [smooth_manifold_with_corners 𝓘(ℂ, E) M]

/-- A holomorphic function on a compact complex manifold is locally constant. -/
protected lemma is_locally_constant {f : M → F} (hf : mdifferentiable 𝓘(ℂ, E) 𝓘(ℂ, F) f) :
  is_locally_constant f :=
begin
  haveI : locally_connected_space M := charted_space.locally_connected_space E M,
  apply is_locally_constant.of_constant_on_preconnected_clopens,
  intros s hs₂ hs₃ a ha b hb,
  have hs₁ : is_compact s := hs₃.2.is_compact,
  -- for an empty set this fact is trivial
  rcases s.eq_empty_or_nonempty with rfl | hs',
  { exact false.rec _ ha },
  -- otherwise, let `p₀` be a point where the value of `f` has maximal norm
  obtain ⟨p₀, hp₀s, hp₀⟩ := hs₁.exists_forall_ge hs' hf.continuous.norm.continuous_on,
  -- we will show `f` agrees everywhere with `f p₀`
  suffices : s ⊆ {r : M | f r = f p₀} ∩ s,
  { exact (this hb).1.trans (this ha).1.symm }, clear ha hb a b,
  refine hs₂.subset_clopen _ ⟨p₀, hp₀s, ⟨rfl, hp₀s⟩⟩,
  -- closedness of the set of points sent to `f p₀`
  refine ⟨_, (is_closed_singleton.preimage hf.continuous).inter hs₃.2⟩,
  -- we will show this set is open by showing it is a neighbourhood of each of its members
  rw is_open_iff_mem_nhds,
  rintros p ⟨hp : f p = _, hps⟩, -- let `p` be  in this set
  have hps' : s ∈ 𝓝 p := hs₃.1.mem_nhds hps,
  have key₁ : (chart_at E p).symm ⁻¹' s ∈ 𝓝 (chart_at E p p),
  { rw [← filter.mem_map, (chart_at E p).symm_map_nhds_eq (mem_chart_source E p)],
    exact hps' },
  have key₂ : (chart_at E p).target ∈ 𝓝 (chart_at E p p) :=
    (local_homeomorph.open_target _).mem_nhds (mem_chart_target E p),
  -- `f` pulled back by the chart at `p` is differentiable around `chart_at E p p`
  have hf' : ∀ᶠ (z : E) in 𝓝 (chart_at E p p), differentiable_at ℂ (f ∘ (chart_at E p).symm) z,
  { refine filter.eventually_of_mem key₂ (λ z hz, _),
    have H₁ : (chart_at E p).symm z ∈ (chart_at E p).source := (chart_at E p).map_target hz,
    have H₂ : f ((chart_at E p).symm z) ∈ (chart_at F (0:F)).source := trivial,
    have H := (mdifferentiable_at_iff_of_mem_source H₁ H₂).mp (hf ((chart_at E p).symm z)),
    simp only [differentiable_within_at_univ] with mfld_simps at H,
    simpa [local_homeomorph.right_inv _ hz] using H.2, },
  -- `f` pulled back by the chart at `p` has a local max at `chart_at E p p`
  have hf'' : is_local_max (norm ∘ f ∘ (chart_at E p).symm) (chart_at E p p),
  { refine filter.eventually_of_mem key₁ (λ z hz, _),
    refine (hp₀ ((chart_at E p).symm z) hz).trans (_ : ‖f p₀‖ ≤ ‖f _‖),
    rw [← hp, local_homeomorph.left_inv _ (mem_chart_source E p)] },
  -- so by the maximum principle `f` is equal to `f p` near `p`
  obtain ⟨U, hU, hUf⟩ := (complex.eventually_eq_of_is_local_max_norm hf' hf'').exists_mem,
  have H₁ : (chart_at E p) ⁻¹' U ∈ 𝓝 p := (chart_at E p).continuous_at (mem_chart_source E p) hU,
  have H₂ : (chart_at E p).source ∈ 𝓝 p :=
    (local_homeomorph.open_source _).mem_nhds (mem_chart_source E p),
  apply filter.mem_of_superset (filter.inter_mem hps' (filter.inter_mem H₁ H₂)),
  rintros q ⟨hqs, hq : chart_at E p q ∈ _, hq'⟩,
  refine ⟨_, hqs⟩,
  simpa [local_homeomorph.left_inv _ hq', hp, -norm_eq_abs] using hUf (chart_at E p q) hq,
end

/-- A holomorphic function on a compact connected complex manifold is constant. -/
lemma apply_eq_of_compact_space [preconnected_space M]
  {f : M → F} (hf : mdifferentiable 𝓘(ℂ, E) 𝓘(ℂ, F) f) (a b : M) :
  f a = f b :=
hf.is_locally_constant.apply_eq_of_preconnected_space _ _

/-- A holomorphic function on a compact connected complex manifold is the constant function `f ≡ v`,
for some value `v`. -/
lemma exists_eq_const_of_compact_space [preconnected_space M]
  {f : M → F} (hf : mdifferentiable 𝓘(ℂ, E) 𝓘(ℂ, F) f) :
  ∃ v : F, f = function.const M v :=
hf.is_locally_constant.exists_eq_const

end mdifferentiable


import Monads.Functor

namespace Monads
  /- Applicative functors allow us to apply functions that are already
     wrapped withing the functor to other values wrapped withing the functor.
     This allows chaining of methods like so: f <$> g <*> h <*> x. -/
  class Applicative (f : Type u → Type v) extends Functor f where
    /- Lift a normal value into an applicative context. -/
    pure : α → f α
    /- Apply a function inside an applicative to a value inside an applicative. -/
    apply : ∀ {α β : Type u}, f (α → β) → f α → f β
    /- Lift a funcion of arity 2 (2 parameters) to the applicative context. -/
    liftA2 : (α → β → γ) → f α → f β → f γ := λ g x y => apply (g <$> x) y
    /- Drop the action on the left and only return the right one. If
       left contains e.g. a sideffect it will still be executed. -/
    seq_right : f α → f β → f β := λ a1 a2 => apply (id <$ a1) a2
    /- Drop the action on the right and only return the left one. If
       right contains e.g. a sideffect it will still be executed. -/
    seq_left : f α → f β → f α := liftA2 (Function.const β)

  export Applicative (pure liftA2)

  infixl:60 " <*> " => Monads.Applicative.apply
  -- The arrow points at the value that is kept
  infixl:60 " *> " => Monads.Applicative.seq_right
  infixl:60 " <* " => Monads.Applicative.seq_left

  /- Lawful applicatives essentially capture the same concept of modifying
     only the contents and not the context they are captured in as a lawful
     regular functor. -/
  class LawfulApplicative (f : Type u → Type v) [app: Applicative f] extends LawfulFunctor f : Prop where
    /- If the function maps values to themselves the values in the applicative
       shall remain unchanged. -/
    apply_id : ∀ x : f α, pure id <*> x = x
    /- Applying a pure function to a pure value with <*> shall be the
       same as first applying them outside of the applicative and wrapping
       the result into it. -/
    apply_homomorphism: ∀ (x : α) (g : α → β), pure g <*> app.pure x = pure (g x)
    /- Applying an effectful function to a pure value should yield the same result,
       regardless of order. -/
    apply_interchange: ∀ {α β : Type u} (x : α) (g : f (α → β)), g <*> pure x = pure (· $ x) <*> g
    /- A modified associativity property for <*>. -/
    apply_comp : ∀ {α β γ: Type u} (x : f (β → γ)) (y : f (α → β)) (z : f α), pure (@Function.comp α β γ) <*> x <*> y <*> z = x <*> (y <*> z)
    /- If there is a custom liftA2 definition it has to behave like the default one -/
    lifta2_behaved : ∀ (g : α → β → γ) (x : f α) (y : f β), liftA2 g x y = g <$> x <*> y
    /- If there is a custom *> definition it has to behave like the default one -/
    seq_right_behaved : ∀ (a1 : f α) (a2 : f β), a1 *> a2 = (id <$ a1) <*> a2
    /- If there is a custom <* definition it has to behave like the default one -/
    seq_left_behaved : ∀ (a1 : f α) (a2 : f β), a1 <* a2 = liftA2 (Function.const β) a1 a2
    /- This law is rather intuitive and provable with the free theorem in Haskell.
       However I'm unsure whether it applies in lean and no formalization exists,
       hence it will be an axiom. (Mathlib does this too). Furthermore it is shown
       below that the right hand side is a lawful functor. -/
    fmap_eq_pure_apply : ∀ (g : α → β) (x : f α), g <$> x = app.pure g <*> x

  namespace LawfulApplicative
    variable {f : Type u → Type v} [Applicative f] [LawfulApplicative f]
    -- These 4 laws allow us to prove equality of any term involving only <*> or pure (if they are equal)
    example {α β : Type u} {g : f (α → β)} {x : f α} : g <*> (pure id <*> x) = g <*> x := by rw [apply_id]
    example {α β : Type u} {g : f (α → β)} {x : f α} : pure id <*> (g <*> x) = g <*> x := by rw [apply_id]
    example {α β γ δ ε: Type u} {h : f (δ → ε)}{g : α → β → γ → δ} {x : α} { y : β} { z : γ} : h <*> (pure g <*> pure x <*> pure y <*> pure z) = h <*> pure (g x y z) := by
      simp only [apply_homomorphism]

    -- Constructing a lawful functor from a lawful applicative
    def apply_fmap : (α → β) → f α → f β := λ g a => pure g <*> a

    -- First law
    example : ∀ {α : Type u} (x : f α), apply_fmap id x = x := by
      intro α x
      simp only [apply_fmap]
      rw [apply_id]

    -- Second law
    example : ∀ {α β γ : Type u} (g : α → β) (h : β → γ) (x : f α), apply_fmap (h ∘ g) x = apply_fmap h (apply_fmap g x) := by
      intro α β γ g h x
      simp only [apply_fmap]
      rw [←apply_comp]
      rw [apply_homomorphism]
      rw [apply_homomorphism]
  end LawfulApplicative
end Monads


import Smt

theorem triv : Nat.zero + Nat.succ Nat.zero = Nat.succ Nat.zero := by
  smt
  simp_all


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.wf
import Mathlib.Lean3Lib.init.data.nat.basic

namespace Mathlib

namespace nat

protected def div (x : ℕ) : ℕ → ℕ :=
  well_founded.fix lt_wf div.F

protected instance has_div : Div ℕ :=
  { div := nat.div }

theorem div_def_aux (x : ℕ) (y : ℕ) : x / y = dite (0 < y ∧ y ≤ x) (fun (h : 0 < y ∧ y ≤ x) => (x - y) / y + 1) fun (h : ¬(0 < y ∧ y ≤ x)) => 0 :=
  congr_fun (well_founded.fix_eq lt_wf div.F x) y

protected def mod (x : ℕ) : ℕ → ℕ :=
  well_founded.fix lt_wf mod.F

protected instance has_mod : Mod ℕ :=
  { mod := nat.mod }

theorem mod_def_aux (x : ℕ) (y : ℕ) : x % y = dite (0 < y ∧ y ≤ x) (fun (h : 0 < y ∧ y ≤ x) => (x - y) % y) fun (h : ¬(0 < y ∧ y ≤ x)) => x :=
  congr_fun (well_founded.fix_eq lt_wf mod.F x) y


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem algebra_manipexpr_apbeq2cceqiacpbceqm2
  (a b c : ℂ)
  (h₀ : a + b = 2 * c)
  (h₁ : c = complex.I) :
  a * c + b * c = -2 :=
begin
  rw [← add_mul, h₀, h₁, mul_assoc, complex.I_mul_I],
  ring,
end


import .add
import principia.mynat.induction

namespace hidden
namespace oldint

theorem intduction (p : oldint → Prop) :
p 0 → (∀ {n}, p n → p (n + 1)) → (∀ {n}, p n → p (n - 1)) →
∀ n, p n :=
begin
  assume h0 hnext hprev,
  intro n,
  cases n, {
    induction n with n hn, {
      rwa [mynat.zz, ←coe_nat_eq, zero_nat],
    }, {
      rw ←coe_nat_eq at hn,
      have h := hnext hn,
      rwa [←coe_nat_eq], -- magic?
    },
  }, {
    induction n with n hn, {
      rw [mynat.zz, ←neg_one],
      apply @hprev 0,
      assumption,
    }, {
      rw [←neg_coe_succ, ←mynat.add_one_succ, ←nat_nat_add, neg_distr,
          one_nat, ←sub_add_neg],
      apply @hprev (-↑(mynat.succ n)),
      rwa neg_coe_succ,
    },
  },
end

open mynat
private theorem one: (1: mynat) = succ 0 := rfl

theorem intduction_from {m : oldint} (p : oldint → Prop):
(∀ {n}, p n → p (n + 1)) → (∀ {n}, p n → p (n - 1)) →
p m → ∀ n, p n :=
begin
  assume hnext hprev hex,
  suffices : p 0,
    apply intduction, repeat {assumption},
  cases m, {
    revert m,
    apply descend_to_zero,
    intro m,
    assume hsucc,
    have := hprev hsucc,
    rwa [sub_add_neg, neg_one, ←coe_nat_eq, nat_neg_add, sub_succ_succ,
         nat_sub_zero] at this,
  }, {
    suffices : p (-1), from hnext this,
    rw neg_one,
    revert m,
    apply descend_to_zero,
    intro m,
    assume hsucc,
    have := hnext hsucc,
    rwa [←one_nat, neg_nat_add, one, sub_succ_succ, zero_sub_neg,
        neg_succ] at this,
  },
end

end oldint
end hidden


/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro

! This file was ported from Lean 3 source module data.list.defs
! leanprover-community/mathlib commit 1fc36cc9c8264e6e81253f88be7fb2cb6c92d76a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Defs
import Mathlib.Control.Functor
import Mathlib.Data.Nat.Basic
import Mathlib.Logic.Basic
import Std.Tactic.Lint.Basic
import Std.Data.RBMap.Basic

/-!
## Definitions on lists

This file contains various definitions on lists. It does not contain
proofs about these definitions, those are contained in other files in `Data.List`
-/

-- Porting notes
-- Many of the definitions in `Data.List.Defs` were already defined upstream in `Std4`
-- These have been annotated with `#align`s
-- To make this easier for review, the `#align`s have been placed in order of occurrence
-- in `mathlib`

namespace List

open Function Nat

section recursor_workarounds
/-- A computable version of `List.rec`. Workaround until Lean has native support for this. -/
def recC.{u_1, u} {α : Type u} {motive : List α → Sort u_1} (nil : motive [])
  (cons : (head : α) → (tail : List α) → motive tail → motive (head :: tail)) :
    (l : List α) → motive l
| [] => nil
| (x :: xs) => cons x xs (List.recC nil cons xs)

@[csimp]
lemma rec_eq_recC : @List.rec = @List.recC := by
  ext α motive nil cons l
  induction l with
  | nil => rfl
  | cons x xs ih =>
    rw [List.recC, ←ih]

/-- A computable version of `List._sizeOf_inst`. -/
def _sizeOf_instC.{u} (α : Type u) [SizeOf α] : SizeOf (List α) where
  sizeOf t := List.rec 1 (fun head _ tail_ih => 1 + SizeOf.sizeOf head + tail_ih) t

@[csimp]
lemma _sizeOfinst_eq_sizeOfinstC : @List._sizeOf_inst = @List._sizeOf_instC := by
  simp [List._sizeOf_1, List._sizeOf_instC, _sizeOf_inst]

end recursor_workarounds

universe u v w x

variable {α β γ δ ε ζ : Type _}

instance [DecidableEq α] : SDiff (List α) :=
  ⟨List.diff⟩

#align list.split_at List.splitAt
#align list.split_on_p List.splitOnP
#align list.split_on List.splitOn
#align list.concat List.concat
#align list.head' List.head?
#align list.to_array List.toArray
#align list.nthd List.getD
-- porting notes: see
-- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/List.2Ehead/near/313204716
-- for the fooI naming convention.
/-- "Inhabited" `get` function: returns `default` instead of `none` in the case
  that the index is out of bounds. -/
def getI [Inhabited α] (l : List α) (n : Nat) : α :=
  getD l n default
#align list.inth List.getI

/-- "Inhabited" `take` function: Take `n` elements from a list `l`. If `l` has less than `n`
  elements, append `n - length l` elements `default`. -/
def takeI [Inhabited α] (n : Nat) (l : List α) : List α :=
  takeD n l default
#align list.take' List.takeI

#align list.modify_nth_tail List.modifyNthTail
#align list.modify_head List.modifyHead
#align list.modify_nth List.modifyNth
#align list.modify_last List.modifyLast
#align list.insert_nth List.insertNth
#align list.take_while List.takeWhile
#align list.scanl List.scanl
#align list.scanr List.scanr

/-- Product of a list.

     `prod [a, b, c] = ((1 * a) * b) * c` -/
def prod [Mul α] [One α] : List α → α :=
  foldl (· * ·) 1
#align list.prod List.prod

-- Later this will be tagged with `to_additive`, but this can't be done yet because of imports.
-- dependencies.
/-- Sum of a list.

     `sum [a, b, c] = ((0 + a) + b) + c` -/
def sum [Add α] [Zero α] : List α → α :=
  foldl (· + ·) 0
#align list.sum List.sum

/-- The alternating sum of a list. -/
def alternatingSum {G : Type _} [Zero G] [Add G] [Neg G] : List G → G
  | [] => 0
  | g :: [] => g
  | g :: h :: t => g + -h + alternatingSum t
#align list.alternating_sum List.alternatingSum

/-- The alternating product of a list. -/
def alternatingProd {G : Type _} [One G] [Mul G] [Inv G] : List G → G
  | [] => 1
  | g :: [] => g
  | g :: h :: t => g * h⁻¹ * alternatingProd t
#align list.alternating_prod List.alternatingProd

#align list.partition_map List.partitionMap
#align list.find List.find?

/-- `findM tac l` returns the first element of `l` on which `tac` succeeds, and
fails otherwise. -/
def findM {α} {m : Type u → Type v} [Alternative m] (tac : α → m PUnit) : List α → m α :=
  List.firstM <| fun a => (tac a) $> a
#align list.mfind List.findM

/-- `findM? p l` returns the first element `a` of `l` for which `p a` returns
true. `findM?` short-circuits, so `p` is not necessarily run on every `a` in
`l`. This is a monadic version of `List.find`. -/
def findM?'
    {m : Type u → Type v}
    [Monad m] {α : Type u}
    (p : α → m (ULift Bool)) : List α → m (Option α)
  | [] => pure none
  | x :: xs => do
    let ⟨px⟩ ← p x
    if px then pure (some x) else findM?' p xs
#align list.mbfind' List.findM?'

#align list.mbfind List.findM?
#align list.many List.anyM
#align list.mall List.allM

section

variable {m : Type → Type v} [Monad m]

/-- `orM xs` runs the actions in `xs`, returning true if any of them returns
true. `orM` short-circuits, so if an action returns true, later actions are
not run. -/
def orM : List (m Bool) → m Bool :=
  anyM id
#align list.mbor List.orM

/-- `andM xs` runs the actions in `xs`, returning true if all of them return
true. `andM` short-circuits, so if an action returns false, later actions are
not run. -/
def andM : List (m Bool) → m Bool :=
  allM id
#align list.mband List.andM

end

#align list.foldr_with_index List.foldrIdx
#align list.foldl_with_index List.foldlIdx
#align list.find_indexes List.findIdxs
#align list.indexes_values List.indexesValues
#align list.indexes_of List.indexesOf

section foldIdxM

variable {m : Type v → Type w} [Monad m]

/-- Monadic variant of `foldlIdx`. -/
def foldlIdxM {α β} (f : ℕ → β → α → m β) (b : β) (as : List α) : m β :=
  as.foldlIdx
    (fun i ma b => do
      let a ← ma
      f i a b)
    (pure b)
#align list.mfoldl_with_index List.foldlIdxM

/-- Monadic variant of `foldrIdx`. -/
def foldrIdxM {α β} (f : ℕ → α → β → m β) (b : β) (as : List α) : m β :=
  as.foldrIdx
    (fun i a mb => do
      let b ← mb
      f i a b)
    (pure b)
#align list.mfoldr_with_index List.foldrIdxM

end foldIdxM

section mapIdxM

-- porting notes: This was defined in `mathlib` with an `Applicative`
-- constraint on `m` and have been `#align`ed to the `Std` versions defined
-- with a `Monad` typeclass constraint.
-- Since all `Monad`s are `Applicative` this won't cause issues
-- downstream & `Monad`ic code is more performant per Mario C
-- See https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/Applicative.20variants.20of.20Monadic.20functions/near/313213172
#align list.mmap_with_index List.mapIdxM

variable {m : Type v → Type w} [Monad m]

/-- Auxiliary definition for `mapIdxM'`. -/
def mapIdxMAux' {α} (f : ℕ → α → m PUnit) : ℕ → List α → m PUnit
  | _, [] => pure ⟨⟩
  | i, a :: as => f i a *> mapIdxMAux' f (i + 1) as
#align list.mmap_with_index'_aux List.mapIdxMAux'

/-- A variant of `mapIdxM` specialised to applicative actions which
return `unit`. -/
def mapIdxM' {α} (f : ℕ → α → m PUnit) (as : List α) : m PUnit :=
  mapIdxMAux' f 0 as
#align list.mmap_with_index' List.mapIdxM'

end mapIdxM

#align list.lookmap List.lookmap
#align list.countp List.countp
#align list.count List.count
#align list.is_prefix List.isPrefix
#align list.is_suffix List.isSuffix
#align list.is_infix List.isInfix
#align list.inits List.inits
#align list.tails List.tails
#align list.sublists' List.sublists'
#align list.sublists List.sublists
#align list.forall₂ List.Forall₂

/-- `l.all₂ p` is equivalent to `∀ a ∈ l, p a`, but unfolds directly to a conjunction, i.e.
`list.all₂ p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
@[simp]
def All₂ (p : α → Prop) : List α → Prop
  | [] => True
  | x :: [] => p x
  | x :: l => p x ∧ All₂ p l
#align list.all₂ List.All₂

#align list.transpose List.transpose
#align list.sections List.sections

section Permutations

/-- An auxiliary function for defining `permutations`. `permutationsAux2 t ts r ys f` is equal to
`(ys ++ ts, (insert_left ys t ts).map f ++ r)`, where `insert_left ys t ts` (not explicitly
defined) is the list of lists of the form `insert_nth n t (ys ++ ts)` for `0 ≤ n < length ys`.

    permutations_aux2 10 [4, 5, 6] [] [1, 2, 3] id =
      ([1, 2, 3, 4, 5, 6],
       [[10, 1, 2, 3, 4, 5, 6],
        [1, 10, 2, 3, 4, 5, 6],
        [1, 2, 10, 3, 4, 5, 6]]) -/
def permutationsAux2 (t : α) (ts : List α) (r : List β) : List α → (List α → β) → List α × List β
  | [], _ => (ts, r)
  | y :: ys, f =>
    let (us, zs) := permutationsAux2 t ts r ys (fun x: List α => f (y :: x))
    (y :: us, f (t :: y :: us) :: zs)
#align list.permutations_aux2 List.permutationsAux2

-- porting note: removed `[elab_as_elim]` per Mario C
-- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/Status.20of.20data.2Elist.2Edefs.3F/near/313571979
/-- A recursor for pairs of lists. To have `C l₁ l₂` for all `l₁`, `l₂`, it suffices to have it for
`l₂ = []` and to be able to pour the elements of `l₁` into `l₂`. -/
def permutationsAux.rec {C : List α → List α → Sort v} (H0 : ∀ is, C [] is)
    (H1 : ∀ t ts is, C ts (t :: is) → C is [] → C (t :: ts) is) : ∀ l₁ l₂, C l₁ l₂
  | [], is => H0 is
  | t :: ts, is =>
      H1 t ts is (permutationsAux.rec H0 H1 ts (t :: is)) (permutationsAux.rec H0 H1 is [])
  termination_by _ ts is => (length ts + length is, length ts)
  decreasing_by simp_wf; simp [Nat.succ_add]; decreasing_tactic
#align list.permutations_aux.rec List.permutationsAux.rec

/-- An auxiliary function for defining `permutations`. `permutationsAux ts is` is the set of all
permutations of `is ++ ts` that do not fix `ts`. -/
def permutationsAux : List α → List α → List (List α) :=
  permutationsAux.rec (fun _ => []) fun t ts is IH1 IH2 =>
    foldr (fun y r => (permutationsAux2 t ts r y id).2) IH1 (is :: IH2)
#align list.permutations_aux List.permutationsAux

/-- List of all permutations of `l`.

     permutations [1, 2, 3] =
       [[1, 2, 3], [2, 1, 3], [3, 2, 1],
        [2, 3, 1], [3, 1, 2], [1, 3, 2]] -/
def permutations (l : List α) : List (List α) :=
  l :: permutationsAux l []
#align list.permutations List.permutations

/-- `permutations'Aux t ts` inserts `t` into every position in `ts`, including the last.
This function is intended for use in specifications, so it is simpler than `permutationsAux2`,
which plays roughly the same role in `permutations`.

Note that `(permutationsAux2 t [] [] ts id).2` is similar to this function, but skips the last
position:

    permutations'Aux 10 [1, 2, 3] =
      [[10, 1, 2, 3], [1, 10, 2, 3], [1, 2, 10, 3], [1, 2, 3, 10]]
    (permutationsAux2 10 [] [] [1, 2, 3] id).2 =
      [[10, 1, 2, 3], [1, 10, 2, 3], [1, 2, 10, 3]] -/
@[simp]
def permutations'Aux (t : α) : List α → List (List α)
  | [] => [[t]]
  | y :: ys => (t :: y :: ys) :: (permutations'Aux t ys).map (cons y)
#align list.permutations'_aux List.permutations'Aux

/-- List of all permutations of `l`. This version of `permutations` is less efficient but has
simpler definitional equations. The permutations are in a different order,
but are equal up to permutation, as shown by `list.permutations_perm_permutations'`.

     permutations [1, 2, 3] =
       [[1, 2, 3], [2, 1, 3], [2, 3, 1],
        [1, 3, 2], [3, 1, 2], [3, 2, 1]] -/
@[simp]
def permutations' : List α → List (List α)
  | [] => [[]]
  | t :: ts => (permutations' ts).bind <| permutations'Aux t
#align list.permutations' List.permutations'

end Permutations

#align list.erasep List.erasePₓ -- prop -> bool

/-- `extractp p l` returns a pair of an element `a` of `l` satisfying the predicate
  `p`, and `l`, with `a` removed. If there is no such element `a` it returns `(none, l)`. -/
def extractp (p : α → Prop) [DecidablePred p] : List α → Option α × List α
  | [] => (none, [])
  | a :: l =>
    if p a then (some a, l)
    else
      let (a', l') := extractp p l
      (a', a :: l')
#align list.extractp List.extractp

#align list.revzip List.revzip
#align list.product List.product
/-- Notation for calculating the product of a `List`
-/
-- This notation binds more strongly than (pre)images, unions and intersections.
infixr:82 " ×ˢ " => List.product
#align list.sigma List.sigma
#align list.of_fn List.ofFn
#align list.of_fn_nth_val List.ofFnNthVal
#align list.disjoint List.Disjoint
#align list.pairwise List.Pairwise
#align list.pairwise_cons List.pairwise_cons
#align list.decidable_pairwise List.instDecidablePairwise
#align list.pw_filter List.pwFilter
#align list.chain List.Chain
#align list.chain' List.Chain'

section Chain

@[simp]
theorem chain_cons {a b : α} {l : List α} : Chain R a (b :: l) ↔ R a b ∧ Chain R b l :=
  ⟨fun p ↦ by cases p with | cons n p => exact ⟨n, p⟩,
   fun ⟨n, p⟩ ↦ p.cons n⟩
#align list.chain_cons List.chain_cons

instance decidableChain [DecidableRel R] (a : α) (l : List α) :
    Decidable (Chain R a l) := by
  induction l generalizing a with
  | nil => simp only [List.Chain.nil]; infer_instance
  | cons a as ih => haveI := ih; simp only [List.chain_cons]; infer_instance
#align list.decidable_chain List.decidableChain

instance decidableChain' [DecidableRel R] (l : List α) : Decidable (Chain' R l) := by
  cases l <;> dsimp only [List.Chain'] <;> infer_instance
#align list.decidable_chain' List.decidableChain'

end Chain

#align list.nodup List.Nodup
#align list.nodup_decidable List.nodupDecidable

/-- `dedup l` removes duplicates from `l` (taking only the last occurrence).
  Defined as `pwFilter (≠)`.

     dedup [1, 0, 2, 2, 1] = [0, 2, 1] -/
def dedup [DecidableEq α] : List α → List α :=
  pwFilter (· ≠ ·)
#align list.dedup List.dedup

/-- Greedily create a sublist of `a :: l` such that, for every two adjacent elements `a, b`,
`R a b` holds. Mostly used with ≠; for example, `destutter' (≠) 1 [2, 2, 1, 1] = [1, 2, 1]`,
`destutter' (≠) 1, [2, 3, 3] = [1, 2, 3]`, `destutter' (<) 1 [2, 5, 2, 3, 4, 9] = [1, 2, 5, 9]`. -/
def destutter' (R : α → α → Prop) [DecidableRel R] : α → List α → List α
  | a, [] => [a]
  | a, h :: l => if R a h then a :: destutter' R h l else destutter' R a l
#align list.destutter' List.destutter'

-- TODO: should below be "lazily"?
/-- Greedily create a sublist of `l` such that, for every two adjacent elements `a, b ∈ l`,
`R a b` holds. Mostly used with ≠; for example, `destutter (≠) [1, 2, 2, 1, 1] = [1, 2, 1]`,
`destutter (≠) [1, 2, 3, 3] = [1, 2, 3]`, `destutter (<) [1, 2, 5, 2, 3, 4, 9] = [1, 2, 5, 9]`. -/
def destutter (R : α → α → Prop) [DecidableRel R] : List α → List α
  | h :: l => destutter' R h l
  | [] => []
#align list.destutter List.destutter

#align list.range' List.range'
#align list.reduce_option List.reduceOption
-- Porting note: replace ilast' by getLastD
#align list.ilast' List.ilast'
-- Porting note: remove last' from Std
#align list.last' List.getLast?
#align list.rotate List.rotate
#align list.rotate' List.rotate'

section Choose

variable (p : α → Prop) [DecidablePred p] (l : List α)

/-- Given a decidable predicate `p` and a proof of existence of `a ∈ l` such that `p a`,
choose the first element with this property. This version returns both `a` and proofs
of `a ∈ l` and `p a`. -/
def chooseX : ∀ l : List α, ∀ _ : ∃ a, a ∈ l ∧ p a, { a // a ∈ l ∧ p a }
  | [], hp => False.elim (Exists.elim hp fun a h => not_mem_nil a h.left)
  | l :: ls, hp =>
    if pl : p l then ⟨l, ⟨mem_cons.mpr <| Or.inl rfl, pl⟩⟩
    else
      let ⟨a, ⟨a_mem_ls, pa⟩⟩ :=
        chooseX ls
          (hp.imp fun _ ⟨o, h₂⟩ => ⟨(mem_cons.mp o).resolve_left fun e => pl <| e ▸ h₂, h₂⟩)
      ⟨a, ⟨mem_cons.mpr <| Or.inr a_mem_ls, pa⟩⟩
#align list.choose_x List.chooseX

/-- Given a decidable predicate `p` and a proof of existence of `a ∈ l` such that `p a`,
choose the first element with this property. This version returns `a : α`, and properties
are given by `choose_mem` and `choose_property`. -/
def choose (hp : ∃ a, a ∈ l ∧ p a) : α :=
  chooseX p l hp
#align list.choose List.choose

end Choose

#align list.mmap_filter List.filterMapM
#align list.mmap_upper_triangle List.mapDiagM

/-- `mapDiagM' f l` calls `f` on all elements in the upper triangular part of `l × l`.
That is, for each `e ∈ l`, it will run `f e e` and then `f e e'`
for each `e'` that appears after `e` in `l`.

Example: suppose `l = [1, 2, 3]`. `mapDiagM' f l` will evaluate, in this order,
`f 1 1`, `f 1 2`, `f 1 3`, `f 2 2`, `f 2 3`, `f 3 3`.
-/
def mapDiagM' {m} [Monad m] {α} (f : α → α → m Unit) : List α → m Unit
-- as ported:
--   | [] => return ()
--   | h :: t => (f h h >> t.mapM' (f h)) >> t.mapDiagM'
  | [] => return ()
  | h :: t => do
    _ ← f h h
    _ ← t.mapM' (f h)
    t.mapDiagM' f
#align list.mmap'_diag List.mapDiagM'

/-- Map each element of a `List` to an action, evaluate these actions in order,
    and collect the results.
-/
protected def traverse {F : Type u → Type v} [Applicative F] {α β : Type _} (f : α → F β)
    : List α → F (List β)
  | [] => pure []
  | x :: xs => List.cons <$> f x <*> List.traverse f xs
#align list.traverse List.traverse

#align list.get_rest List.getRest
#align list.slice List.dropSlice

/-- Left-biased version of `List.map₂`. `map₂Left' f as bs` applies `f` to each
pair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, `f` is
applied to `none` for the remaining `aᵢ`. Returns the results of the `f`
applications and the remaining `bs`.

```
map₂Left' prod.mk [1, 2] ['a'] = ([(1, some 'a'), (2, none)], [])

map₂Left' prod.mk [1] ['a', 'b'] = ([(1, some 'a')], ['b'])
```
-/
@[simp]
def map₂Left' (f : α → Option β → γ) : List α → List β → List γ × List β
  | [], bs => ([], bs)
  | a :: as, [] => ((a :: as).map fun a => f a none, [])
  | a :: as, b :: bs =>
    let rec' := map₂Left' f as bs
    (f a (some b) :: rec'.fst, rec'.snd)
#align list.map₂_left' List.map₂Left'

/-- Right-biased version of `List.map₂`. `map₂Right' f as bs` applies `f` to each
pair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, `f` is
applied to `none` for the remaining `bᵢ`. Returns the results of the `f`
applications and the remaining `as`.

```
map₂Right' prod.mk [1] ['a', 'b'] = ([(some 1, 'a'), (none, 'b')], [])

map₂Right' prod.mk [1, 2] ['a'] = ([(some 1, 'a')], [2])
```
-/
def map₂Right' (f : Option α → β → γ) (as : List α) (bs : List β) : List γ × List α :=
  map₂Left' (flip f) bs as
#align list.map₂_right' List.map₂Right'

/-- Left-biased version of `List.map₂`. `map₂Left f as bs` applies `f` to each pair
`aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, `f` is applied to `none`
for the remaining `aᵢ`.

```
map₂Left Prod.mk [1, 2] ['a'] = [(1, some 'a'), (2, none)]

map₂Left Prod.mk [1] ['a', 'b'] = [(1, some 'a')]

map₂Left f as bs = (map₂Left' f as bs).fst
```
-/
@[simp]
def map₂Left (f : α → Option β → γ) : List α → List β → List γ
  | [], _ => []
  | a :: as, [] => (a :: as).map fun a => f a none
  | a :: as, b :: bs => f a (some b) :: map₂Left f as bs
#align list.map₂_left List.map₂Left

/-- Right-biased version of `List.map₂`. `map₂Right f as bs` applies `f` to each
pair `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, `f` is applied to
`none` for the remaining `bᵢ`.

```
map₂Right Prod.mk [1, 2] ['a'] = [(some 1, 'a')]

map₂Right Prod.mk [1] ['a', 'b'] = [(some 1, 'a'), (none, 'b')]

map₂Right f as bs = (map₂Right' f as bs).fst
```
-/
def map₂Right (f : Option α → β → γ) (as : List α) (bs : List β) : List γ :=
  map₂Left (flip f) bs as
#align list.map₂_right List.map₂Right

#align list.zip_right List.zipRight
#align list.zip_left' List.zipLeft'
#align list.zip_right' List.zipRight'
#align list.zip_left List.zipLeft
#align list.all_some List.allSome
#align list.fill_nones List.fillNones
#align list.take_list List.takeList
#align list.to_rbmap List.toRBMap
#align list.to_chunks_aux List.toChunksAux
#align list.to_chunks List.toChunks

-- porting notes -- was `unsafe` but removed for Lean 4 port
-- TODO: naming is awkward...
/-- Asynchronous version of `List.map`.
-/
def mapAsyncChunked {α β} (f : α → β) (xs : List α) (chunk_size := 1024) : List β :=
  ((xs.toChunks chunk_size).map fun xs => Task.spawn fun _ => List.map f xs).bind Task.get
#align list.map_async_chunked List.mapAsyncChunked

/-!
We add some n-ary versions of `List.zipWith` for functions with more than two arguments.
These can also be written in terms of `List.zip` or `List.zipWith`.
For example, `zipWith3 f xs ys zs` could also be written as
`zipWith id (zipWith f xs ys) zs`
or as
`(zip xs $ zip ys zs).map $ λ ⟨x, y, z⟩, f x y z`.
-/

/-- Ternary version of `List.zipWith`. -/
def zipWith3 (f : α → β → γ → δ) : List α → List β → List γ → List δ
  | x :: xs, y :: ys, z :: zs => f x y z :: zipWith3 f xs ys zs
  | _, _, _ => []
#align list.zip_with3 List.zipWith3

/-- Quaternary version of `list.zipWith`. -/
def zipWith4 (f : α → β → γ → δ → ε) : List α → List β → List γ → List δ → List ε
  | x :: xs, y :: ys, z :: zs, u :: us => f x y z u :: zipWith4 f xs ys zs us
  | _, _, _, _ => []
#align list.zip_with4 List.zipWith4

/-- Quinary version of `list.zipWith`. -/
def zipWith5 (f : α → β → γ → δ → ε → ζ) : List α → List β → List γ → List δ → List ε → List ζ
  | x :: xs, y :: ys, z :: zs, u :: us, v :: vs => f x y z u v :: zipWith5 f xs ys zs us vs
  | _, _, _, _, _ => []
#align list.zip_with5 List.zipWith5

/-- Given a starting list `old`, a list of booleans and a replacement list `new`,
read the items in `old` in succession and either replace them with the next element of `new` or
not, according as to whether the corresponding boolean is `true` or `false`. -/
def replaceIf : List α → List Bool → List α → List α
  | l, _, [] => l
  | [], _, _ => []
  | l, [], _ => l
  | n :: ns, tf :: bs, e@(c :: cs) => if tf then c :: ns.replaceIf bs cs else n :: ns.replaceIf bs e
#align list.replace_if List.replaceIf

#align list.map_with_prefix_suffix_aux List.mapWithPrefixSuffixAux
#align list.map_with_prefix_suffix List.mapWithPrefixSuffix
#align list.map_with_complement List.mapWithComplement

end List


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import geometry.manifold.smooth_manifold_with_corners
import analysis.inner_product_space.pi_L2

/-!
# Constructing examples of manifolds over ℝ

We introduce the necessary bits to be able to define manifolds modelled over `ℝ^n`, boundaryless
or with boundary or with corners. As a concrete example, we construct explicitly the manifold with
boundary structure on the real interval `[x, y]`.

More specifically, we introduce
* `model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_half_space n)` for the model space
  used to define `n`-dimensional real manifolds with boundary
* `model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_quadrant n)` for the model space used
  to define `n`-dimensional real manifolds with corners

## Notations

In the locale `manifold`, we introduce the notations
* `𝓡 n` for the identity model with corners on `euclidean_space ℝ (fin n)`
* `𝓡∂ n` for `model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_half_space n)`.

For instance, if a manifold `M` is boundaryless, smooth and modelled on `euclidean_space ℝ (fin m)`,
and `N` is smooth with boundary modelled on `euclidean_half_space n`, and `f : M → N` is a smooth
map, then the derivative of `f` can be written simply as `mfderiv (𝓡 m) (𝓡∂ n) f` (as to why the
model with corners can not be implicit, see the discussion in `smooth_manifold_with_corners.lean`).

## Implementation notes

The manifold structure on the interval `[x, y] = Icc x y` requires the assumption `x < y` as a
typeclass. We provide it as `[fact (x < y)]`.
-/

noncomputable theory
open set function
open_locale manifold

/--
The half-space in `ℝ^n`, used to model manifolds with boundary. We only define it when
`1 ≤ n`, as the definition only makes sense in this case.
-/
def euclidean_half_space (n : ℕ) [has_zero (fin n)] : Type :=
{x : euclidean_space ℝ (fin n) // 0 ≤ x 0}

/--
The quadrant in `ℝ^n`, used to model manifolds with corners, made of all vectors with nonnegative
coordinates.
-/
def euclidean_quadrant (n : ℕ) : Type := {x : euclidean_space ℝ (fin n) // ∀i:fin n, 0 ≤ x i}

section
/- Register class instances for euclidean half-space and quadrant, that can not be noticed
without the following reducibility attribute (which is only set in this section). -/
local attribute [reducible] euclidean_half_space euclidean_quadrant
variable {n : ℕ}

instance [has_zero (fin n)] : topological_space (euclidean_half_space n) := by apply_instance
instance : topological_space (euclidean_quadrant n) := by apply_instance
instance [has_zero (fin n)] : inhabited (euclidean_half_space n) := ⟨⟨0, le_rfl⟩⟩
instance : inhabited (euclidean_quadrant n) := ⟨⟨0, λ i, le_rfl⟩⟩

lemma range_half_space (n : ℕ) [has_zero (fin n)] :
  range (λx : euclidean_half_space n, x.val) = {y | 0 ≤ y 0} :=
by simp

lemma range_quadrant (n : ℕ) :
  range (λx : euclidean_quadrant n, x.val) = {y | ∀i:fin n, 0 ≤ y i} :=
by simp

end

/--
Definition of the model with corners `(euclidean_space ℝ (fin n), euclidean_half_space n)`, used as
a model for manifolds with boundary. In the locale `manifold`, use the shortcut `𝓡∂ n`.
-/
def model_with_corners_euclidean_half_space (n : ℕ) [has_zero (fin n)] :
  model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_half_space n) :=
{ to_fun      := subtype.val,
  inv_fun     := λx, ⟨update x 0 (max (x 0) 0), by simp [le_refl]⟩,
  source      := univ,
  target      := {x | 0 ≤ x 0},
  map_source' := λx hx, x.property,
  map_target' := λx hx, mem_univ _,
  left_inv'   := λ ⟨xval, xprop⟩ hx, begin
    rw [subtype.mk_eq_mk, update_eq_iff],
    exact ⟨max_eq_left xprop, λ i _, rfl⟩
  end,
  right_inv'  := λx hx, update_eq_iff.2 ⟨max_eq_left hx, λ i _, rfl⟩,
  source_eq    := rfl,
  unique_diff' :=
    have this : unique_diff_on ℝ _ :=
      unique_diff_on.pi (fin n) (λ _, ℝ) _ _ (λ i ∈ ({0} : set (fin n)), unique_diff_on_Ici 0),
    by simpa only [singleton_pi] using this,
  continuous_to_fun  := continuous_subtype_val,
  continuous_inv_fun := (continuous_id.update 0 $
    (continuous_apply 0).max continuous_const).subtype_mk _ }

/--
Definition of the model with corners `(euclidean_space ℝ (fin n), euclidean_quadrant n)`, used as a
model for manifolds with corners -/
def model_with_corners_euclidean_quadrant (n : ℕ) :
  model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_quadrant n) :=
{ to_fun      := subtype.val,
  inv_fun     := λx, ⟨λi, max (x i) 0, λi, by simp only [le_refl, or_true, le_max_iff]⟩,
  source      := univ,
  target      := {x | ∀ i, 0 ≤ x i},
  map_source' := λx hx, by simpa only [subtype.range_val] using x.property,
  map_target' := λx hx, mem_univ _,
  left_inv'   := λ ⟨xval, xprop⟩ hx, by { ext i, simp only [subtype.coe_mk, xprop i, max_eq_left] },
  right_inv' := λ x hx, by { ext1 i, simp only [hx i, max_eq_left] },
  source_eq    := rfl,
  unique_diff' :=
    have this : unique_diff_on ℝ _ :=
      unique_diff_on.univ_pi (fin n) (λ _, ℝ) _ (λ i, unique_diff_on_Ici 0),
    by simpa only [pi_univ_Ici] using this,
  continuous_to_fun  := continuous_subtype_val,
  continuous_inv_fun := continuous.subtype_mk (continuous_pi $ λ i,
    (continuous_id.max continuous_const).comp (continuous_apply i)) _ }

localized "notation (name := model_with_corners_self.euclidean) `𝓡 `n :=
  (model_with_corners_self ℝ (euclidean_space ℝ (fin n)) :
    model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_space ℝ (fin n)))" in manifold
localized "notation (name := model_with_corners_euclidean_half_space.euclidean) `𝓡∂ `n :=
  (model_with_corners_euclidean_half_space n :
    model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_half_space n))" in manifold

/--
The left chart for the topological space `[x, y]`, defined on `[x,y)` and sending `x` to `0` in
`euclidean_half_space 1`.
-/
def Icc_left_chart (x y : ℝ) [fact (x < y)] :
  local_homeomorph (Icc x y) (euclidean_half_space 1) :=
{ source      := {z : Icc x y | z.val < y},
  target      := {z : euclidean_half_space 1 | z.val 0 < y - x},
  to_fun      := λ(z : Icc x y), ⟨λi, z.val - x, sub_nonneg.mpr z.property.1⟩,
  inv_fun     := λz, ⟨min (z.val 0 + x) y, by simp [le_refl, z.prop, le_of_lt (fact.out (x < y))]⟩,
  map_source' := by simp only [imp_self, sub_lt_sub_iff_right, mem_set_of_eq, forall_true_iff],
  map_target' :=
    by { simp only [min_lt_iff, mem_set_of_eq], assume z hz, left,
         dsimp [-subtype.val_eq_coe] at hz, linarith },
  left_inv'   := begin
    rintros ⟨z, hz⟩ h'z,
    simp only [mem_set_of_eq, mem_Icc] at hz h'z,
    simp only [hz, min_eq_left, sub_add_cancel]
  end,
  right_inv'  := begin
    rintros ⟨z, hz⟩ h'z,
    rw subtype.mk_eq_mk,
    funext,
    dsimp at hz h'z,
    have A : x + z 0 ≤ y, by linarith,
    rw subsingleton.elim i 0,
    simp only [A, add_comm, add_sub_cancel', min_eq_left],
  end,
  open_source := begin
    have : is_open {z : ℝ | z < y} := is_open_Iio,
    exact this.preimage continuous_subtype_val
  end,
  open_target := begin
    have : is_open {z : ℝ | z < y - x} := is_open_Iio,
    have : is_open {z : euclidean_space ℝ (fin 1) | z 0 < y - x} :=
      this.preimage (@continuous_apply (fin 1) (λ _, ℝ) _ 0),
    exact this.preimage continuous_subtype_val
  end,
  continuous_to_fun := begin
    apply continuous.continuous_on,
    apply continuous.subtype_mk,
    have : continuous (λ (z : ℝ) (i : fin 1), z - x) :=
      continuous.sub (continuous_pi $ λi, continuous_id) continuous_const,
    exact this.comp continuous_subtype_val,
  end,
  continuous_inv_fun := begin
    apply continuous.continuous_on,
    apply continuous.subtype_mk,
    have A : continuous (λ z : ℝ, min (z + x) y) :=
      (continuous_id.add continuous_const).min continuous_const,
    have B : continuous (λz : euclidean_space ℝ (fin 1), z 0) := continuous_apply 0,
    exact (A.comp B).comp continuous_subtype_val
  end }

/--
The right chart for the topological space `[x, y]`, defined on `(x,y]` and sending `y` to `0` in
`euclidean_half_space 1`.
-/
def Icc_right_chart (x y : ℝ) [fact (x < y)] :
  local_homeomorph (Icc x y) (euclidean_half_space 1) :=
{ source      := {z : Icc x y | x < z.val},
  target      := {z : euclidean_half_space 1 | z.val 0 < y - x},
  to_fun      := λ(z : Icc x y), ⟨λi, y - z.val, sub_nonneg.mpr z.property.2⟩,
  inv_fun     := λz,
    ⟨max (y - z.val 0) x, by simp [le_refl, z.prop, le_of_lt (fact.out (x < y)), sub_eq_add_neg]⟩,
  map_source' := by simp only [imp_self, mem_set_of_eq, sub_lt_sub_iff_left, forall_true_iff],
  map_target' :=
    by { simp only [lt_max_iff, mem_set_of_eq], assume z hz, left,
         dsimp [-subtype.val_eq_coe] at hz, linarith },
  left_inv'   := begin
    rintros ⟨z, hz⟩ h'z,
    simp only [mem_set_of_eq, mem_Icc] at hz h'z,
    simp only [hz, sub_eq_add_neg, max_eq_left, add_add_neg_cancel'_right, neg_add_rev, neg_neg]
  end,
  right_inv'  := begin
    rintros ⟨z, hz⟩ h'z,
    rw subtype.mk_eq_mk,
    funext,
    dsimp at hz h'z,
    have A : x ≤ y - z 0, by linarith,
    rw subsingleton.elim i 0,
    simp only [A, sub_sub_cancel, max_eq_left],
  end,
  open_source := begin
    have : is_open {z : ℝ | x < z} := is_open_Ioi,
    exact this.preimage continuous_subtype_val
  end,
  open_target := begin
    have : is_open {z : ℝ | z < y - x} := is_open_Iio,
    have : is_open {z : euclidean_space ℝ (fin 1) | z 0 < y - x} :=
      this.preimage (@continuous_apply (fin 1) (λ _, ℝ) _ 0),
    exact this.preimage continuous_subtype_val
  end,
  continuous_to_fun := begin
    apply continuous.continuous_on,
    apply continuous.subtype_mk,
    have : continuous (λ (z : ℝ) (i : fin 1), y - z) :=
      continuous_const.sub (continuous_pi (λi, continuous_id)),
    exact this.comp continuous_subtype_val,
  end,
  continuous_inv_fun := begin
    apply continuous.continuous_on,
    apply continuous.subtype_mk,
    have A : continuous (λ z : ℝ, max (y - z) x) :=
      (continuous_const.sub continuous_id).max continuous_const,
    have B : continuous (λz : euclidean_space ℝ (fin 1), z 0) := continuous_apply 0,
    exact (A.comp B).comp continuous_subtype_val
  end }

/--
Charted space structure on `[x, y]`, using only two charts taking values in
`euclidean_half_space 1`.
-/
instance Icc_manifold (x y : ℝ) [fact (x < y)] : charted_space (euclidean_half_space 1) (Icc x y) :=
{ atlas := {Icc_left_chart x y, Icc_right_chart x y},
  chart_at := λz, if z.val < y then Icc_left_chart x y else Icc_right_chart x y,
  mem_chart_source := λz, begin
    by_cases h' : z.val < y,
    { simp only [h', if_true],
      exact h' },
    { simp only [h', if_false],
      apply lt_of_lt_of_le (fact.out (x < y)),
      simpa only [not_lt] using h'}
  end,
  chart_mem_atlas := λ z, by by_cases h' : (z : ℝ) < y; simp [h'] }

/--
The manifold structure on `[x, y]` is smooth.
-/
instance Icc_smooth_manifold (x y : ℝ) [fact (x < y)] :
  smooth_manifold_with_corners (𝓡∂ 1) (Icc x y) :=
begin
  have M : cont_diff_on ℝ ∞ (λz : euclidean_space ℝ (fin 1), - z + (λi, y - x)) univ,
  { rw cont_diff_on_univ,
    exact cont_diff_id.neg.add cont_diff_const },
  apply smooth_manifold_with_corners_of_cont_diff_on,
  assume e e' he he',
  simp only [atlas, mem_singleton_iff, mem_insert_iff] at he he',
  /- We need to check that any composition of two charts gives a `C^∞` function. Each chart can be
  either the left chart or the right chart, leaving 4 possibilities that we handle successively.
  -/
  rcases he with rfl | rfl; rcases he' with rfl | rfl,
  { -- `e = left chart`, `e' = left chart`
    exact (mem_groupoid_of_pregroupoid.mpr (symm_trans_mem_cont_diff_groupoid _ _ _)).1 },
  { -- `e = left chart`, `e' = right chart`
    apply M.congr_mono _ (subset_univ _),
    rintro _ ⟨⟨hz₁, hz₂⟩, ⟨⟨z, hz₀⟩, rfl⟩⟩,
    simp only [model_with_corners_euclidean_half_space, Icc_left_chart, Icc_right_chart,
      update_same, max_eq_left, hz₀, lt_sub_iff_add_lt] with mfld_simps at hz₁ hz₂,
    rw [min_eq_left hz₁.le, lt_add_iff_pos_left] at hz₂,
    ext i,
    rw subsingleton.elim i 0,
    simp only [model_with_corners_euclidean_half_space, Icc_left_chart, Icc_right_chart, *,
      pi_Lp.add_apply, pi_Lp.neg_apply, max_eq_left, min_eq_left hz₁.le, update_same]
      with mfld_simps,
    abel },
  { -- `e = right chart`, `e' = left chart`
    apply M.congr_mono _ (subset_univ _),
    rintro _ ⟨⟨hz₁, hz₂⟩, ⟨z, hz₀⟩, rfl⟩,
    simp only [model_with_corners_euclidean_half_space, Icc_left_chart, Icc_right_chart, max_lt_iff,
      update_same, max_eq_left hz₀] with mfld_simps at hz₁ hz₂,
    rw lt_sub_comm at hz₁,
    ext i,
    rw subsingleton.elim i 0,
    simp only [model_with_corners_euclidean_half_space, Icc_left_chart, Icc_right_chart,
      pi_Lp.add_apply, pi_Lp.neg_apply, update_same, max_eq_left, hz₀, hz₁.le] with mfld_simps,
    abel },
  { -- `e = right chart`, `e' = right chart`
    exact (mem_groupoid_of_pregroupoid.mpr (symm_trans_mem_cont_diff_groupoid _ _ _)).1 }
end

/-! Register the manifold structure on `Icc 0 1`, and also its zero and one. -/
section

local attribute [instance] real.fact_zero_lt_one

instance : charted_space (euclidean_half_space 1) (Icc (0 : ℝ) 1) := by apply_instance
instance : smooth_manifold_with_corners (𝓡∂ 1) (Icc (0 : ℝ) 1) := by apply_instance

end


import implementation.spec.ballot

-- A proposal is a pair of a ballot with a value.
structure proposal (pid_t : Type) [linear_order pid_t] (value_t : Type) : Type :=
  (bal : ballot pid_t) (val : value_t)

namespace proposal

variables {pid_t : Type} [linear_order pid_t] {value_t : Type}

-- When merging proposals, we take the one with higher ballot number.
def merge : option (proposal pid_t value_t) → option (proposal pid_t value_t)
                                            → option (proposal pid_t value_t)
| none      none      := none
| (some p₁) none      := some p₁
| none      (some p₂) := some p₂
| (some p₁) (some p₂) := if (p₁.bal < p₂.bal) then some p₂ else some p₁

-- Gets the proposed value from an option or provides the default if no value is
-- present.
def value_or_default : option (proposal pid_t value_t) → value_t → value_t
| none     := (λ v, v)
| (some p) := (λ _, p.val)

-- The result of a merge with a some on the lhs is at least as large as the lhs.
lemma merge_ballot_ge_left
  (p_left : proposal pid_t value_t) (p_or : option (proposal pid_t value_t)) :
  ∃ res, merge (some p_left) p_or = some res ∧ res.bal ≥ p_left.bal :=
begin
cases p_or,
  case none : {
    exact ⟨p_left, by refl, le_refl p_left.bal⟩
  },
  case some : p_right {
    unfold merge,
    cases decidable.em (p_left.bal < p_right.bal),
    { rw if_pos h,
      exact ⟨p_right, by refl, le_of_lt h⟩ },
    rw if_neg h,
    exact ⟨p_left, by refl, le_refl p_left.bal⟩
  }
end

-- The result of a merge with a some on the rhs is at least as large as the rhs.
lemma merge_ballot_ge_right
  (p_or : option (proposal pid_t value_t)) (p_right : proposal pid_t value_t) :
  ∃ res, merge p_or (some p_right) = some res ∧ res.bal ≥ p_right.bal :=
begin
cases p_or,
  case none : {
    exact ⟨p_right, by refl, le_refl p_right.bal⟩
  },
  case some : p_left {
    unfold merge,
    cases decidable.em (p_left.bal < p_right.bal),
    { rw if_pos h,
      exact ⟨p_right, by refl, le_refl p_right.bal⟩ },
    rw if_neg h,
    exact ⟨p_left, by refl, le_of_not_lt h⟩
  }
end

-- Merging two proposals results in either the left one or the right one.
lemma merge_is_one_of (p_or₁ p_or₂ : option (proposal pid_t value_t)) :
  merge p_or₁ p_or₂ = p_or₁ ∨ merge p_or₁ p_or₂ = p_or₂ :=
begin
cases p_or₁,
  case none : {
    cases p_or₂,
      case none : { unfold merge, left, refl },
      case some : p₂ { unfold merge, right, refl }
  },
  case some : p₁ {
    cases p_or₂,
      case none : { unfold merge, left, refl },
      case some : p₂ {
        unfold merge,
        cases decidable.em (p₁.bal < p₂.bal),
        { right, rw if_pos h },
        left, rw if_neg h
      }
  },
end

end proposal


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

! This file was ported from Lean 3 source module linear_algebra.bilinear_map
! leanprover-community/mathlib commit 87c54600fe3cdc7d32ff5b50873ac724d86aef8d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.LinearAlgebra.Basic

/-!
# Basics on bilinear maps

This file provides basics on bilinear maps. The most general form considered are maps that are
semilinear in both arguments. They are of type `M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P`, where `M` and `N`
are modules over `R` and `S` respectively, `P` is a module over both `R₂` and `S₂` with
commuting actions, and `ρ₁₂ : R →+* R₂` and `σ₁₂ : S →+* S₂`.

## Main declarations

* `LinearMap.mk₂`: a constructor for bilinear maps,
  taking an unbundled function together with proof witnesses of bilinearity
* `LinearMap.flip`: turns a bilinear map `M × N → P` into `N × M → P`
* `LinearMap.lcomp` and `LinearMap.llcomp`: composition of linear maps as a bilinear map
* `LinearMap.compl₂`: composition of a bilinear map `M × N → P` with a linear map `Q → M`
* `LinearMap.compr₂`: composition of a bilinear map `M × N → P` with a linear map `Q → N`
* `LinearMap.lsmul`: scalar multiplication as a bilinear map `R × M → M`

## Tags

bilinear
-/

namespace LinearMap

section Semiring

-- the `ₗ` subscript variables are for special cases about linear (as opposed to semilinear) maps
variable {R : Type _} [Semiring R] {S : Type _} [Semiring S]

variable {R₂ : Type _} [Semiring R₂] {S₂ : Type _} [Semiring S₂]

variable {M : Type _} {N : Type _} {P : Type _}

variable {M₂ : Type _} {N₂ : Type _} {P₂ : Type _}

variable {Nₗ : Type _} {Pₗ : Type _}

variable {M' : Type _} {N' : Type _} {P' : Type _}

variable [AddCommMonoid M] [AddCommMonoid N] [AddCommMonoid P]

variable [AddCommMonoid M₂] [AddCommMonoid N₂] [AddCommMonoid P₂]

variable [AddCommMonoid Nₗ] [AddCommMonoid Pₗ]

variable [AddCommGroup M'] [AddCommGroup N'] [AddCommGroup P']

variable [Module R M] [Module S N] [Module R₂ P] [Module S₂ P]

variable [Module R M₂] [Module S N₂] [Module R P₂] [Module S₂ P₂]

variable [Module R Pₗ] [Module S Pₗ]

variable [Module R M'] [Module S N'] [Module R₂ P'] [Module S₂ P']

variable [SMulCommClass S₂ R₂ P] [SMulCommClass S R Pₗ] [SMulCommClass S₂ R₂ P']

variable [SMulCommClass S₂ R P₂]

variable {ρ₁₂ : R →+* R₂} {σ₁₂ : S →+* S₂}

variable (ρ₁₂ σ₁₂)

/-- Create a bilinear map from a function that is semilinear in each component.
See `mk₂'` and `mk₂` for the linear case. -/
def mk₂'ₛₗ (f : M → N → P) (H1 : ∀ m₁ m₂ n, f (m₁ + m₂) n = f m₁ n + f m₂ n)
    (H2 : ∀ (c : R) (m n), f (c • m) n = ρ₁₂ c • f m n)
    (H3 : ∀ m n₁ n₂, f m (n₁ + n₂) = f m n₁ + f m n₂)
    (H4 : ∀ (c : S) (m n), f m (c • n) = σ₁₂ c • f m n) : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P
    where
  toFun m :=
    { toFun := f m
      map_add' := H3 m
      map_smul' := fun c => H4 c m }
  map_add' m₁ m₂ := LinearMap.ext <| H1 m₁ m₂
  map_smul' c m := LinearMap.ext <| H2 c m
#align linear_map.mk₂'ₛₗ LinearMap.mk₂'ₛₗ

variable {ρ₁₂ σ₁₂}

@[simp]
theorem mk₂'ₛₗ_apply (f : M → N → P) {H1 H2 H3 H4} (m : M) (n : N) :
    (mk₂'ₛₗ ρ₁₂ σ₁₂ f H1 H2 H3 H4 : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) m n = f m n := rfl
#align linear_map.mk₂'ₛₗ_apply LinearMap.mk₂'ₛₗ_apply

variable (R S)

/-- Create a bilinear map from a function that is linear in each component.
See `mk₂` for the special case where both arguments come from modules over the same ring. -/
def mk₂' (f : M → N → Pₗ) (H1 : ∀ m₁ m₂ n, f (m₁ + m₂) n = f m₁ n + f m₂ n)
    (H2 : ∀ (c : R) (m n), f (c • m) n = c • f m n)
    (H3 : ∀ m n₁ n₂, f m (n₁ + n₂) = f m n₁ + f m n₂)
    (H4 : ∀ (c : S) (m n), f m (c • n) = c • f m n) : M →ₗ[R] N →ₗ[S] Pₗ :=
  mk₂'ₛₗ (RingHom.id R) (RingHom.id S) f H1 H2 H3 H4
#align linear_map.mk₂' LinearMap.mk₂'

variable {R S}

@[simp]
theorem mk₂'_apply (f : M → N → Pₗ) {H1 H2 H3 H4} (m : M) (n : N) :
    (mk₂' R S f H1 H2 H3 H4 : M →ₗ[R] N →ₗ[S] Pₗ) m n = f m n := rfl
#align linear_map.mk₂'_apply LinearMap.mk₂'_apply

theorem ext₂ {f g : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P} (H : ∀ m n, f m n = g m n) : f = g :=
  LinearMap.ext fun m => LinearMap.ext fun n => H m n
#align linear_map.ext₂ LinearMap.ext₂

theorem congr_fun₂ {f g : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P} (h : f = g) (x y) : f x y = g x y :=
  LinearMap.congr_fun (LinearMap.congr_fun h x) y
#align linear_map.congr_fun₂ LinearMap.congr_fun₂

section

attribute [local instance] SMulCommClass.symm

/-- Given a linear map from `M` to linear maps from `N` to `P`, i.e., a bilinear map from `M × N` to
`P`, change the order of variables and get a linear map from `N` to linear maps from `M` to `P`. -/
def flip (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) : N →ₛₗ[σ₁₂] M →ₛₗ[ρ₁₂] P :=
  mk₂'ₛₗ σ₁₂ ρ₁₂ (fun n m => f m n) (fun n₁ n₂ m => (f m).map_add _ _)
    (fun c n  m  => (f m).map_smulₛₗ _ _)
    (fun n m₁ m₂ => by simp only [map_add, add_apply])
    (fun c n  m  => by simp only [map_smulₛₗ, smul_apply])
#align linear_map.flip LinearMap.flip

end

@[simp]
theorem flip_apply (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) (m : M) (n : N) : flip f n m = f m n := rfl
#align linear_map.flip_apply LinearMap.flip_apply

attribute [local instance] SMulCommClass.symm

@[simp]
theorem flip_flip (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) : f.flip.flip = f :=
  LinearMap.ext₂ fun _x _y => (f.flip.flip_apply _ _).trans (f.flip_apply _ _)
#align linear_map.flip_flip LinearMap.flip_flip

open BigOperators

theorem flip_inj {f g : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P} (H : flip f = flip g) : f = g :=
  ext₂ fun m n => show flip f n m = flip g n m by rw [H]
#align linear_map.flip_inj LinearMap.flip_inj

theorem map_zero₂ (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) (y) : f 0 y = 0 :=
  (flip f y).map_zero
#align linear_map.map_zero₂ LinearMap.map_zero₂

theorem map_neg₂ (f : M' →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P') (x y) : f (-x) y = -f x y :=
  (flip f y).map_neg _
#align linear_map.map_neg₂ LinearMap.map_neg₂

theorem map_sub₂ (f : M' →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P') (x y z) : f (x - y) z = f x z - f y z :=
  (flip f z).map_sub _ _
#align linear_map.map_sub₂ LinearMap.map_sub₂

theorem map_add₂ (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) (x₁ x₂ y) : f (x₁ + x₂) y = f x₁ y + f x₂ y :=
  (flip f y).map_add _ _
#align linear_map.map_add₂ LinearMap.map_add₂

theorem map_smul₂ (f : M₂ →ₗ[R] N₂ →ₛₗ[σ₁₂] P₂) (r : R) (x y) : f (r • x) y = r • f x y :=
  (flip f y).map_smul _ _
#align linear_map.map_smul₂ LinearMap.map_smul₂

theorem map_smulₛₗ₂ (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) (r : R) (x y) : f (r • x) y = ρ₁₂ r • f x y :=
  (flip f y).map_smulₛₗ _ _
#align linear_map.map_smulₛₗ₂ LinearMap.map_smulₛₗ₂

theorem map_sum₂ {ι : Type _} (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) (t : Finset ι) (x : ι → M) (y) :
    f (∑ i in t, x i) y = ∑ i in t, f (x i) y :=
  (flip f y).map_sum
#align linear_map.map_sum₂ LinearMap.map_sum₂

/-- Restricting a bilinear map in the second entry -/
def domRestrict₂ (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) (q : Submodule S N) : M →ₛₗ[ρ₁₂] q →ₛₗ[σ₁₂] P
    where
  toFun m := (f m).domRestrict q
  map_add' m₁ m₂ := LinearMap.ext fun _ => by simp only [map_add, domRestrict_apply, add_apply]
  map_smul' c m :=
    LinearMap.ext fun _ => by simp only [f.map_smulₛₗ, domRestrict_apply, smul_apply]
#align linear_map.dom_restrict₂ LinearMap.domRestrict₂

theorem domRestrict₂_apply (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) (q : Submodule S N) (x : M) (y : q) :
    f.domRestrict₂ q x y = f x y := rfl
#align linear_map.dom_restrict₂_apply LinearMap.domRestrict₂_apply

/-- Restricting a bilinear map in both components -/
def domRestrict₁₂ (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) (p : Submodule R M) (q : Submodule S N) :
    p →ₛₗ[ρ₁₂] q →ₛₗ[σ₁₂] P :=
  (f.domRestrict p).domRestrict₂ q
#align linear_map.dom_restrict₁₂ LinearMap.domRestrict₁₂

theorem domRestrict₁₂_apply (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) (p : Submodule R M) (q : Submodule S N)
    (x : p) (y : q) : f.domRestrict₁₂ p q x y = f x y := rfl
#align linear_map.dom_restrict₁₂_apply LinearMap.domRestrict₁₂_apply

end Semiring

section CommSemiring

variable {R : Type _} [CommSemiring R] {R₂ : Type _} [CommSemiring R₂]

variable {R₃ : Type _} [CommSemiring R₃] {R₄ : Type _} [CommSemiring R₄]

variable {M : Type _} {N : Type _} {P : Type _} {Q : Type _}

variable {Mₗ : Type _} {Nₗ : Type _} {Pₗ : Type _} {Qₗ Qₗ' : Type _}

variable [AddCommMonoid M] [AddCommMonoid N] [AddCommMonoid P] [AddCommMonoid Q]

variable [AddCommMonoid Mₗ] [AddCommMonoid Nₗ] [AddCommMonoid Pₗ]

variable [AddCommMonoid Qₗ] [AddCommMonoid Qₗ']

variable [Module R M] [Module R₂ N] [Module R₃ P] [Module R₄ Q]

variable [Module R Mₗ] [Module R Nₗ] [Module R Pₗ] [Module R Qₗ] [Module R Qₗ']

variable {σ₁₂ : R →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R →+* R₃}

variable {σ₄₂ : R₄ →+* R₂} {σ₄₃ : R₄ →+* R₃}

variable [RingHomCompTriple σ₁₂ σ₂₃ σ₁₃] [RingHomCompTriple σ₄₂ σ₂₃ σ₄₃]

variable (R)

/-- Create a bilinear map from a function that is linear in each component.

This is a shorthand for `mk₂'` for the common case when `R = S`. -/
def mk₂ (f : M → Nₗ → Pₗ) (H1 : ∀ m₁ m₂ n, f (m₁ + m₂) n = f m₁ n + f m₂ n)
    (H2 : ∀ (c : R) (m n), f (c • m) n = c • f m n)
    (H3 : ∀ m n₁ n₂, f m (n₁ + n₂) = f m n₁ + f m n₂)
    (H4 : ∀ (c : R) (m n), f m (c • n) = c • f m n) : M →ₗ[R] Nₗ →ₗ[R] Pₗ :=
  mk₂' R R f H1 H2 H3 H4
#align linear_map.mk₂ LinearMap.mk₂

@[simp]
theorem mk₂_apply (f : M → Nₗ → Pₗ) {H1 H2 H3 H4} (m : M) (n : Nₗ) :
    (mk₂ R f H1 H2 H3 H4 : M →ₗ[R] Nₗ →ₗ[R] Pₗ) m n = f m n := rfl
#align linear_map.mk₂_apply LinearMap.mk₂_apply

variable {R}

/-- Given a linear map from `M` to linear maps from `N` to `P`, i.e., a bilinear map `M → N → P`,
change the order of variables and get a linear map from `N` to linear maps from `M` to `P`. -/
def lflip : (M →ₛₗ[σ₁₃] N →ₛₗ[σ₂₃] P) →ₗ[R₃] N →ₛₗ[σ₂₃] M →ₛₗ[σ₁₃] P
    where
  toFun := flip
  map_add' _ _ := rfl
  map_smul' _ _ := rfl
#align linear_map.lflip LinearMap.lflip

variable (f : M →ₛₗ[σ₁₃] N →ₛₗ[σ₂₃] P)

@[simp]
theorem lflip_apply (m : M) (n : N) : lflip f n m = f m n := rfl
#align linear_map.lflip_apply LinearMap.lflip_apply

variable (R Pₗ)

/-- Composing a linear map `M → N` and a linear map `N → P` to form a linear map `M → P`. -/
def lcomp (f : M →ₗ[R] Nₗ) : (Nₗ →ₗ[R] Pₗ) →ₗ[R] M →ₗ[R] Pₗ :=
  flip <| LinearMap.comp (flip id) f
#align linear_map.lcomp LinearMap.lcomp

variable {R Pₗ}

@[simp]
theorem lcomp_apply (f : M →ₗ[R] Nₗ) (g : Nₗ →ₗ[R] Pₗ) (x : M) : lcomp _ _ f g x = g (f x) := rfl
#align linear_map.lcomp_apply LinearMap.lcomp_apply

theorem lcomp_apply' (f : M →ₗ[R] Nₗ) (g : Nₗ →ₗ[R] Pₗ) : lcomp R Pₗ f g = g ∘ₗ f := rfl
#align linear_map.lcomp_apply' LinearMap.lcomp_apply'

variable (P σ₂₃)

/-- Composing a semilinear map `M → N` and a semilinear map `N → P` to form a semilinear map
`M → P` is itself a linear map. -/
def lcompₛₗ (f : M →ₛₗ[σ₁₂] N) : (N →ₛₗ[σ₂₃] P) →ₗ[R₃] M →ₛₗ[σ₁₃] P :=
  flip <| LinearMap.comp (flip id) f
#align linear_map.lcompₛₗ LinearMap.lcompₛₗ

variable {P σ₂₃}

@[simp]

variable (R M Nₗ Pₗ)

/-- Composing a linear map `M → N` and a linear map `N → P` to form a linear map `M → P`. -/
def llcomp : (Nₗ →ₗ[R] Pₗ) →ₗ[R] (M →ₗ[R] Nₗ) →ₗ[R] M →ₗ[R] Pₗ :=
  flip
    { toFun := lcomp R Pₗ
      map_add' := fun _f _f' => ext₂ fun g _x => g.map_add _ _
      map_smul' := fun (_c : R) _f => ext₂ fun g _x => g.map_smul _ _ }
#align linear_map.llcomp LinearMap.llcomp

variable {R M Nₗ Pₗ}

section

@[simp]
theorem llcomp_apply (f : Nₗ →ₗ[R] Pₗ) (g : M →ₗ[R] Nₗ) (x : M) :
    llcomp R M Nₗ Pₗ f g x = f (g x) := rfl
#align linear_map.llcomp_apply LinearMap.llcomp_apply

theorem llcomp_apply' (f : Nₗ →ₗ[R] Pₗ) (g : M →ₗ[R] Nₗ) : llcomp R M Nₗ Pₗ f g = f ∘ₗ g := rfl
#align linear_map.llcomp_apply' LinearMap.llcomp_apply'

end

/-- Composing a linear map `Q → N` and a bilinear map `M → N → P` to
form a bilinear map `M → Q → P`. -/
def compl₂ (g : Q →ₛₗ[σ₄₂] N) : M →ₛₗ[σ₁₃] Q →ₛₗ[σ₄₃] P :=
  (lcompₛₗ _ _ g).comp f
#align linear_map.compl₂ LinearMap.compl₂

@[simp]
theorem compl₂_apply (g : Q →ₛₗ[σ₄₂] N) (m : M) (q : Q) : f.compl₂ g m q = f m (g q) := rfl
#align linear_map.compl₂_apply LinearMap.compl₂_apply

@[simp]
theorem compl₂_id : f.compl₂ LinearMap.id = f := by
  ext
  rw [compl₂_apply, id_coe, id.def]
#align linear_map.compl₂_id LinearMap.compl₂_id

/-- Composing linear maps `Q → M` and `Q' → N` with a bilinear map `M → N → P` to
form a bilinear map `Q → Q' → P`. -/
def compl₁₂ (f : Mₗ →ₗ[R] Nₗ →ₗ[R] Pₗ) (g : Qₗ →ₗ[R] Mₗ) (g' : Qₗ' →ₗ[R] Nₗ) :
    Qₗ →ₗ[R] Qₗ' →ₗ[R] Pₗ :=
  (f.comp g).compl₂ g'
#align linear_map.compl₁₂ LinearMap.compl₁₂

@[simp]
theorem compl₁₂_apply (f : Mₗ →ₗ[R] Nₗ →ₗ[R] Pₗ) (g : Qₗ →ₗ[R] Mₗ) (g' : Qₗ' →ₗ[R] Nₗ) (x : Qₗ)
    (y : Qₗ') : f.compl₁₂ g g' x y = f (g x) (g' y) := rfl
#align linear_map.compl₁₂_apply LinearMap.compl₁₂_apply

@[simp]
theorem compl₁₂_id_id (f : Mₗ →ₗ[R] Nₗ →ₗ[R] Pₗ) : f.compl₁₂ LinearMap.id LinearMap.id = f := by
  ext
  simp_rw [compl₁₂_apply, id_coe, id.def]
#align linear_map.compl₁₂_id_id LinearMap.compl₁₂_id_id

theorem compl₁₂_inj {f₁ f₂ : Mₗ →ₗ[R] Nₗ →ₗ[R] Pₗ} {g : Qₗ →ₗ[R] Mₗ} {g' : Qₗ' →ₗ[R] Nₗ}
    (hₗ : Function.Surjective g) (hᵣ : Function.Surjective g') :
    f₁.compl₁₂ g g' = f₂.compl₁₂ g g' ↔ f₁ = f₂ := by
  constructor <;> intro h
  · -- B₁.comp l r = B₂.comp l r → B₁ = B₂
    ext (x y)
    cases' hₗ x with x' hx
    subst hx
    cases' hᵣ y with y' hy
    subst hy
    convert LinearMap.congr_fun₂ h x' y' using 0
  · -- B₁ = B₂ → B₁.comp l r = B₂.comp l r
    subst h; rfl
#align linear_map.compl₁₂_inj LinearMap.compl₁₂_inj

/-- Composing a linear map `P → Q` and a bilinear map `M → N → P` to
form a bilinear map `M → N → Q`. -/
def compr₂ (f : M →ₗ[R] Nₗ →ₗ[R] Pₗ) (g : Pₗ →ₗ[R] Qₗ) : M →ₗ[R] Nₗ →ₗ[R] Qₗ :=
  llcomp R Nₗ Pₗ Qₗ g ∘ₗ f
#align linear_map.compr₂ LinearMap.compr₂

@[simp]
theorem compr₂_apply (f : M →ₗ[R] Nₗ →ₗ[R] Pₗ) (g : Pₗ →ₗ[R] Qₗ) (m : M) (n : Nₗ) :
    f.compr₂ g m n = g (f m n) := rfl
#align linear_map.compr₂_apply LinearMap.compr₂_apply

variable (R M)

/-- Scalar multiplication as a bilinear map `R → M → M`. -/
def lsmul : R →ₗ[R] M →ₗ[R] M :=
  mk₂ R (· • ·) add_smul (fun _ _ _ => mul_smul _ _ _) smul_add fun r s m => by
    simp only [smul_smul, smul_eq_mul, mul_comm]
#align linear_map.lsmul LinearMap.lsmul

variable {R M}

@[simp]
theorem lsmul_apply (r : R) (m : M) : lsmul R M r m = r • m := rfl
#align linear_map.lsmul_apply LinearMap.lsmul_apply

end CommSemiring

section CommRing

variable {R R₂ S S₂ M N P : Type _}

variable {Mₗ Nₗ Pₗ : Type _}

variable [CommRing R] [CommRing S] [CommRing R₂] [CommRing S₂]

section AddCommGroup

variable [AddCommGroup M] [AddCommGroup N] [AddCommGroup P]

variable [Module R M] [Module S N] [Module R₂ P] [Module S₂ P]

theorem lsmul_injective [NoZeroSMulDivisors R M] {x : R} (hx : x ≠ 0) :
    Function.Injective (lsmul R M x) :=
  smul_right_injective _ hx
#align linear_map.lsmul_injective LinearMap.lsmul_injective

theorem ker_lsmul [NoZeroSMulDivisors R M] {a : R} (ha : a ≠ 0) :
  LinearMap.ker (LinearMap.lsmul R M a) = ⊥ :=
  LinearMap.ker_eq_bot_of_injective (LinearMap.lsmul_injective ha)
#align linear_map.ker_lsmul LinearMap.ker_lsmul

end AddCommGroup

end CommRing

end LinearMap