/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis

! This file was ported from Lean 3 source module topology.algebra.affine
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.AffineSpace.AffineMap
import Mathbin.Topology.Algebra.Group.Basic
import Mathbin.Topology.Algebra.MulAction

/-!
# Topological properties of affine spaces and maps

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

For now, this contains only a few facts regarding the continuity of affine maps in the special
case when the point space and vector space are the same.

TODO: Deal with the case where the point spaces are different from the vector spaces. Note that
we do have some results in this direction under the assumption that the topologies are induced by
(semi)norms.
-/

namespace AffineMap

variable {R E F : Type _}

variable [AddCommGroup E] [TopologicalSpace E]

variable [AddCommGroup F] [TopologicalSpace F] [TopologicalAddGroup F]

section Ring

variable [Ring R] [Module R E] [Module R F]

/- warning: affine_map.continuous_iff -> AffineMap.continuous_iff is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {E : Type.{u2}} {F : Type.{u3}} [_inst_1 : AddCommGroup.{u2} E] [_inst_2 : TopologicalSpace.{u2} E] [_inst_3 : AddCommGroup.{u3} F] [_inst_4 : TopologicalSpace.{u3} F] [_inst_5 : TopologicalAddGroup.{u3} F _inst_4 (AddCommGroup.toAddGroup.{u3} F _inst_3)] [_inst_6 : Ring.{u1} R] [_inst_7 : Module.{u1, u2} R E (Ring.toSemiring.{u1} R _inst_6) (AddCommGroup.toAddCommMonoid.{u2} E _inst_1)] [_inst_8 : Module.{u1, u3} R F (Ring.toSemiring.{u1} R _inst_6) (AddCommGroup.toAddCommMonoid.{u3} F _inst_3)] {f : AffineMap.{u1, u2, u2, u3, u3} R E E F F _inst_6 _inst_1 _inst_7 (addGroupIsAddTorsor.{u2} E (AddCommGroup.toAddGroup.{u2} E _inst_1)) _inst_3 _inst_8 (addGroupIsAddTorsor.{u3} F (AddCommGroup.toAddGroup.{u3} F _inst_3))}, Iff (Continuous.{u2, u3} E F _inst_2 _inst_4 (coeFn.{max (succ u2) (succ u3), max (succ u2) (succ u3)} (AffineMap.{u1, u2, u2, u3, u3} R E E F F _inst_6 _inst_1 _inst_7 (addGroupIsAddTorsor.{u2} E (AddCommGroup.toAddGroup.{u2} E _inst_1)) _inst_3 _inst_8 (addGroupIsAddTorsor.{u3} F (AddCommGroup.toAddGroup.{u3} F _inst_3))) (fun (_x : AffineMap.{u1, u2, u2, u3, u3} R E E F F _inst_6 _inst_1 _inst_7 (addGroupIsAddTorsor.{u2} E (AddCommGroup.toAddGroup.{u2} E _inst_1)) _inst_3 _inst_8 (addGroupIsAddTorsor.{u3} F (AddCommGroup.toAddGroup.{u3} F _inst_3))) => E -> F) (AffineMap.hasCoeToFun.{u1, u2, u2, u3, u3} R E E F F _inst_6 _inst_1 _inst_7 (addGroupIsAddTorsor.{u2} E (AddCommGroup.toAddGroup.{u2} E _inst_1)) _inst_3 _inst_8 (addGroupIsAddTorsor.{u3} F (AddCommGroup.toAddGroup.{u3} F _inst_3))) f)) (Continuous.{u2, u3} E F _inst_2 _inst_4 (coeFn.{max (succ u2) (succ u3), max (succ u2) (succ u3)} (LinearMap.{u1, u1, u2, u3} R R (Ring.toSemiring.{u1} R _inst_6) (Ring.toSemiring.{u1} R _inst_6) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R _inst_6))) E F (AddCommGroup.toAddCommMonoid.{u2} E _inst_1) (AddCommGroup.toAddCommMonoid.{u3} F _inst_3) _inst_7 _inst_8) (fun (_x : LinearMap.{u1, u1, u2, u3} R R (Ring.toSemiring.{u1} R _inst_6) (Ring.toSemiring.{u1} R _inst_6) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R _inst_6))) E F (AddCommGroup.toAddCommMonoid.{u2} E _inst_1) (AddCommGroup.toAddCommMonoid.{u3} F _inst_3) _inst_7 _inst_8) => E -> F) (LinearMap.hasCoeToFun.{u1, u1, u2, u3} R R E F (Ring.toSemiring.{u1} R _inst_6) (Ring.toSemiring.{u1} R _inst_6) (AddCommGroup.toAddCommMonoid.{u2} E _inst_1) (AddCommGroup.toAddCommMonoid.{u3} F _inst_3) _inst_7 _inst_8 (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R _inst_6)))) (AffineMap.linear.{u1, u2, u2, u3, u3} R E E F F _inst_6 _inst_1 _inst_7 (addGroupIsAddTorsor.{u2} E (AddCommGroup.toAddGroup.{u2} E _inst_1)) _inst_3 _inst_8 (addGroupIsAddTorsor.{u3} F (AddCommGroup.toAddGroup.{u3} F _inst_3)) f)))
but is expected to have type
  forall {R : Type.{u3}} {E : Type.{u2}} {F : Type.{u1}} [_inst_1 : AddCommGroup.{u2} E] [_inst_2 : TopologicalSpace.{u2} E] [_inst_3 : AddCommGroup.{u1} F] [_inst_4 : TopologicalSpace.{u1} F] [_inst_5 : TopologicalAddGroup.{u1} F _inst_4 (AddCommGroup.toAddGroup.{u1} F _inst_3)] [_inst_6 : Ring.{u3} R] [_inst_7 : Module.{u3, u2} R E (Ring.toSemiring.{u3} R _inst_6) (AddCommGroup.toAddCommMonoid.{u2} E _inst_1)] [_inst_8 : Module.{u3, u1} R F (Ring.toSemiring.{u3} R _inst_6) (AddCommGroup.toAddCommMonoid.{u1} F _inst_3)] {f : AffineMap.{u3, u2, u2, u1, u1} R E E F F _inst_6 _inst_1 _inst_7 (addGroupIsAddTorsor.{u2} E (AddCommGroup.toAddGroup.{u2} E _inst_1)) _inst_3 _inst_8 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3))}, Iff (Continuous.{u2, u1} E F _inst_2 _inst_4 (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (AffineMap.{u3, u2, u2, u1, u1} R E E F F _inst_6 _inst_1 _inst_7 (addGroupIsAddTorsor.{u2} E (AddCommGroup.toAddGroup.{u2} E _inst_1)) _inst_3 _inst_8 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3))) E (fun (_x : E) => (fun (a._@.Mathlib.LinearAlgebra.AffineSpace.AffineMap._hyg.1004 : E) => F) _x) (AffineMap.funLike.{u3, u2, u2, u1, u1} R E E F F _inst_6 _inst_1 _inst_7 (addGroupIsAddTorsor.{u2} E (AddCommGroup.toAddGroup.{u2} E _inst_1)) _inst_3 _inst_8 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3))) f)) (Continuous.{u2, u1} E F _inst_2 _inst_4 (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (LinearMap.{u3, u3, u2, u1} R R (Ring.toSemiring.{u3} R _inst_6) (Ring.toSemiring.{u3} R _inst_6) (RingHom.id.{u3} R (Semiring.toNonAssocSemiring.{u3} R (Ring.toSemiring.{u3} R _inst_6))) E F (AddCommGroup.toAddCommMonoid.{u2} E _inst_1) (AddCommGroup.toAddCommMonoid.{u1} F _inst_3) _inst_7 _inst_8) E (fun (_x : E) => (fun (x._@.Mathlib.Algebra.Module.LinearMap._hyg.6190 : E) => F) _x) (LinearMap.instFunLikeLinearMap.{u3, u3, u2, u1} R R E F (Ring.toSemiring.{u3} R _inst_6) (Ring.toSemiring.{u3} R _inst_6) (AddCommGroup.toAddCommMonoid.{u2} E _inst_1) (AddCommGroup.toAddCommMonoid.{u1} F _inst_3) _inst_7 _inst_8 (RingHom.id.{u3} R (Semiring.toNonAssocSemiring.{u3} R (Ring.toSemiring.{u3} R _inst_6)))) (AffineMap.linear.{u3, u2, u2, u1, u1} R E E F F _inst_6 _inst_1 _inst_7 (addGroupIsAddTorsor.{u2} E (AddCommGroup.toAddGroup.{u2} E _inst_1)) _inst_3 _inst_8 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3)) f)))
Case conversion may be inaccurate. Consider using '#align affine_map.continuous_iff AffineMap.continuous_iffₓ'. -/
/-- An affine map is continuous iff its underlying linear map is continuous. See also
`affine_map.continuous_linear_iff`. -/
theorem continuous_iff {f : E →ᵃ[R] F} : Continuous f ↔ Continuous f.linear :=
  by
  constructor
  · intro hc
    rw [decomp' f]
    have := hc.sub continuous_const
    exact this
  · intro hc
    rw [decomp f]
    have := hc.add continuous_const
    exact this
#align affine_map.continuous_iff AffineMap.continuous_iff

/- warning: affine_map.line_map_continuous -> AffineMap.lineMap_continuous is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {F : Type.{u2}} [_inst_3 : AddCommGroup.{u2} F] [_inst_4 : TopologicalSpace.{u2} F] [_inst_5 : TopologicalAddGroup.{u2} F _inst_4 (AddCommGroup.toAddGroup.{u2} F _inst_3)] [_inst_6 : Ring.{u1} R] [_inst_8 : Module.{u1, u2} R F (Ring.toSemiring.{u1} R _inst_6) (AddCommGroup.toAddCommMonoid.{u2} F _inst_3)] [_inst_9 : TopologicalSpace.{u1} R] [_inst_10 : ContinuousSMul.{u1, u2} R F (SMulZeroClass.toHasSmul.{u1, u2} R F (AddZeroClass.toHasZero.{u2} F (AddMonoid.toAddZeroClass.{u2} F (AddCommMonoid.toAddMonoid.{u2} F (AddCommGroup.toAddCommMonoid.{u2} F _inst_3)))) (SMulWithZero.toSmulZeroClass.{u1, u2} R F (MulZeroClass.toHasZero.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R _inst_6))))) (AddZeroClass.toHasZero.{u2} F (AddMonoid.toAddZeroClass.{u2} F (AddCommMonoid.toAddMonoid.{u2} F (AddCommGroup.toAddCommMonoid.{u2} F _inst_3)))) (MulActionWithZero.toSMulWithZero.{u1, u2} R F (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R _inst_6)) (AddZeroClass.toHasZero.{u2} F (AddMonoid.toAddZeroClass.{u2} F (AddCommMonoid.toAddMonoid.{u2} F (AddCommGroup.toAddCommMonoid.{u2} F _inst_3)))) (Module.toMulActionWithZero.{u1, u2} R F (Ring.toSemiring.{u1} R _inst_6) (AddCommGroup.toAddCommMonoid.{u2} F _inst_3) _inst_8)))) _inst_9 _inst_4] {p : F} {v : F}, Continuous.{u1, u2} R F _inst_9 _inst_4 (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (AffineMap.{u1, u1, u1, u2, u2} R R R F F _inst_6 (NonUnitalNonAssocRing.toAddCommGroup.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_6))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R _inst_6)) (addGroupIsAddTorsor.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R _inst_6)))) _inst_3 _inst_8 (addGroupIsAddTorsor.{u2} F (AddCommGroup.toAddGroup.{u2} F _inst_3))) (fun (_x : AffineMap.{u1, u1, u1, u2, u2} R R R F F _inst_6 (NonUnitalNonAssocRing.toAddCommGroup.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_6))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R _inst_6)) (addGroupIsAddTorsor.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R _inst_6)))) _inst_3 _inst_8 (addGroupIsAddTorsor.{u2} F (AddCommGroup.toAddGroup.{u2} F _inst_3))) => R -> F) (AffineMap.hasCoeToFun.{u1, u1, u1, u2, u2} R R R F F _inst_6 (NonUnitalNonAssocRing.toAddCommGroup.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_6))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R _inst_6)) (addGroupIsAddTorsor.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R _inst_6)))) _inst_3 _inst_8 (addGroupIsAddTorsor.{u2} F (AddCommGroup.toAddGroup.{u2} F _inst_3))) (AffineMap.lineMap.{u1, u2, u2} R F F _inst_6 _inst_3 _inst_8 (addGroupIsAddTorsor.{u2} F (AddCommGroup.toAddGroup.{u2} F _inst_3)) p v))
but is expected to have type
  forall {R : Type.{u2}} {F : Type.{u1}} [_inst_3 : AddCommGroup.{u1} F] [_inst_4 : TopologicalSpace.{u1} F] [_inst_5 : TopologicalAddGroup.{u1} F _inst_4 (AddCommGroup.toAddGroup.{u1} F _inst_3)] [_inst_6 : Ring.{u2} R] [_inst_8 : Module.{u2, u1} R F (Ring.toSemiring.{u2} R _inst_6) (AddCommGroup.toAddCommMonoid.{u1} F _inst_3)] [_inst_9 : TopologicalSpace.{u2} R] [_inst_10 : ContinuousSMul.{u2, u1} R F (SMulZeroClass.toSMul.{u2, u1} R F (NegZeroClass.toZero.{u1} F (SubNegZeroMonoid.toNegZeroClass.{u1} F (SubtractionMonoid.toSubNegZeroMonoid.{u1} F (SubtractionCommMonoid.toSubtractionMonoid.{u1} F (AddCommGroup.toDivisionAddCommMonoid.{u1} F _inst_3))))) (SMulWithZero.toSMulZeroClass.{u2, u1} R F (MonoidWithZero.toZero.{u2} R (Semiring.toMonoidWithZero.{u2} R (Ring.toSemiring.{u2} R _inst_6))) (NegZeroClass.toZero.{u1} F (SubNegZeroMonoid.toNegZeroClass.{u1} F (SubtractionMonoid.toSubNegZeroMonoid.{u1} F (SubtractionCommMonoid.toSubtractionMonoid.{u1} F (AddCommGroup.toDivisionAddCommMonoid.{u1} F _inst_3))))) (MulActionWithZero.toSMulWithZero.{u2, u1} R F (Semiring.toMonoidWithZero.{u2} R (Ring.toSemiring.{u2} R _inst_6)) (NegZeroClass.toZero.{u1} F (SubNegZeroMonoid.toNegZeroClass.{u1} F (SubtractionMonoid.toSubNegZeroMonoid.{u1} F (SubtractionCommMonoid.toSubtractionMonoid.{u1} F (AddCommGroup.toDivisionAddCommMonoid.{u1} F _inst_3))))) (Module.toMulActionWithZero.{u2, u1} R F (Ring.toSemiring.{u2} R _inst_6) (AddCommGroup.toAddCommMonoid.{u1} F _inst_3) _inst_8)))) _inst_9 _inst_4] {p : F} {v : F}, Continuous.{u2, u1} R F _inst_9 _inst_4 (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (AffineMap.{u2, u2, u2, u1, u1} R R R F F _inst_6 (Ring.toAddCommGroup.{u2} R _inst_6) (AffineMap.instModuleToSemiringToAddCommMonoidToNonUnitalNonAssocSemiringToNonUnitalNonAssocRingToNonUnitalRing.{u2} R _inst_6) (addGroupIsAddTorsor.{u2} R (AddGroupWithOne.toAddGroup.{u2} R (Ring.toAddGroupWithOne.{u2} R _inst_6))) _inst_3 _inst_8 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3))) R (fun (_x : R) => (fun (a._@.Mathlib.LinearAlgebra.AffineSpace.AffineMap._hyg.1004 : R) => F) _x) (AffineMap.funLike.{u2, u2, u2, u1, u1} R R R F F _inst_6 (Ring.toAddCommGroup.{u2} R _inst_6) (AffineMap.instModuleToSemiringToAddCommMonoidToNonUnitalNonAssocSemiringToNonUnitalNonAssocRingToNonUnitalRing.{u2} R _inst_6) (addGroupIsAddTorsor.{u2} R (AddGroupWithOne.toAddGroup.{u2} R (Ring.toAddGroupWithOne.{u2} R _inst_6))) _inst_3 _inst_8 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3))) (AffineMap.lineMap.{u2, u1, u1} R F F _inst_6 _inst_3 _inst_8 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3)) p v))
