import Mathlib.Tactic.Relation.Rfl

example (a : Nat) : a = a := rfl

example (a : Nat) : a = a := by rfl

open Setoid

variable {α : Sort u} [Setoid α]

@[refl] def iseqv_refl (a : α) : a ≈ a :=
  iseqv.refl a

example (a : α) : a ≈ a := by rfl

example (a : Nat) : a ≤ a := by (fail_if_success rfl); apply Nat.le_refl

attribute [refl] Nat.le_refl

example (a : Nat) : a ≤ a := by rfl

structure Foo

def Foo.le (_ _ : Foo) := Unit → True
instance : LE Foo := ⟨Foo.le⟩

@[refl] theorem Foo.le_refl (a : Foo) : a ≤ a := fun _ => trivial

example (a : Foo) : a ≤ a := by apply Foo.le_refl
example (a : Foo) : a ≤ a := by rfl


import Lake
import Init
import Mathlib.Data.Real.Basic

#eval 1

def And_implies_right (a b : Prop): a ∧ b → a := by
  intro hab
  apply And.left hab

/-def Distrubutive (a b c : Prop): a ∧ (b ∨ c) ↔ (a ∧ b) ∨ (a ∧ c) := by
  apply Iff.intro
  case mp =>
    intro h
    have ha : a := And.left h
    have hborc : b ∨ c := And.right h
    by_cases hc:c
    case inl =>
      have hac : a ∧ c := by apply And.intro ha hc
      apply Or.inr
      assumption
    case inr =>
        by_cases hb : b
        case inl =>
          have hab : a ∧ b := by apply And.intro ha hb
          apply Or.inl
          assumption
        case inr =>-/

theorem FO (A : Type) : ∀ x : A, ∃ y : A , x = y := by
  intro x'
  have lem1 : x' = x' := rfl
  apply Exists.intro x' lem1

theorem tr : ∃ x : Nat, x > 0 := by
  have h : 1 > 0 := Nat.zero_lt_succ 0
  apply Exists.intro 1 h

#print FO

variable (p q : Prop)

example (h : p ∧ q) : q ∧ p :=
  ⟨h.right, h.left⟩

def divides (x y : Nat) : Prop :=
  ∃ k, k*x = y

def divides_dummy (y : Point) : Prop :=
  ∃ x: Point, x = y

--def divide_seg (z:Point) : Prop :=

/-
def divides_trans (h₁ : divides x y) (h₂ : divides y z) : divides x z :=
  let ⟨k₁, d₁⟩ := h₁
  let ⟨k₂, d₂⟩ := h₂
  ⟨k₁ * k₂, by rw [Nat.mul_comm k₁ k₂, Nat.mul_assoc, d₁, d₂]⟩
-/
-------------------------------------------------------------------------------
set_option autoImplicit false

structure IncidenceGeometry where
  Point : Type
  Line : Type
  lies_on : Point → Line → Prop
  in_between : Point → Point → Point → Prop -- is this supposed to be here?
  between_refl_left (a b : Point) : in_between a a b
  between_refl_right (a b : Point) : in_between a b b
  Segment : Type

/-
structure Segment (geom : IncidenceGeometry) where
  p1 : geom.Point
  p2 : geom.Point
-/

-- defining a new structure "metrics"
structure Metrics extends IncidenceGeometry, Segment  where
  distance (Apt Bpt : Point) : ℝ
  --distance definition
  dist_is_not_neg (A B : Point): distance A B ≥ 0
  dist_same_point (A : Point) : distance A A = 0
  dist_geq_0 (A B : Point) : A ≠ B ↔ distance A B >  0
  dist_is_symm (A B : Point) : distance A B = distance B A
  dist_tri_ineq (A B C : Point) : distance A B + distance B C ≥ distance A C
  -- distance axioms when a point is in between other two
  dist_in_between (a b c : Point) (h : in_between a b c) :
    distance a b + distance b c = distance a c

-- WE PROBABLY DON'T NEED THIS DEFINITION OF CONGRUENCE
axiom Point : Type
-- variable [pts_nonEmpty : Inhabited Point]

axiom Line : Type
axiom lies_on : Point → Line → Prop

-- Congruence has been SKIPPED
axiom congruence : {A : Type} → A → A →  Prop

-- Congruence is equivalence relationship

axiom CongEquiv {A : Type} : IsEquiv A congruence

lemma CongRefl {A : Type} : ∀ a : A, congruence a a :=
  CongEquiv.refl

lemma CongSymm {A : Type} :
  ∀ a b : A, congruence a b → congruence b a :=
  CongEquiv.symm

lemma CongTrans {A : Type} :
  ∀ a b c : A,
    congruence a b → congruence b c → congruence a c :=
  CongEquiv.trans
-- Congruence has been SKIPPED

axiom in_between : Point → Point → Point → Prop --incidence geom

--don't know where to put this
structure Segment : Type :=
  p1 : Point
  p2 : Point

axiom distance (Apt Bpt : Point) : ℝ -- inside struct Metrics.

-- Distance axioms
axiom dist_is_not_neg (A B : Point): distance A B ≥ 0
axiom dist_same_point (A : Point) : distance A A = 0
axiom dist_geq_0 (A B : Point) : A ≠ B ↔ distance A B >  0
axiom dist_is_symm (A B : Point) : distance A B = distance B A
axiom dist_tri_ineq (A B C : Point) :
distance A B + distance B C ≥ distance A C

-- Axioms when a point is in between other two
axiom dist_in_between (a b c : Point) (h : in_between a b c) :
distance a b + distance b c = distance a c

axiom between_refl_left (a b : Point) : in_between a a b
axiom between_refl_right (a b : Point) : in_between a b b

structure EuclidGeometry extends Metrics where
  -- Postulate 1
  -- Between two points there is an unique line passing through them

  Line_of_two_points (A B : Point) (h : A ≠ B): Line -- from two points we get a line (it may not be unique)
  point_contain (A B : Point) (h : A ≠ B) : --says such a line contain both the points
    have l : Line := Line_of_two_points A B h
    lies_on A l ∧ lies_on B l

  line_unique (A B: Point) (h : A ≠ B) (l1 l2 : Line): --says such a line is unique
  (lies_on A l1 ∧ lies_on B l1) ∧ (lies_on A l2 ∧ lies_on B l2) → l1 = l2
  -- end of Postulate 1

  -- Postulate 2
  -- A line segment can be extended to get a line

  points_betw_on_line (a b c : Point) (h : in_between a b c) (k : ¬ a = c):
  --says that a point "b" that is between "a", "c" will be on the line joining them
    lies_on b (Line_of_two_points a c k)

--Euclid postulates

--Postulate 1
--Between two points there is an unique line passing through them
axiom Line_of_two_points (A B : Point) (h : A ≠ B): Line --says you get a line from two points
axiom point_contain (A B : Point) (h : A ≠ B) : --says such a line contain both the points
  have l : Line := Line_of_two_points A B h
  lies_on A l ∧ lies_on B l

axiom line_unique (A B: Point) (h : A ≠ B) (l1 l2 : Line): --says such a line is unique
  (lies_on A l1 ∧ lies_on B l1) ∧ (lies_on A l2 ∧ lies_on B l2) → l1 = l2

axiom points_betw_on_line (a b c : Point) (h : in_between a b c) (k : ¬ a = c):
  lies_on b (Line_of_two_points a c k)

axiom IsCoincide (l1 l2 : Line) : l1 = l2 -- this is not needed

-- I'M HERE!!!! How to bring in the segment structure within EuclidGeometry
--Postulate 2
--A line segment can be extended to get a line
axiom line_from_seg (seg : Segment) : Line --says a you get a line from a segment

axiom contain_end_points (seg : Segment) : --says the end points of the segment lies on the resulting line
  lies_on (seg.p1) (line_from_seg seg) ∧ lies_on (seg.p2) (line_from_seg seg)
/-
theorem line_from_seg_unique (S : Segment) :
let l₁ := line_from_seg S
let l₂ := line_from_seg S
l₁ = l₂ := rfl
  --have lem1 : lies_on S.p1 l₁ ∧ lies_on S.p2 l₂ := contain_end_points S-/

axiom length_of_seg (seg : Segment) : ℝ
axiom Length_of_seg (seg : Segment) : length_of_seg seg = distance seg.p1 seg.p2

--Postulate 3
--A circle can be drawn from any centre and any radius
structure Circle : Type :=
  centre : Point
  radius : ℝ

axiom On_circle (A : Point) (C : Circle) :
distance C.centre A = C.radius

/-
def Equi_triangle (A B C : Point) : Prop :=
distance A B = distance A C ∧ distance A C = distance B C

theorem Elements_th1 (s : Segment) :
∃ C : Point , Equi_triangle (s.p1 s.p2 C) := by
  have c1 : Circle := Circle.mk s.p1 (length_of_seg s)
  have c2 : Circle := Circle.mk s.p2 (length_of_seg s)

-/

--- (c1 : Circle) : c1.centre = segAB.p1 ∧ c1.radius = (distance (segAB.p1 segAB.p2)) →

--Postulate 4
--All right angles are equal
structure Angle : Type :=
  p1 : Point
  Pivot : Point
  p2 : Point
-- check whether p1 and pivot are different points
axiom reflexAngle : Angle → Angle

axiom mAngle : Angle → ℝ

axiom CompleteAngle (A : Angle): mAngle (reflexAngle A) = 360 - mAngle A

-- properties of Angle
axiom AngleSymm (a b c : Point) : Angle.mk a b c = Angle.mk c b a

axiom MakingIntPointAngle (a : Point) (A : Angle) : Prop

-- property of "introducing an interior point 'a' within an angle A"
def IntPointAngle (a : Point) (A : Angle) (_ : MakingIntPointAngle a A): Prop :=
  have A1 : Angle := Angle.mk a A.Pivot A.p1
  have A2 : Angle := Angle.mk a A.Pivot A.p2
  (mAngle (A1) < mAngle  A)
  ∧ (mAngle (A2) < mAngle A) -- strict inequality because of 120

#check IntPointAngle
-- properties of mAngle

axiom mAngle_non_neg (a b c : Point) : mAngle (Angle.mk a b c) ≥ 0
axiom ZeroAngle (a b c : Point) (hc : in_between a c b): mAngle (Angle.mk a b c) = 0
axiom mAngle_postive (a b c : Point) (hc : ¬ in_between a c b) (ha : ¬ in_between c a b):
  mAngle (Angle.mk a b c) > 0

axiom mReflexAngle (A : Angle) : mAngle (reflexAngle A) = 360 - mAngle A

-- Angle A as Sum of its constituents
axiom mAngleAdd (a : Point) (A : Angle) (hInt : MakingIntPointAngle a A)(h : IntPointAngle a A hInt) :
  have A1 : Angle := Angle.mk a A.Pivot A.p1
  have A2 : Angle := Angle.mk a A.Pivot A.p2
  mAngle A = mAngle A1 + mAngle A2

-- Given Angle A, if we introduce segment (a A.Pivot), then
-- the constiuents sum to the whole Angle A. We can obtain the
-- this as a theorem to MakingIntPointAngle, IntPointAngle, mAngleAdd.

-- Postulate 4 says all right angles are equal.
-- We are assigning it a value of 90
axiom isRightAngle (A : Angle): mAngle A = 90
-- straight line is two right angles
axiom StraightAngle (a b c : Point) (h : in_between a b c) : mAngle (Angle.mk a b c) = 180

-- Postulate 5
-- If a straight line falling on two straight lines makes the interior
-- angles on the same side of it taken together less than two right angles, then the
-- two straight lines, if produced indefinitely, meet on that side on which the sum of
-- angles is less than two right angles.

axiom IsParallel : Line → Line → Prop -- defn of parallel lines
--axiom notPara_Intersect (l1 l2 : Line): IsParallel l1 l2 →
--∃ c : Point, lies_on c l1 ∧ lies_on c l2 → False

axiom ParaEquiv : IsEquiv Line IsParallel

def somefunc : Nat → Nat → Nat := fun n m ↦ n*m

#eval somefunc 2 3
#check somefunc

lemma Pararefl : ∀ l : Line, IsParallel l l :=
  ParaEquiv.refl

lemma ParaSymm :
  ∀ l₁ l₂ : Line,
    IsParallel l₁ l₂ → IsParallel l₂ l₁ :=
      ParaEquiv.symm

lemma ParaTrans :
  ∀ l₁ l₂ l₃ : Line,
    IsParallel l₁ l₂ → IsParallel l₂ l₃ → IsParallel l₁ l₃ :=
      ParaEquiv.trans

-- need to take care of the case when l1 = l2 for IsIntersect.
-- we probably don't need this

-- property of IsIntersect
axiom Intersect_common_point (l1 l2 : Line) (h : ¬ IsParallel l1 l2) :
  ∃ c : Point, lies_on c l1 ∧ lies_on c l2

-- Unique intersection point of two lines
theorem UniqueIntersectPoint (l1 l2 : Line) (h : ¬ IsParallel l1 l2) :
  lies_on (a : Point) l1 ∧ lies_on a l2
  →
  lies_on  (b : Point) l1 ∧ lies_on b l2
  →
  a ≠ b →
  False := by
    intro h1 h2 hab
    have h1l : lies_on a l1 := And.left h1
    have h1r : lies_on a l2 := And.right h1
    have h2l : lies_on b l1 := And.left h2
    have h2r : lies_on b l2 := And.right h2
    let lab := Line_of_two_points a b hab
    have lemlab : lies_on a lab ∧ lies_on b lab := point_contain a b hab
    have lem1 : l1 = lab := by
      apply line_unique a b hab
      apply And.intro
      case a.left =>
        apply And.intro
        case left => assumption
        case right => assumption
      case a.right =>
        assumption
    have lem2 : l2 = lab := by
      apply line_unique a b hab
      apply And.intro
      case a.left =>
        apply And.intro
        case left => assumption
        case right => assumption
      case a.right =>
        assumption
    have lem3 : IsParallel l1 lab := by
      rw [lem1]
      apply Pararefl
    have lem4 : IsParallel lab l2 := by
      rw [lem2]
      apply Pararefl
    have lem5 : IsParallel l1 l2 := by
      apply ParaTrans l1 lab l2 lem3 lem4
    contradiction

