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

! This file was ported from Lean 3 source module category_theory.monoidal.preadditive
! leanprover-community/mathlib commit 8ef6f08ff8c781c5c07a8b12843710e1a0d8a688
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Preadditive.AdditiveFunctor
import Mathbin.CategoryTheory.Monoidal.Functor

/-!
# Preadditive monoidal categories

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

A monoidal category is `monoidal_preadditive` if it is preadditive and tensor product of morphisms
is linear in both factors.
-/

noncomputable section

open Classical

namespace CategoryTheory

open CategoryTheory.Limits

open CategoryTheory.MonoidalCategory

variable (C : Type _) [Category C] [Preadditive C] [MonoidalCategory C]

#print CategoryTheory.MonoidalPreadditive /-
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- A category is `monoidal_preadditive` if tensoring is additive in both factors.

Note we don't `extend preadditive C` here, as `abelian C` already extends it,
and we'll need to have both typeclasses sometimes.
-/
class MonoidalPreadditive : Prop where
  tensor_zero' : ∀ {W X Y Z : C} (f : W ⟶ X), f ⊗ (0 : Y ⟶ Z) = 0 := by obviously
  zero_tensor' : ∀ {W X Y Z : C} (f : Y ⟶ Z), (0 : W ⟶ X) ⊗ f = 0 := by obviously
  tensor_add' : ∀ {W X Y Z : C} (f : W ⟶ X) (g h : Y ⟶ Z), f ⊗ (g + h) = f ⊗ g + f ⊗ h := by
    obviously
  add_tensor' : ∀ {W X Y Z : C} (f g : W ⟶ X) (h : Y ⟶ Z), (f + g) ⊗ h = f ⊗ h + g ⊗ h := by
    obviously
#align category_theory.monoidal_preadditive CategoryTheory.MonoidalPreadditive
-/

restate_axiom monoidal_preadditive.tensor_zero'

restate_axiom monoidal_preadditive.zero_tensor'

restate_axiom monoidal_preadditive.tensor_add'

restate_axiom monoidal_preadditive.add_tensor'

attribute [simp] monoidal_preadditive.tensor_zero monoidal_preadditive.zero_tensor

variable {C} [MonoidalPreadditive C]

attribute [local simp] monoidal_preadditive.tensor_add monoidal_preadditive.add_tensor

#print CategoryTheory.tensorLeft_additive /-
instance tensorLeft_additive (X : C) : (tensorLeft X).Additive where
#align category_theory.tensor_left_additive CategoryTheory.tensorLeft_additive
-/

#print CategoryTheory.tensorRight_additive /-
instance tensorRight_additive (X : C) : (tensorRight X).Additive where
#align category_theory.tensor_right_additive CategoryTheory.tensorRight_additive
-/

/- warning: category_theory.tensoring_left_additive -> CategoryTheory.tensoringLeft_additive is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] [_inst_2 : CategoryTheory.Preadditive.{u2, u1} C _inst_1] [_inst_3 : CategoryTheory.MonoidalCategory.{u2, u1} C _inst_1] [_inst_4 : CategoryTheory.MonoidalPreadditive.{u1, u2} C _inst_1 _inst_2 _inst_3] (X : C), CategoryTheory.Functor.Additive.{u1, u1, u2, u2} C C _inst_1 _inst_1 _inst_2 _inst_2 (CategoryTheory.Functor.obj.{u2, max u1 u2, u1, max u2 u1} C _inst_1 (CategoryTheory.Functor.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.Functor.category.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.MonoidalCategory.tensoringLeft.{u2, u1} C _inst_1 _inst_3) X)
but is expected to have type
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] [_inst_2 : CategoryTheory.Preadditive.{u2, u1} C _inst_1] [_inst_3 : CategoryTheory.MonoidalCategory.{u2, u1} C _inst_1] [_inst_4 : CategoryTheory.MonoidalPreadditive.{u1, u2} C _inst_1 _inst_2 _inst_3] (X : C), CategoryTheory.Functor.Additive.{u1, u1, u2, u2} C C _inst_1 _inst_1 _inst_2 _inst_2 (Prefunctor.obj.{succ u2, max (succ u1) (succ u2), u1, max u1 u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) (CategoryTheory.Functor.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.CategoryStruct.toQuiver.{max u1 u2, max u1 u2} (CategoryTheory.Functor.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.Category.toCategoryStruct.{max u1 u2, max u1 u2} (CategoryTheory.Functor.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.Functor.category.{u2, u2, u1, u1} C _inst_1 C _inst_1))) (CategoryTheory.Functor.toPrefunctor.{u2, max u1 u2, u1, max u1 u2} C _inst_1 (CategoryTheory.Functor.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.Functor.category.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.MonoidalCategory.tensoringLeft.{u2, u1} C _inst_1 _inst_3)) X)
Case conversion may be inaccurate. Consider using '#align category_theory.tensoring_left_additive CategoryTheory.tensoringLeft_additiveₓ'. -/
instance tensoringLeft_additive (X : C) : ((tensoringLeft C).obj X).Additive where
#align category_theory.tensoring_left_additive CategoryTheory.tensoringLeft_additive

/- warning: category_theory.tensoring_right_additive -> CategoryTheory.tensoringRight_additive is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] [_inst_2 : CategoryTheory.Preadditive.{u2, u1} C _inst_1] [_inst_3 : CategoryTheory.MonoidalCategory.{u2, u1} C _inst_1] [_inst_4 : CategoryTheory.MonoidalPreadditive.{u1, u2} C _inst_1 _inst_2 _inst_3] (X : C), CategoryTheory.Functor.Additive.{u1, u1, u2, u2} C C _inst_1 _inst_1 _inst_2 _inst_2 (CategoryTheory.Functor.obj.{u2, max u1 u2, u1, max u2 u1} C _inst_1 (CategoryTheory.Functor.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.Functor.category.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.MonoidalCategory.tensoringRight.{u2, u1} C _inst_1 _inst_3) X)
but is expected to have type
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] [_inst_2 : CategoryTheory.Preadditive.{u2, u1} C _inst_1] [_inst_3 : CategoryTheory.MonoidalCategory.{u2, u1} C _inst_1] [_inst_4 : CategoryTheory.MonoidalPreadditive.{u1, u2} C _inst_1 _inst_2 _inst_3] (X : C), CategoryTheory.Functor.Additive.{u1, u1, u2, u2} C C _inst_1 _inst_1 _inst_2 _inst_2 (Prefunctor.obj.{succ u2, max (succ u1) (succ u2), u1, max u1 u2} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) (CategoryTheory.Functor.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.CategoryStruct.toQuiver.{max u1 u2, max u1 u2} (CategoryTheory.Functor.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.Category.toCategoryStruct.{max u1 u2, max u1 u2} (CategoryTheory.Functor.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.Functor.category.{u2, u2, u1, u1} C _inst_1 C _inst_1))) (CategoryTheory.Functor.toPrefunctor.{u2, max u1 u2, u1, max u1 u2} C _inst_1 (CategoryTheory.Functor.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.Functor.category.{u2, u2, u1, u1} C _inst_1 C _inst_1) (CategoryTheory.MonoidalCategory.tensoringRight.{u2, u1} C _inst_1 _inst_3)) X)
Case conversion may be inaccurate. Consider using '#align category_theory.tensoring_right_additive CategoryTheory.tensoringRight_additiveₓ'. -/
instance tensoringRight_additive (X : C) : ((tensoringRight C).obj X).Additive where
#align category_theory.tensoring_right_additive CategoryTheory.tensoringRight_additive