Case conversion may be inaccurate. Consider using '#align affine_map.line_map_continuous AffineMap.lineMap_continuousₓ'. -/
/-- The line map is continuous. -/
@[continuity]
theorem lineMap_continuous [TopologicalSpace R] [ContinuousSMul R F] {p v : F} :
    Continuous ⇑(lineMap p v : R →ᵃ[R] F) :=
  continuous_iff.mpr <|
    (continuous_id.smul continuous_const).add <| @continuous_const _ _ _ _ (0 : F)
#align affine_map.line_map_continuous AffineMap.lineMap_continuous

end Ring

section CommRing

variable [CommRing R] [Module R F] [ContinuousConstSMul R F]

#print AffineMap.homothety_continuous /-
@[continuity]
theorem homothety_continuous (x : F) (t : R) : Continuous <| homothety x t :=
  by
  suffices ⇑(homothety x t) = fun y => t • (y - x) + x
    by
    rw [this]
    continuity
  ext y
  simp [homothety_apply]
#align affine_map.homothety_continuous AffineMap.homothety_continuous
-/

end CommRing

section Field

variable [Field R] [Module R F] [ContinuousConstSMul R F]

/- warning: affine_map.homothety_is_open_map -> AffineMap.homothety_isOpenMap is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {F : Type.{u2}} [_inst_3 : AddCommGroup.{u2} F] [_inst_4 : TopologicalSpace.{u2} F] [_inst_5 : TopologicalAddGroup.{u2} F _inst_4 (AddCommGroup.toAddGroup.{u2} F _inst_3)] [_inst_6 : Field.{u1} R] [_inst_7 : Module.{u1, u2} R F (Ring.toSemiring.{u1} R (DivisionRing.toRing.{u1} R (Field.toDivisionRing.{u1} R _inst_6))) (AddCommGroup.toAddCommMonoid.{u2} F _inst_3)] [_inst_8 : ContinuousConstSMul.{u1, u2} R F _inst_4 (SMulZeroClass.toHasSmul.{u1, u2} R F (AddZeroClass.toHasZero.{u2} F (AddMonoid.toAddZeroClass.{u2} F (AddCommMonoid.toAddMonoid.{u2} F (AddCommGroup.toAddCommMonoid.{u2} F _inst_3)))) (SMulWithZero.toSmulZeroClass.{u1, u2} R F (MulZeroClass.toHasZero.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R (DivisionRing.toRing.{u1} R (Field.toDivisionRing.{u1} R _inst_6))))))) (AddZeroClass.toHasZero.{u2} F (AddMonoid.toAddZeroClass.{u2} F (AddCommMonoid.toAddMonoid.{u2} F (AddCommGroup.toAddCommMonoid.{u2} F _inst_3)))) (MulActionWithZero.toSMulWithZero.{u1, u2} R F (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R (DivisionRing.toRing.{u1} R (Field.toDivisionRing.{u1} R _inst_6)))) (AddZeroClass.toHasZero.{u2} F (AddMonoid.toAddZeroClass.{u2} F (AddCommMonoid.toAddMonoid.{u2} F (AddCommGroup.toAddCommMonoid.{u2} F _inst_3)))) (Module.toMulActionWithZero.{u1, u2} R F (Ring.toSemiring.{u1} R (DivisionRing.toRing.{u1} R (Field.toDivisionRing.{u1} R _inst_6))) (AddCommGroup.toAddCommMonoid.{u2} F _inst_3) _inst_7))))] (x : F) (t : R), (Ne.{succ u1} R t (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (DivisionRing.toRing.{u1} R (Field.toDivisionRing.{u1} R _inst_6))))))))))) -> (IsOpenMap.{u2, u2} F F _inst_4 _inst_4 (coeFn.{succ u2, succ u2} (AffineMap.{u1, u2, u2, u2, u2} R F F F F (CommRing.toRing.{u1} R (Field.toCommRing.{u1} R _inst_6)) _inst_3 _inst_7 (addGroupIsAddTorsor.{u2} F (AddCommGroup.toAddGroup.{u2} F _inst_3)) _inst_3 _inst_7 (addGroupIsAddTorsor.{u2} F (AddCommGroup.toAddGroup.{u2} F _inst_3))) (fun (_x : AffineMap.{u1, u2, u2, u2, u2} R F F F F (CommRing.toRing.{u1} R (Field.toCommRing.{u1} R _inst_6)) _inst_3 _inst_7 (addGroupIsAddTorsor.{u2} F (AddCommGroup.toAddGroup.{u2} F _inst_3)) _inst_3 _inst_7 (addGroupIsAddTorsor.{u2} F (AddCommGroup.toAddGroup.{u2} F _inst_3))) => F -> F) (AffineMap.hasCoeToFun.{u1, u2, u2, u2, u2} R F F F F (CommRing.toRing.{u1} R (Field.toCommRing.{u1} R _inst_6)) _inst_3 _inst_7 (addGroupIsAddTorsor.{u2} F (AddCommGroup.toAddGroup.{u2} F _inst_3)) _inst_3 _inst_7 (addGroupIsAddTorsor.{u2} F (AddCommGroup.toAddGroup.{u2} F _inst_3))) (AffineMap.homothety.{u1, u2, u2} R F F (Field.toCommRing.{u1} R _inst_6) _inst_3 (addGroupIsAddTorsor.{u2} F (AddCommGroup.toAddGroup.{u2} F _inst_3)) _inst_7 x t)))
but is expected to have type
  forall {R : Type.{u2}} {F : Type.{u1}} [_inst_3 : AddCommGroup.{u1} F] [_inst_4 : TopologicalSpace.{u1} F] [_inst_5 : TopologicalAddGroup.{u1} F _inst_4 (AddCommGroup.toAddGroup.{u1} F _inst_3)] [_inst_6 : Field.{u2} R] [_inst_7 : Module.{u2, u1} R F (DivisionSemiring.toSemiring.{u2} R (Semifield.toDivisionSemiring.{u2} R (Field.toSemifield.{u2} R _inst_6))) (AddCommGroup.toAddCommMonoid.{u1} F _inst_3)] [_inst_8 : ContinuousConstSMul.{u2, u1} R F _inst_4 (SMulZeroClass.toSMul.{u2, u1} R F (NegZeroClass.toZero.{u1} F (SubNegZeroMonoid.toNegZeroClass.{u1} F (SubtractionMonoid.toSubNegZeroMonoid.{u1} F (SubtractionCommMonoid.toSubtractionMonoid.{u1} F (AddCommGroup.toDivisionAddCommMonoid.{u1} F _inst_3))))) (SMulWithZero.toSMulZeroClass.{u2, u1} R F (CommMonoidWithZero.toZero.{u2} R (CommGroupWithZero.toCommMonoidWithZero.{u2} R (Semifield.toCommGroupWithZero.{u2} R (Field.toSemifield.{u2} R _inst_6)))) (NegZeroClass.toZero.{u1} F (SubNegZeroMonoid.toNegZeroClass.{u1} F (SubtractionMonoid.toSubNegZeroMonoid.{u1} F (SubtractionCommMonoid.toSubtractionMonoid.{u1} F (AddCommGroup.toDivisionAddCommMonoid.{u1} F _inst_3))))) (MulActionWithZero.toSMulWithZero.{u2, u1} R F (Semiring.toMonoidWithZero.{u2} R (DivisionSemiring.toSemiring.{u2} R (Semifield.toDivisionSemiring.{u2} R (Field.toSemifield.{u2} R _inst_6)))) (NegZeroClass.toZero.{u1} F (SubNegZeroMonoid.toNegZeroClass.{u1} F (SubtractionMonoid.toSubNegZeroMonoid.{u1} F (SubtractionCommMonoid.toSubtractionMonoid.{u1} F (AddCommGroup.toDivisionAddCommMonoid.{u1} F _inst_3))))) (Module.toMulActionWithZero.{u2, u1} R F (DivisionSemiring.toSemiring.{u2} R (Semifield.toDivisionSemiring.{u2} R (Field.toSemifield.{u2} R _inst_6))) (AddCommGroup.toAddCommMonoid.{u1} F _inst_3) _inst_7))))] (x : F) (t : R), (Ne.{succ u2} R t (OfNat.ofNat.{u2} R 0 (Zero.toOfNat0.{u2} R (CommMonoidWithZero.toZero.{u2} R (CommGroupWithZero.toCommMonoidWithZero.{u2} R (Semifield.toCommGroupWithZero.{u2} R (Field.toSemifield.{u2} R _inst_6))))))) -> (IsOpenMap.{u1, u1} F F _inst_4 _inst_4 (FunLike.coe.{succ u1, succ u1, succ u1} (AffineMap.{u2, u1, u1, u1, u1} R F F F F (CommRing.toRing.{u2} R (Field.toCommRing.{u2} R _inst_6)) _inst_3 _inst_7 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3)) _inst_3 _inst_7 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3))) F (fun (_x : F) => (fun (a._@.Mathlib.LinearAlgebra.AffineSpace.AffineMap._hyg.1004 : F) => F) _x) (AffineMap.funLike.{u2, u1, u1, u1, u1} R F F F F (CommRing.toRing.{u2} R (Field.toCommRing.{u2} R _inst_6)) _inst_3 _inst_7 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3)) _inst_3 _inst_7 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3))) (AffineMap.homothety.{u2, u1, u1} R F F (Field.toCommRing.{u2} R _inst_6) _inst_3 (addGroupIsAddTorsor.{u1} F (AddCommGroup.toAddGroup.{u1} F _inst_3)) _inst_7 x t)))
Case conversion may be inaccurate. Consider using '#align affine_map.homothety_is_open_map AffineMap.homothety_isOpenMapₓ'. -/
theorem homothety_isOpenMap (x : F) (t : R) (ht : t ≠ 0) : IsOpenMap <| homothety x t := by
  apply IsOpenMap.of_inverse (homothety_continuous x t⁻¹) <;> intro e <;>
    simp [← AffineMap.comp_apply, ← homothety_mul, ht]
#align affine_map.homothety_is_open_map AffineMap.homothety_isOpenMap

end Field

end AffineMap


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebraic_geometry.Spec

/-!
# The category of schemes

A scheme is a locally ringed space such that every point is contained in some open set
where there is an isomorphism of presheaves between the restriction to that open set,
and the structure sheaf of `Spec R`, for some commutative ring `R`.

A morphism of schemes is just a morphism of the underlying locally ringed spaces.

-/

noncomputable theory

open topological_space
open category_theory
open Top
open opposite

namespace algebraic_geometry

/--
We define `Scheme` as a `X : LocallyRingedSpace`,
along with a proof that every point has an open neighbourhood `U`
so that that the restriction of `X` to `U` is isomorphic,
as a locally ringed space, to `Spec.to_LocallyRingedSpace.obj (op R)`
for some `R : CommRing`.
-/
structure Scheme extends to_LocallyRingedSpace : LocallyRingedSpace :=
(local_affine : ∀ x : to_LocallyRingedSpace, ∃ (U : open_nhds x) (R : CommRing),
  nonempty (to_LocallyRingedSpace.restrict U.open_embedding ≅
    Spec.to_LocallyRingedSpace.obj (op R)))

namespace Scheme

/--
Schemes are a full subcategory of locally ringed spaces.
-/
instance : category Scheme :=
induced_category.category Scheme.to_LocallyRingedSpace

/-- The structure sheaf of a Scheme. -/
protected abbreviation sheaf (X : Scheme) := X.to_SheafedSpace.sheaf

/-- The forgetful functor from `Scheme` to `LocallyRingedSpace`. -/
@[simps, derive[full, faithful]]
def forget_to_LocallyRingedSpace : Scheme ⥤ LocallyRingedSpace :=
  induced_functor _

@[simp] lemma forget_to_LocallyRingedSpace_preimage {X Y : Scheme} (f : X ⟶ Y) :
  Scheme.forget_to_LocallyRingedSpace.preimage f = f := rfl

/-- The forgetful functor from `Scheme` to `Top`. -/
@[simps]
def forget_to_Top : Scheme ⥤ Top :=
  Scheme.forget_to_LocallyRingedSpace ⋙ LocallyRingedSpace.forget_to_Top