-- Towards same-sided-ness
-- entire segment is on the line
/-def SegmentOnLine (A : Segment) (l : Line) : Prop :=
  lies_on A.p1 l ∧ lies_on A.p2 l-/

-- points on a segment
axiom in_betw_lies_on_line (a b c : Point) (h' : a ≠ c) (h : in_between a b c) :
  lies_on b (Line_of_two_points a c h')

def PointOnSegment (a : Point) (A : Segment) : Prop :=
  in_between A.p1 a A.p2

theorem Seg_point_on_line (S : Segment) (a : Point) (h : PointOnSegment a S) :
  lies_on a (line_from_seg S) := by
    let l := line_from_seg S

def SegLineIntersect (A : Segment) (l : Line) : Prop :=
  ∃ C : Point, PointOnSegment C A ∧ lies_on C l

theorem Unique_inter_seg_line (S : Segment) (l : Line)
(h1 : SegLineIntersect S l) (h2 : ¬ line_from_seg S = l) :
  PointOnSegment (c1 : Point) S ∧ lies_on c1 l
  →
  PointOnSegment (c2 : Point) S ∧ lies_on c2 l
  →
  ¬ c1 = c2
  →
  False
  := by
  intro hc1 hc2 hnot
  let l12 := Line_of_two_points c1 c2 hnot
  have lem1 : l = l12 := by
    apply line_unique c1 c2 hnot l l12
    apply And.intro
    case left => apply And.intro (And.right hc1)  (And.right hc2)
    case right => apply point_contain c1 c2 hnot
  let ls12 := line_from_seg S
  have lem2 : lies_on c1 ls12 ∧ lies_on c2 ls12 := by
    apply And.intro
    case left =>

  have lem3 : l12 = line_from_seg S := by

-- need to introduce property of SegLineIntersect
-- have not accounted for the case where segment "stands on" the line

-- Points on the same side of a line segment
def SameSidedPoints (a b : Point) (l : Line) : Prop :=
  ¬ SegLineIntersect (Segment.mk a b) l

  --let S_ab := Segment.mk a b
    --SegLineIntersect S_ab l
  --(h1 : ¬ SegmentOnLine (Segment.mk a b) l)
  --(h2 : ¬ SegLineIntersect (Segment.mk a b) l h1)
  --: Prop

/-
axiom IntersectingLines (A B C : Segment)
  (h1 : ¬ SegmentOnLine (Segment.mk A.p1 B.p1) (line_from_seg C))
  (h2 : ¬ SegLineIntersect (Segment.mk A.p1 B.p1) (line_from_seg C) h1)
  :
  SameSidedPoints (A.p1) (B.p1) (line_from_seg C) h1 h2
  →

  /-
  →
  (in_between A.p1 C.p1 A.p2) ∧ (in_between B.p1 C.p2 B.p2)
  -- what about C.p1 = A.p1? is this not taken care of by SegLineIntersect?
  → -/
--  (need to bring in "same-sided-ness")

-/

axiom Postulate_5 (S₁ S₂ : Segment) (l : Line) :
  let l₁ := line_from_seg S₁
  let l₂ := line_from_seg S₂
  let lem1 : Prop := SegLineIntersect S₁ l
  let lem2 : Prop := SegLineIntersect S₂ l
  let lem3 : Prop := SameSidedPoints S₁.p1 ∧ SameSidedPoints S₂.p1


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import logic.equiv.defs
import tactic.clear
import tactic.simp_result
import tactic.apply
import control.equiv_functor.instances -- these make equiv_rw more powerful!
import logic.equiv.functor              -- so do these!

/-!
# The `equiv_rw` tactic transports goals or hypotheses along equivalences.

The basic syntax is `equiv_rw e`, where `e : α ≃ β` is an equivalence.
This will try to replace occurrences of `α` in the goal with `β`, for example
transforming
* `⊢ α` to `⊢ β`,
* `⊢ option α` to `⊢ option β`
* `⊢ {a // P}` to `{b // P (⇑(equiv.symm e) b)}`

The tactic can also be used to rewrite hypotheses, using the syntax `equiv_rw e at h`.

## Implementation details

The main internal function is `equiv_rw_type e t`,
which attempts to turn an expression `e : α ≃ β` into a new equivalence with left hand side `t`.
As an example, with `t = option α`, it will generate `functor.map_equiv option e`.

This is achieved by generating a new synthetic goal `%%t ≃ _`,
and calling `solve_by_elim` with an appropriate set of congruence lemmas.
To avoid having to specify the relevant congruence lemmas by hand,
we mostly rely on `equiv_functor.map_equiv` and `bifunctor.map_equiv`
along with some structural congruence lemmas such as
* `equiv.arrow_congr'`,
* `equiv.subtype_equiv_of_subtype'`,
* `equiv.sigma_congr_left'`, and
* `equiv.Pi_congr_left'`.

The main `equiv_rw` function, when operating on the goal, simply generates a new equivalence `e'`
with left hand side matching the target, and calls `apply e'.inv_fun`.

When operating on a hypothesis `x : α`, we introduce a new fact `h : x = e.symm (e x)`, revert this,
and then attempt to `generalize`, replacing all occurrences of `e x` with a new constant `y`, before
`intro`ing and `subst`ing `h`, and renaming `y` back to `x`.

## Future improvements
In a future PR I anticipate that `derive equiv_functor` should work on many examples,
(internally using `transport`, which is in turn based on `equiv_rw`)
and we can incrementally bootstrap the strength of `equiv_rw`.

An ambitious project might be to add `equiv_rw!`,
a tactic which, when failing to find appropriate `equiv_functor` instances,
attempts to `derive` them on the spot.

For now `equiv_rw` is entirely based on `equiv`,
but the framework can readily be generalised to also work with other types of equivalences,
for example specific notations such as ring equivalence (`≃+*`),
or general categorical isomorphisms (`≅`).

This will allow us to transport across more general types of equivalences,
but this will wait for another subsequent PR.
-/

namespace tactic

/-- A list of lemmas used for constructing congruence equivalences. -/

-- Although this looks 'hard-coded', in fact the lemma `equiv_functor.map_equiv`
-- allows us to extend `equiv_rw` simply by constructing new instance so `equiv_functor`.

-- TODO: We should also use `category_theory.functorial` and `category_theory.hygienic` instances.
-- (example goal: we could rewrite along an isomorphism of rings (either as `R ≅ S` or `R ≃+* S`)
-- and turn an `x : mv_polynomial σ R` into an `x : mv_polynomial σ S`.).

meta def equiv_congr_lemmas : list (tactic expr) :=
[ `equiv.of_iff,
  -- TODO decide what to do with this; it's an equiv_bifunctor?
  `equiv.equiv_congr,
  -- The function arrow is technically a bifunctor `Typeᵒᵖ → Type → Type`,
  -- but the pattern matcher will never see this.
  `equiv.arrow_congr',
  -- Allow rewriting in subtypes:
  `equiv.subtype_equiv_of_subtype',
  -- Allow rewriting in the first component of a sigma-type:
  `equiv.sigma_congr_left',
  -- Allow rewriting ∀s:
  -- (You might think that repeated application of `equiv.forall_congr'
  -- would handle the higher arity cases, but unfortunately unification is not clever enough.)
  `equiv.forall₃_congr',
  `equiv.forall₂_congr',
  `equiv.forall_congr',
  -- Allow rewriting in argument of Pi types:
   `equiv.Pi_congr_left',
  -- Handles `sum` and `prod`, and many others:
  `bifunctor.map_equiv,
  -- Handles `list`, `option`, `unique`, and many others:
  `equiv_functor.map_equiv,
  -- We have to filter results to ensure we don't cheat and use exclusively
  -- `equiv.refl` and `iff.refl`!
  `equiv.refl,
  `iff.refl
  ].map (λ n, mk_const n)

declare_trace equiv_rw_type

/--
Configuration structure for `equiv_rw`.

* `max_depth` bounds the search depth for equivalences to rewrite along.
  The default value is 10.
  (e.g., if you're rewriting along `e : α ≃ β`, and `max_depth := 2`,
  you can rewrite `option (option α))` but not `option (option (option α))`.
-/
meta structure equiv_rw_cfg :=
(max_depth : ℕ := 10)

/--
Implementation of `equiv_rw_type`, using `solve_by_elim`.
Expects a goal of the form `t ≃ _`,
and tries to solve it using `eq : α ≃ β` and congruence lemmas.
-/
meta def equiv_rw_type_core (eq : expr) (cfg : equiv_rw_cfg) : tactic unit :=
do
  /-
    We now call `solve_by_elim` to try to generate the requested equivalence.
    There are a few subtleties!
    * We make sure that `eq` is the first lemma, so it is applied whenever possible.
    * In `equiv_congr_lemmas`, we put `equiv.refl` last so it is only used when it is not possible
      to descend further.
    * Since some congruence lemmas generate subgoals with `∀` statements,
      we use the `pre_apply` subtactic of `solve_by_elim` to preprocess each new goal with `intros`.
  -/
  solve_by_elim
  { use_symmetry := false,
    use_exfalso := false,
    lemma_thunks := some (pure eq :: equiv_congr_lemmas),
    ctx_thunk := pure [],
    max_depth := cfg.max_depth,
    -- Subgoals may contain function types,
    -- and we want to continue trying to construct equivalences after the binders.
    pre_apply := tactic.intros >> skip,
    backtrack_all_goals := tt,
    -- If solve_by_elim gets stuck, make sure it isn't because there's a later `≃` or `↔` goal
    -- that we should still attempt.
    discharger :=
      `[success_if_fail { match_target _ ≃ _ }] >> `[success_if_fail { match_target _ ↔ _ }] >>
      (`[show _ ≃ _] <|> `[show _ ↔ _]) <|>
      trace_if_enabled `equiv_rw_type "Failed, no congruence lemma applied!" >> failed,
    -- We use the `accept` tactic in `solve_by_elim` to provide tracing.
    accept := λ goals, lock_tactic_state (do
      when_tracing `equiv_rw_type (do
        goals.mmap pp >>= λ goals, trace format!"So far, we've built: {goals}"),
      done <|>
      when_tracing `equiv_rw_type (do
        gs ← get_goals,
        gs ← gs.mmap (λ g, infer_type g >>= pp),
        trace format!"Attempting to adapt to {gs}")) }

/--
`equiv_rw_type e t` rewrites the type `t` using the equivalence `e : α ≃ β`,
returning a new equivalence `t ≃ t'`.
-/
meta def equiv_rw_type (eqv : expr) (ty : expr) (cfg : equiv_rw_cfg) : tactic expr :=
do
  when_tracing `equiv_rw_type (do
    ty_pp ← pp ty,
    eqv_pp ← pp eqv,
    eqv_ty_pp ← infer_type eqv >>= pp,
    trace format!"Attempting to rewrite the type `{ty_pp}` using `{eqv_pp} : {eqv_ty_pp}`."),
  `(_ ≃ _) ← infer_type eqv | fail format!"{eqv} must be an `equiv`",
  -- We prepare a synthetic goal of type `(%%ty ≃ _)`, for some placeholder right hand side.
  equiv_ty ← to_expr ``(%%ty ≃ _),
  -- Now call `equiv_rw_type_core`.
  new_eqv ← prod.snd <$> (solve_aux equiv_ty $ equiv_rw_type_core eqv cfg),
  -- Check that we actually used the equivalence `eq`
  -- (`equiv_rw_type_core` will always find `equiv.refl`,
  -- but hopefully only after all other possibilities)
  new_eqv ← instantiate_mvars new_eqv,
  -- We previously had `guard (eqv.occurs new_eqv)` here, but `kdepends_on` is more reliable.
  kdepends_on new_eqv eqv >>= guardb <|> (do
    eqv_pp ← pp eqv,
    ty_pp ← pp ty,
    fail format!"Could not construct an equivalence from {eqv_pp} of the form: {ty_pp} ≃ _"),
  -- Finally we simplify the resulting equivalence,
  -- to compress away some `map_equiv equiv.refl` subexpressions.
  prod.fst <$> new_eqv.simp {fail_if_unchanged := ff}

mk_simp_attribute equiv_rw_simp "The simpset `equiv_rw_simp` is used by the tactic `equiv_rw` to
simplify applications of equivalences and their inverses."

attribute [equiv_rw_simp] equiv.symm_symm equiv.apply_symm_apply equiv.symm_apply_apply

/--
Attempt to replace the hypothesis with name `x`
by transporting it along the equivalence in `e : α ≃ β`.
-/
meta def equiv_rw_hyp (x : name) (e : expr) (cfg : equiv_rw_cfg := {}) : tactic unit :=
-- We call `dsimp_result` to perform the beta redex introduced by `revert`
dsimp_result (do
  x' ← get_local x,
  x_ty ← infer_type x',
  -- Adapt `e` to an equivalence with left-hand-side `x_ty`.
  e ← equiv_rw_type e x_ty cfg,
  eq ← to_expr ``(%%x' = equiv.symm %%e (equiv.to_fun %%e %%x')),
  prf ← to_expr ``((equiv.symm_apply_apply %%e %%x').symm),
  h ← note_anon eq prf,
  -- Revert the new hypothesis, so it is also part of the goal.
  revert h,
  ex ← to_expr ``(equiv.to_fun %%e %%x'),
  -- Now call `generalize`,
  -- attempting to replace all occurrences of `e x`,
  -- calling it for now `j : β`, with `k : x = e.symm j`.
  generalize ex (by apply_opt_param) transparency.none,
  -- Reintroduce `x` (now of type `b`), and the hypothesis `h`.
  intro x,
  h ← intro1,
  -- Finally, if we're working on properties, substitute along `h`, then do some cleanup,
  -- and if we're working on data, just throw out the old `x`.
  b ← target >>= is_prop,
  if b then do
    subst h,
    `[try { simp only with equiv_rw_simp }]
  else
    -- We may need to unfreeze `x` before we can `clear` it.
    unfreezing_hyp x' (clear' tt [x']) <|> fail
      format!"equiv_rw expected to be able to clear the original hypothesis {x}, but couldn't.",
  skip)
  {fail_if_unchanged := ff} tt -- call `dsimp_result` with `no_defaults := tt`.

/-- Rewrite the goal using an equiv `e`. -/
meta def equiv_rw_target (e : expr) (cfg : equiv_rw_cfg := {}) : tactic unit :=
do
  t ← target,
  e ← equiv_rw_type e t cfg,
  s ← to_expr ``(equiv.inv_fun %%e),
  tactic.eapply s,
  skip

end tactic

namespace tactic.interactive

open tactic
setup_tactic_parser

/-- Auxiliary function to call `equiv_rw_hyp` on a `list pexpr` recursively. -/
meta def equiv_rw_hyp_aux (hyp : name) (cfg : equiv_rw_cfg) (permissive : bool := ff) :
  list expr → itactic
| []       := skip
| (e :: t) := do
  if permissive then equiv_rw_hyp hyp e cfg <|> skip
  else equiv_rw_hyp hyp e cfg,
  equiv_rw_hyp_aux t

/-- Auxiliary function to call `equiv_rw_target` on a `list pexpr` recursively. -/
meta def equiv_rw_target_aux (cfg : equiv_rw_cfg) (permissive : bool) :
  list expr → itactic
| []       := skip
| (e :: t) := do
  if permissive then equiv_rw_target e cfg <|> skip
  else equiv_rw_target e cfg,
  equiv_rw_target_aux t

/--
`equiv_rw e at h₁ h₂ ⋯`, where each `hᵢ : α` is a hypothesis, and `e : α ≃ β`,
will attempt to transport each `hᵢ` along `e`, producing a new hypothesis `hᵢ : β`,
with all occurrences of `hᵢ` in other hypotheses and the goal replaced with `e.symm hᵢ`.

`equiv_rw e` will attempt to transport the goal along an equivalence `e : α ≃ β`.
In its minimal form it replaces the goal `⊢ α` with `⊢ β` by calling `apply e.inv_fun`.

`equiv_rw [e₁, e₂, ⋯] at h₁ h₂ ⋯` is equivalent to
`{ equiv_rw [e₁, e₂, ⋯] at h₁, equiv_rw [e₁, e₂, ⋯] at h₂, ⋯ }`.

`equiv_rw [e₁, e₂, ⋯] at *` will attempt to apply `equiv_rw [e₁, e₂, ⋯]` on the goal
and on each expression available in the local context (except on the `eᵢ`s themselves),
failing silently when it can't. Failing on a rewrite for a certain `eᵢ` at a certain
hypothesis `h` doesn't stop `equiv_rw` from trying the other equivalences on the list
at `h`. This only happens for the wildcard location.

`equiv_rw` will also try rewriting under (equiv_)functors, so it can turn
a hypothesis `h : list α` into `h : list β` or
a goal `⊢ unique α` into `⊢ unique β`.

The maximum search depth for rewriting in subexpressions is controlled by
`equiv_rw e {max_depth := n}`.
-/
meta def equiv_rw
  (l : parse pexpr_list_or_texpr)
  (locat : parse location)
  (cfg : equiv_rw_cfg := {}) : itactic := do
es ← l.mmap (λ e, to_expr e),
match locat with
| loc.wildcard := do
  equiv_rw_target_aux cfg tt es,
  ctx ← local_context,
  ctx.mmap (λ e, if e ∈ es then skip else equiv_rw_hyp_aux e.local_pp_name cfg tt es),
  skip
| loc.ns names := do
  names.mmap
    (λ hyp', match hyp' with
    | some hyp := equiv_rw_hyp_aux hyp cfg ff es
    | none     := equiv_rw_target_aux cfg ff es
    end),
  skip
end

add_tactic_doc
{ name        := "equiv_rw",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.equiv_rw],
  tags        := ["rewriting", "equiv", "transport"] }

/--
Solve a goal of the form `t ≃ _`,
by constructing an equivalence from `e : α ≃ β`.
This is the same equivalence that `equiv_rw` would use to rewrite a term of type `t`.

A typical usage might be:
```
have e' : option α ≃ option β := by equiv_rw_type e
```
-/
meta def equiv_rw_type (e : parse texpr) (cfg : equiv_rw_cfg := {}) : itactic :=
do
 `(%%t ≃ _) ← target | fail "`equiv_rw_type` solves goals of the form `t ≃ _`.",
 e ← to_expr e,
 tactic.equiv_rw_type e t cfg >>= tactic.exact

add_tactic_doc
{ name        := "equiv_rw_type",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.equiv_rw_type],
  tags        := ["rewriting", "equiv", "transport"] }

end tactic.interactive


import analysis.normed.field.unit_ball
import field_theory.is_alg_closed.algebraic_closure
import number_theory.padics.padic_numbers
import topology.metric_space.cau_seq_filter
import topology.algebra.valued_field
import spectral_norm_unique
import normed_valued

noncomputable theory

open_locale nnreal

lemma nat.one_div_cast_lt_one {n : ℕ} (hn : 1 < n) :  1/(n : ℝ) < 1 :=
begin
  rw [one_div, ← inv_one,
    inv_lt_inv (nat.cast_pos.mpr (lt_trans zero_lt_one hn)) zero_lt_one],
  exact nat.one_lt_cast.mpr hn,
  apply_instance, apply_instance,
end

variables (p : ℕ) [fact p.prime]
--include hp

@[reducible] def Q_p_alg : Type* := algebraic_closure ℚ_[p]

lemma Q_p_alg.is_algebraic : algebra.is_algebraic ℚ_[p] (Q_p_alg p) :=
algebraic_closure.is_algebraic _

instance : has_coe ℚ_[p] (Q_p_alg p) := ⟨algebra_map ℚ_[p] (Q_p_alg p)⟩

protected lemma coe_eq : (coe : ℚ_[p] → (Q_p_alg p)) = algebra_map ℚ_[p] (Q_p_alg p) := rfl

lemma padic.is_nonarchimedean : is_nonarchimedean (λ (k : ℚ_[p]), ∥k∥₊) :=
begin
  intros x y,
  simp only [← nnreal.coe_le_coe, nnreal.coe_max, coe_nnnorm],
  rw sub_eq_add_neg,
  convert padic_norm_e.nonarchimedean x (-y) using 2,
  rw norm_neg,
end

instance Q_p_alg.normed_field : normed_field (Q_p_alg p) :=
spectral_norm.normed_field (Q_p_alg.is_algebraic p) (padic.is_nonarchimedean p)

/- instance Q_p_alg.abv : is_absolute_value (Q_p_alg.normed_field p).norm :=
normed_field.is_absolute_value

def C_p :=  @cau_seq.completion.Cauchy _ _ (Q_p_alg p) _ _ (normed_field.is_absolute_value) -/

/- lemma Q_p_alg.is_nonarchimedean : is_nonarchimedean (spectral_norm (Q_p_alg.is_algebraic p)) :=
spectral_norm.is_nonarchimedean (Q_p_alg.is_algebraic p) (padic.is_nonarchimedean p) -/

lemma Q_p_alg.is_nonarchimedean : is_nonarchimedean (nnnorm : (Q_p_alg p) → ℝ≥0) :=
begin
  convert spectral_norm.is_nonarchimedean (Q_p_alg.is_algebraic p) (padic.is_nonarchimedean p),
  ext x,
  rw [coe_nnnorm], refl,
end

noncomputable! instance Q_p_alg.valued_field : valued (Q_p_alg p) ℝ≥0 :=
normed_field.to_valued (Q_p_alg.is_nonarchimedean p)

lemma Q_p_alg.v_def (x : Q_p_alg p) :
  valued.v x = spectral_norm (Q_p_alg.is_algebraic p) x :=
by { ext, refl }

lemma Q_p_alg.v_def' (x : Q_p_alg p) :
  valued.v x = ∥ x ∥₊ :=
by { ext, refl }

--lemma Q_p_alg.v_ext (x : ℚ_[p]) : valued.v (x : Q_p_alg p) = ∥ (x : Q_p_alg p)  ∥₊ := rfl

def C_p := uniform_space.completion (Q_p_alg p)

notation `ℂ_[`p`]` := C_p p

instance : field ℂ_[p] := uniform_space.completion.field

noncomputable! instance C_p.valued_field : valued (ℂ_[p]) ℝ≥0 := valued.valued_completion

instance : has_coe_t (Q_p_alg p) ℂ_[p] := uniform_space.completion.has_coe_t _

lemma C_p.valuation_extends (x : Q_p_alg p) : valued.v (x : ℂ_[p]) = valued.v x :=
valued.extension_extends _

instance : algebra (Q_p_alg p) ℂ_[p] :=
uniform_space.completion.algebra' _

example {p : ℕ} [fact p.prime] : ((p : ℚ_[p]) : Q_p_alg p) = (p : Q_p_alg p) :=
by rw [coe_eq, map_nat_cast]

protected lemma C_p.coe_eq : (coe : (Q_p_alg p) → ℂ_[p]) = algebra_map (Q_p_alg p) ℂ_[p] := rfl

protected lemma C_p.coe_zero : ((0 : Q_p_alg p) : ℂ_[p]) = 0 := rfl

example {p : ℕ} [fact p.prime] : ((p : Q_p_alg p) : ℂ_[p]) = (p : ℂ_[p]) :=
by rw [C_p.coe_eq, map_nat_cast]

lemma Q_p_alg.valuation_p (p : ℕ) [fact p.prime] : valued.v (p : Q_p_alg p) = 1/(p : ℝ≥0) :=
begin
  have hp : (p : Q_p_alg p) = ((p : ℚ_[p]) : Q_p_alg p),
  { rw [coe_eq, map_nat_cast] },
  ext,
  rw [Q_p_alg.v_def, hp, coe_eq, spectral_norm.extends, coe_nnnorm, padic_norm_e.norm_p, one_div,
    nonneg.coe_inv, nnreal.coe_nat_cast],
end

instance : is_rank_one (C_p.valued_field p).v :=
{ rank_le_one := sorry,
  nontrivial  :=
  begin
    use p,
    haveI hp : nat.prime p := _inst_1.elim,
    have hpv : valued.v (p : ℂ_[p]) = 1/(p : ℝ≥0),
    { have : ((p : Q_p_alg p) : ℂ_[p]) = (p : ℂ_[p]),
      { rw [C_p.coe_eq, map_nat_cast] },
      rw ← this,
      rw C_p.valuation_extends,
      exact Q_p_alg.valuation_p p, },
    simp only [hpv,one_div, ne.def, inv_eq_zero, nat.cast_eq_zero, inv_eq_one, nat.cast_eq_one],
    exact ⟨hp.ne_zero, hp.ne_one⟩,
  end }

instance : normed_field ℂ_[p] := valued_field.to_normed_field
  (nat.one_div_cast_pos (nat.prime.pos _inst_1.elim))
  (nat.one_div_cast_lt_one (nat.prime.one_lt _inst_1.elim))

lemma C_p.norm_def :
 (norm : ℂ_[p] → ℝ )= norm_def (nat.one_div_cast_pos (nat.prime.pos _inst_1.elim)) := rfl

lemma C_p.nnnorm_extends (x : Q_p_alg p) : ∥ (x : ℂ_[p]) ∥₊ = ∥ x ∥₊ :=
begin
  ext,
  rw coe_nnnorm, rw coe_nnnorm,
  by_cases hx : x = 0,
  { rw [hx, C_p.coe_zero, norm_zero, norm_zero],},
  { simp only [C_p.norm_def, norm_def, C_p.valuation_extends,
      mult_with_top_R_to_R_monoid_with_zero_hom, monoid_with_zero_hom.coe_mk, mult_with_top_R_to_R],
    rw dif_neg,
    { sorry }, --TODO: is choice of base necessary??
    { sorry }}
end

lemma C_p.is_nonarchimedean : is_nonarchimedean (nnnorm : ℂ_[p] → ℝ≥0) :=
begin
  intros x y,
  apply uniform_space.completion.induction_on₂ x y,
  { apply is_closed_le,
    { refine continuous.comp _ continuous_sub,
      exact continuous_nnnorm,
       },
    { apply continuous.max,
      apply continuous.comp _ (continuous.fst continuous_id),
      { sorry },
      apply continuous.comp _ (continuous.snd continuous_id),
      { sorry }}},
  { intros a b,
    simp only [← uniform_space.completion.coe_sub, C_p.nnnorm_extends],
    exact Q_p_alg.is_nonarchimedean p a b, },
end

#exit

def C_p_integers := metric.closed_ball (0 : ℂ_[p]) 1 --{x : ℂ_[p] // ∥x∥ ≤ 1}

notation `𝓞_ℂ_[`p`]` := C_p_integers p

instance : comm_monoid 𝓞_ℂ_[p] := metric.closed_ball.comm_monoid

--omit hp

lemma metric.mem_closed_ball_zero_add {α : Type*} [seminormed_add_comm_group α] {x y : α} {ε : ℝ}
  (hx : x ∈ metric.closed_ball (0 : α) ε) (hy : y ∈ metric.closed_ball (0 : α) ε)
  (h_na : is_nonarchimedean (λ x : α, ∥x∥₊)) :
  x + y ∈ metric.closed_ball (0 : α) ε :=
begin
  rw [mem_closed_ball_zero_iff, ← coe_nnnorm] at *,
  have h := is_nonarchimedean.add_le (nnnorm_zero)
h_na x y,
  simp only [← nnreal.coe_le_coe] at h,
  apply le_trans h,
  rw [nnreal.coe_max, max_le_iff],
  exact ⟨hx, hy⟩
end

lemma metric.mem_closed_ball_zero_neg {α : Type*} [seminormed_add_comm_group α] {x : α} {ε : ℝ}
  (hx : x ∈ metric.closed_ball (0 : α) ε) : - x ∈ metric.closed_ball (0 : α) ε :=
by { rw [mem_closed_ball_zero_iff, norm_neg, ← mem_closed_ball_zero_iff], exact hx }

def subring.unit_closed_ball (𝕜 : Type*) [semi_normed_ring 𝕜] [norm_one_class 𝕜]
  (h_na : is_nonarchimedean (λ x : 𝕜, ∥x∥₊)) : subring 𝕜 :=
{ carrier   := metric.closed_ball (0 : 𝕜) 1,
  add_mem'  := λ x y hx hy, metric.mem_closed_ball_zero_add hx hy h_na,
  zero_mem' := metric.mem_closed_ball_self zero_le_one,
  neg_mem'  := λ x hx, metric.mem_closed_ball_zero_neg hx,
  .. submonoid.unit_closed_ball  𝕜 }

--include hp
instance : comm_ring 𝓞_ℂ_[p] :=
subring_class.to_comm_ring (subring.unit_closed_ball ℂ_[p] (C_p.is_nonarchimedean p))


import luc_squares
import data.nat.sqrt

lemma double_qr_mod8 (a:ℕ ): (2*a^2)%8 =0 ∨ (2*a^2)%8=2:=
begin
    rw nat.pow_two, rw nat.mul_mod, nth_rewrite 1 nat.mul_mod, nth_rewrite_rhs 1 nat.mul_mod,
    have h1:= nat.mod_lt a (show 8>0, by linarith), interval_cases a%8; rw h; tauto
end

lemma res_mod_12 (n: ℕ ) (h: n%2=1) (h1: n%3=0): n%12=3 ∨ n%12=9:=
begin
    have g1:= nat.mod_lt n (show 12>0, by linarith),
    have g2:= nat.mod_mul_left_mod n 4 3, rw [show 4*3=12, from rfl] at g2, rw h1 at g2,
    rw ←nat.dvd_iff_mod_eq_zero at g2, cases g2 with x g2, rw g2 at g1,
    have g3: x<4, by linarith,
    have g4:= nat.mod_mul_left_mod n 6 2, rw (show 6*2 =12, from rfl) at g4, rw←  g4 at h,
    interval_cases x; simp * at *, right, refl
end

lemma res_mod_4 (n a: ℕ ) (h: n=2*a ): n%4 =0 ∨ n%4=2:=
begin
    have g1:= nat.mod_lt n (show 4>0, by linarith),
    apply_fun (λ (a: ℕ ), a%2) at h, rw nat.mul_mod at h, rw (show 2%2=0, from rfl) at h, rw zero_mul at h,
    have g2:= nat.mod_mul_left_mod n 2 2, rw [show 2*2=4, from rfl] at g2, rw h at g2,
    interval_cases n%4; simp [g2, h_1, (show 3%2=1, from rfl), (show 0%2=0, from rfl), (show 1%2 =1, from rfl)] at *; exfalso; assumption
end

lemma res_mod_8 (n: ℕ) (h: n%4=2): n%8 = 6 ∨ n%8=2:=
begin
    have g1:= nat.mod_lt n (show 8>0, by linarith),
    have g2:= nat.mod_mul_left_mod n 2 4, rw [show 2*4=8, from rfl] at g2, rw h at g2,
    interval_cases n%8; simp [* ,(show 1%4=1, from rfl), (show 3%4 =3, from rfl), (show 5%4 =1, from rfl), (show 7%4=3, from rfl)] at *; cc
end

lemma add_sub_add (a b c: ℕ) (h: b≤ a) (h2: b ≤ c): a-b+c = c-b+a:=
begin
    omega
end

theorem luc_double_square  (n k: ℕ ) (h: luc n =2*k^2) :  n=0 ∨ n=6 :=
begin
    cases even_or_odd n with w h1, cases h1 with h1 h1', swap,
    {apply_fun ( λ (a: ℕ ), a%2) at h1', simp [nat.add_mod, nat.mul_mod, (show 1%2=1, from rfl)] at h1',
    have h2:= congr_arg (λ (a: ℕ), a%2 ) h, simp at h2, rw luc_even at h2,
    have h3:= res_mod_12 n h1' h2,
    have h4:= luc_mod_8_gen n, rw h at h4,
    have h5:= double_qr_mod8 k, rw h4 at h5, cases h3 with h31 h32,
    {rw h31 at h5, rw [show luc 3%8 = 4, from rfl]at h5,cc},
    {rw h32 at h5, rw [show luc 9%8 = 4, from rfl] at h5,cc}},

    {cases res_mod_4 n w h1,
    {cases div_algo n 4 with s h2, cases nat_case_bash s 0 with g2 g3, swap,
    {cases g3 with q g3, rw add_zero q at g3, cases decomp_pow_3 s (show s>0, by linarith) with r g4, rcases g4 with ⟨ u, g4, g5 ⟩, rw add_comm at h2,
    have g6:=double_not_zero_mod3 u g5,
    have g7:= fun_gen_add 1 u n s q r (n%4) (luc(2*u)) (luc) h2 g3 g4 (mod_luc (2*1*u) g6), repeat {rw mul_one at g7},
    rw h at g7, rw ← zmod.nat_coe_zmod_eq_zero_iff_dvd at g7, apply_fun (λ (a: zmod (luc(2*u))), (a- luc(n%4))) at g7,
    have H: (↑ (2*k*k) : zmod (luc(2*u))) = -luc(n%4), {simp at g7, simp, rw ← g7, ring},
    rw h_1 at H, rw (show luc 0 =2*1*1, from rfl) at H,  repeat{rw nat.cast_mul at H}, repeat{rw mul_assoc at H}, repeat{rw ← pow_two at H},
    have g8:= squares_inv 1 2 (luc(2*u)) k (nat.coprime_one_left (luc(2*u))) (show nat.coprime 2 (luc(2*u)), from luc_coprime_2 _ (g6.2)) H (luc_pos(2*u)), cases g8 with l g8,
    have g9:= non_res_3_mod_4 _ _ (luc_pos(2*u)) g8, rw luc_mod_4 (2*u) g6 at g9, contradiction},
    {rw le_zero_iff_eq at g2, rw g2 at h2, rw h_1 at h2, simp [h2]}},

    {have h2:= res_mod_8 n h_1, cases h2 with h21 h22,
    {cases div_algo n 8 with s h2, cases nat_case_bash s 0 with g2 g3, swap,
    {cases g3 with q g3, rw add_zero q at g3, cases decomp_pow_3 s (show s>0, by linarith) with r g4, rcases g4 with ⟨ u, g4, g5 ⟩, rw add_comm at h2,
    have g6:=double_not_zero_mod3 u g5, cases g6 with g61 g62,
    have g6': 2*u %3 ≠ 0 → ¬ 3 ∣ 2*u, contrapose!, exact nat.mod_eq_zero_of_dvd,
    have G6:=double_not_zero_mod3 (2*u) (g6' g62), rw ← mul_assoc at G6,
    have g7:= fun_gen_add 2 u n s q r (n%(4*2)) (luc(2*2*u)) (luc) h2 g3 g4 (mod_luc (2*2*u) G6),
    rw h at g7, rw mul_assoc at g7, rw mul_assoc at G6, rw [show 4*2 =8, from rfl] at g7, rw ← zmod.nat_coe_zmod_eq_zero_iff_dvd at g7, apply_fun (λ (a: zmod (luc(2*(2*u)))), (a- luc(n%(8)))) at g7,
    have H: (↑ (2*k*k) : zmod (luc(2*(2*u)))) = -luc(n%(8)), {simp at g7, simp, rw ← g7, ring},
    rw h21 at H, rw (show luc 6 =2*3*3, from rfl) at H, repeat{rw nat.cast_mul at H}, repeat{rw mul_assoc at H}, repeat{rw ← pow_two at H},
    have g8: (2*(2*u))%4 ≠ 2, {rw ← mul_assoc, rw (show 2*2=4, from rfl), rw nat.mul_mod, rw (show 4%4=0, from rfl), rw zero_mul, simp, linarith},
    have g9:= squares_inv 3 2 (luc(2*(2*u))) k (show nat.coprime 3 (luc(2*(2*u))), from luc_coprime_3 _ (g8)) (show nat.coprime 2 (luc(2*(2*u))), from luc_coprime_2 _ (G6.2)) H (luc_pos(2*(2*u))), cases g9 with l g9,
    have g10:= non_res_3_mod_4 _ _ (luc_pos(2*(2*u))) g9, rw luc_mod_4 (2*(2*u)) G6 at g10, contradiction},
    {rw le_zero_iff_eq at g2, rw g2 at h2, rw h21 at h2, simp at h2, right, exact h2}},

    {cases div_algo n 8 with q h2', rw h22 at h2',
    have h2: n = 8*(q+1)-6, {rw h2', rw mul_add, rw mul_one, rw nat.add_sub_assoc (show 6 ≤ 8, by linarith)},
    cases decomp_pow_3 (q+1) (show q+1>0, by linarith) with r g4, rcases g4 with ⟨ u, g4, g5 ⟩, rw add_comm at h2,
    have g6:=double_not_zero_mod3 u g5, cases g6 with g61 g62,
    have g6': 2*u %3 ≠ 0 → ¬ 3 ∣ 2*u, {contrapose!, exact nat.mod_eq_zero_of_dvd},
    have G6:=double_not_zero_mod3 (2*u) (g6' g62), rw ← mul_assoc at G6,
    have g7:= fun_gen_add 2 u (8*u-6 + 4*2*(q+1)) (q+1) q r (8*u-6) (luc(2*2*u)) (luc) (show 8*u-6+4*2*(q+1) = 8*u-6+4*2*(q+1), from rfl) (show q+1=q+1, from rfl) g4 (mod_luc (2*2*u) G6),
    have g8:= mod_luc (2*2*u) G6 (8*(q+1)-6),
    have i1: 6 ≤ 2*(2*2*u),
        {have h2: 1 ≤ u, {by_contra, push_neg at a, interval_cases u, linarith},
        ring, apply le_trans (show 6 ≤ 8*1, by linarith), linarith},
    have g9:= mod_luc_sub (2*2*u) (6) (G6.1) (G6.2) (i1),
    rw (show (-1 :ℤ )^6 = 1, by ring) at g9, rw one_mul at g9, norm_cast at g9, rw (show 2*(2*2*u)=8*u, by ring) at *,
    have g10: 8*(q+1)-6+8*u = 8*u -6+4*2*(q+1), {rw (show 4*2 =8, from rfl), rw add_sub_add _ _ _ (i1) (show 6 ≤ 8*(q+1), by linarith)}, rw g10 at g8,
    have g11:= nat.dvd_add g8 g9, rw add_assoc at g11, nth_rewrite 1 ← add_assoc at g11, nth_rewrite 4 add_comm at g11, repeat {rw ← add_assoc at g11}, rw add_assoc at g11, rw nat.dvd_add_right g7 at g11,
    rw add_comm at h2, rw h2 at h, rw h at g11, rw mul_assoc at g11, rw mul_assoc at G6, rw ← zmod.nat_coe_zmod_eq_zero_iff_dvd at g11, apply_fun (λ (a: zmod (luc(2*(2*u)))), (a- luc(6))) at g11,
    have H: (↑ (2*k*k) : zmod (luc(2*(2*u)))) = -luc(6), {simp at g11, simp, rw ← g11, ring},
    rw (show luc 6 =2*3*3, from rfl) at H, repeat{rw nat.cast_mul at H}, repeat{rw mul_assoc at H}, repeat{rw ← pow_two at H},
    have g12: (2*(2*u))%4 ≠ 2, {rw ← mul_assoc, rw (show 2*2=4, from rfl), rw nat.mul_mod, rw (show 4%4=0, from rfl), rw zero_mul, simp, linarith},
    have g13:= squares_inv 3 2 (luc(2*(2*u))) k (show nat.coprime 3 (luc(2*(2*u))), from luc_coprime_3 _ (g12)) (show nat.coprime 2 (luc(2*(2*u))), from luc_coprime_2 _ (G6.2)) H (luc_pos(2*(2*u))), cases g13 with l g13,
    have g14:= non_res_3_mod_4 _ _ (luc_pos(2*(2*u))) g13, rw luc_mod_4 (2*(2*u)) G6 at g14, contradiction}}}
end


/-
Copyright (c) 2020 Yury Kudryashov All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Moritz Doll

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

/-!
# Partially defined linear maps

A `LinearPMap R E F` or `E →ₗ.[R] F` is a linear map from a submodule of `E` to `F`.
We define a `SemilatticeInf` with `OrderBot` instance on this this, and define three operations:

* `mkSpanSingleton` defines a partial linear map defined on the span of a singleton.
* `sup` takes two partial linear maps `f`, `g` that agree on the intersection of their
  domains, and returns the unique partial linear map on `f.domain ⊔ g.domain` that
  extends both `f` and `g`.
* `supₛ` takes a `DirectedOn (· ≤ ·)` set of partial linear maps, and returns the unique
  partial linear map on the `supₛ` of their domains that extends all these maps.

Moreover, we define
* `LinearPMap.graph` is the graph of the partial linear map viewed as a submodule of `E × F`.

Partially defined maps are currently used in `Mathlib` to prove Hahn-Banach theorem
and its variations. Namely, `LinearPMap.supₛ` implies that every chain of `LinearPMap`s
is bounded above.
They are also the basis for the theory of unbounded operators.

-/

open Set

-- Porting note: TODO Erase this line. Needed because we don't have η for classes. (lean4#2074)
attribute [-instance] Ring.toNonAssocRing

universe u v w

/-- A `LinearPMap R E F` or `E →ₗ.[R] F` is a linear map from a submodule of `E` to `F`. -/
structure LinearPMap (R : Type u) [Ring R] (E : Type v) [AddCommGroup E] [Module R E] (F : Type w)
  [AddCommGroup F] [Module R F] where
  domain : Submodule R E
  toFun : domain →ₗ[R] F
#align linear_pmap LinearPMap

notation:25 E " →ₗ.[" R:25 "] " F:0 => LinearPMap R E F

variable {R : Type _} [Ring R] {E : Type _} [AddCommGroup E] [Module R E] {F : Type _}
  [AddCommGroup F] [Module R F] {G : Type _} [AddCommGroup G] [Module R G]

namespace LinearPMap

open Submodule

-- Porting note: A new definition underlying a coercion `↑`.
@[coe]
def toFun' (f : E →ₗ.[R] F) : f.domain → F := f.toFun

instance : CoeFun (E →ₗ.[R] F) fun f : E →ₗ.[R] F => f.domain → F :=
  ⟨toFun'⟩

@[simp]
theorem toFun_eq_coe (f : E →ₗ.[R] F) (x : f.domain) : f.toFun x = f x :=
  rfl
#align linear_pmap.to_fun_eq_coe LinearPMap.toFun_eq_coe

@[ext]
theorem ext {f g : E →ₗ.[R] F} (h : f.domain = g.domain)
    (h' : ∀ ⦃x : f.domain⦄ ⦃y : g.domain⦄ (_h : (x : E) = y), f x = g y) : f = g := by
  rcases f with ⟨f_dom, f⟩
  rcases g with ⟨g_dom, g⟩
  obtain rfl : f_dom = g_dom := h
  obtain rfl : f = g := LinearMap.ext fun x => h' rfl
  rfl
#align linear_pmap.ext LinearPMap.ext

@[simp]
theorem map_zero (f : E →ₗ.[R] F) : f 0 = 0 :=
  f.toFun.map_zero
#align linear_pmap.map_zero LinearPMap.map_zero

theorem ext_iff {f g : E →ₗ.[R] F} :
    f = g ↔
      ∃ _domain_eq : f.domain = g.domain,
        ∀ ⦃x : f.domain⦄ ⦃y : g.domain⦄ (_h : (x : E) = y), f x = g y :=
  ⟨fun EQ =>
    EQ ▸
      ⟨rfl, fun x y h => by
        congr
        exact_mod_cast h⟩,
    fun ⟨deq, feq⟩ => ext deq feq⟩
#align linear_pmap.ext_iff LinearPMap.ext_iff

theorem ext' {s : Submodule R E} {f g : s →ₗ[R] F} (h : f = g) : mk s f = mk s g :=
  h ▸ rfl
#align linear_pmap.ext' LinearPMap.ext'

theorem map_add (f : E →ₗ.[R] F) (x y : f.domain) : f (x + y) = f x + f y :=
  f.toFun.map_add x y
#align linear_pmap.map_add LinearPMap.map_add

theorem map_neg (f : E →ₗ.[R] F) (x : f.domain) : f (-x) = -f x :=
  f.toFun.map_neg x
#align linear_pmap.map_neg LinearPMap.map_neg

theorem map_sub (f : E →ₗ.[R] F) (x y : f.domain) : f (x - y) = f x - f y :=
  f.toFun.map_sub x y
#align linear_pmap.map_sub LinearPMap.map_sub

theorem map_smul (f : E →ₗ.[R] F) (c : R) (x : f.domain) : f (c • x) = c • f x :=
  f.toFun.map_smul c x
#align linear_pmap.map_smul LinearPMap.map_smul

@[simp]
theorem mk_apply (p : Submodule R E) (f : p →ₗ[R] F) (x : p) : mk p f x = f x :=
  rfl
#align linear_pmap.mk_apply LinearPMap.mk_apply

/-- The unique `LinearPMap` on `R ∙ x` that sends `x` to `y`. This version works for modules
over rings, and requires a proof of `∀ c, c • x = 0 → c • y = 0`. -/
noncomputable def mkSpanSingleton' (x : E) (y : F) (H : ∀ c : R, c • x = 0 → c • y = 0) :
    E →ₗ.[R] F where
  domain := R ∙ x
  toFun :=
    have H : ∀ c₁ c₂ : R, c₁ • x = c₂ • x → c₁ • y = c₂ • y := by
      intro c₁ c₂ h
      rw [← sub_eq_zero, ← sub_smul] at h ⊢
      exact H _ h
    { toFun := fun z => Classical.choose (mem_span_singleton.1 z.prop) • y
      -- Porting note: `dsimp only []` are required.
      -- Porting note: Were `Classical.choose_spec (mem_span_singleton.1 _)`.
      map_add' := fun y z => by
        dsimp only []
        rw [← add_smul]
        apply H
        simp only [add_smul, sub_smul,
          fun w : R ∙ x => Classical.choose_spec (mem_span_singleton.1 w.prop)]
        apply coe_add
      map_smul' := fun c z => by
        dsimp only []
        rw [smul_smul]
        apply H
        simp only [mul_smul,
          fun w : R ∙ x => Classical.choose_spec (mem_span_singleton.1 w.prop)]
        apply coe_smul }
#align linear_pmap.mk_span_singleton' LinearPMap.mkSpanSingleton'

@[simp]
theorem domain_mkSpanSingleton (x : E) (y : F) (H : ∀ c : R, c • x = 0 → c • y = 0) :
    (mkSpanSingleton' x y H).domain = R ∙ x :=
  rfl
#align linear_pmap.domain_mk_span_singleton LinearPMap.domain_mkSpanSingleton

@[simp]
theorem mkSpanSingleton'_apply (x : E) (y : F) (H : ∀ c : R, c • x = 0 → c • y = 0) (c : R) (h) :
    mkSpanSingleton' x y H ⟨c • x, h⟩ = c • y := by
  dsimp [mkSpanSingleton']
  rw [← sub_eq_zero, ← sub_smul]
  apply H
  simp only [sub_smul, one_smul, sub_eq_zero]
  apply Classical.choose_spec (mem_span_singleton.1 h)
#align linear_pmap.mk_span_singleton'_apply LinearPMap.mkSpanSingleton'_apply

@[simp]
theorem mkSpanSingleton'_apply_self (x : E) (y : F) (H : ∀ c : R, c • x = 0 → c • y = 0) (h) :
    mkSpanSingleton' x y H ⟨x, h⟩ = y := by
  -- Porting note: A placeholder should be specified before `convert`.
  have := by refine mkSpanSingleton'_apply x y H 1 ?_; rwa [one_smul]
  convert this <;> rw [one_smul]
#align linear_pmap.mk_span_singleton'_apply_self LinearPMap.mkSpanSingleton'_apply_self

/-- The unique `LinearPMap` on `span R {x}` that sends a non-zero vector `x` to `y`.
This version works for modules over division rings. -/
@[reducible]
noncomputable def mkSpanSingleton {K E F : Type _} [DivisionRing K] [AddCommGroup E] [Module K E]
    [AddCommGroup F] [Module K F] (x : E) (y : F) (hx : x ≠ 0) : E →ₗ.[K] F :=
  mkSpanSingleton' x y fun c hc =>
    (smul_eq_zero.1 hc).elim (fun hc => by rw [hc, zero_smul]) fun hx' => absurd hx' hx
#align linear_pmap.mk_span_singleton LinearPMap.mkSpanSingleton

theorem mkSpanSingleton_apply (K : Type _) {E F : Type _} [DivisionRing K] [AddCommGroup E]
    [Module K E] [AddCommGroup F] [Module K F] {x : E} (hx : x ≠ 0) (y : F) :
    mkSpanSingleton x y hx ⟨x, (Submodule.mem_span_singleton_self x : x ∈ Submodule.span K {x})⟩ =
      y :=
  LinearPMap.mkSpanSingleton'_apply_self _ _ _ _
#align linear_pmap.mk_span_singleton_apply LinearPMap.mkSpanSingleton_apply

/-- Projection to the first coordinate as a `LinearPMap` -/
protected def fst (p : Submodule R E) (p' : Submodule R F) : E × F →ₗ.[R] E where
  domain := p.prod p'
  toFun := (LinearMap.fst R E F).comp (p.prod p').subtype
#align linear_pmap.fst LinearPMap.fst

@[simp]
theorem fst_apply (p : Submodule R E) (p' : Submodule R F) (x : p.prod p') :
    LinearPMap.fst p p' x = (x : E × F).1 :=
  rfl
#align linear_pmap.fst_apply LinearPMap.fst_apply

/-- Projection to the second coordinate as a `LinearPMap` -/
protected def snd (p : Submodule R E) (p' : Submodule R F) : E × F →ₗ.[R] F where
  domain := p.prod p'
  toFun := (LinearMap.snd R E F).comp (p.prod p').subtype
#align linear_pmap.snd LinearPMap.snd

@[simp]
theorem snd_apply (p : Submodule R E) (p' : Submodule R F) (x : p.prod p') :
    LinearPMap.snd p p' x = (x : E × F).2 :=
  rfl
#align linear_pmap.snd_apply LinearPMap.snd_apply

instance neg : Neg (E →ₗ.[R] F) :=
  ⟨fun f => ⟨f.domain, -f.toFun⟩⟩
#align linear_pmap.has_neg LinearPMap.neg

@[simp]
theorem neg_apply (f : E →ₗ.[R] F) (x) : (-f) x = -f x :=
  rfl
#align linear_pmap.neg_apply LinearPMap.neg_apply

instance le : LE (E →ₗ.[R] F) :=
  ⟨fun f g => f.domain ≤ g.domain ∧ ∀ ⦃x : f.domain⦄ ⦃y : g.domain⦄ (_h : (x : E) = y), f x = g y⟩
#align linear_pmap.has_le LinearPMap.le

theorem apply_comp_ofLe {T S : E →ₗ.[R] F} (h : T ≤ S) (x : T.domain) :
    T x = S (Submodule.ofLe h.1 x) :=
  h.2 rfl
#align linear_pmap.apply_comp_of_le LinearPMap.apply_comp_ofLe

theorem exists_of_le {T S : E →ₗ.[R] F} (h : T ≤ S) (x : T.domain) :
    ∃ y : S.domain, (x : E) = y ∧ T x = S y :=
  ⟨⟨x.1, h.1 x.2⟩, ⟨rfl, h.2 rfl⟩⟩
#align linear_pmap.exists_of_le LinearPMap.exists_of_le

theorem eq_of_le_of_domain_eq {f g : E →ₗ.[R] F} (hle : f ≤ g) (heq : f.domain = g.domain) :
    f = g :=
  ext heq hle.2
#align linear_pmap.eq_of_le_of_domain_eq LinearPMap.eq_of_le_of_domain_eq

/-- Given two partial linear maps `f`, `g`, the set of points `x` such that
both `f` and `g` are defined at `x` and `f x = g x` form a submodule. -/
def eqLocus (f g : E →ₗ.[R] F) : Submodule R E where
  carrier := { x | ∃ (hf : x ∈ f.domain) (hg : x ∈ g.domain), f ⟨x, hf⟩ = g ⟨x, hg⟩ }
  zero_mem' := ⟨zero_mem _, zero_mem _, f.map_zero.trans g.map_zero.symm⟩
  add_mem' := fun {x y} ⟨hfx, hgx, hx⟩ ⟨hfy, hgy, hy⟩ =>
    ⟨add_mem hfx hfy, add_mem hgx hgy, by
      erw [f.map_add ⟨x, hfx⟩ ⟨y, hfy⟩, g.map_add ⟨x, hgx⟩ ⟨y, hgy⟩, hx, hy]⟩
  -- Porting note: `by rintro` is required, or error of a free variable happens.
  smul_mem' := by
    rintro c x ⟨hfx, hgx, hx⟩
    exact
      ⟨smul_mem _ c hfx, smul_mem _ c hgx,
        by erw [f.map_smul c ⟨x, hfx⟩, g.map_smul c ⟨x, hgx⟩, hx]⟩
#align linear_pmap.eq_locus LinearPMap.eqLocus

instance inf : Inf (E →ₗ.[R] F) :=
  ⟨fun f g => ⟨f.eqLocus g, f.toFun.comp <| ofLe fun _x hx => hx.fst⟩⟩
#align linear_pmap.has_inf LinearPMap.inf

instance bot : Bot (E →ₗ.[R] F) :=
  ⟨⟨⊥, 0⟩⟩
#align linear_pmap.has_bot LinearPMap.bot

instance inhabited : Inhabited (E →ₗ.[R] F) :=
  ⟨⊥⟩
#align linear_pmap.inhabited LinearPMap.inhabited

instance semilatticeInf : SemilatticeInf (E →ₗ.[R] F) where
  le := (· ≤ ·)
  le_refl f := ⟨le_refl f.domain, fun x y h => Subtype.eq h ▸ rfl⟩
  le_trans := fun f g h ⟨fg_le, fg_eq⟩ ⟨gh_le, gh_eq⟩ =>
    ⟨le_trans fg_le gh_le, fun x z hxz =>
      have hxy : (x : E) = ofLe fg_le x := rfl
      (fg_eq hxy).trans (gh_eq <| hxy.symm.trans hxz)⟩
  le_antisymm f g fg gf := eq_of_le_of_domain_eq fg (le_antisymm fg.1 gf.1)
  inf := (· ⊓ ·)
  -- Porting note: `by rintro` is required, or error of a metavariable happens.
  le_inf := by
    rintro f g h ⟨fg_le, fg_eq⟩ ⟨fh_le, fh_eq⟩
    exact ⟨fun x hx =>
      ⟨fg_le hx, fh_le hx, by
        -- Porting note: `[exact ⟨x, hx⟩, rfl, rfl]` → `[skip, exact ⟨x, hx⟩, skip] <;> rfl`
        refine' (fg_eq _).symm.trans (fh_eq _) <;> [skip, exact ⟨x, hx⟩, skip] <;> rfl⟩,
      fun x ⟨y, yg, hy⟩ h => by
        apply fg_eq
        exact h⟩
  inf_le_left f g := ⟨fun x hx => hx.fst, fun x y h => congr_arg f <| Subtype.eq <| h⟩
  inf_le_right f g :=
    ⟨fun x hx => hx.snd.fst, fun ⟨x, xf, xg, hx⟩ y h => hx.trans <| congr_arg g <| Subtype.eq <| h⟩
#align linear_pmap.semilattice_inf LinearPMap.semilatticeInf

instance orderBot : OrderBot (E →ₗ.[R] F) where
  bot := ⊥
  bot_le f :=
    ⟨bot_le, fun x y h => by
      have hx : x = 0 := Subtype.eq ((mem_bot R).1 x.2)
      have hy : y = 0 := Subtype.eq (h.symm.trans (congr_arg _ hx))
      rw [hx, hy, map_zero, map_zero]⟩
#align linear_pmap.order_bot LinearPMap.orderBot

theorem le_of_eqLocus_ge {f g : E →ₗ.[R] F} (H : f.domain ≤ f.eqLocus g) : f ≤ g :=
  suffices f ≤ f ⊓ g from le_trans this inf_le_right
  ⟨H, fun _x _y hxy => ((inf_le_left : f ⊓ g ≤ f).2 hxy.symm).symm⟩
#align linear_pmap.le_of_eq_locus_ge LinearPMap.le_of_eqLocus_ge

private theorem sup_aux (f g : E →ₗ.[R] F)
    (h : ∀ (x : f.domain) (y : g.domain), (x : E) = y → f x = g y) :
    ∃ fg : ↥(f.domain ⊔ g.domain) →ₗ[R] F,
      ∀ (x : f.domain) (y : g.domain) (z : ↥(f.domain ⊔ g.domain)),
        (x : E) + y = ↑z → fg z = f x + g y := by
  choose x hx y hy hxy using fun z : ↥(f.domain ⊔ g.domain) => mem_sup.1 z.prop
  set fg := fun z => f ⟨x z, hx z⟩ + g ⟨y z, hy z⟩
  have fg_eq :
    ∀ (x' : f.domain) (y' : g.domain) (z' : ↥(f.domain ⊔ g.domain)) (_H : (x' : E) + y' = z'),
      fg z' = f x' + g y' :=
    by
    intro x' y' z' H
    dsimp
    rw [add_comm, ← sub_eq_sub_iff_add_eq_add, eq_comm, ← map_sub, ← map_sub]
    apply h
    simp only [← eq_sub_iff_add_eq] at hxy
    simp only [AddSubgroupClass.coe_sub, coe_mk, coe_mk, hxy, ← sub_add, ← sub_sub, sub_self,
      zero_sub, ← H]
    apply neg_add_eq_sub
  refine' ⟨{ toFun := fg.. }, fg_eq⟩
  · rintro ⟨z₁, hz₁⟩ ⟨z₂, hz₂⟩
    rw [← add_assoc, add_right_comm (f _), ← map_add, add_assoc, ← map_add]
    apply fg_eq
    simp only [coe_add, coe_mk, ← add_assoc]
    rw [add_right_comm (x _), hxy, add_assoc, hxy, coe_mk, coe_mk]
  · intro c z
    rw [smul_add, ← map_smul, ← map_smul]
    apply fg_eq
    simp only [coe_smul, coe_mk, ← smul_add, hxy, RingHom.id_apply]

/-- Given two partial linear maps that agree on the intersection of their domains,
`f.sup g h` is the unique partial linear map on `f.domain ⊔ g.domain` that agrees
with `f` and `g`. -/
protected noncomputable def sup (f g : E →ₗ.[R] F)
    (h : ∀ (x : f.domain) (y : g.domain), (x : E) = y → f x = g y) : E →ₗ.[R] F :=
  ⟨_, Classical.choose (sup_aux f g h)⟩
#align linear_pmap.sup LinearPMap.sup

@[simp]
theorem domain_sup (f g : E →ₗ.[R] F)
    (h : ∀ (x : f.domain) (y : g.domain), (x : E) = y → f x = g y) :
    (f.sup g h).domain = f.domain ⊔ g.domain :=
  rfl
#align linear_pmap.domain_sup LinearPMap.domain_sup

theorem sup_apply {f g : E →ₗ.[R] F} (H : ∀ (x : f.domain) (y : g.domain), (x : E) = y → f x = g y)
    (x : f.domain) (y : g.domain) (z : ↥(f.domain ⊔ g.domain)) (hz : (↑x : E) + ↑y = ↑z) :
    f.sup g H z = f x + g y :=
  Classical.choose_spec (sup_aux f g H) x y z hz
#align linear_pmap.sup_apply LinearPMap.sup_apply

protected theorem left_le_sup (f g : E →ₗ.[R] F)
    (h : ∀ (x : f.domain) (y : g.domain), (x : E) = y → f x = g y) : f ≤ f.sup g h := by
  refine' ⟨le_sup_left, fun z₁ z₂ hz => _⟩
  rw [← add_zero (f _), ← g.map_zero]
  refine' (sup_apply h _ _ _ _).symm
  simpa
#align linear_pmap.left_le_sup LinearPMap.left_le_sup

protected theorem right_le_sup (f g : E →ₗ.[R] F)
    (h : ∀ (x : f.domain) (y : g.domain), (x : E) = y → f x = g y) : g ≤ f.sup g h := by
  refine' ⟨le_sup_right, fun z₁ z₂ hz => _⟩
  rw [← zero_add (g _), ← f.map_zero]
  refine' (sup_apply h _ _ _ _).symm
  simpa
#align linear_pmap.right_le_sup LinearPMap.right_le_sup

protected theorem sup_le {f g h : E →ₗ.[R] F}
    (H : ∀ (x : f.domain) (y : g.domain), (x : E) = y → f x = g y) (fh : f ≤ h) (gh : g ≤ h) :
    f.sup g H ≤ h :=
  have Hf : f ≤ f.sup g H ⊓ h := le_inf (f.left_le_sup g H) fh
  have Hg : g ≤ f.sup g H ⊓ h := le_inf (f.right_le_sup g H) gh
  le_of_eqLocus_ge <| sup_le Hf.1 Hg.1
#align linear_pmap.sup_le LinearPMap.sup_le

/-- Hypothesis for `LinearPMap.sup` holds, if `f.domain` is disjoint with `g.domain`. -/
theorem sup_h_of_disjoint (f g : E →ₗ.[R] F) (h : Disjoint f.domain g.domain) (x : f.domain)
    (y : g.domain) (hxy : (x : E) = y) : f x = g y := by
  rw [disjoint_def] at h
  have hy : y = 0 := Subtype.eq (h y (hxy ▸ x.2) y.2)
  have hx : x = 0 := Subtype.eq (hxy.trans <| congr_arg _ hy)
  simp [*]
#align linear_pmap.sup_h_of_disjoint LinearPMap.sup_h_of_disjoint

section Smul

variable {M N : Type _} [Monoid M] [DistribMulAction M F] [SMulCommClass R M F]

variable [Monoid N] [DistribMulAction N F] [SMulCommClass R N F]

instance smul : SMul M (E →ₗ.[R] F) :=
  ⟨fun a f =>
    { domain := f.domain
      toFun := a • f.toFun }⟩
#align linear_pmap.has_smul LinearPMap.smul

@[simp]
theorem smul_domain (a : M) (f : E →ₗ.[R] F) : (a • f).domain = f.domain :=
  rfl
#align linear_pmap.smul_domain LinearPMap.smul_domain

theorem smul_apply (a : M) (f : E →ₗ.[R] F) (x : (a • f).domain) : (a • f) x = a • f x :=
  rfl
#align linear_pmap.smul_apply LinearPMap.smul_apply

@[simp]
theorem coe_smul (a : M) (f : E →ₗ.[R] F) : ⇑(a • f) = a • ⇑f :=
  rfl
#align linear_pmap.coe_smul LinearPMap.coe_smul

instance smulCommClass [SMulCommClass M N F] : SMulCommClass M N (E →ₗ.[R] F) :=
  ⟨fun a b f => ext' <| smul_comm a b f.toFun⟩
#align linear_pmap.smul_comm_class LinearPMap.smulCommClass

instance isScalarTower [SMul M N] [IsScalarTower M N F] : IsScalarTower M N (E →ₗ.[R] F) :=
  ⟨fun a b f => ext' <| smul_assoc a b f.toFun⟩
#align linear_pmap.is_scalar_tower LinearPMap.isScalarTower

instance mulAction : MulAction M (E →ₗ.[R] F) where
  smul := (· • ·)
  one_smul := fun ⟨_s, f⟩ => ext' <| one_smul M f
  mul_smul a b f := ext' <| mul_smul a b f.toFun
#align linear_pmap.mul_action LinearPMap.mulAction

end Smul

section Vadd

instance vadd : VAdd (E →ₗ[R] F) (E →ₗ.[R] F) :=
  ⟨fun f g =>
    { domain := g.domain
      toFun := f.comp g.domain.subtype + g.toFun }⟩
#align linear_pmap.has_vadd LinearPMap.vadd

@[simp]
theorem vadd_domain (f : E →ₗ[R] F) (g : E →ₗ.[R] F) : (f +ᵥ g).domain = g.domain :=
  rfl
#align linear_pmap.vadd_domain LinearPMap.vadd_domain

theorem vadd_apply (f : E →ₗ[R] F) (g : E →ₗ.[R] F) (x : (f +ᵥ g).domain) :
    (f +ᵥ g) x = f x + g x :=
  rfl
#align linear_pmap.vadd_apply LinearPMap.vadd_apply

@[simp]
theorem coe_vadd (f : E →ₗ[R] F) (g : E →ₗ.[R] F) : ⇑(f +ᵥ g) = ⇑(f.comp g.domain.subtype) + ⇑g :=
  rfl
#align linear_pmap.coe_vadd LinearPMap.coe_vadd

instance addAction : AddAction (E →ₗ[R] F) (E →ₗ.[R] F)
    where
  vadd := (· +ᵥ ·)
  zero_vadd := fun ⟨_s, _f⟩ => ext' <| zero_add _
  add_vadd := fun _f₁ _f₂ ⟨_s, _g⟩ => ext' <| LinearMap.ext fun _x => add_assoc _ _ _
#align linear_pmap.add_action LinearPMap.addAction

end Vadd

section

variable {K : Type _} [DivisionRing K] [Module K E] [Module K F]

/-- Extend a `LinearPMap` to `f.domain ⊔ K ∙ x`. -/
noncomputable def supSpanSingleton (f : E →ₗ.[K] F) (x : E) (y : F) (hx : x ∉ f.domain) :
    E →ₗ.[K] F :=
  -- Porting note: `simpa [..]` → `simp [..]; exact ..`
  f.sup (mkSpanSingleton x y fun h₀ => hx <| h₀.symm ▸ f.domain.zero_mem) <|
    sup_h_of_disjoint _ _ <| by simp [disjoint_span_singleton]; exact fun h => False.elim <| hx h
#align linear_pmap.sup_span_singleton LinearPMap.supSpanSingleton

@[simp]
theorem domain_supSpanSingleton (f : E →ₗ.[K] F) (x : E) (y : F) (hx : x ∉ f.domain) :
    (f.supSpanSingleton x y hx).domain = f.domain ⊔ K ∙ x :=
  rfl
#align linear_pmap.domain_sup_span_singleton LinearPMap.domain_supSpanSingleton

@[simp, nolint simpNF] -- Porting note: Left-hand side does not simplify.
theorem supSpanSingleton_apply_mk (f : E →ₗ.[K] F) (x : E) (y : F) (hx : x ∉ f.domain) (x' : E)
    (hx' : x' ∈ f.domain) (c : K) :
    f.supSpanSingleton x y hx
        ⟨x' + c • x, mem_sup.2 ⟨x', hx', _, mem_span_singleton.2 ⟨c, rfl⟩, rfl⟩⟩ =
      f ⟨x', hx'⟩ + c • y := by
  -- Porting note: `erw [..]; rfl; exact ..` → `erw [..]; exact ..; rfl`
  erw [sup_apply _ ⟨x', hx'⟩ ⟨c • x, _⟩, mkSpanSingleton'_apply]
  exact mem_span_singleton.2 ⟨c, rfl⟩
  rfl
#align linear_pmap.sup_span_singleton_apply_mk LinearPMap.supSpanSingleton_apply_mk

end

private theorem supₛ_aux (c : Set (E →ₗ.[R] F)) (hc : DirectedOn (· ≤ ·) c) :
    ∃ f : ↥(supₛ (domain '' c)) →ₗ[R] F, (⟨_, f⟩ : E →ₗ.[R] F) ∈ upperBounds c := by
  cases' c.eq_empty_or_nonempty with ceq cne
  · subst c
    simp
  have hdir : DirectedOn (· ≤ ·) (domain '' c) :=
    directedOn_image.2 (hc.mono @(domain_mono.monotone))
  have P : ∀ x : ↥(supₛ (domain '' c)), { p : c // (x : E) ∈ p.val.domain } := by
    rintro x
    apply Classical.indefiniteDescription
    have := (mem_supₛ_of_directed (cne.image _) hdir).1 x.2
    -- Porting note: + `← bex_def`
    rwa [bex_image_iff, ← bex_def, SetCoe.exists'] at this
  set f : ↥(supₛ (domain '' c)) → F := fun x => (P x).val.val ⟨x, (P x).property⟩
  have f_eq : ∀ (p : c) (x : ↥(supₛ (domain '' c))) (y : p.1.1) (_hxy : (x : E) = y),
      f x = p.1 y := by
    intro p x y hxy
    rcases hc (P x).1.1 (P x).1.2 p.1 p.2 with ⟨q, _hqc, hxq, hpq⟩
    -- Porting note: `refine' ..; exacts [ofLe hpq.1 y, hxy, rfl]`
    --               → `refine' .. <;> [skip, exact ofLe hpq.1 y, rfl]; exact hxy`
    refine' (hxq.2 _).trans (hpq.2 _).symm <;> [skip, exact ofLe hpq.1 y, rfl]; exact hxy
  refine' ⟨{ toFun := f.. }, _⟩
  · intro x y
    rcases hc (P x).1.1 (P x).1.2 (P y).1.1 (P y).1.2 with ⟨p, hpc, hpx, hpy⟩
    set x' := ofLe hpx.1 ⟨x, (P x).2⟩
    set y' := ofLe hpy.1 ⟨y, (P y).2⟩
    rw [f_eq ⟨p, hpc⟩ x x' rfl, f_eq ⟨p, hpc⟩ y y' rfl, f_eq ⟨p, hpc⟩ (x + y) (x' + y') rfl,
      map_add]
  · intro c x
    -- Porting note: `simp [..]` to `simp only [..]`, or timeouts.
    simp only [f_eq (P x).1 (c • x) (c • ⟨x, (P x).2⟩) rfl, ← map_smul, RingHom.id_apply]
  · intro p hpc
    refine' ⟨le_supₛ <| mem_image_of_mem domain hpc, fun x y hxy => Eq.symm _⟩
    exact f_eq ⟨p, hpc⟩ _ _ hxy.symm

protected noncomputable def supₛ (c : Set (E →ₗ.[R] F)) (hc : DirectedOn (· ≤ ·) c) : E →ₗ.[R] F :=
  ⟨_, Classical.choose <| supₛ_aux c hc⟩
#align linear_pmap.Sup LinearPMap.supₛ

protected theorem le_supₛ {c : Set (E →ₗ.[R] F)} (hc : DirectedOn (· ≤ ·) c) {f : E →ₗ.[R] F}
    (hf : f ∈ c) : f ≤ LinearPMap.supₛ c hc :=
  Classical.choose_spec (supₛ_aux c hc) hf
#align linear_pmap.le_Sup LinearPMap.le_supₛ

protected theorem supₛ_le {c : Set (E →ₗ.[R] F)} (hc : DirectedOn (· ≤ ·) c) {g : E →ₗ.[R] F}
    (hg : ∀ f ∈ c, f ≤ g) : LinearPMap.supₛ c hc ≤ g :=
  le_of_eqLocus_ge <|
    supₛ_le fun _ ⟨f, hf, Eq⟩ =>
      Eq ▸
        have : f ≤ LinearPMap.supₛ c hc ⊓ g := le_inf (LinearPMap.le_supₛ _ hf) (hg f hf)
        this.1
#align linear_pmap.Sup_le LinearPMap.supₛ_le

protected theorem supₛ_apply {c : Set (E →ₗ.[R] F)} (hc : DirectedOn (· ≤ ·) c) {l : E →ₗ.[R] F}
    (hl : l ∈ c) (x : l.domain) :
    (LinearPMap.supₛ c hc) ⟨x, (LinearPMap.le_supₛ hc hl).1 x.2⟩ = l x := by
  symm
  apply (Classical.choose_spec (supₛ_aux c hc) hl).2
  rfl
#align linear_pmap.Sup_apply LinearPMap.supₛ_apply

end LinearPMap

namespace LinearMap

/-- Restrict a linear map to a submodule, reinterpreting the result as a `LinearPMap`. -/
def toPMap (f : E →ₗ[R] F) (p : Submodule R E) : E →ₗ.[R] F :=
  ⟨p, f.comp p.subtype⟩
#align linear_map.to_pmap LinearMap.toPMap

@[simp]
theorem toPMap_apply (f : E →ₗ[R] F) (p : Submodule R E) (x : p) : f.toPMap p x = f x :=
  rfl
#align linear_map.to_pmap_apply LinearMap.toPMap_apply

/-- Compose a linear map with a `LinearPMap` -/
def compPMap (g : F →ₗ[R] G) (f : E →ₗ.[R] F) : E →ₗ.[R] G where
  domain := f.domain
  toFun := g.comp f.toFun
#align linear_map.comp_pmap LinearMap.compPMap

@[simp]
theorem compPMap_apply (g : F →ₗ[R] G) (f : E →ₗ.[R] F) (x) : g.compPMap f x = g (f x) :=
  rfl
#align linear_map.comp_pmap_apply LinearMap.compPMap_apply

end LinearMap

namespace LinearPMap

/-- Restrict codomain of a `LinearPMap` -/
def codRestrict (f : E →ₗ.[R] F) (p : Submodule R F) (H : ∀ x, f x ∈ p) : E →ₗ.[R] p
    where
  domain := f.domain
  toFun := f.toFun.codRestrict p H
#align linear_pmap.cod_restrict LinearPMap.codRestrict

/-- Compose two `LinearPMap`s -/
def comp (g : F →ₗ.[R] G) (f : E →ₗ.[R] F) (H : ∀ x : f.domain, f x ∈ g.domain) : E →ₗ.[R] G :=
  g.toFun.compPMap <| f.codRestrict _ H
#align linear_pmap.comp LinearPMap.comp

/-- `f.coprod g` is the partially defined linear map defined on `f.domain × g.domain`,
and sending `p` to `f p.1 + g p.2`. -/
def coprod (f : E →ₗ.[R] G) (g : F →ₗ.[R] G) : E × F →ₗ.[R] G where
  domain := f.domain.prod g.domain
  toFun :=
    -- Porting note: This is just
    -- `(f.comp (LinearPMap.fst f.domain g.domain) fun x => x.2.1).toFun +`
    -- `  (g.comp (LinearPMap.snd f.domain g.domain) fun x => x.2.2).toFun`,
    HAdd.hAdd
      (α := f.domain.prod g.domain →ₗ[R] G)
      (β := f.domain.prod g.domain →ₗ[R] G)
      (f.comp (LinearPMap.fst f.domain g.domain) fun x => x.2.1).toFun
      (g.comp (LinearPMap.snd f.domain g.domain) fun x => x.2.2).toFun
#align linear_pmap.coprod LinearPMap.coprod

@[simp]
theorem coprod_apply (f : E →ₗ.[R] G) (g : F →ₗ.[R] G) (x) :
    f.coprod g x = f ⟨(x : E × F).1, x.2.1⟩ + g ⟨(x : E × F).2, x.2.2⟩ :=
  rfl
#align linear_pmap.coprod_apply LinearPMap.coprod_apply

/-- Restrict a partially defined linear map to a submodule of `E` contained in `f.domain`. -/
def domRestrict (f : E →ₗ.[R] F) (S : Submodule R E) : E →ₗ.[R] F :=
  ⟨S ⊓ f.domain, f.toFun.comp (Submodule.ofLe (by simp))⟩
#align linear_pmap.dom_restrict LinearPMap.domRestrict

@[simp]
theorem domRestrict_domain (f : E →ₗ.[R] F) {S : Submodule R E} :
    (f.domRestrict S).domain = S ⊓ f.domain :=
  rfl
#align linear_pmap.dom_restrict_domain LinearPMap.domRestrict_domain

theorem domRestrict_apply {f : E →ₗ.[R] F} {S : Submodule R E} ⦃x : ↥(S ⊓ f.domain)⦄ ⦃y : f.domain⦄
    (h : (x : E) = y) : f.domRestrict S x = f y := by
  have : Submodule.ofLe (by simp) x = y := by
    ext
    simp [h]
  rw [← this]
  exact LinearPMap.mk_apply _ _ _
#align linear_pmap.dom_restrict_apply LinearPMap.domRestrict_apply

theorem domRestrict_le {f : E →ₗ.[R] F} {S : Submodule R E} : f.domRestrict S ≤ f :=
  ⟨by simp, fun x y hxy => domRestrict_apply hxy⟩
#align linear_pmap.dom_restrict_le LinearPMap.domRestrict_le

/-! ### Graph -/

section Graph

/-- The graph of a `LinearPMap` viewed as a submodule on `E × F`. -/
def graph (f : E →ₗ.[R] F) : Submodule R (E × F) :=
  f.toFun.graph.map (f.domain.subtype.prodMap (LinearMap.id : F →ₗ[R] F))
#align linear_pmap.graph LinearPMap.graph

theorem mem_graph_iff' (f : E →ₗ.[R] F) {x : E × F} : x ∈ f.graph ↔ ∃ y : f.domain, (↑y, f y) = x :=
  by simp [graph]
#align linear_pmap.mem_graph_iff' LinearPMap.mem_graph_iff'

@[simp]
theorem mem_graph_iff (f : E →ₗ.[R] F) {x : E × F} :
    x ∈ f.graph ↔ ∃ y : f.domain, (↑y : E) = x.1 ∧ f y = x.2 := by
  cases x
  simp_rw [mem_graph_iff', Prod.mk.inj_iff]
#align linear_pmap.mem_graph_iff LinearPMap.mem_graph_iff

/-- The tuple `(x, f x)` is contained in the graph of `f`. -/
theorem mem_graph (f : E →ₗ.[R] F) (x : domain f) : ((x : E), f x) ∈ f.graph := by simp
#align linear_pmap.mem_graph LinearPMap.mem_graph

variable {M : Type _} [Monoid M] [DistribMulAction M F] [SMulCommClass R M F] (y : M)

/-- The graph of `z • f` as a pushforward. -/
theorem smul_graph (f : E →ₗ.[R] F) (z : M) :
    (z • f).graph =
      f.graph.map ((LinearMap.id : E →ₗ[R] E).prodMap (z • (LinearMap.id : F →ₗ[R] F))) := by
  ext x; cases' x with x_fst x_snd
  constructor <;> intro h
  · rw [mem_graph_iff] at h
    rcases h with ⟨y, hy, h⟩
    rw [LinearPMap.smul_apply] at h
    rw [Submodule.mem_map]
    simp only [mem_graph_iff, LinearMap.prodMap_apply, LinearMap.id_coe, id.def,
      LinearMap.smul_apply, Prod.mk.inj_iff, Prod.exists, exists_exists_and_eq_and]
    use x_fst, y
    simp [hy, h]
  rw [Submodule.mem_map] at h
  rcases h with ⟨x', hx', h⟩
  cases x'
  simp only [LinearMap.prodMap_apply, LinearMap.id_coe, id.def, LinearMap.smul_apply,
    Prod.mk.inj_iff] at h
  rw [mem_graph_iff] at hx'⊢
  rcases hx' with ⟨y, hy, hx'⟩
  use y
  rw [← h.1, ← h.2]
  simp [hy, hx']
#align linear_pmap.smul_graph LinearPMap.smul_graph

/-- The graph of `-f` as a pushforward. -/
theorem neg_graph (f : E →ₗ.[R] F) :
    (-f).graph =
    f.graph.map ((LinearMap.id : E →ₗ[R] E).prodMap (-(LinearMap.id : F →ₗ[R] F))) := by
  ext x; cases' x with x_fst x_snd
  constructor <;> intro h
  · rw [mem_graph_iff] at h
    rcases h with ⟨y, hy, h⟩
    rw [LinearPMap.neg_apply] at h
    rw [Submodule.mem_map]
    simp only [mem_graph_iff, LinearMap.prodMap_apply, LinearMap.id_coe, id.def,
      LinearMap.neg_apply, Prod.mk.inj_iff, Prod.exists, exists_exists_and_eq_and]
    use x_fst, y
    simp [hy, h]
  rw [Submodule.mem_map] at h
  rcases h with ⟨x', hx', h⟩
  cases x'
  simp only [LinearMap.prodMap_apply, LinearMap.id_coe, id.def, LinearMap.neg_apply,
    Prod.mk.inj_iff] at h
  rw [mem_graph_iff] at hx'⊢
  rcases hx' with ⟨y, hy, hx'⟩
  use y
  rw [← h.1, ← h.2]
  simp [hy, hx']
#align linear_pmap.neg_graph LinearPMap.neg_graph

theorem mem_graph_snd_inj (f : E →ₗ.[R] F) {x y : E} {x' y' : F} (hx : (x, x') ∈ f.graph)
    (hy : (y, y') ∈ f.graph) (hxy : x = y) : x' = y' := by
  rw [mem_graph_iff] at hx hy
  rcases hx with ⟨x'', hx1, hx2⟩
  rcases hy with ⟨y'', hy1, hy2⟩
  simp only at hx1 hx2 hy1 hy2
  rw [← hx1, ← hy1, SetLike.coe_eq_coe] at hxy
  rw [← hx2, ← hy2, hxy]
#align linear_pmap.mem_graph_snd_inj LinearPMap.mem_graph_snd_inj

theorem mem_graph_snd_inj' (f : E →ₗ.[R] F) {x y : E × F} (hx : x ∈ f.graph) (hy : y ∈ f.graph)
    (hxy : x.1 = y.1) : x.2 = y.2 := by
  cases x
  cases y
  exact f.mem_graph_snd_inj hx hy hxy
#align linear_pmap.mem_graph_snd_inj' LinearPMap.mem_graph_snd_inj'

/-- The property that `f 0 = 0` in terms of the graph. -/
theorem graph_fst_eq_zero_snd (f : E →ₗ.[R] F) {x : E} {x' : F} (h : (x, x') ∈ f.graph)
    (hx : x = 0) : x' = 0 :=
  f.mem_graph_snd_inj h f.graph.zero_mem hx
#align linear_pmap.graph_fst_eq_zero_snd LinearPMap.graph_fst_eq_zero_snd

theorem mem_domain_iff {f : E →ₗ.[R] F} {x : E} : x ∈ f.domain ↔ ∃ y : F, (x, y) ∈ f.graph := by
  constructor <;> intro h
  · use f ⟨x, h⟩
    exact f.mem_graph ⟨x, h⟩
  cases' h with y h
  rw [mem_graph_iff] at h
  cases' h with x' h
  simp only at h
  rw [← h.1]
  simp
#align linear_pmap.mem_domain_iff LinearPMap.mem_domain_iff

theorem mem_domain_of_mem_graph {f : E →ₗ.[R] F} {x : E} {y : F} (h : (x, y) ∈ f.graph) :
    x ∈ f.domain := by
  rw [mem_domain_iff]
  exact ⟨y, h⟩
#align linear_pmap.mem_domain_of_mem_graph LinearPMap.mem_domain_of_mem_graph

theorem image_iff {f : E →ₗ.[R] F} {x : E} {y : F} (hx : x ∈ f.domain) :
    y = f ⟨x, hx⟩ ↔ (x, y) ∈ f.graph := by
  rw [mem_graph_iff]
  constructor <;> intro h
  · use ⟨x, hx⟩
    simp [h]
  rcases h with ⟨⟨x', hx'⟩, ⟨h1, h2⟩⟩
  simp only [Submodule.coe_mk] at h1 h2
  simp only [← h2, h1]
#align linear_pmap.image_iff LinearPMap.image_iff

theorem mem_range_iff {f : E →ₗ.[R] F} {y : F} : y ∈ Set.range f ↔ ∃ x : E, (x, y) ∈ f.graph := by
  constructor <;> intro h
  · rw [Set.mem_range] at h
    rcases h with ⟨⟨x, hx⟩, h⟩
    use x
    rw [← h]
    exact f.mem_graph ⟨x, hx⟩
  cases' h with x h
  rw [mem_graph_iff] at h
  cases' h with x h
  rw [Set.mem_range]
  use x
  simp only at h
  rw [h.2]
#align linear_pmap.mem_range_iff LinearPMap.mem_range_iff

theorem mem_domain_iff_of_eq_graph {f g : E →ₗ.[R] F} (h : f.graph = g.graph) {x : E} :
    x ∈ f.domain ↔ x ∈ g.domain := by simp_rw [mem_domain_iff, h]
#align linear_pmap.mem_domain_iff_of_eq_graph LinearPMap.mem_domain_iff_of_eq_graph

theorem le_of_le_graph {f g : E →ₗ.[R] F} (h : f.graph ≤ g.graph) : f ≤ g := by
  constructor
  · intro x hx
    rw [mem_domain_iff] at hx⊢
    cases' hx with y hx
    use y
    exact h hx
  rintro ⟨x, hx⟩ ⟨y, hy⟩ hxy
  rw [image_iff]
  refine' h _
  simp only [Submodule.coe_mk] at hxy
  rw [hxy] at hx
  rw [← image_iff hx]
  simp [hxy]
#align linear_pmap.le_of_le_graph LinearPMap.le_of_le_graph

theorem le_graph_of_le {f g : E →ₗ.[R] F} (h : f ≤ g) : f.graph ≤ g.graph := by
  intro x hx
  rw [mem_graph_iff] at hx⊢
  cases' hx with y hx
  use ⟨y, h.1 y.2⟩
  simp only [hx, Submodule.coe_mk, eq_self_iff_true, true_and_iff]
  convert hx.2 using 1
  refine' (h.2 _).symm
  simp only [hx.1, Submodule.coe_mk]
#align linear_pmap.le_graph_of_le LinearPMap.le_graph_of_le

theorem le_graph_iff {f g : E →ₗ.[R] F} : f.graph ≤ g.graph ↔ f ≤ g :=
  ⟨le_of_le_graph, le_graph_of_le⟩
#align linear_pmap.le_graph_iff LinearPMap.le_graph_iff

theorem eq_of_eq_graph {f g : E →ₗ.[R] F} (h : f.graph = g.graph) : f = g := by
  -- Porting note: `ext` → `refine ext ..`
  refine ext (Submodule.ext fun x => ?_) (fun x y h' => ?_)
  exact mem_domain_iff_of_eq_graph h
  exact (le_of_le_graph h.le).2 h'
#align linear_pmap.eq_of_eq_graph LinearPMap.eq_of_eq_graph

end Graph

end LinearPMap

namespace Submodule

section SubmoduleToLinearPMap

theorem existsUnique_from_graph {g : Submodule R (E × F)}
    (hg : ∀ {x : E × F} (_hx : x ∈ g) (_hx' : x.fst = 0), x.snd = 0) {a : E}
    (ha : a ∈ g.map (LinearMap.fst R E F)) : ∃! b : F, (a, b) ∈ g := by
  refine' exists_unique_of_exists_of_unique _ _
  · convert ha
    simp
  intro y₁ y₂ hy₁ hy₂
  have hy : ((0 : E), y₁ - y₂) ∈ g := by
    convert g.sub_mem hy₁ hy₂
    exact (sub_self _).symm
  exact sub_eq_zero.mp (hg hy (by simp))
#align submodule.exists_unique_from_graph Submodule.existsUnique_from_graph

/-- Auxiliary definition to unfold the existential quantifier. -/
noncomputable def valFromGraph {g : Submodule R (E × F)}
    (hg : ∀ (x : E × F) (_hx : x ∈ g) (_hx' : x.fst = 0), x.snd = 0) {a : E}
    (ha : a ∈ g.map (LinearMap.fst R E F)) : F :=
  (ExistsUnique.exists (existsUnique_from_graph @hg ha)).choose
#align submodule.val_from_graph Submodule.valFromGraph

theorem valFromGraph_mem {g : Submodule R (E × F)}
    (hg : ∀ (x : E × F) (_hx : x ∈ g) (_hx' : x.fst = 0), x.snd = 0) {a : E}
    (ha : a ∈ g.map (LinearMap.fst R E F)) : (a, valFromGraph hg ha) ∈ g :=
  (ExistsUnique.exists (existsUnique_from_graph @hg ha)).choose_spec
#align submodule.val_from_graph_mem Submodule.valFromGraph_mem

/-- Define a `LinearPMap` from its graph. -/
noncomputable def toLinearPMap (g : Submodule R (E × F))
    (hg : ∀ (x : E × F) (_hx : x ∈ g) (_hx' : x.fst = 0), x.snd = 0) : E →ₗ.[R] F
    where
  domain := g.map (LinearMap.fst R E F)
  toFun :=
    { toFun := fun x => valFromGraph hg x.2
      map_add' := fun v w => by
        have hadd := (g.map (LinearMap.fst R E F)).add_mem v.2 w.2
        have hvw := valFromGraph_mem hg hadd
        have hvw' := g.add_mem (valFromGraph_mem hg v.2) (valFromGraph_mem hg w.2)
        rw [Prod.mk_add_mk] at hvw'
        exact (existsUnique_from_graph @hg hadd).unique hvw hvw'
      map_smul' := fun a v =>
        by
        have hsmul := (g.map (LinearMap.fst R E F)).smul_mem a v.2
        have hav := valFromGraph_mem hg hsmul
        have hav' := g.smul_mem a (valFromGraph_mem hg v.2)
        rw [Prod.smul_mk] at hav'
        exact (existsUnique_from_graph @hg hsmul).unique hav hav' }
#align submodule.to_linear_pmap Submodule.toLinearPMap

theorem mem_graph_toLinearPMap (g : Submodule R (E × F))
    (hg : ∀ (x : E × F) (_hx : x ∈ g) (_hx' : x.fst = 0), x.snd = 0)
    (x : g.map (LinearMap.fst R E F)) : (x.val, g.toLinearPMap hg x) ∈ g :=
  valFromGraph_mem hg x.2
#align submodule.mem_graph_to_linear_pmap Submodule.mem_graph_toLinearPMap

@[simp]
theorem toLinearPMap_graph_eq (g : Submodule R (E × F))
    (hg : ∀ (x : E × F) (_hx : x ∈ g) (_hx' : x.fst = 0), x.snd = 0) :
    (g.toLinearPMap hg).graph = g := by
  ext x
  constructor <;> intro hx
  · rw [LinearPMap.mem_graph_iff] at hx
    rcases hx with ⟨y, hx1, hx2⟩
    convert g.mem_graph_toLinearPMap hg y using 1
    exact Prod.ext hx1.symm hx2.symm
  rw [LinearPMap.mem_graph_iff]
  cases' x with x_fst x_snd
  have hx_fst : x_fst ∈ g.map (LinearMap.fst R E F) :=
    by
    simp only [mem_map, LinearMap.fst_apply, Prod.exists, exists_and_right, exists_eq_right]
    exact ⟨x_snd, hx⟩
  refine' ⟨⟨x_fst, hx_fst⟩, Subtype.coe_mk x_fst hx_fst, _⟩
  exact (existsUnique_from_graph @hg hx_fst).unique (valFromGraph_mem hg hx_fst) hx
#align submodule.to_linear_pmap_graph_eq Submodule.toLinearPMap_graph_eq

end SubmoduleToLinearPMap

end Submodule


-- Copyright (c) 2018 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Scott Morrison, Reid Barton

import category_theory.limits.limits

universes v u -- declare the `v`'s first; see `category_theory.category` for an explanation

open category_theory
open category_theory.limits

namespace category_theory.limits.types

variables {J : Type u} [small_category J]

def limit (F : J ⥤ Type u) : cone F :=
{ X := {u : Π j, F.obj j // ∀ {j j'} (f : j ⟶ j'), F.map f (u j) = u j'},
  π := { app := λ j u, u.val j } }

local attribute [elab_simple] congr_fun
def limit_is_limit (F : J ⥤ Type u) : is_limit (limit F) :=
{ lift := λ s v, ⟨λ j, s.π.app j v, λ j j' f, congr_fun (cone.w s f) _⟩,
  uniq' :=
  begin
    intros, ext x, apply subtype.eq, ext j,
    exact congr_fun (w j) x
  end }

instance : has_limits.{u} (Type u) :=
λ J 𝒥 F, by exactI { cone := limit F, is_limit := limit_is_limit F }

@[simp] lemma types_limit (F : J ⥤ Type u) :
  limits.limit F = {u : Π j, F.obj j // ∀ {j j'} f, F.map f (u j) = u j'} := rfl
@[simp] lemma types_limit_π (F : J ⥤ Type u) (j : J) (g : (limit F).X) :
  limit.π F j g = g.val j := rfl
@[simp] lemma types_limit_pre
  (F : J ⥤ Type u) {K : Type u} [𝒦 : small_category K] (E : K ⥤ J) (g : (limit F).X) :
  limit.pre F E g = (⟨λ k, g.val (E.obj k), by obviously⟩ : (limit (E ⋙ F)).X) := rfl
@[simp] lemma types_limit_map {F G : J ⥤ Type u} (α : F ⟹ G) (g : (limit F).X) :
  (lim.map α : (limit F).X → (limit G).X) g =
  (⟨λ j, (α.app j) (g.val j), λ j j' f,
    by rw [←functor_to_types.naturality, ←(g.property f)]⟩ : (limit G).X) := rfl

@[simp] lemma types_limit_lift (F : J ⥤ Type u) (c : cone F) (x : c.X):
  limit.lift F c x = (⟨λ j, c.π.app j x, λ j j' f, congr_fun (cone.w c f) x⟩ : (limit F).X) :=
rfl

def colimit (F : J ⥤ Type u) : cocone F :=
{ X := @quot (Σ j, F.obj j) (λ p p', ∃ f : p.1 ⟶ p'.1, p'.2 = F.map f p.2),
  ι :=
  { app := λ j x, quot.mk _ ⟨j, x⟩,
    naturality' := λ j j' f, funext $ λ x, eq.symm (quot.sound ⟨f, rfl⟩) } }

local attribute [elab_with_expected_type] quot.lift

def colimit_is_colimit (F : J ⥤ Type u) : is_colimit (colimit F) :=
{ desc := λ s, quot.lift (λ (p : Σ j, F.obj j), s.ι.app p.1 p.2)
    (assume ⟨j, x⟩ ⟨j', x'⟩ ⟨f, hf⟩, by rw hf; exact (congr_fun (cocone.w s f) x).symm) }

instance : has_colimits.{u} (Type u) :=
λ J 𝒥 F, by exactI { cocone := colimit F, is_colimit := colimit_is_colimit F }

@[simp] lemma types_colimit (F : J ⥤ Type u) :
  limits.colimit F = @quot (Σ j, F.obj j) (λ p p', ∃ f : p.1 ⟶ p'.1, p'.2 = F.map f p.2) := rfl
@[simp] lemma types_colimit_ι (F : J ⥤ Type u) (j : J) :
  colimit.ι F j = λ x, quot.mk _ ⟨j, x⟩ := rfl
@[simp] lemma types_colimit_pre
  (F : J ⥤ Type u) {K : Type u} [𝒦 : small_category K] (E : K ⥤ J) (g : (colimit (E ⋙ F)).X) :
  colimit.pre F E =
  quot.lift (λ p, quot.mk _ ⟨E.obj p.1, p.2⟩) (λ p p' ⟨f, h⟩, quot.sound ⟨E.map f, h⟩) := rfl
@[simp] lemma types_colimit_map {F G : J ⥤ Type u} (α : F ⟹ G) :
  (colim.map α : (colimit F).X → (colimit G).X) =
  quot.lift
    (λ p, quot.mk _ ⟨p.1, (α.app p.1) p.2⟩)
    (λ p p' ⟨f, h⟩, quot.sound ⟨f, by rw h; exact functor_to_types.naturality _ _ α f _⟩) := rfl

@[simp] lemma types_colimit_desc (F : J ⥤ Type u) (c : cocone F) :
  colimit.desc F c =
  quot.lift
    (λ p, c.ι.app p.1 p.2)
    (λ p p' ⟨f, h⟩, by rw h; exact (functor_to_types.naturality _ _ c.ι f _).symm) := rfl

end category_theory.limits.types