/- warning: category_theory.monoidal_preadditive_of_faithful -> CategoryTheory.monoidalPreadditive_of_faithful is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] [_inst_2 : CategoryTheory.Preadditive.{u2, u1} C _inst_1] [_inst_3 : CategoryTheory.MonoidalCategory.{u2, u1} C _inst_1] [_inst_4 : CategoryTheory.MonoidalPreadditive.{u1, u2} C _inst_1 _inst_2 _inst_3] {D : Type.{u3}} [_inst_5 : CategoryTheory.Category.{u4, u3} D] [_inst_6 : CategoryTheory.Preadditive.{u4, u3} D _inst_5] [_inst_7 : CategoryTheory.MonoidalCategory.{u4, u3} D _inst_5] (F : CategoryTheory.MonoidalFunctor.{u4, u2, u3, u1} D _inst_5 _inst_7 C _inst_1 _inst_3) [_inst_8 : CategoryTheory.Faithful.{u4, u2, u3, u1} D _inst_5 C _inst_1 (CategoryTheory.LaxMonoidalFunctor.toFunctor.{u4, u2, u3, u1} D _inst_5 _inst_7 C _inst_1 _inst_3 (CategoryTheory.MonoidalFunctor.toLaxMonoidalFunctor.{u4, u2, u3, u1} D _inst_5 _inst_7 C _inst_1 _inst_3 F))] [_inst_9 : CategoryTheory.Functor.Additive.{u3, u1, u4, u2} D C _inst_5 _inst_1 _inst_6 _inst_2 (CategoryTheory.LaxMonoidalFunctor.toFunctor.{u4, u2, u3, u1} D _inst_5 _inst_7 C _inst_1 _inst_3 (CategoryTheory.MonoidalFunctor.toLaxMonoidalFunctor.{u4, u2, u3, u1} D _inst_5 _inst_7 C _inst_1 _inst_3 F))], CategoryTheory.MonoidalPreadditive.{u3, u4} D _inst_5 _inst_6 _inst_7
but is expected to have type
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] [_inst_2 : CategoryTheory.Preadditive.{u2, u1} C _inst_1] [_inst_3 : CategoryTheory.MonoidalCategory.{u2, u1} C _inst_1] [_inst_4 : CategoryTheory.MonoidalPreadditive.{u1, u2} C _inst_1 _inst_2 _inst_3] {D : Type.{u4}} [_inst_5 : CategoryTheory.Category.{u3, u4} D] [_inst_6 : CategoryTheory.Preadditive.{u3, u4} D _inst_5] [_inst_7 : CategoryTheory.MonoidalCategory.{u3, u4} D _inst_5] (F : CategoryTheory.MonoidalFunctor.{u3, u2, u4, u1} D _inst_5 _inst_7 C _inst_1 _inst_3) [_inst_8 : CategoryTheory.Faithful.{u3, u2, u4, u1} D _inst_5 C _inst_1 (CategoryTheory.LaxMonoidalFunctor.toFunctor.{u3, u2, u4, u1} D _inst_5 _inst_7 C _inst_1 _inst_3 (CategoryTheory.MonoidalFunctor.toLaxMonoidalFunctor.{u3, u2, u4, u1} D _inst_5 _inst_7 C _inst_1 _inst_3 F))] [_inst_9 : CategoryTheory.Functor.Additive.{u4, u1, u3, u2} D C _inst_5 _inst_1 _inst_6 _inst_2 (CategoryTheory.LaxMonoidalFunctor.toFunctor.{u3, u2, u4, u1} D _inst_5 _inst_7 C _inst_1 _inst_3 (CategoryTheory.MonoidalFunctor.toLaxMonoidalFunctor.{u3, u2, u4, u1} D _inst_5 _inst_7 C _inst_1 _inst_3 F))], CategoryTheory.MonoidalPreadditive.{u4, u3} D _inst_5 _inst_6 _inst_7
Case conversion may be inaccurate. Consider using '#align category_theory.monoidal_preadditive_of_faithful CategoryTheory.monoidalPreadditive_of_faithfulₓ'. -/
/-- A faithful additive monoidal functor to a monoidal preadditive category
ensures that the domain is monoidal preadditive. -/
theorem monoidalPreadditive_of_faithful {D} [Category D] [Preadditive D] [MonoidalCategory D]
    (F : MonoidalFunctor D C) [Faithful F.toFunctor] [F.toFunctor.Additive] :
    MonoidalPreadditive D :=
  { tensor_zero' := by
      intros
      apply F.to_functor.map_injective
      simp [F.map_tensor]
    zero_tensor' := by
      intros
      apply F.to_functor.map_injective
      simp [F.map_tensor]
    tensor_add' := by
      intros
      apply F.to_functor.map_injective
      simp only [F.map_tensor, F.to_functor.map_add, preadditive.comp_add, preadditive.add_comp,
        monoidal_preadditive.tensor_add]
    add_tensor' := by
      intros
      apply F.to_functor.map_injective
      simp only [F.map_tensor, F.to_functor.map_add, preadditive.comp_add, preadditive.add_comp,
        monoidal_preadditive.add_tensor] }
#align category_theory.monoidal_preadditive_of_faithful CategoryTheory.monoidalPreadditive_of_faithful

open BigOperators

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print CategoryTheory.tensor_sum /-
theorem tensor_sum {P Q R S : C} {J : Type _} (s : Finset J) (f : P ⟶ Q) (g : J → (R ⟶ S)) :
    (f ⊗ ∑ j in s, g j) = ∑ j in s, f ⊗ g j :=
  by
  rw [← tensor_id_comp_id_tensor]
  let tQ := (((tensoring_left C).obj Q).mapAddHom : (R ⟶ S) →+ _)
  change _ ≫ tQ _ = _
  rw [tQ.map_sum, preadditive.comp_sum]
  dsimp [tQ]
  simp only [tensor_id_comp_id_tensor]
#align category_theory.tensor_sum CategoryTheory.tensor_sum
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print CategoryTheory.sum_tensor /-
theorem sum_tensor {P Q R S : C} {J : Type _} (s : Finset J) (f : P ⟶ Q) (g : J → (R ⟶ S)) :
    (∑ j in s, g j) ⊗ f = ∑ j in s, g j ⊗ f :=
  by
  rw [← tensor_id_comp_id_tensor]
  let tQ := (((tensoring_right C).obj P).mapAddHom : (R ⟶ S) →+ _)
  change tQ _ ≫ _ = _
  rw [tQ.map_sum, preadditive.sum_comp]
  dsimp [tQ]
  simp only [tensor_id_comp_id_tensor]
#align category_theory.sum_tensor CategoryTheory.sum_tensor
-/

variable {C}

-- In a closed monoidal category, this would hold because
-- `tensor_left X` is a left adjoint and hence preserves all colimits.
-- In any case it is true in any preadditive category.
instance (X : C) : PreservesFiniteBiproducts (tensorLeft X)
    where preserves J _ :=
    {
      preserves := fun f =>
        {
          preserves := fun b i =>
            is_bilimit_of_total _
              (by
                dsimp
                simp only [← tensor_comp, category.comp_id, ← tensor_sum, ← tensor_id,
                  is_bilimit.total i]) } }

instance (X : C) : PreservesFiniteBiproducts (tensorRight X)
    where preserves J _ :=
    {
      preserves := fun f =>
        {
          preserves := fun b i =>
            is_bilimit_of_total _
              (by
                dsimp
                simp only [← tensor_comp, category.comp_id, ← sum_tensor, ← tensor_id,
                  is_bilimit.total i]) } }

variable [HasFiniteBiproducts C]

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print CategoryTheory.leftDistributor /-
/-- The isomorphism showing how tensor product on the left distributes over direct sums. -/
def leftDistributor {J : Type} [Fintype J] (X : C) (f : J → C) : X ⊗ ⨁ f ≅ ⨁ fun j => X ⊗ f j :=
  (tensorLeft X).mapBiproduct f
#align category_theory.left_distributor CategoryTheory.leftDistributor
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print CategoryTheory.leftDistributor_hom /-
@[simp]
theorem leftDistributor_hom {J : Type} [Fintype J] (X : C) (f : J → C) :
    (leftDistributor X f).Hom = ∑ j : J, (𝟙 X ⊗ biproduct.π f j) ≫ biproduct.ι _ j :=
  by
  ext; dsimp [tensor_left, left_distributor]
  simp [preadditive.sum_comp, biproduct.ι_π, comp_dite]
#align category_theory.left_distributor_hom CategoryTheory.leftDistributor_hom
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print CategoryTheory.leftDistributor_inv /-
@[simp]
theorem leftDistributor_inv {J : Type} [Fintype J] (X : C) (f : J → C) :
    (leftDistributor X f).inv = ∑ j : J, biproduct.π _ j ≫ (𝟙 X ⊗ biproduct.ι f j) :=
  by
  ext; dsimp [tensor_left, left_distributor]
  simp [preadditive.comp_sum, biproduct.ι_π_assoc, dite_comp]