instance {X Y : Scheme} : has_lift_t (X ⟶ Y)
  (X.to_SheafedSpace ⟶ Y.to_SheafedSpace) := (@@coe_to_lift $ @@coe_base coe_subtype)

lemma id_val_base (X : Scheme) : (subtype.val (𝟙 X)).base = 𝟙 _ := rfl

@[simp] lemma id_coe_base (X : Scheme) :
  (↑(𝟙 X) : X.to_SheafedSpace ⟶ X.to_SheafedSpace).base = 𝟙 _ := rfl

@[simp] lemma id_app {X : Scheme} (U : (opens X.carrier)ᵒᵖ) :
  (subtype.val (𝟙 X)).c.app U = X.presheaf.map
    (eq_to_hom (by { induction U using opposite.rec, cases U, refl })) :=
PresheafedSpace.id_c_app X.to_PresheafedSpace U

@[reassoc]
lemma comp_val {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g).val = f.val ≫ g.val := rfl

@[reassoc, simp]
lemma comp_coe_base {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (↑(f ≫ g) : X.to_SheafedSpace ⟶ Z.to_SheafedSpace).base = f.val.base ≫ g.val.base := rfl

@[reassoc, elementwise]
lemma comp_val_base {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g).val.base = f.val.base ≫ g.val.base := rfl

@[reassoc, simp]
lemma comp_val_c_app {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) (U) :
  (f ≫ g).val.c.app U = g.val.c.app U ≫ f.val.c.app _ := rfl

lemma congr_app {X Y : Scheme} {f g : X ⟶ Y} (e : f = g) (U) :
  f.val.c.app U = g.val.c.app U ≫ X.presheaf.map (eq_to_hom (by subst e)) :=
by { subst e, dsimp, simp }

lemma app_eq {X Y : Scheme} (f : X ⟶ Y) {U V : opens Y.carrier} (e : U = V) :
  f.val.c.app (op U) = Y.presheaf.map (eq_to_hom e.symm).op ≫
    f.val.c.app (op V) ≫ X.presheaf.map (eq_to_hom (congr_arg (opens.map f.val.base).obj e)).op :=
begin
  rw [← is_iso.inv_comp_eq, ← functor.map_inv, f.val.c.naturality, presheaf.pushforward_obj_map],
  congr
end
instance is_LocallyRingedSpace_iso {X Y : Scheme} (f : X ⟶ Y) [is_iso f] :
  @is_iso LocallyRingedSpace _ _ _ f :=
forget_to_LocallyRingedSpace.map_is_iso f

@[simp]
lemma inv_val_c_app {X Y : Scheme} (f : X ⟶ Y) [is_iso f] (U : opens X.carrier) :
  (inv f).val.c.app (op U) = X.presheaf.map (eq_to_hom $ by { rw is_iso.hom_inv_id, ext1, refl } :
    (opens.map (f ≫ inv f).1.base).obj U ⟶ U).op ≫
      inv (f.val.c.app (op $ (opens.map _).obj U)) :=
begin
  rw [is_iso.eq_comp_inv],
  erw ← Scheme.comp_val_c_app,
  rw [Scheme.congr_app (is_iso.hom_inv_id f),
    Scheme.id_app, ← functor.map_comp, eq_to_hom_trans, eq_to_hom_op],
  refl
end

/--
The spectrum of a commutative ring, as a scheme.
-/
def Spec_obj (R : CommRing) : Scheme :=
{ local_affine := λ x,
  ⟨⟨⊤, trivial⟩, R, ⟨(Spec.to_LocallyRingedSpace.obj (op R)).restrict_top_iso⟩⟩,
  to_LocallyRingedSpace := Spec.LocallyRingedSpace_obj R }

@[simp] lemma Spec_obj_to_LocallyRingedSpace (R : CommRing) :
  (Spec_obj R).to_LocallyRingedSpace = Spec.LocallyRingedSpace_obj R := rfl

/--
The induced map of a ring homomorphism on the ring spectra, as a morphism of schemes.
-/
def Spec_map {R S : CommRing} (f : R ⟶ S) :
  Spec_obj S ⟶ Spec_obj R :=
(Spec.LocallyRingedSpace_map f : Spec.LocallyRingedSpace_obj S ⟶ Spec.LocallyRingedSpace_obj R)

@[simp] lemma Spec_map_id (R : CommRing) :
  Spec_map (𝟙 R) = 𝟙 (Spec_obj R) :=
Spec.LocallyRingedSpace_map_id R

lemma Spec_map_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T) :
  Spec_map (f ≫ g) = Spec_map g ≫ Spec_map f :=
Spec.LocallyRingedSpace_map_comp f g

/--
The spectrum, as a contravariant functor from commutative rings to schemes.
-/
@[simps] def Spec : CommRingᵒᵖ ⥤ Scheme :=
{ obj := λ R, Spec_obj (unop R),
  map := λ R S f, Spec_map f.unop,
  map_id' := λ R, by rw [unop_id, Spec_map_id],
  map_comp' := λ R S T f g, by rw [unop_comp, Spec_map_comp] }

/--
The empty scheme, as `Spec 0`.
-/
def empty : Scheme :=
Spec_obj (CommRing.of punit)

instance : has_emptyc Scheme := ⟨empty⟩

instance : inhabited Scheme := ⟨∅⟩

/--
The global sections, notated Gamma.
-/
def Γ : Schemeᵒᵖ ⥤ CommRing :=
(induced_functor Scheme.to_LocallyRingedSpace).op ⋙ LocallyRingedSpace.Γ

lemma Γ_def : Γ = (induced_functor Scheme.to_LocallyRingedSpace).op ⋙ LocallyRingedSpace.Γ := rfl

@[simp] lemma Γ_obj (X : Schemeᵒᵖ) : Γ.obj X = (unop X).presheaf.obj (op ⊤) := rfl

lemma Γ_obj_op (X : Scheme) : Γ.obj (op X) = X.presheaf.obj (op ⊤) := rfl

@[simp] lemma Γ_map {X Y : Schemeᵒᵖ} (f : X ⟶ Y) :
  Γ.map f = f.unop.1.c.app (op ⊤) := rfl

lemma Γ_map_op {X Y : Scheme} (f : X ⟶ Y) :
  Γ.map f.op = f.1.c.app (op ⊤) := rfl

section basic_open

variables (X : Scheme) {V U : opens X.carrier} (f g : X.presheaf.obj (op U))

/-- The subset of the underlying space where the given section does not vanish. -/
def basic_open : opens X.carrier := X.to_LocallyRingedSpace.to_RingedSpace.basic_open f

@[simp]
lemma mem_basic_open (x : U) : ↑x ∈ X.basic_open f ↔ is_unit (X.presheaf.germ x f) :=
RingedSpace.mem_basic_open _ _ _

@[simp]
lemma mem_basic_open_top (f : X.presheaf.obj (op ⊤)) (x : X.carrier) :
  x ∈ X.basic_open f ↔ is_unit (X.presheaf.germ (⟨x, trivial⟩ : (⊤ : opens _)) f) :=
RingedSpace.mem_basic_open _ f ⟨x, trivial⟩

@[simp]
lemma basic_open_res (i : op U ⟶ op V) :
  X.basic_open (X.presheaf.map i f) = V ∩ X.basic_open f :=
RingedSpace.basic_open_res _ i f

-- This should fire before `basic_open_res`.
@[simp, priority 1100]
lemma basic_open_res_eq (i : op U ⟶ op V) [is_iso i] :
  X.basic_open (X.presheaf.map i f) = X.basic_open f :=
RingedSpace.basic_open_res_eq _ i f

lemma basic_open_subset : X.basic_open f ⊆ U :=
RingedSpace.basic_open_subset _ _

lemma preimage_basic_open {X Y : Scheme} (f : X ⟶ Y) {U : opens Y.carrier}
  (r : Y.presheaf.obj $ op U) :
  (opens.map f.1.base).obj (Y.basic_open r) =
    @Scheme.basic_open X ((opens.map f.1.base).obj U) (f.1.c.app _ r) :=
LocallyRingedSpace.preimage_basic_open f r

@[simp]
lemma preimage_basic_open' {X Y : Scheme} (f : X ⟶ Y) {U : opens Y.carrier}
  (r : Y.presheaf.obj $ op U) :
  (opens.map (↑f : X.to_SheafedSpace ⟶ Y.to_SheafedSpace).base).obj (Y.basic_open r) =
    @Scheme.basic_open X ((opens.map f.1.base).obj U) (f.1.c.app _ r) :=
LocallyRingedSpace.preimage_basic_open f r

@[simp]
lemma basic_open_zero (U : opens X.carrier) : X.basic_open (0 : X.presheaf.obj $ op U) = ∅ :=
LocallyRingedSpace.basic_open_zero _ U

@[simp]
lemma basic_open_mul : X.basic_open (f * g) = X.basic_open f ⊓ X.basic_open g :=
RingedSpace.basic_open_mul _ _ _

@[simp]
lemma basic_open_of_is_unit {f : X.presheaf.obj (op U)} (hf : is_unit f) : X.basic_open f = U :=
RingedSpace.basic_open_of_is_unit _ hf

end basic_open

end Scheme

lemma basic_open_eq_of_affine {R : CommRing} (f : R) :
  (Scheme.Spec.obj $ op R).basic_open ((Spec_Γ_identity.app R).inv f) =
    prime_spectrum.basic_open f :=
begin
  ext,
  erw Scheme.mem_basic_open_top,
  suffices : is_unit (structure_sheaf.to_stalk R x f) ↔ f ∉ prime_spectrum.as_ideal x,
  { exact this },
  erw [← is_unit_map_iff (structure_sheaf.stalk_to_fiber_ring_hom R x),
    structure_sheaf.stalk_to_fiber_ring_hom_to_stalk],
  exact (is_localization.at_prime.is_unit_to_map_iff
    (localization.at_prime (prime_spectrum.as_ideal x)) (prime_spectrum.as_ideal x) f : _)
end

@[simp]
lemma basic_open_eq_of_affine' {R : CommRing}
  (f : (Spec.to_SheafedSpace.obj (op R)).presheaf.obj (op ⊤)) :
  (Scheme.Spec.obj $ op R).basic_open f =
    prime_spectrum.basic_open ((Spec_Γ_identity.app R).hom f) :=
begin
  convert basic_open_eq_of_affine ((Spec_Γ_identity.app R).hom f),
  exact (coe_hom_inv_id _ _).symm
end

end algebraic_geometry


example : 2 + 3 = 5 := rfl

example : 15 - 8 = 7 := rfl

example : "Hello".append " lean" = "Hello lean" := rfl

example : 5 < 8 := by simp

def getFiftElem (x : List α) (h : x.length > 5) := x[5]'h

def getSixthElem (x : List α) (h1 : x.length > 10) := x[6]'h2
  where h2 : x.length > 6 := by
have h : 6 < 10 := by simp
apply Nat.lt_trans h
exact h1


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author(s): Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.control.monad.basic
import Mathlib.data.fintype.basic
import Mathlib.PostPort

universes u_1 l u_2

namespace Mathlib

/-!
Type class for finitely enumerable types. The property is stronger
than `fintype` in that it assigns each element a rank in a finite
enumeration.
-/

/-- `fin_enum α` means that `α` is finite and can be enumerated in some order,
  i.e. `α` has an explicit bijection with `fin n` for some n. -/
class fin_enum (α : Sort u_1) where
  card : ℕ
  equiv : α ≃ fin card
  dec_eq : DecidableEq α

namespace fin_enum

/-- transport a `fin_enum` instance across an equivalence -/
def of_equiv (α : Sort u_1) {β : Sort u_2} [fin_enum α] (h : β ≃ α) : fin_enum β :=
  mk (card α) (equiv.trans h (equiv α))

/-- create a `fin_enum` instance from an exhaustive list without duplicates -/
def of_nodup_list {α : Type u_1} [DecidableEq α] (xs : List α) (h : ∀ (x : α), x ∈ xs)
    (h' : list.nodup xs) : fin_enum α :=
  mk (list.length xs)
    (equiv.mk (fun (x : α) => { val := list.index_of x xs, property := sorry })
      (fun (_x : fin (list.length xs)) => sorry) sorry sorry)

/-- create a `fin_enum` instance from an exhaustive list; duplicates are removed -/
def of_list {α : Type u_1} [DecidableEq α] (xs : List α) (h : ∀ (x : α), x ∈ xs) : fin_enum α :=
  of_nodup_list (list.erase_dup xs) sorry sorry

/-- create an exhaustive list of the values of a given type -/
def to_list (α : Type u_1) [fin_enum α] : List α :=
  list.map (⇑(equiv.symm (equiv α))) (list.fin_range (card α))

@[simp] theorem mem_to_list {α : Type u_1} [fin_enum α] (x : α) : x ∈ to_list α := sorry

@[simp] theorem nodup_to_list {α : Type u_1} [fin_enum α] : list.nodup (to_list α) := sorry

/-- create a `fin_enum` instance using a surjection -/
def of_surjective {α : Type u_1} {β : Type u_2} (f : β → α) [DecidableEq α] [fin_enum β]
    (h : function.surjective f) : fin_enum α :=
  of_list (list.map f (to_list β)) sorry

/-- create a `fin_enum` instance using an injection -/
def of_injective {α : Type u_1} {β : Type u_2} (f : α → β) [DecidableEq α] [fin_enum β]
    (h : function.injective f) : fin_enum α :=
  of_list (list.filter_map (function.partial_inv f) (to_list β)) sorry

protected instance pempty : fin_enum pempty := of_list [] sorry

protected instance empty : fin_enum empty := of_list [] sorry

protected instance punit : fin_enum PUnit := of_list [PUnit.unit] sorry

protected instance prod {α : Type u_1} {β : Type u_2} [fin_enum α] [fin_enum β] :
    fin_enum (α × β) :=
  of_list (list.product (to_list α) (to_list β)) sorry

protected instance sum {α : Type u_1} {β : Type u_2} [fin_enum α] [fin_enum β] : fin_enum (α ⊕ β) :=
  of_list (list.map sum.inl (to_list α) ++ list.map sum.inr (to_list β)) sorry

protected instance fin {n : ℕ} : fin_enum (fin n) := of_list (list.fin_range n) sorry

protected instance quotient.enum {α : Type u_1} [fin_enum α] (s : setoid α)
    [DecidableRel has_equiv.equiv] : fin_enum (quotient s) :=
  of_surjective quotient.mk sorry

/-- enumerate all finite sets of a given type -/
def finset.enum {α : Type u_1} [DecidableEq α] : List α → List (finset α) := sorry

@[simp] theorem finset.mem_enum {α : Type u_1} [DecidableEq α] (s : finset α) (xs : List α) :
    s ∈ finset.enum xs ↔ ∀ (x : α), x ∈ s → x ∈ xs :=
  sorry

protected instance finset.fin_enum {α : Type u_1} [fin_enum α] : fin_enum (finset α) :=
  of_list (finset.enum (to_list α)) sorry

protected instance subtype.fin_enum {α : Type u_1} [fin_enum α] (p : α → Prop) [decidable_pred p] :
    fin_enum (Subtype fun (x : α) => p x) :=
  of_list
    (list.filter_map
      (fun (x : α) =>
        dite (p x) (fun (h : p x) => some { val := x, property := h }) fun (h : ¬p x) => none)
      (to_list α))
    sorry

protected instance sigma.fin_enum {α : Type u_1} (β : α → Type u_2) [fin_enum α]
    [(a : α) → fin_enum (β a)] : fin_enum (sigma β) :=
  of_list (list.bind (to_list α) fun (a : α) => list.map (sigma.mk a) (to_list (β a))) sorry

protected instance psigma.fin_enum {α : Type u_1} {β : α → Type u_2} [fin_enum α]
    [(a : α) → fin_enum (β a)] : fin_enum (psigma fun (a : α) => β a) :=
  of_equiv (sigma fun (i : α) => β i) (equiv.psigma_equiv_sigma fun (i : α) => β i)

protected instance psigma.fin_enum_prop_left {α : Prop} {β : α → Type u_1}
    [(a : α) → fin_enum (β a)] [Decidable α] : fin_enum (psigma fun (a : α) => β a) :=
  dite α (fun (h : α) => of_list (list.map (psigma.mk h) (to_list (β h))) sorry)
    fun (h : ¬α) => of_list [] sorry

protected instance psigma.fin_enum_prop_right {α : Type u_1} {β : α → Prop} [fin_enum α]
    [(a : α) → Decidable (β a)] : fin_enum (psigma fun (a : α) => β a) :=
  of_equiv (Subtype fun (a : α) => β a)
    (equiv.mk (fun (_x : psigma fun (a : α) => β a) => sorry)
      (fun (_x : Subtype fun (a : α) => β a) => sorry) sorry sorry)

protected instance psigma.fin_enum_prop_prop {α : Prop} {β : α → Prop} [Decidable α]
    [(a : α) → Decidable (β a)] : fin_enum (psigma fun (a : α) => β a) :=
  dite (∃ (a : α), β a) (fun (h : ∃ (a : α), β a) => of_list [psigma.mk sorry sorry] sorry)
    fun (h : ¬∃ (a : α), β a) => of_list [] sorry

protected instance fintype {α : Type u_1} [fin_enum α] : fintype α :=
  fintype.mk (finset.map (equiv.to_embedding (equiv.symm (equiv α))) finset.univ) sorry

/-- For `pi.cons x xs y f` create a function where every `i ∈ xs` is mapped to `f i` and
`x` is mapped to `y`  -/
def pi.cons {α : Type u_1} {β : α → Type u_2} [DecidableEq α] (x : α) (xs : List α) (y : β x)
    (f : (a : α) → a ∈ xs → β a) (a : α) : a ∈ x :: xs → β a :=
  sorry

/-- Given `f` a function whose domain is `x :: xs`, produce a function whose domain
is restricted to `xs`.  -/
def pi.tail {α : Type u_1} {β : α → Type u_2} {x : α} {xs : List α}
    (f : (a : α) → a ∈ x :: xs → β a) (a : α) : a ∈ xs → β a :=
  sorry

/-- `pi xs f` creates the list of functions `g` such that, for `x ∈ xs`, `g x ∈ f x` -/
def pi {α : Type u_1} {β : α → Type (max u_1 u_2)} [DecidableEq α] (xs : List α) :
    ((a : α) → List (β a)) → List ((a : α) → a ∈ xs → β a) :=
  sorry

theorem mem_pi {α : Type u_1} {β : α → Type (max u_1 u_2)} [fin_enum α] [(a : α) → fin_enum (β a)]
    (xs : List α) (f : (a : α) → a ∈ xs → β a) : f ∈ pi xs fun (x : α) => to_list (β x) :=
  sorry

/-- enumerate all functions whose domain and range are finitely enumerable -/
def pi.enum {α : Type u_1} (β : α → Type (max u_1 u_2)) [fin_enum α] [(a : α) → fin_enum (β a)] :
    List ((a : α) → β a) :=
  list.map (fun (f : (a : α) → a ∈ to_list α → β a) (x : α) => f x (mem_to_list x))
    (pi (to_list α) fun (x : α) => to_list (β x))

theorem pi.mem_enum {α : Type u_1} {β : α → Type (max u_1 u_2)} [fin_enum α]
    [(a : α) → fin_enum (β a)] (f : (a : α) → β a) : f ∈ pi.enum β :=
  sorry

protected instance pi.fin_enum {α : Type u_1} {β : α → Type (max u_1 u_2)} [fin_enum α]
    [(a : α) → fin_enum (β a)] : fin_enum ((a : α) → β a) :=
  of_list (pi.enum fun (a : α) => β a) sorry

protected instance pfun_fin_enum (p : Prop) [Decidable p] (α : p → Type u_1)
    [(hp : p) → fin_enum (α hp)] : fin_enum ((hp : p) → α hp) :=
  dite p (fun (hp : p) => of_list (list.map (fun (x : α hp) (hp' : p) => x) (to_list (α hp))) sorry)
    fun (hp : ¬p) => of_list [fun (hp' : p) => false.elim (hp hp')] sorry

end Mathlib


import galois.tactic

universes u

namespace list
def mem_induction {A : Type u}
  (P : A → list A → Prop)
  (Phere : ∀ x xs, P x (x :: xs))
  (Pthere : ∀ x y ys, P x ys → P x (y :: ys))
  (x : A) (xs : list A) (H : x ∈ xs)
  : P x xs
:= begin
induction xs, cases H,
dsimp [has_mem.mem, list.mem] at H,
induction H, subst a, apply Phere,
apply Pthere, apply ih_1, assumption,
end

lemma mem_map' {A B} (f : A → B) (xs : list A)
  (x : A) (y : B) (H : f x = y)
  (H' : x ∈ xs)
  : y ∈ xs.map f
:= begin
subst H, apply mem_induction _ _ _ _ _ H'; intros,
left, reflexivity, right, assumption,
end

end list

lemma list.mem_bind' {A B} (xs : list A) (f : A → list B)
  (y : B) (H : y ∈ xs >>= f)
  : ∃ x : A, x ∈ xs ∧ y ∈ f x
:= begin
dsimp [(>>=), list.bind, list.join] at H,
induction xs; dsimp [list.map, list.join] at H,
rw list.mem_nil_iff at H, contradiction,
rw list.mem_append at H,
induction H with H H',
existsi a, split, constructor, reflexivity, assumption,
specialize (ih_1 H'),
induction ih_1 with x H,
induction H with H1 H2,
existsi x, split,
dsimp [has_mem.mem, list.mem],
right, assumption, assumption,
end

lemma list.mem_bind_iff' {A B} (xs : list A) (f : A → list B)
  (y : B)
  : y ∈ xs >>= f
  ↔ ∃ x : A, x ∈ xs ∧ y ∈ f x
:= begin
split; intros H, apply list.mem_bind', assumption,
induction H with x Hx, induction Hx with H1 H2,
dsimp [(>>=), list.bind, list.join],
induction xs; dsimp [list.map, list.join],
rw list.mem_nil_iff at H1, contradiction,
rw list.mem_append, dsimp [has_mem.mem, list.mem] at H1,
induction H1 with H1 H1, subst a,
left, assumption, right, apply ih_1, assumption,
end


/-
Copyright (c) 2020 Gabriel Ebner, Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Simon Hudon
-/
import tactic.ext
import data.stream
import data.list.basic
import data.list.range

/-!
# Additional instances and attributes for streams
-/

attribute [ext] stream.ext

instance {α} [inhabited α] : inhabited (stream α) :=
⟨stream.const (default _)⟩

namespace stream
open nat

/-- `take s n` returns a list of the `n` first elements of stream `s` -/
def take {α} (s : stream α) (n : ℕ) : list α :=
(list.range n).map s

lemma length_take {α} (s : stream α) (n : ℕ) : (take s n).length = n :=
by simp [take]

/-- Use a state monad to generate a stream through corecursion -/
def corec_state {σ α} (cmd : state σ α) (s : σ) : stream α :=
stream.corec prod.fst (cmd.run ∘ prod.snd) (cmd.run s)

end stream


import data.equiv

namespace xena
def chℕ := Π X : Type, (X → X) → X → X
#check (chℕ : Type 1)

inductive nat' : Type 1
| zero : nat'
| succ (n : nat') : nat'
#check (chℕ : Type 1)

theorem over_optimistic_theorem : equiv nat' chℕ := sorry

end xena


import .basic

namespace hidden

open myring
open ordered_myring
open myfield
open ordered_myfield

namespace cau_seq

-- We have to prove that it actually gives a cau_seq
def add : cau_seq → cau_seq → cau_seq :=
λ f g, ⟨λ n, f.val n + g.val n,
begin
  have hf := f.property,
  have hg := g.property,
  dsimp only [is_cau_seq] at *,
  intros ε hε,
  have hfε := hf (ε / 2) (half_pos hε),
  have hgε := hg (ε / 2) (half_pos hε),
  clear hf hg,
  cases hfε with M hM,
  cases hgε with N hN,
  existsi mynat.max M N,
  intros m n hm hn,
  have : f.val n + g.val n - (f.val m + g.val m) = (f.val n - f.val m) + (g.val n - g.val m),
    rw [sub_def, neg_distr],
    have : f.val n + g.val n + (-f.val m + -g.val m) = (f.val n + -f.val m) + (g.val n + -g.val m),
      ac_refl,
    rw this, clear this,
    rw [←sub_def, ←sub_def],
  rw this, clear this,
  have : abs (f.val n - f.val m + (g.val n - g.val m)) ≤
         abs (f.val n - f.val m) + abs (g.val n - g.val m),
    apply triangle_ineq,
  apply le_lt_chain (abs (f.val n - f.val m) + abs (g.val n - g.val m)),
    assumption,
  have hN₁ := hN m n (mynat.max_le_cancel_right hm) (mynat.max_le_cancel_right hn),
  have hM₁ := hM m n (mynat.max_le_cancel_left hm) (mynat.max_le_cancel_left hn),
  clear this hM hN,
  have := lt_comb hM₁ hN₁,
  rw [div_def, ←mul_add, ←one_div, half_plus_half (myrat.two_nzero), mul_one] at this,
  assumption,
end⟩

instance: has_add cau_seq := ⟨add⟩

theorem add_val {a b : cau_seq} {n : mynat} : (a + b).val n = a.val n + b.val n := rfl

end cau_seq

namespace real

open cau_seq

def add : real → real → real :=
quotient.lift₂ (λ f g, ⟦f + g⟧)
begin
  intros a x b y hab hxy,
  dsimp only [],
  rw cau_seq.class_equiv,
  rw cau_seq.setoid_equiv at *,
  dsimp only [cau_seq.equivalent] at *,
  intros ε hε,
  cases hab (ε / 2) (half_pos hε) with M hM,
  cases hxy (ε / 2) (half_pos hε) with N hN,
  existsi mynat.max M N,
  intros n hn,
  have hMn := hM n (mynat.max_le_cancel_left hn),
  have hNn := hN n (mynat.max_le_cancel_right hn),
  clear hM hN hxy hab,
  have h := lt_comb hMn hNn,
  rw half_plus_half at h,
  rw [cau_seq.add_val, cau_seq.add_val, sub_def, neg_distr],
  have : a.val n + x.val n + (-b.val n + -y.val n) = a.val n + -b.val n + (x.val n + -y.val n),
    ac_refl,
  rw this, clear this,
  apply le_lt_chain (abs (a.val n - b.val n) + abs (x.val n - y.val n)),
    rw [sub_def, sub_def],
    from @triangle_ineq _ _ (a.val n + -b.val n) (x.val n + -y.val n),
    assumption,
  from myrat.two_nzero,
end

instance : has_add real := ⟨add⟩

theorem add_eq_cls {x y : real} {f g : cau_seq}: x = ⟦f⟧ → y = ⟦g⟧ → x + y = ⟦f + g⟧ :=
λ hxf hyg, by rw [hxf, hyg]; refl

theorem add_assoc (x y z : real) : x + y + z = x + (y + z) :=
begin
  cases quotient.exists_rep x with f hf, subst hf,
  cases quotient.exists_rep y with g hg, subst hg,
  cases quotient.exists_rep z with h hh, subst hh,
  repeat { rw [add_eq_cls rfl rfl] },
  apply seq_eq_imp_real_eq rfl rfl,
  intro n,
  repeat { rw add_val, },
  ac_refl,
end

@[simp] theorem add_zero (x : real) : x + 0 = x :=
begin
  cases quotient.exists_rep x with f hf, subst hf,
  rw [real_zero, coe_def],
  rw add_eq_cls rfl rfl,
  apply seq_eq_imp_real_eq rfl rfl,
  intro n,
  rw add_val,
  dsimp only [],
  rw add_zero,
end

@[simp] theorem add_neg (x : real) : x + -x = 0 :=
begin
  cases quotient.exists_rep x with f hf, subst hf,
  rw [neg_eq_cls rfl, add_eq_cls rfl rfl],
  rw real_zero,
  apply seq_eq_imp_real_eq rfl rfl,
  intro n,
  dsimp only [],
  rw [add_val, neg_val, ←sub_def, sub_self],
end

theorem coe_add (a b : myrat) : ↑(a + b) = ↑a + (↑b : real) :=
begin
  repeat { rw coe_def, },
  rw add_eq_cls rfl rfl,
  rw cau_seq.class_equiv,
  apply seq_eq_impl_cau_seq_equiv,
  intros n,
  rw cau_seq.add_val,
end

theorem real_two : (2 : real) = ↑(2 : myrat) :=
begin
  change 1 + (1 : real) = ↑(1 + (1 : myrat)),
  rw coe_add,
  rw real_one,
end

theorem two_nzero : (2 : real) ≠ 0 :=
begin
  rw [real_two, real_zero],
  assume water,
  rw eq_iff_coe_eq at water,
  exact myrat.two_nzero water,
end

end real

end hidden


import topology.basic
import topology.metric_space.basic
import topology.path_connected
import topology.continuous_function.basic
import topology.homotopy.basic
import topology.homotopy.fundamental_groupoid
import category_theory.endomorphism
import category_theory.groupoid
import algebra.category.Group.basic
import category_theory.category.basic
import category_theory.types
import .pointed_space

example {X Y : Type} [setoid X] (f : X → Y) (x : X) (h : ∀ (a b : X), a ≈ b → f a = f b) :
  (quotient.lift f h) ⟦x⟧ = f x := begin
    exact quotient.lift_mk f h x
  end

/--
Define the fundamental group as the the automorphism group of the fundamental groupoid i.e.
the set of all arrows from the basepoint to itself (p ⟶ p).
-/
def fundamental_group {X : Type} [topological_space X] (Xp : pointed_space X) : Type :=
@category_theory.Aut
  X
  (@category_theory.groupoid.to_category (fundamental_groupoid X) _)
  Xp.basepoint

/--
Use the automorphism group instance to give a group structure to the fundamental group.
-/
noncomputable instance fundamental_group.group {X : Type} [topological_space X] {Xp : pointed_space X} :
   group (fundamental_group Xp) :=
@category_theory.Aut.group
  X
  (@category_theory.groupoid.to_category (fundamental_groupoid X) _)
  Xp.basepoint

noncomputable instance category.topological_space (X : Type) [topological_space X] : category_theory.category X :=
fundamental_groupoid.category_theory.groupoid.to_category

@[simp]
def space_of_fg {X : Type} [topological_space X] (p : fundamental_groupoid X) : X := p
notation `↘` p : 70 := space_of_fg p

def fg_of_space {X : Type} [topological_space X] (p : X) : fundamental_groupoid X := p
notation `↗` p : 70 := fg_of_space p

def path_quotient_of_groupoid_arrow {X : Type} [topological_space X] {a b : fundamental_groupoid X} :
  (a ⟶ b) = quotient (path.homotopic.setoid (↘a) (↘b)) := rfl

lemma fg_mul {X : Type} [topological_space X] {Xp : pointed_space X} (a b : fundamental_group Xp) :
  a * b = category_theory.iso.trans b a :=
by refl

lemma fg_one {X : Type} [topological_space X] {Xp : pointed_space X}:
  (1 : fundamental_group Xp) = @category_theory.iso.refl X (category.topological_space X) (Xp.basepoint) :=
by refl

/--
Type alias for working with loops in a space X with basepoint p.
-/
def loop {X : Type} [topological_space X] (Xp : pointed_space X) : Type :=
path Xp.basepoint Xp.basepoint

example (X Y : Type) (f : X → Y) (a b : X) : a = b → f a = f b :=
begin
  exact congr_arg (λ (a : X), f a),
end

/-
The following is a set of helper lemmas for rewriting computations on ℝ.
-/

@[simp]
lemma sub_12 : (1 : ℝ) - (2 : ℝ) = -1 :=
by linarith

@[simp]
lemma arith (s : ℝ) : s * (1 - |1 - 2|) = 0 :=
calc s * (1 - |1 - 2|) = s * (1 - |(-1)|) : by rw sub_12
... = s * (1 - 1) : by simp
... = s * 0 : by rw sub_self
... = 0 : mul_zero s

@[simp]
lemma arith2 (a : ℝ) : 2 * a ≤ 1 + 1 ↔ a ≤ 1 := begin
  split;
  { intros, linarith, },
end

@[simp]
lemma unit_interval_bound_fst (st : unit_interval × unit_interval) : st.fst ≥ 0 ∧ st.fst ≤ 1 :=
begin
  apply and.intro,
  exact unit_interval.nonneg',
  exact unit_interval.le_one',
end

@[simp]
lemma unit_interval_bound_snd (st : unit_interval × unit_interval) : st.snd ≥ 0 ∧ st.snd ≤ 1 :=
begin
  apply and.intro,
  exact unit_interval.nonneg',
  exact unit_interval.le_one',
end

/--
Defines the homotopy between an out-and-back path and a point i.e. for path γ
starting at point p, γ * γ⁻¹ ∼ p.
-/
noncomputable def linear_symm_homotopy {X : Type} [topological_space X] {p q : X} (γ : path p q) :
  path.homotopy (path.refl p) (γ.trans γ.symm) := {
  to_homotopy := {
    to_fun := λst, γ (subtype.mk (st.fst.val * (1 - |1 - 2 * st.snd.val|)) begin
      simp,
      have hs : st.fst ≥ 0 ∧ st.fst ≤ 1 := unit_interval_bound_fst st,
      have ht : st.snd ≥ 0 ∧ st.snd ≤ 1 := unit_interval_bound_snd st,
      apply and.intro;
      apply or.elim (abs_cases ((1 : ℝ) - 2 * ↑(st.snd)));
      intro h;
      rw (and.elim_left h),
      { apply mul_nonneg,
        repeat {simp, tautology}, },
      { apply mul_nonneg,
        repeat {simp, tautology}, },
      { apply mul_le_one,
        tautology, simp, tautology, simp, linarith, },
      { apply mul_le_one,
        tautology, simp, tautology, simp, linarith, },
    end),
    to_fun_zero := by simp,
    to_fun_one := begin
      simp,
      intros t ht,
      rw path.trans_apply,
      split_ifs;
      simp [unit_interval.symm];
      apply congr_arg;
      apply subtype.eq;
      simp;
      rw subtype.coe_mk at h,
      { have h_abs_pos : 0 ≤ 1 - 2 * t := by linarith, -- TODO: finish this!
        rw abs_of_nonneg h_abs_pos,
        linarith, },
      { have h_abs_neg : 1 - 2 * t ≤ 0 := by linarith,
        rw abs_of_nonpos h_abs_neg,
        linarith, },
    end,
  },
  prop' := begin
    intros s t ht_endpoint,
    simp at *,
    apply or.elim ht_endpoint;
    intro ht;
    apply and.intro;
    simp [ht],
  end,
}

/--
Given a path connected space X and two points p, q, we return a path between them
along with the reverse path, bundled together.
-/
noncomputable def conn_path {X : Type} [topological_space X] [path_connected_space X] (p q : X) :
  @category_theory.iso (fundamental_groupoid X) _ p q :=
let pq_path := joined.some_path (path_connected_space.joined p q) in {
  hom := @quotient.mk (path p q) (path.homotopic.setoid p q) pq_path,
  inv := @quotient.mk (path q p) (path.homotopic.setoid q p) pq_path.symm,
  hom_inv_id' := begin
    apply quotient.sound,
    apply nonempty_of_exists,
    apply @exists.intro _ (λ_, true)
      (path.homotopy.symm (linear_symm_homotopy pq_path))
      (by tautology),
  end,
  inv_hom_id' := begin
    apply quotient.sound,
    apply nonempty_of_exists,
    let homotopy := linear_symm_homotopy pq_path.symm,
    rw path.symm_symm at homotopy,
    apply @exists.intro _ (λ_, true)
      (path.homotopy.symm homotopy)
      (by tautology),
  end,
}

/--
Given a path connected space X, the fundamental group is independent of which basepoint was used.
-/
noncomputable theorem iso_fg_of_path_conn {X : Type} [topological_space X] [path_connected_space X]
  (Xp : pointed_space X) (Xq : pointed_space X) :
  (fundamental_group Xp) ≅ (fundamental_group Xq) :=
let α := conn_path Xp.basepoint Xq.basepoint in {
  hom := λγ, category_theory.iso.mk
    (α.inv ≫ γ.hom ≫ α.hom)
    (α.inv ≫ γ.inv ≫ α.hom)
    (by simp)
    (by simp),
  inv := λγ, category_theory.iso.mk
    (α.hom ≫ γ.hom ≫ α.inv)
    (α.hom ≫ γ.inv ≫ α.inv)
    (by simp)
    (by simp),
}

/--
Similar to `iso_fg_of_path_conn`, except it defines a group isomorphism between the two fundamental groups
as opposed to a category isomorphism.
-/
noncomputable theorem mulequiv_fg_of_path_conn {X : Type} [topological_space X] [path_connected_space X]
  (Xp : pointed_space X) (Xq : pointed_space X) :
  (fundamental_group Xp) ≃* (fundamental_group Xq) :=
let α := conn_path Xp.basepoint Xq.basepoint in {
  to_fun := λγ, category_theory.iso.mk
    (α.inv ≫ γ.hom ≫ α.hom)
    (α.inv ≫ γ.inv ≫ α.hom)
    (by simp)
    (by simp),
  inv_fun := λγ, category_theory.iso.mk
    (α.hom ≫ γ.hom ≫ α.inv)
    (α.hom ≫ γ.inv ≫ α.inv)
    (by simp)
    (by simp),

  left_inv :=
    begin
      intro γ,
      simp,
      apply category_theory.iso.ext,
      refl,
    end,
  right_inv :=
    begin
      intro γ,
      simp,
      apply category_theory.iso.ext,
      refl,
    end,
  map_mul' :=
    begin
      intros γ₁ γ₂,
      rw @fg_mul _ _ Xq,
      apply category_theory.iso.ext,
      rw fg_mul,
      simp,
    end,
}

/--
Given a continuous function between pointed spaces, we can create a functor between the
associated fundamental groupoids of the spaces.
-/
noncomputable def induced_groupoid_functor {X Y : Type} [topological_space X] [topological_space Y]
  {Xp : pointed_space X} {Yq : pointed_space Y} (f : Cp(Xp, Yq)) :
  fundamental_groupoid X ⥤ fundamental_groupoid Y := {
  obj := f,
  map := begin
    intros p₁ p₂ α,
    let x_setoid := path.homotopic.setoid (↘p₁) (↘p₂),
    let y_setoid := path.homotopic.setoid (f ↘p₁) (f ↘p₂),
    have h_cont : continuous ⇑f := f.to_continuous_map.continuous,

    let f_path : path (↘p₁) (↘p₂) → path (f ↘p₁) (f ↘p₂) :=
      λγ, {
        to_continuous_map := {
          to_fun := f ∘ γ,
          continuous_to_fun := begin
            apply continuous.comp,
            { exact continuous_map.continuous_to_fun f.to_continuous_map, },
            { exact continuous_map.continuous_to_fun γ.to_continuous_map, },
          end,
        },
        source' := by simp,
        target' := by simp,
      },
    let f_path_class : path (↘p₁) (↘p₂) → ((f p₁) ⟶ (f p₂)) :=
      λγ, @quotient.mk _ y_setoid (f_path γ),
    let f_lift : (p₁ ⟶ p₂) → ((f p₁) ⟶ (f p₂)) :=
      begin
        apply @quotient.lift _ _ x_setoid f_path_class,
        intros γ₁ γ₂ h_homotopic,
        apply quotient.sound,
        apply nonempty.intro,
        exact {
          to_homotopy := {
            to_fun := f ∘ ⇑(classical.choice h_homotopic),
            to_fun_zero := by simp,
            to_fun_one := by simp,
          },
          prop' := begin
            intros s t ht_endpoint,
            simp at *,
            apply or.elim ht_endpoint;
            intro ht;
            apply and.intro;
            simp [ht],
          end,
        },
      end,
    exact f_lift α,
  end,
  map_comp' := begin
    intros a b c δ ε,
    rw path_quotient_of_groupoid_arrow at δ,
    rw path_quotient_of_groupoid_arrow at ε,
    simp,
    -- rw quotient.lift_mk,
    sorry,
  end,
}

notation `↟` f : 70 := induced_groupoid_functor f

-- ℤ
/--
Helpful rewrite lemma for dealing with the
-/
@[simp]
lemma f_of_induced_groupoid_functor {X Y : Type} [topological_space X] [topological_space Y]
  {Xp : pointed_space X} {Yq : pointed_space Y} (f : Cp(Xp, Yq)) (x : X) :
  (↟f).obj x = f x := by refl

@[simp]
lemma induced_functor_of_id {X Y : Type} [topological_space X] [topological_space Y]
  {Xp : pointed_space X} {Yq : pointed_space Y} (f : Cp(Xp, Yq)) :
  (↟f).map (𝟙 Xp.basepoint) = 𝟙 ((↟f).obj Xp.basepoint) := by simp

/--
Given a function f : X → Y, returns the induced map between the fundamental groups i.e.
returns f⋆ : π₁(X) → π₁(Y).
-/
noncomputable def induced_hom {X Y : Type} [topological_space X] [topological_space Y]
  {Xp : pointed_space X} {Yq : pointed_space Y} (f : Cp(Xp, Yq)) :
  (fundamental_group Xp) →* (fundamental_group Yq) :=
let h_pointed : f Xp.basepoint = Yq.basepoint := pointed_continuous_map.pointed_map f in
let q1 : (↟f).obj Xp.basepoint ⟶ Yq.basepoint := begin simp [h_pointed], exact 𝟙 Yq.basepoint, end in
let q2 : Yq.basepoint ⟶ (↟f).obj Xp.basepoint := begin simp [h_pointed], exact 𝟙 Yq.basepoint, end in
let h_qinv₁ : q1 ≫ q2 = 𝟙 ((↟f).obj Xp.basepoint) := sorry in
let h_qinv₂ : q2 ≫ q1 = 𝟙 Yq.basepoint := sorry in
{
  to_fun := λγ, {
    hom := q2 ≫ (↟f).map γ.hom ≫ q1,
    inv := q2 ≫ (↟f).map γ.inv ≫ q1,
    hom_inv_id' :=
      calc (q2 ≫ (↟f).map γ.hom ≫ q1) ≫ q2 ≫ (↟f).map γ.inv ≫ q1 = q2 ≫ ((↟f).map γ.hom ≫ (q1 ≫ q2) ≫ (↟f).map γ.inv) ≫ q1 : by simp
        ... = q2 ≫ ((↟f).map γ.hom ≫ (↟f).map γ.inv) ≫ q1 : by simp [h_qinv₁]
        ... = q2 ≫ 𝟙 ((↟f).obj Xp.basepoint) ≫ q1 : begin rw ← category_theory.functor.map_comp (↟f) γ.hom γ.inv, simp, end
        ... = 𝟙 Yq.basepoint : by simp [h_qinv₂],
    inv_hom_id' :=
      calc (q2 ≫ (↟f).map γ.inv ≫ q1) ≫ q2 ≫ (↟f).map γ.hom ≫ q1 = q2 ≫ ((↟f).map γ.inv ≫ (q1 ≫ q2) ≫ (↟f).map γ.hom) ≫ q1 : by simp
        ... = q2 ≫ ((↟f).map γ.inv ≫ (↟f).map γ.hom) ≫ q1 : by simp [h_qinv₁]
        ... = q2 ≫ 𝟙 ((↟f).obj Xp.basepoint) ≫ q1 : begin rw ← category_theory.functor.map_comp (↟f) γ.inv γ.hom, simp, end
        ... = 𝟙 Yq.basepoint : by simp [h_qinv₂],
  },
  map_one' :=
    begin
      rw @fg_one _ _ Yq,
      ext,
      simp,
      rw ← h_qinv₂,
      sorry,
    end,
  map_mul' :=
    begin
      intros δ ε,
      ext,
      rw @fg_mul _ _ Yq _ _,
      simp [h_qinv₁],
      sorry,
    end,
}

/--
Given a surjective map f : X → Y, the induced map f⋆ on fundamental groups is also surjective.
-/
lemma surj_hom_of_surj {X Y : Type} [topological_space X] [topological_space Y]
  {Xp : pointed_space X} {Yq : pointed_space Y} (f : Cp(Xp, Yq)) :
  function.surjective f → function.surjective (induced_hom f) :=
begin
  intros h_f_surj y_loop,
  let y_loop_rep : path Yq.basepoint Yq.basepoint :=
    classical.some (@quotient.exists_rep _ (path.homotopic.setoid Yq.basepoint Yq.basepoint) y_loop.hom),
  let x_loop_rep : path Xp.basepoint Xp.basepoint := {
    to_fun := λt, classical.some (h_f_surj (y_loop_rep t)),
    continuous_to_fun := sorry,
    source' :=
      begin
        simp,
        -- classical.some_spec
        sorry,
      end,
    target' :=
      begin
        simp,
        -- classical.some_spec
        sorry,
      end,
  },
  let x_loop : fundamental_group Xp :=
    sorry, --@quotient.mk _ (path.homotopic.setoid Xp.basepoint Xp.basepoint) x_loop_rep,
  apply exists.intro x_loop,
  sorry,
end


import ..fglib
import ..basic
import ..linear_space
import ..matrix_representation

namespace FG

/- ## Example : addition of integers -/

/- `ℤ` is a group under addition -/

namespace example_int

structure group_int : Type :=
( x : ℤ )

namespace group_int

-- @[simps] instance : has_coe int group_int :=
-- { coe := λ x, { x := x } }
-- @[simps] instance : has_coe group_int int :=
-- { coe := λ x, x.x }

@[simp] def one : group_int := { x := int.zero }
@[simp] def mul (a b : group_int) : group_int := { x := int.add a.x b.x }
@[simp] def inv (a : group_int) : group_int := { x := int.neg a.x }

@[ext] theorem ext (a b : group_int) : a.x = b.x → a = b :=
begin
  intro h,
  cases' a with a,
  cases' b with b,
  simp at h,
  rw h
end

@[simp] lemma ext_iff (a b : group_int) : a.x = b.x ↔ a = b :=
iff.intro (ext a b) (by intro h; rw h)

instance : group group_int :=
{ one := one,
  mul := mul,
  inv := inv,
  one_mul := by intro a; cases' a; simp; refl,
  mul_one := by intro a; cases' a; simp; refl,
  mul_assoc := by intros a b c; simp; ring,
  mul_left_inv := begin
    intro a,
    have h : mul (inv a) a = one := begin
      cases' a,
      simp,
      apply int.add_group.add_left_neg
    end,
    exact h
  end }

/- Here is a representation -/
def rep : matrix_representation 1 group_int :=
{ f := λx, ⟨![![1, x.x], ![0, 1]], by square_matrix.invertible_det2⟩,
  id_mapped := begin
    apply invertible_matrix.ext,
    simp,
    rw ←matrix.diagonal_one,
    funext i j,
    fin_cases i,
    repeat { fin_cases j, repeat { refl } }
  end,
  mul_mapped := begin
    intros z₁ z₂,
    apply invertible_matrix.ext,
    simp only [invertible_matrix.mul, invertible_matrix.group_mul],
    cases' z₁ with x,
    cases' z₂ with y,
    have h : ({x := x} : group_int) * {x := y} = {x := x + y} := by refl,
    rw h,
    funext i j,
    fin_cases i,
    { fin_cases j,
      { simp [vec.smul] },
      { simp [vec.smul, add_comm] } },
    { fin_cases j,
      { simp [vec.smul] },
      { simp [vec.smul] }
    }
  end }

/- The representation is reducible -/
@[simp] def P : square_matrix 1 := ![![1, 0], ![0, 0]]

lemma rep.is_reducible_by_P :
  rep.is_reducible_by P :=
begin
  intro x,
  cases' x,
  funext i j,
  fin_cases i,
  repeat { fin_cases j,
    repeat { simp [rep, vec.smul] } }
end

example : rep.is_reducible :=
begin
  use P,
  exact rep.is_reducible_by_P
end

/- But it is not completely reducible -/
example : ¬rep.is_completely_reducible :=
begin
  intro h,
  have h₁ := rep.orthogonal_completely_reducible P h rep.is_reducible_by_P,
  have h₂ : ¬rep.is_reducible_by (1 - P) :=
  begin
    apply iff.elim_right not_forall,
    use ⟨2⟩,
    have h₁ : (1 - P) = ![![0, 0], ![0, 1]] :=
    begin
      funext i j,
      fin_cases i,
      repeat { fin_cases j,
        repeat { simp [matrix.vec_head, matrix.vec_tail] } }
    end,
    have h₂ : (rep.f ⟨2⟩).val = ![![1, 2], ![0, 1]] :=
    begin
      simp [rep],
      funext i j,
      fin_cases i,
      repeat { fin_cases j,
        repeat { simp } }
    end,
    have h₃ := by calc (1 - P) * (rep.f ⟨2⟩).val * (1 - P) = ![![0, 0], ![0, 1]] * ![![1, 2], ![0, 1]] * ![![0, 0], ![0, 1]]
        : by rw [h₁, h₂]
      ... = ![![0, 0], ![0, 1]]
        : begin
          funext i j,
          repeat { fin_cases j,
            repeat { simp [vec.smul, matrix.vec_head, matrix.vec_tail] } }
        end,
    have h₄ : (rep.f ⟨2⟩).val * (1 - P) = ![![0, 2], ![0, 1]] :=
      begin
        simp [rep],
        funext i j,
        repeat { fin_cases j,
          repeat { simp [vec.smul, matrix.vec_head, matrix.vec_tail] } }
      end,
    rw [h₃, h₄],
    intro h₅,
    apply_fun (λx, x 0 1) at h₅,
    simp at h₅,
    exact h₅
  end,
  exact h₂ h₁
end

end group_int

end example_int

end FG


import .struc

open profinite

structure carry_struc (input : profinite) : Type :=
( init : twoadic )
( carry_add : (twoadic.prod input).map twoadic )
( output : input.map boolp )

def add_seq_aux (x y : ℕ → bool) : ℕ → bool × bool
| 0 := (bxor (x 0) (y 0), x 0 && y 0)
| (n+1) := let carry := (add_seq_aux n).2 in
  let a := x (n + 1), b := y (n + 1) in
  (bxor a (bxor b carry), (a && b) || (b && carry) || (a && carry))

def add_seq (x y : ℕ → bool) : ℕ → bool :=
λ n, (add_seq_aux x y n).1

def fin_add_seq_aux {n : ℕ} (x y : fin n → bool) : fin n → bool × bool
| ⟨0, h⟩ := (bxor (x ⟨0, h⟩) (y ⟨0, h⟩), x ⟨0, h⟩ && y ⟨0, h⟩)
| ⟨k+1, h⟩ := let carry :=
    (fin_add_seq_aux ⟨k, lt_trans (nat.lt_succ_self _) h⟩).2 in
  let a := x ⟨k+1, h⟩, b := y ⟨k+1, h⟩ in
  (bxor a (bxor b carry), (a && b) || (b && carry) || (a && carry))

def fin_add_seq {n : ℕ} (x y : fin n → bool) : fin n → bool :=
λ i, (fin_add_seq_aux x y i).1

lemma fin_add_seq_eq_add_seq_aux {n : ℕ} (x y : ℕ → bool) : ∀ (i : fin n),
  fin_add_seq (λ i, x i) (λ i, y i) i = add_seq x y i ∧
    (fin_add_seq_aux (λ i, x i) (λ i, y i) i).2 =
      (add_seq_aux x y i).2
| ⟨0, h⟩ :=
 by simp [fin_add_seq, fin_add_seq_aux, add_seq, add_seq_aux]
| ⟨(n+1), h⟩ :=
begin
  cases fin_add_seq_eq_add_seq_aux ⟨n, lt_trans (nat.lt_succ_self _) h⟩ with H1 H2,
  clear_aux_decl,
  simp [fin_add_seq, fin_add_seq_aux, add_seq, add_seq_aux] at *,
  simp [H1, H2]
end

lemma fin_add_seq_eq_add_seq {n : ℕ} (x y : ℕ → bool) : ∀ (i : fin n),
  fin_add_seq (λ i, x i) (λ i, y i) i = add_seq x y i :=
λ i, (fin_add_seq_eq_add_seq_aux x y i).1

lemma finset.sup_id_mem (s : finset ℕ) : ∀ (hs : s.nonempty), s.sup id ∈ s :=
finset.induction_on s (by simp) $
(λ a s has ih, begin
  clear ih has,
  apply finset.induction_on s,
  { simp },
  { intros b s hbs ih _,
    simp at *,
    cases ih with ih ih,
    { cases le_total b a with hba hba,
      { tauto },
      { have : s.sup id ≤ a,
        { rw [finset.sup_le_iff],
          simpa },
        rw [← sup_assoc, sup_eq_right.2 hba, sup_eq_left.2 (le_trans this hba)],
        simp * } },
    { cases le_total b a with hba hba,
      { rw [← sup_assoc, sup_eq_left.2 hba],
        simp * },
      { cases le_total b (s.sup id) with hbs hbs,
        { rw [sup_eq_right.2 hbs], simp * },
        { rw [sup_eq_left.2 hbs, sup_eq_right.2 hba],
          simp * } } } }
end)

def divtwo : twoadic.map twoadic :=
{ to_fun := λ f i, f (i + 1),
  preimage := λ C,
  { s := C.s.image nat.succ,
    S := C.S.map ⟨λ f i, f ⟨nat.pred i.1, begin have := i.2,
      simp at this,
      cases this with a ha,
      simp [← ha.2, ha.1],
       end⟩, begin
         intros x y hxy,
         simp [function.funext_iff] at *,
         intros x h,
         exact hxy _ _ ⟨h, rfl⟩,
       end⟩  },
  continuous' := begin
   intros x hx,
    dsimp [twoadic, clopen.to_set] at *,
    simp [function.swap, function.funext_iff],
    split,
    { intro h,
      refine ⟨_, h, _⟩,
      simp },
    { rintros ⟨a, ha, ha₂⟩,
      convert ha,
      funext,
      have := ha₂ _ _ ⟨i.2, rfl⟩,
      cases i, exact this.symm }
  end }

def twoadic_add : (twoadic.prod twoadic).map twoadic :=
{ to_fun := λ x, add_seq x.1 x.2,
  preimage := λ x, show clopen (twoadic.prod twoadic), from
  { s := let t := finset.range (x.s.sup id + 1) in
    ⟨(t.map ⟨sum.inl, by intros _ _ h; injection h⟩).1 +
     (t.map ⟨sum.inr, by intros _ _ h; injection h⟩).1,
    (multiset.nodup.add_iff (finset.nodup _) (finset.nodup _)).2 (λ x h₁ h₂, begin
      simp only [finset.map_val, finset.range_coe, function.embedding.coe_fn_mk, multiset.mem_map, multiset.mem_range,
        finset.lt_sup_iff, id.def, exists_prop] at *,
      rcases h₁ with ⟨a, _, rfl⟩,
      rcases h₂ with ⟨s, _, _, h⟩, end)⟩,
    S := finset.univ.filter (λ f,
      let n : ℕ := x.s.sup id in
      let a : fin (n+1) → bool := λ i, f ⟨sum.inl (i : ℕ), begin
        cases i with i hi,
        simp [sum.inl.inj_eq, n] at *,
        rw [nat.lt_succ_iff] at hi,
        cases lt_or_eq_of_le hi with hi hi,
        { right,
          use n,
          simp only [hi, and_true],
          apply finset.sup_id_mem _ _,
          apply finset.nonempty_of_ne_empty,
          intro h; simp * at * },
        { simp * at * }
        end⟩ in
      let b : fin (n+1) → bool := λ i, f ⟨sum.inr (i : ℕ), begin
        cases i with i hi,
        simp [sum.inr.inj_eq, n] at *,
        rw [nat.lt_succ_iff] at hi,
        cases lt_or_eq_of_le hi with hi hi,
        { right,
          use n,
          simp only [hi, and_true],
          apply finset.sup_id_mem _ _,
          apply finset.nonempty_of_ne_empty,
          intro h; simp * at * },
        { simp * at * }
        end⟩ in
      let a_add_b : (x.s : set twoadic.ι) → bool :=
        λ i, fin_add_seq a b ⟨i.1, nat.lt_succ_of_le (begin
          dsimp [n],
          refine @finset.le_sup _ _ _ _ _ id _ _,
          exact i.2
        end)⟩ in
      a_add_b ∈ x.S) },
  continuous' := begin
    dsimp [clopen.to_set],
    intros x c,
    simp,
    rw [iff_iff_eq],
    congr' 1,
    funext i,
    dsimp [twoadic, function.swap, profinite.prod],
    rw [fin_add_seq_eq_add_seq],
    simp,
  end }

@[simps] def xor_map : (boolp.prod boolp).map boolp :=
{ to_fun := λ x, bxor x.1 x.2,
  preimage := λ C, let C' : finset bool := finset.univ.filter (λ x, x ∈ C.to_set) in
  { s :=
    if tt ∈ C'
      then if ff ∈ C' then ∅
      else {sum.inl (), sum.inr ()}
    else if ff ∈ C' then {sum.inl (), sum.inr ()}
    else {sum.inl ()},
    S := if h₁ : tt ∈ C'
      then if h₂ : ff ∈ C' then finset.univ
      else begin
        rw [if_pos h₁, if_neg h₂],
        exact {λ x, sum.elim (λ _, tt) (λ _, ff) x.1,
               λ x, sum.elim (λ _, ff) (λ _, tt) x.1}
      end
    else if h₂ : ff ∈ C' then begin
      rw [if_neg h₁, if_pos h₂],
      exact {λ x, sum.elim (λ _, ff) (λ _, ff) x.1,
             λ x, sum.elim (λ _, tt) (λ _, tt) x.1}
      end
      else ∅ },
  continuous' := begin
    dsimp [boolp, profinite.prod, coe_sort, has_coe_to_sort.coe, clopen.to_set],
    intros x c, cases c with s S,
    dsimp at *,
    revert x s S,
    exact dec_trivial
  end }

@[simps] def carry_struc.to_propagate_struc {input : profinite} (struc : carry_struc input) :
  propagate_struc input twoadic :=
{ init := struc.init,
  transition := diag.comp ((prodmapm struc.carry_add fstm).comp twoadic_add),
  output := begin
    have f := struc.output,
    have g := prodmapm (twoadic.projm (show ℕ, from 0)) f,
    exact g.comp xor_map,
  end }

@[simps] def add_struc {X : profinite} (p q : carry_struc X) :
  carry_struc X :=
{ init := twoadic_add (p.init, q.init),
  carry_add := diag.comp ((prodmapm p.carry_add q.carry_add).comp twoadic_add),
  output := diag.comp ((prodmapm p.output q.output).comp xor_map) }
--FALSE
def nth_state_add_struc {X : profinite} (p q : carry_struc X) (x : ℕ → X)
  (i : ℕ) : (add_struc p q).to_propagate_struc.nth_state x i =
  twoadic_add (p.to_propagate_struc.nth_state x i, q.to_propagate_struc.nth_state x i) :=
begin
  induction i with i ih,
  { dsimp [propagate_struc.nth_state, add_struc, carry_struc.to_propagate_struc],
    refl },
  { rw [propagate_struc.nth_state, ih, propagate_struc.nth_state,
      propagate_struc.nth_state],
    dsimp [diag, profinite.map.comp, coe_fn, has_coe_to_fun.coe, prodmapm, fstm,
      twoadic_add],

     }

end


example : True := by
  unfold Nat.add

example (h : x = 2 * y) : True := by
  unfold Nat.add at h


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.fully_faithful

/-!
# Functors which reflect isomorphisms

A functor `F` reflects isomorphisms if whenever `F.map f` is an isomorphism, `f` was too.

It is formalized as a `Prop` valued typeclass `reflects_isomorphisms F`.

Any fully faithful functor reflects isomorphisms.
-/

open category_theory

namespace category_theory

universes v₁ v₂ v₃ u₁ u₂ u₃

variables {C : Type u₁} [category.{v₁} C]

section reflects_iso
variables {D : Type u₂} [category.{v₂} D]
variables {E : Type u₃} [category.{v₃} E]

/--
Define what it means for a functor `F : C ⥤ D` to reflect isomorphisms: for any
morphism `f : A ⟶ B`, if `F.map f` is an isomorphism then `f` is as well.
Note that we do not assume or require that `F` is faithful.
-/
class reflects_isomorphisms (F : C ⥤ D) : Prop :=
(reflects : Π {A B : C} (f : A ⟶ B) [is_iso (F.map f)], is_iso f)

/-- If `F` reflects isos and `F.map f` is an iso, then `f` is an iso. -/
lemma is_iso_of_reflects_iso {A B : C} (f : A ⟶ B) (F : C ⥤ D)
  [is_iso (F.map f)] [reflects_isomorphisms F] :
  is_iso f :=
reflects_isomorphisms.reflects F f

@[priority 100]
instance of_full_and_faithful (F : C ⥤ D) [full F] [faithful F] : reflects_isomorphisms F :=
{ reflects := λ X Y f i, by exactI
  ⟨⟨F.preimage (inv (F.map f)), ⟨F.map_injective (by simp), F.map_injective (by simp)⟩⟩⟩ }

instance (F : C ⥤ D) (G : D ⥤ E) [reflects_isomorphisms F] [reflects_isomorphisms G] :
  reflects_isomorphisms (F ⋙ G) :=
⟨λ _ _ f (hf : is_iso (G.map _)),
  by { resetI, haveI := is_iso_of_reflects_iso (F.map f) G, exact is_iso_of_reflects_iso f F }⟩

end reflects_iso

end category_theory


/-
Copyright (c) 2022 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Damiano Testa
-/
import tactic.interactive

/-! `congrm`: `congr` with pattern-matching

`congrm e` gives to the use the functionality of using `congr` with an expression `e` "guiding"
`congr` through the matching.  This allows more flexibility than `congr' n`, which enters uniformly
through `n` iterations.  Instead, we can guide the matching deeper on some parts of the expression
and stop earlier on other parts.
-/

namespace tactic

/--
For each element of `list congr_arg_kind` that is `eq`, add a pair `(g, pat)` to the
final list.  Otherwise, discard an appropriate number of initial terms from each list
(possibly none from the first) and repeat.

`pat` is the given pattern-piece at the appropriate location, extracted from the last `list expr`.
It appears to be the list of arguments of a function application.

`g` is possibly the proof of an equality?  It is extracted from the first `list expr`.
-/
private meta def extract_subgoals : list expr → list congr_arg_kind → list expr →
  tactic (list (expr × expr))
| (_ :: _ :: g :: prf_args) (congr_arg_kind.eq :: kinds)             (pat :: pat_args) :=
  (λ rest, (g, pat) :: rest) <$> extract_subgoals prf_args kinds pat_args
| (_ :: prf_args)           (congr_arg_kind.fixed :: kinds)          (_ :: pat_args) :=
  extract_subgoals prf_args kinds pat_args
| prf_args                  (congr_arg_kind.fixed_no_param :: kinds) (_ :: pat_args) :=
  extract_subgoals prf_args kinds pat_args
| (_ :: _ :: prf_args)      (congr_arg_kind.cast :: kinds)           (_ :: pat_args) :=
  extract_subgoals prf_args kinds pat_args
| _ _ [] := pure []
| _ _ _ := fail "unsupported congr lemma"

/--
`equate_with_pattern_core pat` solves a single goal of the form `lhs = rhs`
(assuming that `lhs` and `rhs` are unifiable with `pat`)
by applying congruence lemmas until `pat` is a metavariable.
Returns the list of metavariables for the new subgoals at the leafs.
Calls `set_goals []` at the end.
-/
meta def equate_with_pattern_core : expr → tactic (list expr) | pat :=
(applyc ``subsingleton.elim >> pure []) <|>
(applyc ``rfl >> pure []) <|>
if pat.is_mvar || pat.get_delayed_abstraction_locals.is_some then do
  try $ applyc ``_root_.propext,
  get_goals <* set_goals []
else match pat with
| expr.app _ _ := do
  cl ← mk_specialized_congr_lemma pat,
  H_congr_lemma ← assertv `H_congr_lemma cl.type cl.proof,
  [prf] ← get_goals,
  apply H_congr_lemma <|> fail "could not apply congr_lemma",
  all_goals' $ try $ clear H_congr_lemma,  -- given the `set_goals []` that follows, is this needed?
  set_goals [],
  prf ← instantiate_mvars prf,
  subgoals ← extract_subgoals prf.get_app_args cl.arg_kinds pat.get_app_args,
  subgoals ← subgoals.mmap (λ ⟨subgoal, subpat⟩, do
    set_goals [subgoal],
    equate_with_pattern_core subpat),
  pure subgoals.join
| expr.lam _ _ _ body := do
  applyc ``_root_.funext,
  x ← intro pat.binding_name,
  equate_with_pattern_core $ body.instantiate_var x
| expr.pi _ _ _ codomain := do
  applyc ``_root_.pi_congr,
  x ← intro pat.binding_name,
  equate_with_pattern_core $ codomain.instantiate_var x
| _ := do
  pat ← pp pat,
  fail $ to_fmt "unsupported pattern:\n" ++ pat
end

/--
`equate_with_pattern pat` solves a single goal of the form `lhs = rhs`
(assuming that `lhs` and `rhs` are unifiable with `pat`)
by applying congruence lemmas until `pat` is a metavariable.
The subgoals for the leafs are prepended to the goals.
--/
meta def equate_with_pattern (pat : expr) : tactic unit := do
congr_subgoals ← solve1 (equate_with_pattern_core pat),
gs ← get_goals,
set_goals $ congr_subgoals ++ gs

end tactic

namespace tactic.interactive
open tactic interactive
setup_tactic_parser

/--
Assume that the goal is of the form `lhs = rhs` or `lhs ↔ rhs`.
`congrm e` takes an expression `e` containing placeholders `_` and scans `e, lhs, rhs` in parallel.

It matches both `lhs` and `rhs` to the pattern `e`, and produces one goal for each placeholder,
stating that the corresponding subexpressions in `lhs` and `rhs` are equal.

Examples:
```lean
example {a b c d : ℕ} :
  nat.pred a.succ * (d + (c + a.pred)) = nat.pred b.succ * (b + (c + d.pred)) :=
begin
  congrm nat.pred (nat.succ _) * (_ + _),
/-  Goals left:
⊢ a = b
⊢ d = b
⊢ c + a.pred = c + d.pred
-/
  sorry,
  sorry,
  sorry,
end

example {a b : ℕ} (h : a = b) : (λ y : ℕ, ∀ z, a + a = z) = (λ x, ∀ z, b + a = z) :=
begin
  congrm λ x, ∀ w, _ + a = w,
  -- produces one goal for the underscore: ⊢ a = b
  exact h,
end
```
-/
meta def congrm (arg : parse texpr) : tactic unit := do
try $ applyc ``_root_.eq.to_iff,
`(@eq %%ty _ _) ← target | fail "congrm: goal must be an equality or iff",
ta ← to_expr ``((%%arg : %%ty)) tt ff,
equate_with_pattern ta

add_tactic_doc
{ name := "congrm",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.congrm],
  tags := ["congruence"] }

end tactic.interactive


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import topology.sheaves.presheaf
import category_theory.adjunction.fully_faithful

/-!
# Presheafed spaces

Introduces the category of topological spaces equipped with a presheaf (taking values in an
arbitrary target category `C`.)

We further describe how to apply functors and natural transformations to the values of the
presheaves.
-/

universes w v u

open category_theory
open Top
open topological_space
open opposite
open category_theory.category category_theory.functor

variables (C : Type u) [category.{v} C]

local attribute [tidy] tactic.op_induction' tactic.auto_cases_opens

namespace algebraic_geometry

/-- A `PresheafedSpace C` is a topological space equipped with a presheaf of `C`s. -/
structure PresheafedSpace :=
(carrier : Top.{w})
(presheaf : carrier.presheaf C)

variables {C}

namespace PresheafedSpace

attribute [protected] presheaf

instance coe_carrier : has_coe (PresheafedSpace.{w v u} C) Top.{w} :=
{ coe := λ X, X.carrier }

@[simp] lemma as_coe (X : PresheafedSpace.{w v u} C) : X.carrier = (X : Top.{w}) := rfl
@[simp] lemma mk_coe (carrier) (presheaf) : (({ carrier := carrier, presheaf := presheaf } :
  PresheafedSpace.{v} C) : Top.{v}) = carrier := rfl

instance (X : PresheafedSpace.{v} C) : topological_space X := X.carrier.str

/-- The constant presheaf on `X` with value `Z`. -/
def const (X : Top) (Z : C) : PresheafedSpace C :=
{ carrier := X,
  presheaf :=
  { obj := λ U, Z,
    map := λ U V f, 𝟙 Z, } }

instance [inhabited C] : inhabited (PresheafedSpace C) := ⟨const (Top.of pempty) default⟩

/-- A morphism between presheafed spaces `X` and `Y` consists of a continuous map
    `f` between the underlying topological spaces, and a (notice contravariant!) map
    from the presheaf on `Y` to the pushforward of the presheaf on `X` via `f`. -/
structure hom (X Y : PresheafedSpace.{w v u} C) :=
(base : (X : Top.{w}) ⟶ (Y : Top.{w}))
(c : Y.presheaf ⟶ base _* X.presheaf)

@[ext] lemma ext {X Y : PresheafedSpace C} (α β : hom X Y)
  (w : α.base = β.base)
  (h : α.c ≫ (whisker_right (eq_to_hom (by rw w)) _) = β.c) :
  α = β :=
begin
  cases α, cases β,
  dsimp [presheaf.pushforward_obj] at *,
  tidy, -- TODO including `injections` would make tidy work earlier.
end

lemma hext {X Y : PresheafedSpace C} (α β : hom X Y)
  (w : α.base = β.base)
  (h : α.c == β.c) :
  α = β :=
by { cases α, cases β, congr, exacts [w,h] }

.

/-- The identity morphism of a `PresheafedSpace`. -/
def id (X : PresheafedSpace.{w v u} C) : hom X X :=
{ base := 𝟙 (X : Top.{w}),
  c := eq_to_hom (presheaf.pushforward.id_eq X.presheaf).symm }

instance hom_inhabited (X : PresheafedSpace C) : inhabited (hom X X) := ⟨id X⟩

/-- Composition of morphisms of `PresheafedSpace`s. -/
def comp {X Y Z : PresheafedSpace C} (α : hom X Y) (β : hom Y Z) : hom X Z :=
{ base := α.base ≫ β.base,
  c := β.c ≫ (presheaf.pushforward _ β.base).map α.c }

lemma comp_c {X Y Z : PresheafedSpace C} (α : hom X Y) (β : hom Y Z) :
  (comp α β).c = β.c ≫ (presheaf.pushforward _ β.base).map α.c := rfl

variables (C)

section
local attribute [simp] id comp

/- The proofs below can be done by `tidy`, but it is too slow,
   and we don't have a tactic caching mechanism. -/
/-- The category of PresheafedSpaces. Morphisms are pairs, a continuous map and a presheaf map
    from the presheaf on the target to the pushforward of the presheaf on the source. -/
instance category_of_PresheafedSpaces : category (PresheafedSpace.{v v u} C) :=
{ hom := hom,
  id := id,
  comp := λ X Y Z f g, comp f g,
  id_comp' := λ X Y f, begin
    ext1,
    { rw comp_c,
      erw eq_to_hom_map,
      simp only [eq_to_hom_refl, assoc, whisker_right_id'],
      erw [comp_id, comp_id] },
    apply id_comp
  end,
  comp_id' := λ X Y f, begin
    ext1,
    { rw comp_c,
      erw congr_hom (presheaf.id_pushforward _) f.c,
      simp only [comp_id, functor.id_map, eq_to_hom_refl, assoc, whisker_right_id'],
      erw eq_to_hom_trans_assoc,
      simp only [id_comp, eq_to_hom_refl],
      erw comp_id },
    apply comp_id
  end,
  assoc' := λ W X Y Z f g h, begin
    ext1,
    repeat {rw comp_c},
    simp only [eq_to_hom_refl, assoc, functor.map_comp, whisker_right_id'],
    erw comp_id,
    congr,
    refl
  end }

end

variables {C}
local attribute [simp] eq_to_hom_map

@[simp] lemma id_base (X : PresheafedSpace.{v v u} C) :
  ((𝟙 X) : X ⟶ X).base = 𝟙 (X : Top.{v}) := rfl

lemma id_c (X : PresheafedSpace.{v v u} C) :
  ((𝟙 X) : X ⟶ X).c = eq_to_hom (presheaf.pushforward.id_eq X.presheaf).symm := rfl

@[simp] lemma id_c_app (X : PresheafedSpace.{v v u} C) (U) :
  ((𝟙 X) : X ⟶ X).c.app U = X.presheaf.map
    (eq_to_hom (by { induction U using opposite.rec, cases U, refl })) :=
by { induction U using opposite.rec, cases U, simp only [id_c], dsimp, simp, }

@[simp] lemma comp_base {X Y Z : PresheafedSpace.{v v u} C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g).base = f.base ≫ g.base := rfl

instance (X Y : PresheafedSpace.{v v u} C) : has_coe_to_fun (X ⟶ Y) (λ _, X → Y) :=
⟨λ f, f.base⟩

lemma coe_to_fun_eq {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) : (f : X → Y) = f.base := rfl

-- The `reassoc` attribute was added despite the LHS not being a composition of two homs,
-- for the reasons explained in the docstring.
/-- Sometimes rewriting with `comp_c_app` doesn't work because of dependent type issues.
In that case, `erw comp_c_app_assoc` might make progress.
The lemma `comp_c_app_assoc` is also better suited for rewrites in the opposite direction. -/
@[reassoc, simp] lemma comp_c_app {X Y Z : PresheafedSpace.{v v u} C} (α : X ⟶ Y) (β : Y ⟶ Z) (U) :
  (α ≫ β).c.app U = (β.c).app U ≫ (α.c).app (op ((opens.map (β.base)).obj (unop U))) := rfl

lemma congr_app {X Y : PresheafedSpace.{v v u} C} {α β : X ⟶ Y} (h : α = β) (U) :
  α.c.app U = β.c.app U ≫ X.presheaf.map (eq_to_hom (by subst h)) :=
by { subst h, dsimp, simp, }

section
variables (C)

/-- The forgetful functor from `PresheafedSpace` to `Top`. -/
@[simps]
def forget : PresheafedSpace.{v v u} C ⥤ Top :=
{ obj := λ X, (X : Top.{v}),
  map := λ X Y f, f.base }

end

section iso

variables {X Y : PresheafedSpace.{v v u} C}

/--
An isomorphism of PresheafedSpaces is a homeomorphism of the underlying space, and a
natural transformation between the sheaves.
-/
@[simps hom inv]
def iso_of_components (H : X.1 ≅ Y.1) (α : H.hom _* X.2 ≅ Y.2) : X ≅ Y :=
{ hom := { base := H.hom, c := α.inv },
  inv := { base := H.inv,
    c := presheaf.to_pushforward_of_iso H α.hom },
  hom_inv_id' := by { ext, { simp, erw category.id_comp, simpa }, simp },
  inv_hom_id' :=
  begin
    ext x,
    induction x using opposite.rec,
    simp only [comp_c_app, whisker_right_app, presheaf.to_pushforward_of_iso_app,
      nat_trans.comp_app, eq_to_hom_app, id_c_app, category.assoc],
    erw [← α.hom.naturality],
    have := nat_trans.congr_app (α.inv_hom_id) (op x),
    cases x,
    rw nat_trans.comp_app at this,
    convert this,
    { dsimp, simp },
    { simp },
    { simp }
  end }

/-- Isomorphic PresheafedSpaces have natural isomorphic presheaves. -/
@[simps]
def sheaf_iso_of_iso (H : X ≅ Y) : Y.2 ≅ H.hom.base _* X.2 :=
{ hom := H.hom.c,
  inv := presheaf.pushforward_to_of_iso ((forget _).map_iso H).symm H.inv.c,
  hom_inv_id' :=
  begin
    ext U,
    have := congr_app H.inv_hom_id U,
    simp only [comp_c_app, id_c_app,
      eq_to_hom_map, eq_to_hom_trans] at this,
    generalize_proofs h at this,
    simpa using congr_arg (λ f, f ≫ eq_to_hom h.symm) this,
  end,
  inv_hom_id' :=
  begin
    ext U,
    simp only [presheaf.pushforward_to_of_iso_app, nat_trans.comp_app, category.assoc,
      nat_trans.id_app, H.hom.c.naturality],
    have := congr_app H.hom_inv_id ((opens.map H.hom.base).op.obj U),
    generalize_proofs h at this,
    simpa using congr_arg (λ f, f ≫ X.presheaf.map (eq_to_hom h.symm)) this
  end }

instance base_is_iso_of_iso (f : X ⟶ Y) [is_iso f] : is_iso f.base :=
is_iso.of_iso ((forget _).map_iso (as_iso f))

instance c_is_iso_of_iso (f : X ⟶ Y) [is_iso f] : is_iso f.c :=
is_iso.of_iso (sheaf_iso_of_iso (as_iso f))

/-- This could be used in conjunction with `category_theory.nat_iso.is_iso_of_is_iso_app`. -/
lemma is_iso_of_components (f : X ⟶ Y) [is_iso f.base] [is_iso f.c] : is_iso f :=
begin
  convert is_iso.of_iso (iso_of_components (as_iso f.base) (as_iso f.c).symm),
  ext, { simpa }, { simp },
end

end iso

section restrict

/--
The restriction of a presheafed space along an open embedding into the space.
-/
@[simps]
def restrict {U : Top} (X : PresheafedSpace.{v v u} C)
  {f : U ⟶ (X : Top.{v})} (h : open_embedding f) : PresheafedSpace C :=
{ carrier := U,
  presheaf := h.is_open_map.functor.op ⋙ X.presheaf }

/--
The map from the restriction of a presheafed space.
-/
@[simps]
def of_restrict {U : Top} (X : PresheafedSpace.{v v u} C)
  {f : U ⟶ (X : Top.{v})} (h : open_embedding f) :
  X.restrict h ⟶ X :=
{ base := f,
  c := { app := λ V, X.presheaf.map (h.is_open_map.adjunction.counit.app V.unop).op,
    naturality' := λ U V f, show _ = _ ≫ X.presheaf.map _,
      by { rw [← map_comp, ← map_comp], refl } } }

instance of_restrict_mono {U : Top} (X : PresheafedSpace C) (f : U ⟶ X.1)
   (hf : open_embedding f) : mono (X.of_restrict hf) :=
 begin
   haveI : mono f := (Top.mono_iff_injective _).mpr hf.inj,
   constructor,
   intros Z g₁ g₂ eq,
   ext V,
   { induction V using opposite.rec,
     have hV : (opens.map (X.of_restrict hf).base).obj (hf.is_open_map.functor.obj V) = V,
     { ext1, exact set.preimage_image_eq _ hf.inj },
     haveI : is_iso (hf.is_open_map.adjunction.counit.app
               (unop (op (hf.is_open_map.functor.obj V)))) :=
       (nat_iso.is_iso_app_of_is_iso (whisker_left
         hf.is_open_map.functor hf.is_open_map.adjunction.counit) V : _),
     have := PresheafedSpace.congr_app eq (op (hf.is_open_map.functor.obj V)),
     simp only [PresheafedSpace.comp_c_app, PresheafedSpace.of_restrict_c_app, category.assoc,
       cancel_epi] at this,
     have h : _ ≫ _ = _ ≫ _ ≫ _ :=
       congr_arg (λ f, (X.restrict hf).presheaf.map (eq_to_hom hV).op ≫ f) this,
     erw [g₁.c.naturality, g₂.c.naturality_assoc] at h,
     simp only [presheaf.pushforward_obj_map, eq_to_hom_op,
       category.assoc, eq_to_hom_map, eq_to_hom_trans] at h,
     rw ←is_iso.comp_inv_eq at h,
     simpa using h },
   { have := congr_arg PresheafedSpace.hom.base eq,
     simp only [PresheafedSpace.comp_base, PresheafedSpace.of_restrict_base] at this,
     rw cancel_mono at this,
     exact this }
 end

lemma of_restrict_top_c (X : PresheafedSpace C) :
  (X.of_restrict (opens.open_embedding ⊤)).c = eq_to_hom
    (by { rw [restrict_top_presheaf, ←presheaf.pushforward.comp_eq],
          erw iso.inv_hom_id, rw presheaf.pushforward.id_eq }) :=
  /- another approach would be to prove the left hand side
     is a natural isoomorphism, but I encountered a universe
     issue when `apply nat_iso.is_iso_of_is_iso_app`. -/
begin
  ext U, change X.presheaf.map _ = _, convert eq_to_hom_map _ _ using 1,
  congr, simpa,
  { induction U using opposite.rec, dsimp, congr, ext,
    exact ⟨ λ h, ⟨⟨x,trivial⟩,h,rfl⟩, λ ⟨⟨_,_⟩,h,rfl⟩, h ⟩ },
  /- or `rw [opens.inclusion_top_functor, ←comp_obj, ←opens.map_comp_eq],
         erw iso.inv_hom_id, cases U, refl` after `dsimp` -/
end

/--
The map to the restriction of a presheafed space along the canonical inclusion from the top
subspace.
-/
@[simps]
def to_restrict_top (X : PresheafedSpace C) :
  X ⟶ X.restrict (opens.open_embedding ⊤) :=
{ base := (opens.inclusion_top_iso X.carrier).inv,
  c := eq_to_hom (restrict_top_presheaf X) }

/--
The isomorphism from the restriction to the top subspace.
-/
@[simps]
def restrict_top_iso (X : PresheafedSpace C) :
  X.restrict (opens.open_embedding ⊤) ≅ X :=
{ hom := X.of_restrict _,
  inv := X.to_restrict_top,
  hom_inv_id' := ext _ _ (concrete_category.hom_ext _ _ $ λ ⟨x, _⟩, rfl) $
    by { erw comp_c, rw X.of_restrict_top_c, ext, simp },
  inv_hom_id' := ext _ _ rfl $
    by { erw comp_c, rw X.of_restrict_top_c, ext, simpa [-eq_to_hom_refl] } }

end restrict

/--
The global sections, notated Gamma.
-/
@[simps]
def Γ : (PresheafedSpace.{v v u} C)ᵒᵖ ⥤ C :=
{ obj := λ X, (unop X).presheaf.obj (op ⊤),
  map := λ X Y f, f.unop.c.app (op ⊤) }

lemma Γ_obj_op (X : PresheafedSpace C) : Γ.obj (op X) = X.presheaf.obj (op ⊤) := rfl

lemma Γ_map_op {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) :
  Γ.map f.op = f.c.app (op ⊤) := rfl

end PresheafedSpace

end algebraic_geometry

open algebraic_geometry algebraic_geometry.PresheafedSpace

variables {C}

namespace category_theory

variables {D : Type u} [category.{v} D]

local attribute [simp] presheaf.pushforward_obj

namespace functor

/-- We can apply a functor `F : C ⥤ D` to the values of the presheaf in any `PresheafedSpace C`,
    giving a functor `PresheafedSpace C ⥤ PresheafedSpace D` -/
def map_presheaf (F : C ⥤ D) : PresheafedSpace.{v v u} C ⥤ PresheafedSpace.{v v u} D :=
{ obj := λ X, { carrier := X.carrier, presheaf := X.presheaf ⋙ F },
  map := λ X Y f, { base := f.base, c := whisker_right f.c F }, }

@[simp] lemma map_presheaf_obj_X (F : C ⥤ D) (X : PresheafedSpace C) :
  ((F.map_presheaf.obj X) : Top.{v}) = (X : Top.{v}) := rfl
@[simp] lemma map_presheaf_obj_presheaf (F : C ⥤ D) (X : PresheafedSpace C) :
  (F.map_presheaf.obj X).presheaf = X.presheaf ⋙ F := rfl
@[simp] lemma map_presheaf_map_f (F : C ⥤ D) {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) :
  (F.map_presheaf.map f).base = f.base := rfl
@[simp] lemma map_presheaf_map_c (F : C ⥤ D) {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) :
  (F.map_presheaf.map f).c = whisker_right f.c F := rfl

end functor

namespace nat_trans

/--
A natural transformation induces a natural transformation between the `map_presheaf` functors.
-/
def on_presheaf {F G : C ⥤ D} (α : F ⟶ G) : G.map_presheaf ⟶ F.map_presheaf :=
{ app := λ X,
  { base := 𝟙 _,
    c := whisker_left X.presheaf α ≫ eq_to_hom (presheaf.pushforward.id_eq _).symm } }

-- TODO Assemble the last two constructions into a functor
--   `(C ⥤ D) ⥤ (PresheafedSpace C ⥤ PresheafedSpace D)`
end nat_trans

end category_theory