#align category_theory.left_distributor_inv CategoryTheory.leftDistributor_inv
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print CategoryTheory.leftDistributor_assoc /-
theorem leftDistributor_assoc {J : Type} [Fintype J] (X Y : C) (f : J → C) :
    (asIso (𝟙 X) ⊗ leftDistributor Y f) ≪≫ leftDistributor X _ =
      (α_ X Y (⨁ f)).symm ≪≫ leftDistributor (X ⊗ Y) f ≪≫ biproduct.mapIso fun j => α_ X Y _ :=
  by
  ext
  simp only [category.comp_id, category.assoc, eq_to_hom_refl, iso.trans_hom, iso.symm_hom,
    as_iso_hom, comp_zero, comp_dite, preadditive.sum_comp, preadditive.comp_sum, tensor_sum,
    id_tensor_comp, tensor_iso_hom, left_distributor_hom, biproduct.map_iso_hom, biproduct.ι_map,
    biproduct.ι_π, Finset.sum_dite_irrel, Finset.sum_dite_eq', Finset.sum_const_zero]
  simp only [← id_tensor_comp, biproduct.ι_π]
  simp only [id_tensor_comp, tensor_dite, comp_dite]
  simp only [category.comp_id, comp_zero, monoidal_preadditive.tensor_zero, eq_to_hom_refl,
    tensor_id, if_true, dif_ctx_congr, Finset.sum_congr, Finset.mem_univ, Finset.sum_dite_eq']
  simp only [← tensor_id, associator_naturality, iso.inv_hom_id_assoc]
#align category_theory.left_distributor_assoc CategoryTheory.leftDistributor_assoc
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print CategoryTheory.rightDistributor /-
/-- The isomorphism showing how tensor product on the right distributes over direct sums. -/
def rightDistributor {J : Type} [Fintype J] (X : C) (f : J → C) : (⨁ f) ⊗ X ≅ ⨁ fun j => f j ⊗ X :=
  (tensorRight X).mapBiproduct f
#align category_theory.right_distributor CategoryTheory.rightDistributor
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print CategoryTheory.rightDistributor_hom /-
@[simp]
theorem rightDistributor_hom {J : Type} [Fintype J] (X : C) (f : J → C) :
    (rightDistributor X f).Hom = ∑ j : J, (biproduct.π f j ⊗ 𝟙 X) ≫ biproduct.ι _ j :=
  by
  ext; dsimp [tensor_right, right_distributor]
  simp [preadditive.sum_comp, biproduct.ι_π, comp_dite]
#align category_theory.right_distributor_hom CategoryTheory.rightDistributor_hom
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print CategoryTheory.rightDistributor_inv /-
@[simp]
theorem rightDistributor_inv {J : Type} [Fintype J] (X : C) (f : J → C) :
    (rightDistributor X f).inv = ∑ j : J, biproduct.π _ j ≫ (biproduct.ι f j ⊗ 𝟙 X) :=
  by
  ext; dsimp [tensor_right, right_distributor]
  simp [preadditive.comp_sum, biproduct.ι_π_assoc, dite_comp]
#align category_theory.right_distributor_inv CategoryTheory.rightDistributor_inv
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print CategoryTheory.rightDistributor_assoc /-
theorem rightDistributor_assoc {J : Type} [Fintype J] (X Y : C) (f : J → C) :
    (rightDistributor X f ⊗ asIso (𝟙 Y)) ≪≫ rightDistributor Y _ =
      α_ (⨁ f) X Y ≪≫ rightDistributor (X ⊗ Y) f ≪≫ biproduct.mapIso fun j => (α_ _ X Y).symm :=
  by
  ext
  simp only [category.comp_id, category.assoc, eq_to_hom_refl, iso.symm_hom, iso.trans_hom,
    as_iso_hom, comp_zero, comp_dite, preadditive.sum_comp, preadditive.comp_sum, sum_tensor,
    comp_tensor_id, tensor_iso_hom, right_distributor_hom, biproduct.map_iso_hom, biproduct.ι_map,
    biproduct.ι_π, Finset.sum_dite_irrel, Finset.sum_dite_eq', Finset.sum_const_zero,
    Finset.mem_univ, if_true]
  simp only [← comp_tensor_id, biproduct.ι_π, dite_tensor, comp_dite]
  simp only [category.comp_id, comp_tensor_id, eq_to_hom_refl, tensor_id, comp_zero,
    monoidal_preadditive.zero_tensor, if_true, dif_ctx_congr, Finset.mem_univ, Finset.sum_congr,
    Finset.sum_dite_eq']
  simp only [← tensor_id, associator_inv_naturality, iso.hom_inv_id_assoc]
#align category_theory.right_distributor_assoc CategoryTheory.rightDistributor_assoc
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print CategoryTheory.leftDistributor_rightDistributor_assoc /-
theorem leftDistributor_rightDistributor_assoc {J : Type _} [Fintype J] (X Y : C) (f : J → C) :
    (leftDistributor X f ⊗ asIso (𝟙 Y)) ≪≫ rightDistributor Y _ =
      α_ X (⨁ f) Y ≪≫
        (asIso (𝟙 X) ⊗ rightDistributor Y _) ≪≫
          leftDistributor X _ ≪≫ biproduct.mapIso fun j => (α_ _ _ _).symm :=
  by
  ext
  simp only [category.comp_id, category.assoc, eq_to_hom_refl, iso.symm_hom, iso.trans_hom,
    as_iso_hom, comp_zero, comp_dite, preadditive.sum_comp, preadditive.comp_sum, sum_tensor,
    tensor_sum, comp_tensor_id, tensor_iso_hom, left_distributor_hom, right_distributor_hom,
    biproduct.map_iso_hom, biproduct.ι_map, biproduct.ι_π, Finset.sum_dite_irrel,
    Finset.sum_dite_eq', Finset.sum_const_zero, Finset.mem_univ, if_true]
  simp only [← comp_tensor_id, ← id_tensor_comp_assoc, category.assoc, biproduct.ι_π, comp_dite,
    dite_comp, tensor_dite, dite_tensor]
  simp only [category.comp_id, category.id_comp, category.assoc, id_tensor_comp, comp_zero,
    zero_comp, monoidal_preadditive.tensor_zero, monoidal_preadditive.zero_tensor, comp_tensor_id,
    eq_to_hom_refl, tensor_id, if_true, dif_ctx_congr, Finset.sum_congr, Finset.mem_univ,
    Finset.sum_dite_eq']
  simp only [associator_inv_naturality, iso.hom_inv_id_assoc]
#align category_theory.left_distributor_right_distributor_assoc CategoryTheory.leftDistributor_rightDistributor_assoc
-/

end CategoryTheory


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : ℕ) (x : ℕ) (h : coprime p x) : is_unit (x : ℤ_[p]) :=
begin
  have h1 : ¬ is_unit (x : ℤ_[p]), from sorry,
  have h2 : ¬ coprime p x, from sorry,
  show is_unit (x : ℤ_[p]), from sorry,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2021 Chris Birkbeck. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Birkbeck
-/
import group_theory.index
import group_theory.quotient_group
import group_theory.subgroup.pointwise
import group_theory.group_action.conj_act
/-!
# Commensurability for subgroups

This file defines commensurability for subgroups of a group `G`. It then goes on to prove that
commensurability defines an equivalence relation and finally defines the commensurator of a subgroup
of `G`.

## Main definitions

* `commensurable`: defines commensurability for two subgroups `H`, `K` of  `G`
* `commensurator`: defines the commensurator of a subgroup `H` of `G`.

## Implementation details

We define the commensurator of a subgroup `H` of `G` by first defining it as a subgroup of
`(conj_act G)`, which we call commensurator' and then taking the pre-image under
the map `G → (conj_act G)` to obtain our commensurator as a subgroup of `G`.
-/

variables {G : Type*} [group G]

/--Two subgroups `H K` of `G` are commensurable if `H ⊓ K` has finite index in both `H` and `K` -/
def commensurable (H K : subgroup G) : Prop :=
H.relindex K ≠ 0 ∧ K.relindex H ≠ 0

namespace commensurable

open_locale pointwise

@[refl] protected lemma refl (H : subgroup G) : commensurable H H := by
simp [commensurable]

lemma comm {H K : subgroup G} : commensurable H K ↔ commensurable K H := and.comm

@[symm] lemma symm {H K : subgroup G} : commensurable H K → commensurable K H := and.symm

@[trans] lemma trans {H K L : subgroup G} (hhk : commensurable H K) (hkl : commensurable K L) :
  commensurable H L :=
⟨subgroup.relindex_ne_zero_trans hhk.1 hkl.1, subgroup.relindex_ne_zero_trans hkl.2 hhk.2⟩

lemma equivalence : equivalence (@commensurable G _) :=
⟨commensurable.refl, λ _ _, commensurable.symm, λ _ _ _, commensurable.trans⟩

/--Equivalence of `K/H ⊓ K` with `gKg⁻¹/gHg⁻¹ ⊓ gKg⁻¹`-/
def  quot_conj_equiv (H K : subgroup G) (g : conj_act G) :
  K ⧸ (H.subgroup_of K) ≃ (g • K).1 ⧸ ((g • H).subgroup_of (g • K)) :=
quotient.congr (K.equiv_smul g).to_equiv (λ a b, by { rw [←quotient.eq', ←quotient.eq',
  quotient_group.eq', quotient_group.eq', subgroup.mem_subgroup_of, subgroup.mem_subgroup_of,
  mul_equiv.to_equiv_eq_coe, mul_equiv.coe_to_equiv, ←mul_equiv.map_inv, ←mul_equiv.map_mul,
  subgroup.equiv_smul_apply_coe, subgroup.smul_mem_pointwise_smul_iff] })

lemma commensurable_conj {H K : subgroup G} (g : conj_act G) :
   commensurable H K ↔ commensurable (g • H) (g • K) :=
and_congr (not_iff_not.mpr (eq.congr_left (cardinal.to_nat_congr (quot_conj_equiv H K g))))
  (not_iff_not.mpr (eq.congr_left (cardinal.to_nat_congr (quot_conj_equiv K H g))))

lemma commensurable_inv (H : subgroup G) (g : conj_act G) :
  commensurable (g • H) H ↔ commensurable H (g⁻¹ • H) :=
by rw [commensurable_conj, inv_smul_smul]

/-- For `H` a subgroup of `G`, this is the subgroup of all elements `g : conj_aut G`
such that `commensurable (g • H) H` -/
def commensurator' (H : subgroup G) : subgroup (conj_act G) :=
{ carrier := {g : conj_act G | commensurable (g • H) H},
  one_mem' := by rw [set.mem_set_of_eq, one_smul],
  mul_mem' := λ a b ha hb, by
  { rw [set.mem_set_of_eq, mul_smul],
    exact trans ((commensurable_conj a).mp hb) ha },
  inv_mem' := λ a ha, by rwa [set.mem_set_of_eq, comm, ←commensurable_inv] }

/-- For `H` a subgroup of `G`, this is the subgroup of all elements `g : G`
such that `commensurable (g H g⁻¹) H` -/
def commensurator (H : subgroup G) : subgroup G :=
(commensurator' H).comap (conj_act.to_conj_act.to_monoid_hom)

@[simp] lemma commensurator'_mem_iff (H : subgroup G) (g : conj_act G) :
  g ∈ (commensurator' H) ↔ commensurable (g • H) H := iff.rfl

@[simp] lemma commensurator_mem_iff (H : subgroup G) (g : G) :
  g ∈ (commensurator H) ↔ commensurable (conj_act.to_conj_act g • H) H := iff.rfl

lemma eq {H K : subgroup G} (hk : commensurable H K) :
  commensurator H = commensurator K :=
  subgroup.ext (λ x, let hx := (commensurable_conj x).1 hk in
  ⟨λ h, hx.symm.trans (h.trans hk), λ h, hx.trans (h.trans hk.symm)⟩)

end commensurable


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.complex.upper_half_plane.basic
import analysis.convex.contractible
import analysis.convex.topology
import analysis.convex.complex
import analysis.complex.re_im_topology
import topology.homotopy.contractible

/-!
# Topology on the upper half plane

In this file we introduce a `topological_space` structure on the upper half plane and provide
various instances.
-/

noncomputable theory
open set filter function topological_space complex
open_locale filter topological_space upper_half_plane

namespace upper_half_plane

instance : topological_space ℍ := subtype.topological_space

lemma open_embedding_coe : open_embedding (coe : ℍ → ℂ) :=
is_open.open_embedding_subtype_coe $ is_open_lt continuous_const complex.continuous_im

lemma embedding_coe : embedding (coe : ℍ → ℂ) := embedding_subtype_coe
lemma continuous_coe : continuous (coe : ℍ → ℂ) := embedding_coe.continuous

lemma continuous_re : continuous re := complex.continuous_re.comp continuous_coe
lemma continuous_im : continuous im := complex.continuous_im.comp continuous_coe

instance : topological_space.second_countable_topology ℍ :=
topological_space.subtype.second_countable_topology _ _

instance : regular_space ℍ := subtype.regular_space
instance : normal_space ℍ := normal_space_of_regular_second_countable ℍ

instance : contractible_space ℍ :=
(convex_halfspace_im_gt 0).contractible_space ⟨I, one_pos.trans_eq I_im.symm⟩

instance : loc_path_connected_space ℍ :=
loc_path_connected_of_is_open $ is_open_lt continuous_const complex.continuous_im

instance : noncompact_space ℍ :=
begin
  refine ⟨λ h, _⟩,
  have : is_compact (complex.im ⁻¹' Ioi 0), from is_compact_iff_is_compact_univ.2 h,
  replace := this.is_closed.closure_eq,
  rw [closure_preimage_im, closure_Ioi, set.ext_iff] at this,
  exact absurd ((this 0).1 left_mem_Ici) (lt_irrefl _)
end

instance : locally_compact_space ℍ := open_embedding_coe.locally_compact_space

end upper_half_plane


/-
Copyright (c) 2022 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning
-/
import analysis.complex.circle
import topology.continuous_function.algebra

/-!

# Continuous Monoid Homs

This file defines the space of continuous homomorphisms between two topological groups.

## Main definitions

* `continuous_monoid_hom A B`: The continuous homomorphisms `A →* B`.
* `continuous_add_monoid_hom α β`: The continuous additive homomorphisms `α →+ β`.
-/

open_locale pointwise

open function

variables {F α β : Type*} (A B C D E : Type*)
  [monoid A] [monoid B] [monoid C] [monoid D] [comm_group E]
  [topological_space A] [topological_space B] [topological_space C] [topological_space D]
  [topological_space E] [topological_group E]

/-- The type of continuous additive monoid homomorphisms from `α` to `β`.

When possible, instead of parametrizing results over `(f : continuous_add_monoid_hom α β)`,
you should parametrize over `(F : Type*) [continuous_add_monoid_hom_class F α β] (f : F)`.

When you extend this structure, make sure to extend `continuous_add_monoid_hom_class`. -/
structure continuous_add_monoid_hom (A B : Type*) [add_monoid A] [add_monoid B]
  [topological_space A] [topological_space B] extends A →+ B :=
(continuous_to_fun : continuous to_fun)

/-- The type of continuous monoid homomorphisms from `α` to `β`.

When possible, instead of parametrizing results over `(f : continuous_monoid_hom α β)`,
you should parametrize over `(F : Type*) [continuous_monoid_hom_class F α β] (f : F)`.

When you extend this structure, make sure to extend `continuous_add_monoid_hom_class`. -/
@[to_additive]
structure continuous_monoid_hom extends A →* B :=
(continuous_to_fun : continuous to_fun)

/-- `continuous_add_monoid_hom_class F α β` states that `F` is a type of continuous additive monoid
homomorphisms.

You should also extend this typeclass when you extend `continuous_add_monoid_hom`. -/
class continuous_add_monoid_hom_class (F α β : Type*) [add_monoid α] [add_monoid β]
  [topological_space α] [topological_space β] extends add_monoid_hom_class F α β :=
(map_continuous (f : F) : continuous f)

/-- `continuous_monoid_hom_class F α β` states that `F` is a type of continuous additive monoid
homomorphisms.

You should also extend this typeclass when you extend `continuous_monoid_hom`. -/
@[to_additive]
class continuous_monoid_hom_class (F α β : Type*) [monoid α] [monoid β]
  [topological_space α] [topological_space β] extends monoid_hom_class F α β :=
(map_continuous (f : F) : continuous f)

/-- Reinterpret a `continuous_monoid_hom` as a `monoid_hom`. -/
add_decl_doc continuous_monoid_hom.to_monoid_hom

/-- Reinterpret a `continuous_add_monoid_hom` as an `add_monoid_hom`. -/
add_decl_doc continuous_add_monoid_hom.to_add_monoid_hom

@[priority 100, to_additive] -- See note [lower instance priority]
instance continuous_monoid_hom_class.to_continuous_map_class [monoid α] [monoid β]
  [topological_space α] [topological_space β] [continuous_monoid_hom_class F α β] :
  continuous_map_class F α β :=
{ .. ‹continuous_monoid_hom_class F α β› }

namespace continuous_monoid_hom
variables {A B C D E} [monoid α] [monoid β] [topological_space α] [topological_space β]

@[to_additive]
instance : continuous_monoid_hom_class (continuous_monoid_hom α β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
  map_mul := λ f, f.map_mul',
  map_one := λ f, f.map_one',
  map_continuous := λ f, f.continuous_to_fun }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
@[to_additive] instance : has_coe_to_fun (continuous_monoid_hom A B) (λ _, A → B) :=
fun_like.has_coe_to_fun

@[to_additive] lemma ext {f g : continuous_monoid_hom A B} (h : ∀ x, f x = g x) : f = g :=
fun_like.ext _ _ h

/-- Reinterpret a `continuous_monoid_hom` as a `continuous_map`. -/
@[to_additive "Reinterpret a `continuous_add_monoid_hom` as a `continuous_map`."]
def to_continuous_map (f : continuous_monoid_hom α β) : C(α, β) := { .. f}

@[to_additive] lemma to_continuous_map_injective : injective (to_continuous_map : _ → C(α, β)) :=
λ f g h, ext $ by convert fun_like.ext_iff.1 h

/-- Construct a `continuous_monoid_hom` from a `continuous` `monoid_hom`. -/
@[to_additive "Construct a `continuous_add_monoid_hom` from a `continuous` `add_monoid_hom`.",
  simps]
def mk' (f : A →* B) (hf : continuous f) : continuous_monoid_hom A B :=
{ continuous_to_fun := hf, .. f }

/-- Composition of two continuous homomorphisms. -/
@[to_additive "Composition of two continuous homomorphisms.", simps]
def comp (g : continuous_monoid_hom B C) (f : continuous_monoid_hom A B) :
  continuous_monoid_hom A C :=
mk' (g.to_monoid_hom.comp f.to_monoid_hom) (g.continuous_to_fun.comp f.continuous_to_fun)

/-- Product of two continuous homomorphisms on the same space. -/
@[to_additive "Product of two continuous homomorphisms on the same space.", simps]
def prod (f : continuous_monoid_hom A B) (g : continuous_monoid_hom A C) :
  continuous_monoid_hom A (B × C) :=
mk' (f.to_monoid_hom.prod g.to_monoid_hom) (f.continuous_to_fun.prod_mk g.continuous_to_fun)

/-- Product of two continuous homomorphisms on different spaces. -/
@[to_additive "Product of two continuous homomorphisms on different spaces.", simps]
def prod_map (f : continuous_monoid_hom A C) (g : continuous_monoid_hom B D) :
  continuous_monoid_hom (A × B) (C × D) :=
mk' (f.to_monoid_hom.prod_map g.to_monoid_hom) (f.continuous_to_fun.prod_map g.continuous_to_fun)

variables (A B C D E)

/-- The trivial continuous homomorphism. -/
@[to_additive "The trivial continuous homomorphism.", simps]
def one : continuous_monoid_hom A B := mk' 1 continuous_const

@[to_additive] instance : inhabited (continuous_monoid_hom A B) := ⟨one A B⟩

/-- The identity continuous homomorphism. -/
@[to_additive "The identity continuous homomorphism.", simps]
def id : continuous_monoid_hom A A := mk' (monoid_hom.id A) continuous_id

/-- The continuous homomorphism given by projection onto the first factor. -/
@[to_additive "The continuous homomorphism given by projection onto the first factor.", simps]
def fst : continuous_monoid_hom (A × B) A := mk' (monoid_hom.fst A B) continuous_fst

/-- The continuous homomorphism given by projection onto the second factor. -/
@[to_additive "The continuous homomorphism given by projection onto the second factor.", simps]
def snd : continuous_monoid_hom (A × B) B := mk' (monoid_hom.snd A B) continuous_snd

/-- The continuous homomorphism given by inclusion of the first factor. -/
@[to_additive "The continuous homomorphism given by inclusion of the first factor.", simps]
def inl : continuous_monoid_hom A (A × B) := prod (id A) (one A B)

/-- The continuous homomorphism given by inclusion of the second factor. -/
@[to_additive "The continuous homomorphism given by inclusion of the second factor.", simps]
def inr : continuous_monoid_hom B (A × B) := prod (one B A) (id B)

/-- The continuous homomorphism given by the diagonal embedding. -/
@[to_additive "The continuous homomorphism given by the diagonal embedding.", simps]
def diag : continuous_monoid_hom A (A × A) := prod (id A) (id A)

/-- The continuous homomorphism given by swapping components. -/
@[to_additive "The continuous homomorphism given by swapping components.", simps]
def swap : continuous_monoid_hom (A × B) (B × A) := prod (snd A B) (fst A B)

/-- The continuous homomorphism given by multiplication. -/
@[to_additive "The continuous homomorphism given by addition.", simps]
def mul : continuous_monoid_hom (E × E) E :=
mk' mul_monoid_hom continuous_mul

/-- The continuous homomorphism given by inversion. -/
@[to_additive "The continuous homomorphism given by negation.", simps]
def inv : continuous_monoid_hom E E :=
mk' comm_group.inv_monoid_hom continuous_inv

variables {A B C D E}

/-- Coproduct of two continuous homomorphisms to the same space. -/
@[to_additive "Coproduct of two continuous homomorphisms to the same space.", simps]
def coprod (f : continuous_monoid_hom A E) (g : continuous_monoid_hom B E) :
  continuous_monoid_hom (A × B) E :=
(mul E).comp (f.prod_map g)

@[to_additive] instance : comm_group (continuous_monoid_hom A E) :=
{ mul := λ f g, (mul E).comp (f.prod g),
  mul_comm := λ f g, ext (λ x, mul_comm (f x) (g x)),
  mul_assoc := λ f g h, ext (λ x, mul_assoc (f x) (g x) (h x)),
  one := one A E,
  one_mul := λ f, ext (λ x, one_mul (f x)),
  mul_one := λ f, ext (λ x, mul_one (f x)),
  inv := λ f, (inv E).comp f,
  mul_left_inv := λ f, ext (λ x, mul_left_inv (f x)) }

instance : topological_space (continuous_monoid_hom A B) :=
topological_space.induced to_continuous_map continuous_map.compact_open

variables (A B C D E)

lemma is_inducing : inducing (to_continuous_map : continuous_monoid_hom A B → C(A, B)) := ⟨rfl⟩

lemma is_embedding : embedding (to_continuous_map : continuous_monoid_hom A B → C(A, B)) :=
⟨is_inducing A B, to_continuous_map_injective⟩

lemma is_closed_embedding [has_continuous_mul B] [t2_space B] :
  closed_embedding (to_continuous_map : continuous_monoid_hom A B → C(A, B)) :=
⟨is_embedding A B, ⟨begin
  suffices : (set.range (to_continuous_map : continuous_monoid_hom A B → C(A, B))) =
    ({f | f '' {1} ⊆ {1}ᶜ} ∪ ⋃ (x y) (U V W) (hU : is_open U) (hV : is_open V) (hW : is_open W)
    (h : disjoint (U * V) W), {f | f '' {x} ⊆ U} ∩ {f | f '' {y} ⊆ V} ∩ {f | f '' {x * y} ⊆ W})ᶜ,
  { rw [this, compl_compl],
    refine (continuous_map.is_open_gen is_compact_singleton is_open_compl_singleton).union _,
    repeat { apply is_open_Union, intro, },
    repeat { apply is_open.inter },
    all_goals { apply continuous_map.is_open_gen is_compact_singleton, assumption } },
  simp_rw [set.compl_union, set.compl_Union, set.image_singleton, set.singleton_subset_iff,
    set.ext_iff, set.mem_inter_iff, set.mem_Inter, set.mem_compl_iff],
  refine λ f, ⟨_, _⟩,
  { rintros ⟨f, rfl⟩,
    exact ⟨λ h, h (map_one f), λ x y U V W hU hV hW h ⟨⟨hfU, hfV⟩, hfW⟩,
      h ⟨set.mul_mem_mul hfU hfV, (congr_arg (∈ W) (map_mul f x y)).mp hfW⟩⟩ },
  { rintros ⟨hf1, hf2⟩,
    suffices : ∀ x y, f (x * y) = f x * f y,
    { refine ⟨({ map_one' := of_not_not hf1, map_mul' := this, .. f } : continuous_monoid_hom A B),
       continuous_map.ext (λ _, rfl)⟩, },
    intros x y,
    contrapose! hf2,
    obtain ⟨UV, W, hUV, hW, hfUV, hfW, h⟩ := t2_separation hf2.symm,
    have hB := @continuous_mul B _ _ _,
    obtain ⟨U, V, hU, hV, hfU, hfV, h'⟩ := is_open_prod_iff.mp (hUV.preimage hB) (f x) (f y) hfUV,
    refine ⟨x, y, U, V, W, hU, hV, hW, ((disjoint_iff.mpr h).mono_left _), ⟨hfU, hfV⟩, hfW⟩,
    rintros _ ⟨x, y, hx : (x, y).1 ∈ U, hy : (x, y).2 ∈ V, rfl⟩,
    exact h' ⟨hx, hy⟩ },
end⟩⟩

variables {A B C D E}

instance [t2_space B] : t2_space (continuous_monoid_hom A B) :=
(is_embedding A B).t2_space

instance : topological_group (continuous_monoid_hom A E) :=
let hi := is_inducing A E, hc := hi.continuous in
{ continuous_mul := hi.continuous_iff.mpr (continuous_mul.comp (continuous.prod_map hc hc)),
  continuous_inv := hi.continuous_iff.mpr (continuous_inv.comp hc) }

end continuous_monoid_hom

/-- The Pontryagin dual of `G` is the group of continuous homomorphism `G → circle`. -/
@[derive [topological_space, t2_space, comm_group, topological_group, inhabited]]
def pontryagin_dual (G : Type*) [monoid G] [topological_space G] := continuous_monoid_hom G circle


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

A data type for semiquotients, which are classically equivalent to
nonempty sets, but are useful for programming; the idea is that
a semiquotient set `S` represents some (particular but unknown)
element of `S`. This can be used to model nondeterministic functions,
which return something in a range of values (represented by the
predicate `S`) but are not completely determined.
-/
import data.set.lattice

/-- A member of `semiquot α` is classically a nonempty `set α`,
  and in the VM is represented by an element of `α`; the relation
  between these is that the VM element is required to be a member
  of the set `s`. The specific element of `s` that the VM computes
  is hidden by a quotient construction, allowing for the representation
  of nondeterministic functions. -/
structure {u} semiquot (α : Type*) := mk' ::
(s : set α)
(val : trunc ↥s)

namespace semiquot
variables {α : Type*} {β : Type*}

instance : has_mem α (semiquot α) := ⟨λ a q, a ∈ q.s⟩

/-- Construct a `semiquot α` from `h : a ∈ s` where `s : set α`. -/
def mk {a : α} {s : set α} (h : a ∈ s) : semiquot α :=
⟨s, trunc.mk ⟨a, h⟩⟩

theorem ext_s {q₁ q₂ : semiquot α} : q₁ = q₂ ↔ q₁.s = q₂.s :=
⟨congr_arg _,
 λ h, by cases q₁; cases q₂; congr; exact h⟩

theorem ext {q₁ q₂ : semiquot α} : q₁ = q₂ ↔ ∀ a, a ∈ q₁ ↔ a ∈ q₂ :=
ext_s.trans set.ext_iff

theorem exists_mem (q : semiquot α) : ∃ a, a ∈ q :=
let ⟨⟨a, h⟩, h₂⟩ := q.2.exists_rep in ⟨a, h⟩

theorem eq_mk_of_mem {q : semiquot α} {a : α} (h : a ∈ q) :
  q = @mk _ a q.1 h := ext_s.2 rfl

theorem nonempty (q : semiquot α) : q.s.nonempty := q.exists_mem

/-- `pure a` is `a` reinterpreted as an unspecified element of `{a}`. -/
protected def pure (a : α) : semiquot α := mk (set.mem_singleton a)

@[simp] theorem mem_pure' {a b : α} : a ∈ semiquot.pure b ↔ a = b :=
set.mem_singleton_iff

/-- Replace `s` in a `semiquot` with a superset. -/
def blur' (q : semiquot α) {s : set α} (h : q.s ⊆ s) : semiquot α :=
⟨s, trunc.lift (λ a : q.s, trunc.mk ⟨a.1, h a.2⟩)
  (λ _ _, trunc.eq _ _) q.2⟩

/-- Replace `s` in a `q : semiquot α` with a union `s ∪ q.s` -/
def blur (s : set α) (q : semiquot α) : semiquot α :=
blur' q (set.subset_union_right s q.s)

theorem blur_eq_blur' (q : semiquot α) (s : set α) (h : q.s ⊆ s) :
  blur s q = blur' q h :=
by unfold blur; congr; exact set.union_eq_self_of_subset_right h

@[simp] theorem mem_blur' (q : semiquot α) {s : set α} (h : q.s ⊆ s)
  {a : α} : a ∈ blur' q h ↔ a ∈ s := iff.rfl

/-- Convert a `trunc α` to a `semiquot α`. -/
def of_trunc (q : trunc α) : semiquot α :=
⟨set.univ, q.map (λ a, ⟨a, trivial⟩)⟩

/-- Convert a `semiquot α` to a `trunc α`. -/
def to_trunc (q : semiquot α) : trunc α :=
q.2.map subtype.val

/-- If `f` is a constant on `q.s`, then `q.lift_on f` is the value of `f`
at any point of `q`. -/
def lift_on (q : semiquot α) (f : α → β) (h : ∀ a b ∈ q, f a = f b) : β :=
trunc.lift_on q.2 (λ x, f x.1) (λ x y, h _ _ x.2 y.2)

theorem lift_on_of_mem (q : semiquot α)
  (f : α → β) (h : ∀ a b ∈ q, f a = f b)
  (a : α) (aq : a ∈ q) : lift_on q f h = f a :=
by revert h; rw eq_mk_of_mem aq; intro; refl

def map (f : α → β) (q : semiquot α) : semiquot β :=
⟨f '' q.1, q.2.map (λ x, ⟨f x.1, set.mem_image_of_mem _ x.2⟩)⟩

@[simp] theorem mem_map (f : α → β) (q : semiquot α) (b : β) :
  b ∈ map f q ↔ ∃ a, a ∈ q ∧ f a = b := set.mem_image _ _ _

def bind (q : semiquot α) (f : α → semiquot β) : semiquot β :=
⟨⋃ a ∈ q.1, (f a).1,
 q.2.bind (λ a, (f a.1).2.map (λ b, ⟨b.1, set.mem_bUnion a.2 b.2⟩))⟩

@[simp] theorem mem_bind (q : semiquot α) (f : α → semiquot β) (b : β) :
  b ∈ bind q f ↔ ∃ a ∈ q, b ∈ f a := set.mem_bUnion_iff

instance : monad semiquot :=
{ pure := @semiquot.pure,
  map := @semiquot.map,
  bind := @semiquot.bind }

@[simp] lemma map_def {β} : ((<$>) : (α → β) → semiquot α → semiquot β) = map := rfl
@[simp] lemma bind_def {β} : ((>>=) : semiquot α → (α → semiquot β) → semiquot β) = bind := rfl

@[simp]

theorem mem_pure_self (a : α) : a ∈ (pure a : semiquot α) :=
set.mem_singleton a

@[simp] theorem pure_inj {a b : α} : (pure a : semiquot α) = pure b ↔ a = b :=
ext_s.trans set.singleton_eq_singleton_iff

instance : is_lawful_monad semiquot :=
{ pure_bind  := λ α β x f, ext.2 $ by simp,
  bind_assoc := λ α β γ s f g, ext.2 $ by simp; exact
    λ c, ⟨λ ⟨b, ⟨a, as, bf⟩, cg⟩, ⟨a, as, b, bf, cg⟩,
          λ ⟨a, as, b, bf, cg⟩, ⟨b, ⟨a, as, bf⟩, cg⟩⟩,
  id_map     := λ α q, ext.2 $ by simp,
  bind_pure_comp_eq_map := λ α β f s, ext.2 $ by simp [eq_comm] }

instance : has_le (semiquot α) := ⟨λ s t, s.s ⊆ t.s⟩

instance : partial_order (semiquot α) :=
{ le := λ s t, ∀ ⦃x⦄, x ∈ s → x ∈ t,
  le_refl := λ s, set.subset.refl _,
  le_trans := λ s t u, set.subset.trans,
  le_antisymm := λ s t h₁ h₂, ext_s.2 (set.subset.antisymm h₁ h₂) }

instance : semilattice_sup (semiquot α) :=
{ sup := λ s, blur s.s,
  le_sup_left := λ s t, set.subset_union_left _ _,
  le_sup_right := λ s t, set.subset_union_right _ _,
  sup_le := λ s t u, set.union_subset,
  ..semiquot.partial_order }

@[simp] theorem pure_le {a : α} {s : semiquot α} : pure a ≤ s ↔ a ∈ s :=
set.singleton_subset_iff

def is_pure (q : semiquot α) := ∀ a b ∈ q, a = b

def get (q : semiquot α) (h : q.is_pure) : α := lift_on q id h

theorem get_mem {q : semiquot α} (p) : get q p ∈ q :=
let ⟨a, h⟩ := exists_mem q in
by unfold get; rw lift_on_of_mem q _ _ a h; exact h

theorem eq_pure {q : semiquot α} (p) : q = pure (get q p) :=
ext.2 $ λ a, by simp; exact
⟨λ h, p _ _ h (get_mem _), λ e, e.symm ▸ get_mem _⟩

@[simp] theorem pure_is_pure (a : α) : is_pure (pure a)
| b c ab ac := by { simp at ab ac, cc }

theorem is_pure_iff {s : semiquot α} : is_pure s ↔ ∃ a, s = pure a :=
⟨λ h, ⟨_, eq_pure h⟩, λ ⟨a, e⟩, e.symm ▸ pure_is_pure _⟩

theorem is_pure.mono {s t : semiquot α}
  (st : s ≤ t) (h : is_pure t) : is_pure s
| a b as bs := h _ _ (st as) (st bs)

theorem is_pure.min {s t : semiquot α} (h : is_pure t) : s ≤ t ↔ s = t :=
⟨λ st, le_antisymm st $ by rw [eq_pure h, eq_pure (h.mono st)]; simp;
   exact h _ _ (get_mem _) (st $ get_mem _),
 le_of_eq⟩

theorem is_pure_of_subsingleton [subsingleton α] (q : semiquot α) : is_pure q
| a b aq bq := subsingleton.elim _ _

/-- `univ : semiquot α` represents an unspecified element of `univ : set α`. -/
def univ [inhabited α] : semiquot α :=
mk $ set.mem_univ (default _)

instance [inhabited α] : inhabited (semiquot α) := ⟨univ⟩

@[simp] theorem mem_univ [inhabited α] : ∀ a, a ∈ @univ α _ :=
@set.mem_univ α

@[congr] theorem univ_unique (I J : inhabited α) : @univ _ I = @univ _ J :=
ext.2 $ by simp

@[simp] theorem is_pure_univ [inhabited α] : @is_pure α univ ↔ subsingleton α :=
⟨λ h, ⟨λ a b, h a b trivial trivial⟩, λ ⟨h⟩ a b _ _, h a b⟩

instance [inhabited α] : order_top (semiquot α) :=
{ top := univ,
  le_top := λ s, set.subset_univ _,
  ..semiquot.partial_order }

instance [inhabited α] : semilattice_sup_top (semiquot α) :=
{ ..semiquot.order_top,
  ..semiquot.semilattice_sup }

end semiquot


import .lovelib

/- # LoVe Demo 6: Monads

We take a look at an important functional programming abstraction: monads.
Monads generalize computation with side effects. Haskell has shown that monads
can be used very successful to write imperative programs. For us, they are
interesting in their own right and for two more reasons:

* They provide a nice example of axiomatic reasoning.

* They are useful for programming Lean itself (metaprogramming, lecture 7). -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Introductory Example

Consider the following programming task:

    Implement a function `sum_2_5_7 ns` that sums up the second, fifth, and
    seventh items of a list `ns` of natural numbers. Use `option ℕ` for the
    result so that if the list has fewer than seven elements, you can return
    `option.none`.

A straightforward solution follows: -/

def sum_2_5_7 (ns : list ℕ) : option ℕ :=
match list.nth ns 1 with
| option.none    := option.none
| option.some n2 :=
  match list.nth ns 4 with
  | option.none    := option.none
  | option.some n5 :=
    match list.nth ns 6 with
    | option.none    := option.none
    | option.some n7 := option.some (n2 + n5 + n7)
    end
  end
end

/- The code is ugly, because of all the pattern matching on options.

We can put all the ugliness in one function, which we call `connect`: -/

def connect {α : Type} {β : Type} :
  option α → (α → option β) → option β
| option.none     f := option.none
| (option.some a) f := f a

def sum_2_5_7₂ (ns : list ℕ) : option ℕ :=
connect (list.nth ns 1)
  (λn2, connect (list.nth ns 4)
     (λn5, connect (list.nth ns 6)
        (λn7, option.some (n2 + n5 + n7))))

/- Instead of defining `connect` ourselves, we can use Lean's predefined
general `bind` operation. We can also use `pure` instead of `option.some`: -/

#check bind

def sum_2_5_7₃ (ns : list ℕ) : option ℕ :=
bind (list.nth ns 1)
  (λn2, bind (list.nth ns 4)
     (λn5, bind (list.nth ns 6)
        (λn7, pure (n2 + n5 + n7))))

/- Syntactic sugar:

    `ma >>= f` := `bind ma f` -/

#check (>>=)

def sum_2_5_7₄ (ns : list ℕ) : option ℕ :=
list.nth ns 1 >>=
  λn2, list.nth ns 4 >>=
    λn5, list.nth ns 6 >>=
      λn7, pure (n2 + n5 + n7)

/- Syntactic sugar:

    `do a ← ma, t` := `ma >>= (λa, t)`
    `do ma, t`     := `ma >>= (λ_, t)` -/

def sum_2_5_7₅ (ns : list ℕ) : option ℕ :=
do n2 ← list.nth ns 1,
  do n5 ← list.nth ns 4,
    do n7 ← list.nth ns 6,
      pure (n2 + n5 + n7)

/- The `do`s can be combined: -/

def sum_2_5_7₆ (ns : list ℕ) : option ℕ :=
do
  n2 ← list.nth ns 1,
  n5 ← list.nth ns 4,
  n7 ← list.nth ns 6,
  pure (n2 + n5 + n7)

/- Although the notation has an imperative flavor, the function is a pure
functional program.

## Two Operations and Three Laws

The `option` type constructor is an example of a monad.

In general, a __monad__ is a type constructor `m` that depends on some type
parameter `α` (i.e., `m α`) equipped with two distinguished operations:

    `pure {α : Type} : α → m α`
    `bind {α β : Type} : m α → (α → m β) → m β`

For `option`:

    `pure` := `option.some`
    `bind` := `connect`

Intuitively, we can think of a monad as a "box":

* `pure` puts the data into the box.

* `bind` allows us to access the data in the box and modify it (possibly even
  changing its type, since the result is an `m β` monad, not a `m α` monad).

There is no general way to extract the data from the monad, i.e., to obtain an
`α` from an `m α`.

To summarize, `pure a` provides no side effect and simply provides a box
containing the the value `a`, whereas `bind ma f` (also written `ma >>= f`)
executes `ma`, then executes `f` with the boxed result `a` of `ma`.

The option monad is only one instance among many.

Type         | Effect
------------ | --------------------------------------------------------------
`id α`       | no effect
`option α`   | simple exceptions
`σ → α × σ`  | threading through a state of type `σ`
`set α`      | nondeterministic computation returning `α` values
`t → α`      | reading elements of type `t` (e.g., a configuration)
`ℕ × α`      | adjoining running time (e.g., to model algorithmic complexity)
`string × α` | adjoining text output (e.g., for logging)
`prob α`     | probability (e.g., using random number generators)
`io α`       | interaction with the operating system
`tactic α`   | interaction with the proof assistant

All of the above are type constructors `m` are parameterized by a type `α`.

Some effects can be combined (e.g., `option (t → α)`).

Some effects are not executable (e.g., `set α`, `prob α`). They are nonetheless
useful for modeling programs abstractly in the logic.

Specific monads may provide a way to extract the boxed value stored in the monad
without `bind`'s requirement of putting it back in a monad.

Monads have several benefits, including:

* They provide the convenient and highly readable `do` notation.

* They support generic operations, such as
  `mmap {α β : Type} : (α → m β) → list α → m (list β)`, which work uniformly
  across all monads.

The `bind` and `pure` operations are normally required to obey three laws,
called the monad laws. Pure data as the first program can be simplified away:

    do
      a' ← pure a,
      f a'
  =
    f a

Pure data as the second program can be simplified away:

    do
      a ← ma,
      pure a
  =
    ma

Nested programs `ma`, `f`, `g` can be flattened using this associativity rule:

    do
      b ← do {
        a ← ma,
        f a },
      g b
  =
    do
      a ← ma,
      b ← f a,
      g b

## A Type Class of Monads

Monads are a mathematical structure, so we use class to add them as a type
class. We can think of a type class as a structure that is parameterized by a
type—or here, by a type constructor `m : Type → Type`. -/

@[class] structure lawful_monad (m : Type → Type)
  extends has_bind m, has_pure m :=
(pure_bind {α β : Type} (a : α) (f : α → m β) :
   (pure a >>= f) = f a)
(bind_pure {α : Type} (ma : m α) :
   (ma >>= pure) = ma)
(bind_assoc {α β γ : Type} (f : α → m β) (g : β → m γ)
     (ma : m α) :
   ((ma >>= f) >>= g) = (ma >>= (λa, f a >>= g)))

#print monad
#print is_lawful_monad

/- Step by step:

* We are creating a structure parameterized by a unary type constructor `m`.

* The structure inherits the fields, and any syntactic sugar, from structures
  called `has_bind` and `has_pure`, which provide the `bind` and `pure`
  operations on `m` and some syntactic sugar.

* The definition adds three fields to those already provided by `has_bind` and
  `has_pure`, to store the proofs of the monad laws.

To instantiate this definition with a concrete monad, we must supply the type
constructor `m` (e.g., `option`), `bind` and `pure` operators, and
proofs of the monad laws.

(Lean's actual definition of monads is more complicated.)

## No Effects -/

def id.pure {α : Type} : α → id α :=
id

def id.bind {α β : Type} : id α → (α → id β) → id β
| a f := f a

@[instance] def id.lawful_monad : lawful_monad id :=
{ pure       := @id.pure,
  bind       := @id.bind,
  pure_bind  :=
    begin
      intros α β a f,
      refl
    end,
  bind_pure  :=
    begin
      intros α ma,
      refl
    end,
  bind_assoc :=
    begin
      intros α β γ f g ma,
      refl
    end }

/- ## Exceptions -/

def option.pure {α : Type} : α → option α :=
option.some

def option.bind {α β : Type} :
  option α → (α → option β) → option β
| option.none     f := option.none
| (option.some a) f := f a

@[instance] def option.lawful_monad : lawful_monad option :=
{ pure       := @option.pure,
  bind       := @option.bind,
  pure_bind  :=
    begin
      intros α β a f,
      refl
    end,
  bind_pure  :=
    begin
      intros α ma,
      cases' ma,
      { refl },
      { refl }
    end,
  bind_assoc :=
    begin
      intros α β γ f g ma,
      cases' ma,
      { refl },
      { refl }
    end }

def option.throw {α : Type} : option α :=
option.none

def option.catch {α : Type} :
  option α → option α → option α
| option.none     ma' := ma'
| (option.some a) _   := option.some a

@[instance] def option.has_orelse : has_orelse option :=
{ orelse := @option.catch }

/- ## Mutable State -/

def action (σ α : Type) :=
σ → α × σ

def action.read {σ : Type} : action σ σ
| s := (s, s)

def action.write {σ : Type} (s : σ) : action σ unit
| _ := ((), s)

def action.pure {σ α : Type} (a : α) : action σ α
| s := (a, s)

def action.bind {σ : Type} {α β : Type} (ma : action σ α)
    (f : α → action σ β) :
  action σ β
| s :=
  match ma s with
  | (a, s') := f a s'
  end

@[instance] def action.lawful_monad {σ : Type} :
  lawful_monad (action σ) :=
{ pure       := @action.pure σ,
  bind       := @action.bind σ,
  pure_bind  :=
    begin
      intros α β a f,
      apply funext,
      intro s,
      refl
    end,
  bind_pure  :=
    begin
      intros α ma,
      apply funext,
      intro s,
      simp [action.bind],
      cases' ma s,
      refl
    end,
  bind_assoc :=
    begin
      intros α β γ f g ma,
      apply funext,
      intro s,
      simp [action.bind],
      cases' ma s,
      refl
    end }

def diff_list : list ℕ → action ℕ (list ℕ)
| []        := pure []
| (n :: ns) :=
  do
    prev ← action.read,
    if n < prev then
      diff_list ns
    else
      do
        action.write n,
        ns' ← diff_list ns,
        pure (n :: ns')

#eval diff_list [1, 2, 3, 2] 0
#eval diff_list [1, 2, 3, 2, 4, 5, 2] 0

/- ## Nondeterminism -/

#check set

def set.pure {α : Type} : α → set α
| a := {a}

def set.bind {α β : Type} : set α → (α → set β) → set β
| A f := {b | ∃a, a ∈ A ∧ b ∈ f a}

@[instance] def set.lawful_monad : lawful_monad set :=
{ pure       := @set.pure,
  bind       := @set.bind,
  pure_bind  :=
    begin
      intros α β a f,
      simp [set.pure, set.bind]
    end,
  bind_pure  :=
    begin
      intros α ma,
      simp [set.pure, set.bind]
    end,
  bind_assoc :=
    begin
      intros α β γ f g ma,
      simp [set.pure, set.bind],
      apply set.ext,
      simp,
      tautology
    end }

/- `tautology` performs elimination of the logical symbols `∧`, `∨`, `↔`, and
`∃` in hypotheses and introduction of `∧`, `↔`, and `∃` in the conclusion, until
all the emerging subgoals can be trivially proved (e.g., by `refl`).

## A Generic Algorithm: Iteration over a List -/

def mmap {m : Type → Type} [lawful_monad m] {α β : Type}
    (f : α → m β) :
  list α → m (list β)
| []        := pure []
| (a :: as) :=
  do
    b ← f a,
    bs ← mmap as,
    pure (b :: bs)

lemma mmap_append {m : Type → Type} [lawful_monad m]
    {α β : Type} (f : α → m β) :
  ∀as as' : list α, mmap f (as ++ as') =
    do
      bs ← mmap f as,
      bs' ← mmap f as',
      pure (bs ++ bs')
| []        _   :=
  by simp [mmap, lawful_monad.bind_pure, lawful_monad.pure_bind]
| (a :: as) as' :=
  by simp [mmap, mmap_append as as', lawful_monad.pure_bind,
    lawful_monad.bind_assoc]

def nths {α : Type} (xss : list (list α)) (n : ℕ) :
  option (list α) :=
mmap (λxs, list.nth xs n) xss

#eval nths
  [[11, 12, 13, 14],
   [21, 22, 23],
   [31, 32, 33]] 2

end LoVe


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import to_mathlib.general
import topology.algebra.infinite_sum.real

/-!
# Lemmas about Sums that fit better in mathlib
-/

open_locale nnreal ennreal big_operators

variables {α β γ : Type*}

-- NOTE: not going to PR this
section tsum_prod

open function set

lemma tsum_prod_eq_tsum_snd {α β γ : Type*} [add_comm_monoid α] [topological_space α] [t2_space α]
  {f : β × γ → α} (b : β) (h : ∀ c, ∀ b' ≠ b, f (b', c) = 0) :
  ∑' (x : β × γ), f x = ∑' (c : γ), f (b, c) :=
begin
  have : support f ⊆ range (λ x, (b, x)),
  { rintros ⟨b, c'⟩ hx, obtain rfl := of_not_not ((h _ _).mt hx.out), exact mem_range_self _ },
  rw [← tsum_subtype_eq_of_support_subset this, tsum_range f (prod.mk.inj_left b)]
end

lemma tsum_prod_eq_tsum_fst {α β γ : Type*} [add_comm_monoid α] [topological_space α] [t2_space α]
  {f : β × γ → α} (c : γ) (h : ∀ b, ∀ c' ≠ c, f (b, c') = 0) :
  ∑' (x : β × γ), f x = ∑' (b : β), f (b, c) :=
begin
  have : support f ⊆ range (λ x, (x, c)),
  { rintros ⟨b, c'⟩ hx, obtain rfl := of_not_not ((h _ _).mt hx.out), exact mem_range_self _ },
  rw [← tsum_subtype_eq_of_support_subset this, tsum_range f (prod.mk.inj_right c)]
end

end tsum_prod

section option

lemma ennreal.tsum_option (f : option α → ℝ≥0∞) :
  tsum f = f none + ∑' a, f (some a) :=
begin
  refine trans (ennreal.tsum_eq_add_tsum_ite none) _,
  refine congr_arg (λ x, f none + x) _,
  refine (tsum_eq_tsum_of_ne_zero_bij (λ a, some a.1) _ (λ x hx, _) _),
  { simp only [subtype.val_eq_coe, imp_self, set_coe.forall, implies_true_iff] },
  { rw [function.mem_support, ne.def, ite_eq_left_iff, not_imp,
      ← ne.def, option.ne_none_iff_exists] at hx,
    obtain ⟨y, hy⟩ := hx.1,
    refine set.mem_range.2 ⟨⟨y, function.mem_support.2 (hy.symm ▸ hx.2)⟩, hy⟩ },
  convert λ x, if_neg (option.some_ne_none _),
end

lemma nnreal.tsum_option [decidable_eq α] {f : option α → ℝ≥0} (hf : summable f) :
  tsum f = f none + ∑' (a : α), f (some a) :=
calc ∑' (x : option α), f x
  = f none + ∑' (x : option α), ite (x = none) 0 (f x) :
  begin
    convert @nnreal.tsum_eq_add_tsum_ite (option α) f hf none,
    ext x, split_ifs,
    refl, refl,
  end
  ... = f none + ∑' (a : α), f (some a) : begin
    refine congr_arg (λ x, f none + x) (tsum_eq_tsum_of_ne_zero_bij (λ a, some a.1) _ _ _),
    { simp only [subtype.val_eq_coe, imp_self, set_coe.forall, implies_true_iff] },
    { simp only [function.support_subset_iff, ne.def, ite_eq_left_iff, not_forall, exists_prop,
        set.mem_range, set_coe.exists, function.mem_support, and_imp],
      intros x hx hfx,
      cases x with a,
      { exact false.elim (hx rfl) },
      { exact ⟨a, hfx, rfl⟩ } },
    { simp only [subtype.val_eq_coe, if_false, eq_self_iff_true, implies_true_iff] }
end

end option

section vector

lemma tsum_vector_succ [add_comm_monoid β] [topological_space β]
  (n : ℕ) (f : vector α n.succ → β) :
  ∑' (xs' : vector α n.succ), f xs' = ∑' (x : α) (xs : vector α n), f (x ::ᵥ xs) :=
begin
  sorry
end

end vector


import data.list
open list
variable α: Type*
example (xs ys: list α):
  length (reverse (xs ++ ys)) = length xs + length ys :=
by simp [add_comm]


import analysis.normed_space.basic
import analysis.specific_limits
import for_mathlib.topology

open set metric function normed_field

lemma nondiscrete_normed_field.nondiscrete {k  : Type*} [nondiscrete_normed_field k] :
  ¬ discrete_topology k :=
begin
  intro h,
  replace h := discrete_iff_open_singletons.mp h 0,
  rw is_open_iff at h,
  rcases h 0 (mem_singleton 0) with ⟨ε, ε_pos, hε⟩,
  rcases exists_norm_lt_one k with ⟨x₀, x₀_ne, hx₀⟩,
  obtain ⟨n, hn⟩ : ∃ n : ℕ, ∥x₀^n∥ < ε,
  { cases tendsto_at_top.mp (tendsto_pow_at_top_nhds_0_of_lt_1 (le_of_lt x₀_ne) hx₀) ε ε_pos with N hN,
    use N,
    simpa [norm_pow] using hN N (le_refl _) },
  rw ball_0_eq at hε,
  specialize hε hn,
  rw [mem_singleton_iff, ← norm_eq_zero, norm_pow] at hε,
  rw pow_eq_zero hε at x₀_ne,
  exact lt_irrefl _ x₀_ne
end


import algebra.category.Group.limits
import for_mathlib.Profinite.extend
import Lbar.basic
import Lbar.functor
import pseudo_normed_group.category.strictProFiltPseuNormGrpWithTinv
import pseudo_normed_group.bounded_limits

noncomputable theory

universes u v

open_locale nnreal

set_option pp.universes true

open Lbar Profinite CommGroup category_theory.limits

lemma limit_torsion_free_to_Ab
  {C : Type u} [category_theory.small_category C] (J : C ⥤ Ab.{u})
  (h_tf : ∀ j, no_zero_smul_divisors ℤ (J.obj j))
  : no_zero_smul_divisors ℤ (limit J).α :=
begin
  let L := get_limit_cone _,
  haveI := AddCommGroup.forget_preserves_limits.{u u},
  have h_inj := @concrete.to_product_injective_of_is_limit.{u} AddCommGroup.{u} _ _
    C _ J _ L.cone L.is_limit,
  fconstructor,
  intros c x hx,
  let φ := λ x : (limit J), λ j, (L.cone.π.app j) x,
  have h1: φ 0 = 0,
  { ext j,
    exact (L.cone.π.app j).2 },
  have h2: φ (c • x) = c • φ x,
  { ext j,
    exact map_zsmul (L.cone.π.app j) _ _ },
  apply_fun φ at hx,
  simp only [h1, h2, pi.zero_def, function.funext_iff, pi.smul_apply, smul_eq_zero] at hx,
  by_cases hc : c = 0,
  { apply or.intro_left, exact hc},
  { simp only [hc, false_or] at hx,
    apply or.intro_right,
    apply h_inj,
    funext j,
    specialize hx j,
    simp only [_root_.map_zero],
    exact hx },
end

--[FAE] not needed for LTE, may be for mathlib?
lemma add_comm_group.limit_on_nat_torsion_free
  (J : (category_theory.as_small.{u} ℕ) ⥤ AddCommGroup.{u})
  (h_tf : ∀ j, no_zero_smul_divisors ℤ (J.obj j))
  : no_zero_smul_divisors ℤ (limit J).α := limit_torsion_free_to_Ab J h_tf

open CompHausFiltPseuNormGrp₁ category_theory

instance : concrete_category.{u} PseuNormGrp₁.{u} :=
{ forget :=
  { obj := λ M, M,
    map := λ M N f, f,
    map_id' := λ M, rfl,
    map_comp' := λ _ _ _ f g, rfl },
  forget_faithful := { map_injective' := λ M N f g h, by { ext, dsimp at h, rw h, } } }

lemma PNG₁.iso_injective {X Y : PseuNormGrp₁.{u}} (f : X ≅ Y) :
  function.injective f.hom :=
begin
  intros x y h,
  apply_fun f.inv at h,
  simp only [← category_theory.comp_apply, f.hom_inv_id] at h,
  exact h,
end

lemma PNG₁.map_zsmul {X Y : PseuNormGrp₁} (f : X ⟶ Y) (n : ℤ) (x : X) :
  f (n • x) = n • f x :=
f.to_add_monoid_hom.map_zsmul _ _

namespace Profinite

lemma extend_torsion_free (A : Fintype.{u} ⥤ CompHausFiltPseuNormGrp₁)
  (hA : ∀ X, no_zero_smul_divisors ℤ (A.obj X)) (S : Profinite) :
  no_zero_smul_divisors ℤ ((Profinite.extend A).obj S) :=
begin
  let T := Ab.explicit_limit_cone.{u u}
    ((S.fintype_diagram ⋙ A ⋙ to_PNG₁) ⋙ PseuNormGrp₁.to_Ab),
  set T' := limit.cone.{u u} ((S.fintype_diagram ⋙ A ⋙ to_PNG₁) ⋙ PseuNormGrp₁.to_Ab) with hT',
  let hT : is_limit T := Ab.explicit_limit_cone_is_limit _,
  let E := PseuNormGrp₁.bounded_cone.{u} ⟨T,hT⟩,
  let hE : is_limit E := PseuNormGrp₁.bounded_cone_is_limit _,
  suffices claim : no_zero_smul_divisors ℤ E.X,
  { resetI,
    let iso : to_PNG₁.obj ((extend (A)).obj S) ≅ E.X :=
      (is_limit_of_preserves to_PNG₁
      (limit.is_limit _)).cone_point_unique_up_to_iso hE,
    apply function.injective.no_zero_smul_divisors iso.hom (PNG₁.iso_injective _),
    any_goals { apply_instance },
    { apply strict_pseudo_normed_group_hom.map_zero },
    { intros, rw PNG₁.map_zsmul } },
  let ι : E.X →+ T.X := add_subgroup.subtype _,
  apply function.injective.no_zero_smul_divisors ι (subtype.val_injective.{u+1}) ι.map_zero,
  any_goals { apply_instance },
  { intros c x, apply ι.map_zsmul, },
  let iso_pts := functor.map_iso (limits.cones.forget.{u} _)
    (hT.unique_up_to_iso (limit_cone.is_limit.{u u u u+1} _)),
  let φ := (@iso.AddCommGroup_iso_to_add_equiv.{u} T.X T'.X iso_pts),
  apply function.injective.no_zero_smul_divisors φ φ.injective φ.map_zero,
  { intros c x,
    exact map_zsmul φ _ _ },
  apply limit_torsion_free_to_Ab.{u},
  intro j,
  exact hA ((S.fintype_diagram).obj j),
end

end Profinite


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.equiv.basic
import tactic.clear
import tactic.simp_result
import tactic.apply
import control.equiv_functor.instances -- these make equiv_rw more powerful!
import data.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 lean.parser
open interactive interactive.types
open tactic

local postfix `?`:9001 := optional

/--
`equiv_rw e at h`, where `h : α` is a hypothesis, and `e : α ≃ β`,
will attempt to transport `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` will also try rewriting under (equiv_)functors, so 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 (e : parse texpr) (loc : parse $ (tk "at" *> ident)?) (cfg : equiv_rw_cfg := {}) :
  itactic :=
do e ← to_expr e,
   match loc with
   | (some hyp) := equiv_rw_hyp hyp e cfg
   | none := equiv_rw_target e cfg
   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


/- induction tactic -/

example (as : List α) (a : α) : (as.concat a).length = as.length + 1 := by
  induction as with
  | nil => rfl
  | cons x xs ih => simp [List.concat, ih]

example (as : List α) (a : α) : (as.concat a).length = as.length + 1 := by
  induction as <;> simp! [*]