/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser

! This file was ported from Lean 3 source module group_theory.perm.subgroup
! leanprover-community/mathlib commit 50832daea47b195a48b5b33b1c8b2162c48c3afc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.Perm.Basic
import Mathbin.Data.Fintype.Perm
import Mathbin.GroupTheory.Subgroup.Finite

/-!
# Lemmas about subgroups within the permutations (self-equivalences) of a type `α`

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

This file provides extra lemmas about some `subgroup`s that exist within `equiv.perm α`.
`group_theory.subgroup` depends on `group_theory.perm.basic`, so these need to be in a separate
file.

It also provides decidable instances on membership in these subgroups, since
`monoid_hom.decidable_mem_range` cannot be inferred without the help of a lambda.
The presence of these instances induces a `fintype` instance on the `quotient_group.quotient` of
these subgroups.
-/

namespace Equiv

namespace Perm

universe u

/- warning: equiv.perm.sum_congr_hom.decidable_mem_range -> Equiv.Perm.sumCongrHom.decidableMemRange is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : DecidableEq.{succ u2} β] [_inst_3 : Fintype.{u1} α] [_inst_4 : Fintype.{u2} β], DecidablePred.{succ (max u1 u2)} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (fun (_x : Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) => Membership.Mem.{max u1 u2, max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β))) (SetLike.hasMem.{max u1 u2, max u1 u2} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Subgroup.setLike.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β)))) _x (MonoidHom.range.{max u1 u2, max u1 u2} (Prod.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β)) (Prod.group.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u1} α) (Equiv.Perm.permGroup.{u2} β)) (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β)) (Equiv.Perm.sumCongrHom.{u1, u2} α β)))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : DecidableEq.{succ u2} β] [_inst_3 : Fintype.{u1} α] [_inst_4 : Fintype.{u2} β], DecidablePred.{succ (max u1 u2)} (Equiv.Perm.{max (succ u2) (succ u1)} (Sum.{u1, u2} α β)) (fun (_x : Equiv.Perm.{max (succ u2) (succ u1)} (Sum.{u1, u2} α β)) => Membership.mem.{max u1 u2, max u1 u2} (Equiv.Perm.{max (succ u2) (succ u1)} (Sum.{u1, u2} α β)) (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u2) (succ u1)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β))) (SetLike.instMembership.{max u1 u2, max u1 u2} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u2) (succ u1)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β))) (Equiv.Perm.{max (succ u2) (succ u1)} (Sum.{u1, u2} α β)) (Subgroup.instSetLikeSubgroup.{max u1 u2} (Equiv.Perm.{max (succ u2) (succ u1)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β)))) _x (MonoidHom.range.{max u1 u2, max u1 u2} (Prod.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β)) (Prod.instGroupProd.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u1} α) (Equiv.Perm.permGroup.{u2} β)) (Equiv.Perm.{max (succ u2) (succ u1)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β)) (Equiv.Perm.sumCongrHom.{u1, u2} α β)))
Case conversion may be inaccurate. Consider using '#align equiv.perm.sum_congr_hom.decidable_mem_range Equiv.Perm.sumCongrHom.decidableMemRangeₓ'. -/
instance sumCongrHom.decidableMemRange {α β : Type _} [DecidableEq α] [DecidableEq β] [Fintype α]
    [Fintype β] : DecidablePred (· ∈ (sumCongrHom α β).range) := fun x => inferInstance
#align equiv.perm.sum_congr_hom.decidable_mem_range Equiv.Perm.sumCongrHom.decidableMemRange

/- warning: equiv.perm.sum_congr_hom.card_range -> Equiv.Perm.sumCongrHom.card_range is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Fintype.{max u1 u2} (coeSort.{succ (max u1 u2), succ (succ (max u1 u2))} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β))) Type.{max u1 u2} (SetLike.hasCoeToSort.{max u1 u2, max u1 u2} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Subgroup.setLike.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β)))) (MonoidHom.range.{max u1 u2, max u1 u2} (Prod.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β)) (Prod.group.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u1} α) (Equiv.Perm.permGroup.{u2} β)) (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β)) (Equiv.Perm.sumCongrHom.{u1, u2} α β)))] [_inst_2 : Fintype.{max u1 u2} (Prod.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β))], Eq.{1} Nat (Fintype.card.{max u1 u2} (coeSort.{succ (max u1 u2), succ (succ (max u1 u2))} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β))) Type.{max u1 u2} (SetLike.hasCoeToSort.{max u1 u2, max u1 u2} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Subgroup.setLike.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β)))) (MonoidHom.range.{max u1 u2, max u1 u2} (Prod.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β)) (Prod.group.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u1} α) (Equiv.Perm.permGroup.{u2} β)) (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β)) (Equiv.Perm.permGroup.{max u1 u2} (Sum.{u1, u2} α β)) (Equiv.Perm.sumCongrHom.{u1, u2} α β))) _inst_1) (Fintype.card.{max u1 u2} (Prod.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β)) _inst_2)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Fintype.{max u2 u1} (Subtype.{succ (max u2 u1)} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (fun (x : Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) => Membership.mem.{max u2 u1, max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Subgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Equiv.Perm.permGroup.{max u2 u1} (Sum.{u2, u1} α β))) (SetLike.instMembership.{max u2 u1, max u2 u1} (Subgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Equiv.Perm.permGroup.{max u2 u1} (Sum.{u2, u1} α β))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Subgroup.instSetLikeSubgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Equiv.Perm.permGroup.{max u2 u1} (Sum.{u2, u1} α β)))) x (MonoidHom.range.{max u2 u1, max u2 u1} (Prod.{u2, u1} (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β)) (Prod.instGroupProd.{u2, u1} (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β) (Equiv.Perm.permGroup.{u2} α) (Equiv.Perm.permGroup.{u1} β)) (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Equiv.Perm.permGroup.{max u2 u1} (Sum.{u2, u1} α β)) (Equiv.Perm.sumCongrHom.{u2, u1} α β))))] [_inst_2 : Fintype.{max u1 u2} (Prod.{u2, u1} (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β))], Eq.{1} Nat (Fintype.card.{max u2 u1} (Subtype.{succ (max u2 u1)} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (fun (x : Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) => Membership.mem.{max u2 u1, max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Subgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Equiv.Perm.permGroup.{max u2 u1} (Sum.{u2, u1} α β))) (SetLike.instMembership.{max u2 u1, max u2 u1} (Subgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Equiv.Perm.permGroup.{max u2 u1} (Sum.{u2, u1} α β))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Subgroup.instSetLikeSubgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Equiv.Perm.permGroup.{max u2 u1} (Sum.{u2, u1} α β)))) x (MonoidHom.range.{max u2 u1, max u2 u1} (Prod.{u2, u1} (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β)) (Prod.instGroupProd.{u2, u1} (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β) (Equiv.Perm.permGroup.{u2} α) (Equiv.Perm.permGroup.{u1} β)) (Equiv.Perm.{max (succ u1) (succ u2)} (Sum.{u2, u1} α β)) (Equiv.Perm.permGroup.{max u2 u1} (Sum.{u2, u1} α β)) (Equiv.Perm.sumCongrHom.{u2, u1} α β)))) _inst_1) (Fintype.card.{max u1 u2} (Prod.{u2, u1} (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β)) _inst_2)
Case conversion may be inaccurate. Consider using '#align equiv.perm.sum_congr_hom.card_range Equiv.Perm.sumCongrHom.card_rangeₓ'. -/
@[simp]
theorem sumCongrHom.card_range {α β : Type _} [Fintype (sumCongrHom α β).range]
    [Fintype (Perm α × Perm β)] :
    Fintype.card (sumCongrHom α β).range = Fintype.card (Perm α × Perm β) :=
  Fintype.card_eq.mpr ⟨(ofInjective (sumCongrHom α β) sumCongrHom_injective).symm⟩
#align equiv.perm.sum_congr_hom.card_range Equiv.Perm.sumCongrHom.card_range

/- warning: equiv.perm.sigma_congr_right_hom.decidable_mem_range -> Equiv.Perm.sigmaCongrRightHom.decidableMemRange is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : forall (a : α), DecidableEq.{succ u2} (β a)] [_inst_3 : Fintype.{u1} α] [_inst_4 : forall (a : α), Fintype.{u2} (β a)], DecidablePred.{succ (max u1 u2)} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (fun (_x : Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) => Membership.Mem.{max u1 u2, max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a)))) (SetLike.hasMem.{max u1 u2, max u1 u2} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a)))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Subgroup.setLike.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))))) _x (MonoidHom.range.{max u1 u2, max u1 u2} (forall (a : α), Equiv.Perm.{succ u2} (β a)) (Pi.group.{u1, u2} α (fun (a : α) => Equiv.Perm.{succ u2} (β a)) (fun (i : α) => Equiv.Perm.permGroup.{u2} (β i))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.sigmaCongrRightHom.{u1, u2} α β)))
but is expected to have type
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : forall (a : α), DecidableEq.{succ u2} (β a)] [_inst_3 : Fintype.{u1} α] [_inst_4 : forall (a : α), Fintype.{u2} (β a)], DecidablePred.{succ (max u1 u2)} (Equiv.Perm.{max (succ u2) (succ u1)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (fun (_x : Equiv.Perm.{max (succ u2) (succ u1)} (Sigma.{u1, u2} α (fun (a : α) => β a))) => Membership.mem.{max u1 u2, max u1 u2} (Equiv.Perm.{max (succ u2) (succ u1)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u2) (succ u1)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a)))) (SetLike.instMembership.{max u1 u2, max u1 u2} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u2) (succ u1)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a)))) (Equiv.Perm.{max (succ u2) (succ u1)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Subgroup.instSetLikeSubgroup.{max u1 u2} (Equiv.Perm.{max (succ u2) (succ u1)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))))) _x (MonoidHom.range.{max u1 u2, max u1 u2} (forall (a : α), Equiv.Perm.{succ u2} (β a)) (Pi.group.{u1, u2} α (fun (a : α) => Equiv.Perm.{succ u2} (β a)) (fun (i : α) => Equiv.Perm.permGroup.{u2} (β i))) (Equiv.Perm.{max (succ u2) (succ u1)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.sigmaCongrRightHom.{u1, u2} α β)))
Case conversion may be inaccurate. Consider using '#align equiv.perm.sigma_congr_right_hom.decidable_mem_range Equiv.Perm.sigmaCongrRightHom.decidableMemRangeₓ'. -/
instance sigmaCongrRightHom.decidableMemRange {α : Type _} {β : α → Type _} [DecidableEq α]
    [∀ a, DecidableEq (β a)] [Fintype α] [∀ a, Fintype (β a)] :
    DecidablePred (· ∈ (sigmaCongrRightHom β).range) := fun x => inferInstance
#align equiv.perm.sigma_congr_right_hom.decidable_mem_range Equiv.Perm.sigmaCongrRightHom.decidableMemRange

/- warning: equiv.perm.sigma_congr_right_hom.card_range -> Equiv.Perm.sigmaCongrRightHom.card_range is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : Fintype.{max u1 u2} (coeSort.{succ (max u1 u2), succ (succ (max u1 u2))} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a)))) Type.{max u1 u2} (SetLike.hasCoeToSort.{max u1 u2, max u1 u2} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a)))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Subgroup.setLike.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))))) (MonoidHom.range.{max u1 u2, max u1 u2} (forall (a : α), Equiv.Perm.{succ u2} (β a)) (Pi.group.{u1, u2} α (fun (a : α) => Equiv.Perm.{succ u2} (β a)) (fun (i : α) => Equiv.Perm.permGroup.{u2} (β i))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.sigmaCongrRightHom.{u1, u2} α β)))] [_inst_2 : Fintype.{max u1 u2} (forall (a : α), Equiv.Perm.{succ u2} (β a))], Eq.{1} Nat (Fintype.card.{max u1 u2} (coeSort.{succ (max u1 u2), succ (succ (max u1 u2))} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a)))) Type.{max u1 u2} (SetLike.hasCoeToSort.{max u1 u2, max u1 u2} (Subgroup.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a)))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Subgroup.setLike.{max u1 u2} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))))) (MonoidHom.range.{max u1 u2, max u1 u2} (forall (a : α), Equiv.Perm.{succ u2} (β a)) (Pi.group.{u1, u2} α (fun (a : α) => Equiv.Perm.{succ u2} (β a)) (fun (i : α) => Equiv.Perm.permGroup.{u2} (β i))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => β a))) (Equiv.Perm.sigmaCongrRightHom.{u1, u2} α β))) _inst_1) (Fintype.card.{max u1 u2} (forall (a : α), Equiv.Perm.{succ u2} (β a)) _inst_2)
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u1}} [_inst_1 : Fintype.{max u2 u1} (Subtype.{succ (max u2 u1)} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (fun (x : Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) => Membership.mem.{max u2 u1, max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Subgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a)))) (SetLike.instMembership.{max u2 u1, max u2 u1} (Subgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a)))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Subgroup.instSetLikeSubgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a))))) x (MonoidHom.range.{max u2 u1, max u2 u1} (forall (a : α), Equiv.Perm.{succ u1} (β a)) (Pi.group.{u2, u1} α (fun (a : α) => Equiv.Perm.{succ u1} (β a)) (fun (i : α) => Equiv.Perm.permGroup.{u1} (β i))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Equiv.Perm.sigmaCongrRightHom.{u2, u1} α β))))] [_inst_2 : Fintype.{max u2 u1} (forall (a : α), Equiv.Perm.{succ u1} (β a))], Eq.{1} Nat (Fintype.card.{max u2 u1} (Subtype.{succ (max u2 u1)} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (fun (x : Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) => Membership.mem.{max u2 u1, max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Subgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a)))) (SetLike.instMembership.{max u2 u1, max u2 u1} (Subgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a)))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Subgroup.instSetLikeSubgroup.{max u2 u1} (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a))))) x (MonoidHom.range.{max u2 u1, max u2 u1} (forall (a : α), Equiv.Perm.{succ u1} (β a)) (Pi.group.{u2, u1} α (fun (a : α) => Equiv.Perm.{succ u1} (β a)) (fun (i : α) => Equiv.Perm.permGroup.{u1} (β i))) (Equiv.Perm.{max (succ u1) (succ u2)} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Equiv.Perm.permGroup.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => β a))) (Equiv.Perm.sigmaCongrRightHom.{u2, u1} α β)))) _inst_1) (Fintype.card.{max u2 u1} (forall (a : α), Equiv.Perm.{succ u1} (β a)) _inst_2)
Case conversion may be inaccurate. Consider using '#align equiv.perm.sigma_congr_right_hom.card_range Equiv.Perm.sigmaCongrRightHom.card_rangeₓ'. -/
@[simp]
theorem sigmaCongrRightHom.card_range {α : Type _} {β : α → Type _}
    [Fintype (sigmaCongrRightHom β).range] [Fintype (∀ a, Perm (β a))] :
    Fintype.card (sigmaCongrRightHom β).range = Fintype.card (∀ a, Perm (β a)) :=
  Fintype.card_eq.mpr ⟨(ofInjective (sigmaCongrRightHom β) sigmaCongrRightHom_injective).symm⟩
#align equiv.perm.sigma_congr_right_hom.card_range Equiv.Perm.sigmaCongrRightHom.card_range

/- warning: equiv.perm.subtype_congr_hom.decidable_mem_range -> Equiv.Perm.subtypeCongrHom.decidableMemRange is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] [_inst_2 : Fintype.{u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a)))))] [_inst_3 : DecidableEq.{succ u1} (Equiv.Perm.{succ u1} α)], DecidablePred.{succ u1} (Equiv.Perm.{succ u1} α) (fun (_x : Equiv.Perm.{succ u1} α) => Membership.Mem.{u1, u1} (Equiv.Perm.{succ u1} α) (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) (SetLike.hasMem.{u1, u1} (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) (Equiv.Perm.{succ u1} α) (Subgroup.setLike.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))) _x (MonoidHom.range.{u1, u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Prod.group.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a)))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α) (Equiv.Perm.subtypeCongrHom.{u1} α p (fun (a : α) => _inst_1 a))))
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] [_inst_2 : Fintype.{u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a)))))] [_inst_3 : DecidableEq.{succ u1} (Equiv.Perm.{succ u1} α)], DecidablePred.{succ u1} (Equiv.Perm.{succ u1} α) (fun (_x : Equiv.Perm.{succ u1} α) => Membership.mem.{u1, u1} (Equiv.Perm.{succ u1} α) (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) (SetLike.instMembership.{u1, u1} (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) (Equiv.Perm.{succ u1} α) (Subgroup.instSetLikeSubgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))) _x (MonoidHom.range.{u1, u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Prod.instGroupProd.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a)))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α) (Equiv.Perm.subtypeCongrHom.{u1} α p (fun (a : α) => _inst_1 a))))
Case conversion may be inaccurate. Consider using '#align equiv.perm.subtype_congr_hom.decidable_mem_range Equiv.Perm.subtypeCongrHom.decidableMemRangeₓ'. -/
instance subtypeCongrHom.decidableMemRange {α : Type _} (p : α → Prop) [DecidablePred p]
    [Fintype (Perm { a // p a } × Perm { a // ¬p a })] [DecidableEq (Perm α)] :
    DecidablePred (· ∈ (subtypeCongrHom p).range) := fun x => inferInstance
#align equiv.perm.subtype_congr_hom.decidable_mem_range Equiv.Perm.subtypeCongrHom.decidableMemRange

/- warning: equiv.perm.subtype_congr_hom.card_range -> Equiv.Perm.subtypeCongrHom.card_range is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] [_inst_2 : Fintype.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) (Equiv.Perm.{succ u1} α) (Subgroup.setLike.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))) (MonoidHom.range.{u1, u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Prod.group.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a)))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α) (Equiv.Perm.subtypeCongrHom.{u1} α p (fun (a : α) => _inst_1 a))))] [_inst_3 : Fintype.{u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a)))))], Eq.{1} Nat (Fintype.card.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) (Equiv.Perm.{succ u1} α) (Subgroup.setLike.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))) (MonoidHom.range.{u1, u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Prod.group.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a)))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α) (Equiv.Perm.subtypeCongrHom.{u1} α p (fun (a : α) => _inst_1 a)))) _inst_2) (Fintype.card.{u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) _inst_3)
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] [_inst_2 : Fintype.{u1} (Subtype.{succ u1} (Equiv.Perm.{succ u1} α) (fun (x : Equiv.Perm.{succ u1} α) => Membership.mem.{u1, u1} (Equiv.Perm.{succ u1} α) (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) (SetLike.instMembership.{u1, u1} (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) (Equiv.Perm.{succ u1} α) (Subgroup.instSetLikeSubgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))) x (MonoidHom.range.{u1, u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Prod.instGroupProd.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a)))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α) (Equiv.Perm.subtypeCongrHom.{u1} α p (fun (a : α) => _inst_1 a)))))] [_inst_3 : Fintype.{u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a)))))], Eq.{1} Nat (Fintype.card.{u1} (Subtype.{succ u1} (Equiv.Perm.{succ u1} α) (fun (x : Equiv.Perm.{succ u1} α) => Membership.mem.{u1, u1} (Equiv.Perm.{succ u1} α) (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) (SetLike.instMembership.{u1, u1} (Subgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)) (Equiv.Perm.{succ u1} α) (Subgroup.instSetLikeSubgroup.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))) x (MonoidHom.range.{u1, u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Prod.instGroupProd.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a)))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.permGroup.{u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α) (Equiv.Perm.subtypeCongrHom.{u1} α p (fun (a : α) => _inst_1 a))))) _inst_2) (Fintype.card.{u1} (Prod.{u1, u1} (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => p a))) (Equiv.Perm.{succ u1} (Subtype.{succ u1} α (fun (a : α) => Not (p a))))) _inst_3)
Case conversion may be inaccurate. Consider using '#align equiv.perm.subtype_congr_hom.card_range Equiv.Perm.subtypeCongrHom.card_rangeₓ'. -/
@[simp]
theorem subtypeCongrHom.card_range {α : Type _} (p : α → Prop) [DecidablePred p]
    [Fintype (subtypeCongrHom p).range] [Fintype (Perm { a // p a } × Perm { a // ¬p a })] :
    Fintype.card (subtypeCongrHom p).range =
      Fintype.card (Perm { a // p a } × Perm { a // ¬p a }) :=
  Fintype.card_eq.mpr ⟨(ofInjective (subtypeCongrHom p) (subtypeCongrHom_injective p)).symm⟩
#align equiv.perm.subtype_congr_hom.card_range Equiv.Perm.subtypeCongrHom.card_range

/- warning: equiv.perm.subgroup_of_mul_action -> Equiv.Perm.subgroupOfMulAction is a dubious translation:
lean 3 declaration is
  forall (G : Type.{u1}) (H : Type.{u2}) [_inst_1 : Group.{u1} G] [_inst_2 : MulAction.{u1, u2} G H (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))] [_inst_3 : FaithfulSMul.{u1, u2} G H (MulAction.toHasSmul.{u1, u2} G H (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) _inst_2)], MulEquiv.{u1, u2} G (coeSort.{succ u2, succ (succ u2)} (Subgroup.{u2} (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H)) Type.{u2} (SetLike.hasCoeToSort.{u2, u2} (Subgroup.{u2} (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H)) (Equiv.Perm.{succ u2} H) (Subgroup.setLike.{u2} (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H))) (MonoidHom.range.{u1, u2} G _inst_1 (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H) (MulAction.toPermHom.{u1, u2} G H _inst_1 _inst_2))) (MulOneClass.toHasMul.{u1} G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)))) (Subgroup.mul.{u2} (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H) (MonoidHom.range.{u1, u2} G _inst_1 (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H) (MulAction.toPermHom.{u1, u2} G H _inst_1 _inst_2)))
but is expected to have type
  forall (G : Type.{u1}) (H : Type.{u2}) [_inst_1 : Group.{u1} G] [_inst_2 : MulAction.{u1, u2} G H (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))] [_inst_3 : FaithfulSMul.{u1, u2} G H (MulAction.toSMul.{u1, u2} G H (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)) _inst_2)], MulEquiv.{u1, u2} G (Subtype.{succ u2} (Equiv.Perm.{succ u2} H) (fun (x : Equiv.Perm.{succ u2} H) => Membership.mem.{u2, u2} (Equiv.Perm.{succ u2} H) (Subgroup.{u2} (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H)) (SetLike.instMembership.{u2, u2} (Subgroup.{u2} (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H)) (Equiv.Perm.{succ u2} H) (Subgroup.instSetLikeSubgroup.{u2} (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H))) x (MonoidHom.range.{u1, u2} G _inst_1 (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H) (MulAction.toPermHom.{u1, u2} G H _inst_1 _inst_2)))) (MulOneClass.toMul.{u1} G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1)))) (Subgroup.mul.{u2} (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H) (MonoidHom.range.{u1, u2} G _inst_1 (Equiv.Perm.{succ u2} H) (Equiv.Perm.permGroup.{u2} H) (MulAction.toPermHom.{u1, u2} G H _inst_1 _inst_2)))
Case conversion may be inaccurate. Consider using '#align equiv.perm.subgroup_of_mul_action Equiv.Perm.subgroupOfMulActionₓ'. -/
/-- **Cayley's theorem**: Every group G is isomorphic to a subgroup of the symmetric group acting on
`G`. Note that we generalize this to an arbitrary "faithful" group action by `G`. Setting `H = G`
recovers the usual statement of Cayley's theorem via `right_cancel_monoid.to_has_faithful_smul` -/
noncomputable def subgroupOfMulAction (G H : Type _) [Group G] [MulAction G H] [FaithfulSMul G H] :
    G ≃* (MulAction.toPermHom G H).range :=
  MulEquiv.ofLeftInverse' _ (Classical.choose_spec MulAction.toPerm_injective.HasLeftInverse)
#align equiv.perm.subgroup_of_mul_action Equiv.Perm.subgroupOfMulAction

end Perm

end Equiv


/-
Copyright (c) 2019 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Yury Kudryashov, Yaël Dillies

! This file was ported from Lean 3 source module analysis.convex.segment
! leanprover-community/mathlib commit c5773405394e073885e2a144c9ca14637e8eb963
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Invertible
import Mathlib.Algebra.Order.SMul
import Mathlib.LinearAlgebra.AffineSpace.Midpoint
import Mathlib.LinearAlgebra.Ray
import Mathlib.Tactic.Positivity

/-!
# Segments in vector spaces

In a 𝕜-vector space, we define the following objects and properties.
* `segment 𝕜 x y`: Closed segment joining `x` and `y`.
* `openSegment 𝕜 x y`: Open segment joining `x` and `y`.

## Notations

We provide the following notation:
* `[x -[𝕜] y] = segment 𝕜 x y` in locale `convex`

## TODO

Generalize all this file to affine spaces.

Should we rename `segment` and `openSegment` to `convex.Icc` and `convex.Ioo`? Should we also
define `clopenSegment`/`convex.Ico`/`convex.Ioc`?
-/

variable {𝕜 E F G ι : Type _} {π : ι → Type _}

open Function Set

open Pointwise Convex

section OrderedSemiring

variable [OrderedSemiring 𝕜] [AddCommMonoid E]

section SMul

variable (𝕜) [SMul 𝕜 E] {s : Set E} {x y : E}

/-- Segments in a vector space. -/
def segment (x y : E) : Set E :=
  { z : E | ∃ (a b : 𝕜) (_ : 0 ≤ a) (_ : 0 ≤ b) (_ : a + b = 1), a • x + b • y = z }
#align segment segment

/-- Open segment in a vector space. Note that `openSegment 𝕜 x x = {x}` instead of being `∅` when
the base semiring has some element between `0` and `1`. -/
def openSegment (x y : E) : Set E :=
  { z : E | ∃ (a b : 𝕜) (_ : 0 < a) (_ : 0 < b) (_ : a + b = 1), a • x + b • y = z }
#align open_segment openSegment

scoped[Convex] notation (priority := high) "[" x "-[" 𝕜 "]" y "]" => segment 𝕜 x y

theorem segment_eq_image₂ (x y : E) :
    [x -[𝕜] y] =
      (fun p : 𝕜 × 𝕜 => p.1 • x + p.2 • y) '' { p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 = 1 } :=
  by simp only [segment, image, Prod.exists, mem_setOf_eq, exists_prop, and_assoc]
#align segment_eq_image₂ segment_eq_image₂

theorem openSegment_eq_image₂ (x y : E) :
    openSegment 𝕜 x y =
      (fun p : 𝕜 × 𝕜 => p.1 • x + p.2 • y) '' { p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 = 1 } :=
  by simp only [openSegment, image, Prod.exists, mem_setOf_eq, exists_prop, and_assoc]
#align open_segment_eq_image₂ openSegment_eq_image₂

theorem segment_symm (x y : E) : [x -[𝕜] y] = [y -[𝕜] x] :=
  Set.ext fun _ =>
    ⟨fun ⟨a, b, ha, hb, hab, H⟩ => ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩,
      fun ⟨a, b, ha, hb, hab, H⟩ =>
      ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩⟩
#align segment_symm segment_symm

theorem openSegment_symm (x y : E) : openSegment 𝕜 x y = openSegment 𝕜 y x :=
  Set.ext fun _ =>
    ⟨fun ⟨a, b, ha, hb, hab, H⟩ => ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩,
      fun ⟨a, b, ha, hb, hab, H⟩ =>
      ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩⟩
#align open_segment_symm openSegment_symm

theorem openSegment_subset_segment (x y : E) : openSegment 𝕜 x y ⊆ [x -[𝕜] y] :=
  fun _ ⟨a, b, ha, hb, hab, hz⟩ => ⟨a, b, ha.le, hb.le, hab, hz⟩
#align open_segment_subset_segment openSegment_subset_segment

theorem segment_subset_iff :
    [x -[𝕜] y] ⊆ s ↔ ∀ a b : 𝕜, 0 ≤ a → 0 ≤ b → a + b = 1 → a • x + b • y ∈ s :=
  ⟨fun H a b ha hb hab => H ⟨a, b, ha, hb, hab, rfl⟩, fun H _ ⟨a, b, ha, hb, hab, hz⟩ =>
    hz ▸ H a b ha hb hab⟩
#align segment_subset_iff segment_subset_iff

theorem openSegment_subset_iff :
    openSegment 𝕜 x y ⊆ s ↔ ∀ a b : 𝕜, 0 < a → 0 < b → a + b = 1 → a • x + b • y ∈ s :=
  ⟨fun H a b ha hb hab => H ⟨a, b, ha, hb, hab, rfl⟩, fun H _ ⟨a, b, ha, hb, hab, hz⟩ =>
    hz ▸ H a b ha hb hab⟩
#align open_segment_subset_iff openSegment_subset_iff

end SMul

open Convex

section MulActionWithZero

variable (𝕜)
variable [MulActionWithZero 𝕜 E]

set_option synthInstance.etaExperiment true

theorem left_mem_segment (x y : E) : x ∈ [x -[𝕜] y] :=
  ⟨1, 0, zero_le_one, le_refl 0, add_zero 1, by rw [zero_smul, one_smul, add_zero]⟩
#align left_mem_segment left_mem_segment

theorem right_mem_segment (x y : E) : y ∈ [x -[𝕜] y] :=
  segment_symm 𝕜 y x ▸ left_mem_segment 𝕜 y x
#align right_mem_segment right_mem_segment

end MulActionWithZero

section Module

variable (𝕜)
variable [Module 𝕜 E] {s : Set E} {x y z : E}

@[simp]
theorem segment_same (x : E) : [x -[𝕜] x] = {x} :=
  Set.ext fun z =>
    ⟨fun ⟨a, b, _, _, hab, hz⟩ => by
      simpa only [(add_smul _ _ _).symm, mem_singleton_iff, hab, one_smul, eq_comm] using hz,
      fun h => mem_singleton_iff.1 h ▸ left_mem_segment 𝕜 z z⟩
#align segment_same segment_same

theorem insert_endpoints_openSegment (x y : E) :
    insert x (insert y (openSegment 𝕜 x y)) = [x -[𝕜] y] := by
  simp only [subset_antisymm_iff, insert_subset, left_mem_segment, right_mem_segment,
    openSegment_subset_segment, true_and_iff]
  rintro z ⟨a, b, ha, hb, hab, rfl⟩
  refine' hb.eq_or_gt.imp _ fun hb' => ha.eq_or_gt.imp _ fun ha' => _
  · rintro rfl
    rw [← add_zero a, hab, one_smul, zero_smul, add_zero]
  · rintro rfl
    rw [← zero_add b, hab, one_smul, zero_smul, zero_add]
  · exact ⟨a, b, ha', hb', hab, rfl⟩
#align insert_endpoints_open_segment insert_endpoints_openSegment

variable {𝕜}

theorem mem_openSegment_of_ne_left_right (hx : x ≠ z) (hy : y ≠ z) (hz : z ∈ [x -[𝕜] y]) :
    z ∈ openSegment 𝕜 x y := by
  rw [← insert_endpoints_openSegment] at hz
  exact (hz.resolve_left hx.symm).resolve_left hy.symm
#align mem_open_segment_of_ne_left_right mem_openSegment_of_ne_left_right

theorem openSegment_subset_iff_segment_subset (hx : x ∈ s) (hy : y ∈ s) :
    openSegment 𝕜 x y ⊆ s ↔ [x -[𝕜] y] ⊆ s := by
  simp only [← insert_endpoints_openSegment, insert_subset, *, true_and_iff]
#align open_segment_subset_iff_segment_subset openSegment_subset_iff_segment_subset

end Module

end OrderedSemiring

open Convex

section OrderedRing

variable (𝕜) [OrderedRing 𝕜] [AddCommGroup E] [AddCommGroup F] [AddCommGroup G] [Module 𝕜 E]
  [Module 𝕜 F]

section DenselyOrdered

variable [Nontrivial 𝕜] [DenselyOrdered 𝕜]

@[simp]
theorem openSegment_same (x : E) : openSegment 𝕜 x x = {x} :=
  Set.ext fun z =>
    ⟨fun ⟨a, b, _, _, hab, hz⟩ => by
      simpa only [← add_smul, mem_singleton_iff, hab, one_smul, eq_comm] using hz, fun h : z = x =>
      by
      obtain ⟨a, ha₀, ha₁⟩ := DenselyOrdered.dense (0 : 𝕜) 1 zero_lt_one
      refine' ⟨a, 1 - a, ha₀, sub_pos_of_lt ha₁, add_sub_cancel'_right _ _, _⟩
      rw [← add_smul, add_sub_cancel'_right, one_smul, h]⟩
#align open_segment_same openSegment_same

end DenselyOrdered

theorem segment_eq_image (x y : E) :
    [x -[𝕜] y] = (fun θ : 𝕜 => (1 - θ) • x + θ • y) '' Icc (0 : 𝕜) 1 :=
  Set.ext fun z =>
    ⟨fun ⟨a, b, ha, hb, hab, hz⟩ =>
      ⟨b, ⟨hb, hab ▸ le_add_of_nonneg_left ha⟩, hab ▸ hz ▸ by simp only [add_sub_cancel]⟩,
      fun ⟨θ, ⟨hθ₀, hθ₁⟩, hz⟩ => ⟨1 - θ, θ, sub_nonneg.2 hθ₁, hθ₀, sub_add_cancel _ _, hz⟩⟩
#align segment_eq_image segment_eq_image

theorem openSegment_eq_image (x y : E) :
    openSegment 𝕜 x y = (fun θ : 𝕜 => (1 - θ) • x + θ • y) '' Ioo (0 : 𝕜) 1 :=
  Set.ext fun z =>
    ⟨fun ⟨a, b, ha, hb, hab, hz⟩ =>
      ⟨b, ⟨hb, hab ▸ lt_add_of_pos_left _ ha⟩, hab ▸ hz ▸ by simp only [add_sub_cancel]⟩,
      fun ⟨θ, ⟨hθ₀, hθ₁⟩, hz⟩ => ⟨1 - θ, θ, sub_pos.2 hθ₁, hθ₀, sub_add_cancel _ _, hz⟩⟩
#align open_segment_eq_image openSegment_eq_image

theorem segment_eq_image' (x y : E) :
    [x -[𝕜] y] = (fun θ : 𝕜 => x + θ • (y - x)) '' Icc (0 : 𝕜) 1 := by
  convert segment_eq_image 𝕜 x y using 2
  simp only [smul_sub, sub_smul, one_smul]
  abel
#align segment_eq_image' segment_eq_image'

theorem openSegment_eq_image' (x y : E) :
    openSegment 𝕜 x y = (fun θ : 𝕜 => x + θ • (y - x)) '' Ioo (0 : 𝕜) 1 := by
  convert openSegment_eq_image 𝕜 x y using 2
  simp only [smul_sub, sub_smul, one_smul]
  abel
#align open_segment_eq_image' openSegment_eq_image'

theorem segment_eq_image_lineMap (x y : E) : [x -[𝕜] y] = AffineMap.lineMap x y '' Icc (0 : 𝕜) 1 :=
  by
  convert segment_eq_image 𝕜 x y using 2
  exact AffineMap.lineMap_apply_module _ _ _
#align segment_eq_image_line_map segment_eq_image_lineMap

theorem openSegment_eq_image_lineMap (x y : E) :
    openSegment 𝕜 x y = AffineMap.lineMap x y '' Ioo (0 : 𝕜) 1 := by
  convert openSegment_eq_image 𝕜 x y using 2
  exact AffineMap.lineMap_apply_module _ _ _
#align open_segment_eq_image_line_map openSegment_eq_image_lineMap

@[simp]
theorem image_segment (f : E →ᵃ[𝕜] F) (a b : E) : f '' [a -[𝕜] b] = [f a -[𝕜] f b] :=
  Set.ext fun x => by
    simp_rw [segment_eq_image_lineMap, mem_image, exists_exists_and_eq_and, AffineMap.apply_lineMap]
#align image_segment image_segment

@[simp]
theorem image_openSegment (f : E →ᵃ[𝕜] F) (a b : E) :
    f '' openSegment 𝕜 a b = openSegment 𝕜 (f a) (f b) :=
  Set.ext fun x => by
    simp_rw [openSegment_eq_image_lineMap, mem_image, exists_exists_and_eq_and,
      AffineMap.apply_lineMap]
#align image_open_segment image_openSegment

@[simp]
theorem vadd_segment [AddTorsor G E] [VAddCommClass G E E] (a : G) (b c : E) :
    a +ᵥ [b -[𝕜] c] = [a +ᵥ b -[𝕜] a +ᵥ c] :=
  image_segment 𝕜 ⟨_, LinearMap.id, fun _ _ => vadd_comm _ _ _⟩ b c
#align vadd_segment vadd_segment

@[simp]
theorem vadd_openSegment [AddTorsor G E] [VAddCommClass G E E] (a : G) (b c : E) :
    a +ᵥ openSegment 𝕜 b c = openSegment 𝕜 (a +ᵥ b) (a +ᵥ c) :=
  image_openSegment 𝕜 ⟨_, LinearMap.id, fun _ _ => vadd_comm _ _ _⟩ b c
#align vadd_open_segment vadd_openSegment

@[simp]
theorem mem_segment_translate (a : E) {x b c} : a + x ∈ [a + b -[𝕜] a + c] ↔ x ∈ [b -[𝕜] c] := by
  simp_rw [← vadd_eq_add, ← vadd_segment, vadd_mem_vadd_set_iff]
#align mem_segment_translate mem_segment_translate

@[simp]
theorem mem_openSegment_translate (a : E) {x b c : E} :
    a + x ∈ openSegment 𝕜 (a + b) (a + c) ↔ x ∈ openSegment 𝕜 b c := by
  simp_rw [← vadd_eq_add, ← vadd_openSegment, vadd_mem_vadd_set_iff]
#align mem_open_segment_translate mem_openSegment_translate

theorem segment_translate_preimage (a b c : E) :
    (fun x => a + x) ⁻¹' [a + b -[𝕜] a + c] = [b -[𝕜] c] :=
  Set.ext fun _ => mem_segment_translate 𝕜 a
#align segment_translate_preimage segment_translate_preimage

theorem openSegment_translate_preimage (a b c : E) :
    (fun x => a + x) ⁻¹' openSegment 𝕜 (a + b) (a + c) = openSegment 𝕜 b c :=
  Set.ext fun _ => mem_openSegment_translate 𝕜 a
#align open_segment_translate_preimage openSegment_translate_preimage

theorem segment_translate_image (a b c : E) : (fun x => a + x) '' [b -[𝕜] c] = [a + b -[𝕜] a + c] :=
  segment_translate_preimage 𝕜 a b c ▸ image_preimage_eq _ <| add_left_surjective a
#align segment_translate_image segment_translate_image

theorem openSegment_translate_image (a b c : E) :
    (fun x => a + x) '' openSegment 𝕜 b c = openSegment 𝕜 (a + b) (a + c) :=
  openSegment_translate_preimage 𝕜 a b c ▸ image_preimage_eq _ <| add_left_surjective a
#align open_segment_translate_image openSegment_translate_image

end OrderedRing

theorem sameRay_of_mem_segment [StrictOrderedCommRing 𝕜] [AddCommGroup E] [Module 𝕜 E] {x y z : E}
    (h : x ∈ [y -[𝕜] z]) : SameRay 𝕜 (x - y) (z - x) := by
  rw [segment_eq_image'] at h
  rcases h with ⟨θ, ⟨hθ₀, hθ₁⟩, rfl⟩
  simpa only [add_sub_cancel', ← sub_sub, sub_smul, one_smul] using
    (SameRay.sameRay_nonneg_smul_left (z - y) hθ₀).nonneg_smul_right (sub_nonneg.2 hθ₁)
#align same_ray_of_mem_segment sameRay_of_mem_segment

section LinearOrderedRing

variable [LinearOrderedRing 𝕜] [AddCommGroup E] [Module 𝕜 E] {x y : E}

theorem midpoint_mem_segment [Invertible (2 : 𝕜)] (x y : E) : midpoint 𝕜 x y ∈ [x -[𝕜] y] := by
  rw [segment_eq_image_lineMap]
  exact ⟨⅟ 2, ⟨invOf_nonneg.mpr zero_le_two, invOf_le_one one_le_two⟩, rfl⟩
#align midpoint_mem_segment midpoint_mem_segment

theorem mem_segment_sub_add [Invertible (2 : 𝕜)] (x y : E) : x ∈ [x - y -[𝕜] x + y] := by
  convert @midpoint_mem_segment 𝕜 _ _ _ _ _ _ _
  rw [midpoint_sub_add]
#align mem_segment_sub_add mem_segment_sub_add

theorem mem_segment_add_sub [Invertible (2 : 𝕜)] (x y : E) : x ∈ [x + y -[𝕜] x - y] := by
  convert @midpoint_mem_segment 𝕜 _ _ _ _ _ _ _
  rw [midpoint_add_sub]
#align mem_segment_add_sub mem_segment_add_sub

@[simp]
theorem left_mem_openSegment_iff [DenselyOrdered 𝕜] [NoZeroSMulDivisors 𝕜 E] :
    x ∈ openSegment 𝕜 x y ↔ x = y := by
  constructor
  · rintro ⟨a, b, _, hb, hab, hx⟩
    refine' smul_right_injective _ hb.ne' ((add_right_inj (a • x)).1 _)
    rw [hx, ← add_smul, hab, one_smul]
  · rintro rfl
    rw [openSegment_same]
    exact mem_singleton _
#align left_mem_open_segment_iff left_mem_openSegment_iff

@[simp]
theorem right_mem_openSegment_iff [DenselyOrdered 𝕜] [NoZeroSMulDivisors 𝕜 E] :
    y ∈ openSegment 𝕜 x y ↔ x = y := by rw [openSegment_symm, left_mem_openSegment_iff, eq_comm]
#align right_mem_open_segment_iff right_mem_openSegment_iff

end LinearOrderedRing

section LinearOrderedSemifield

variable [LinearOrderedSemifield 𝕜] [AddCommGroup E] [Module 𝕜 E] {x y z : E}

theorem mem_segment_iff_div :
    x ∈ [y -[𝕜] z] ↔
      ∃ a b : 𝕜, 0 ≤ a ∧ 0 ≤ b ∧ 0 < a + b ∧ (a / (a + b)) • y + (b / (a + b)) • z = x := by
  constructor
  · rintro ⟨a, b, ha, hb, hab, rfl⟩
    use a, b, ha, hb
    simp [*]
  · rintro ⟨a, b, ha, hb, hab, rfl⟩
    refine' ⟨a / (a + b), b / (a + b), div_nonneg ha hab.le, div_nonneg hb hab.le, _, rfl⟩
    rw [← add_div, div_self hab.ne']
#align mem_segment_iff_div mem_segment_iff_div

theorem mem_openSegment_iff_div :
    x ∈ openSegment 𝕜 y z ↔ ∃ a b : 𝕜, 0 < a ∧ 0 < b ∧ (a / (a + b)) • y + (b / (a + b)) • z = x :=
  by
  constructor
  · rintro ⟨a, b, ha, hb, hab, rfl⟩
    use a, b, ha, hb
    rw [hab, div_one, div_one]
  · rintro ⟨a, b, ha, hb, rfl⟩
    have hab : 0 < a + b := by positivity
    refine' ⟨a / (a + b), b / (a + b), by positivity, by positivity, _, rfl⟩
    rw [← add_div, div_self hab.ne']
#align mem_open_segment_iff_div mem_openSegment_iff_div

end LinearOrderedSemifield

section LinearOrderedField

variable [LinearOrderedField 𝕜] [AddCommGroup E] [Module 𝕜 E] {x y z : E}

theorem mem_segment_iff_sameRay : x ∈ [y -[𝕜] z] ↔ SameRay 𝕜 (x - y) (z - x) := by
  refine' ⟨sameRay_of_mem_segment, fun h => _⟩
  rcases h.exists_eq_smul_add with ⟨a, b, ha, hb, hab, hxy, hzx⟩
  rw [add_comm, sub_add_sub_cancel] at hxy hzx
  rw [← mem_segment_translate _ (-x), neg_add_self]
  refine' ⟨b, a, hb, ha, add_comm a b ▸ hab, _⟩
  rw [← sub_eq_neg_add, ← neg_sub, hxy, ← sub_eq_neg_add, hzx, smul_neg, smul_comm, neg_add_self]
#align mem_segment_iff_same_ray mem_segment_iff_sameRay

open AffineMap

/-- If `z = lineMap x y c` is a point on the line passing through `x` and `y`, then the open
segment `openSegment 𝕜 x y` is included in the union of the open segments `openSegment 𝕜 x z`,
`openSegment 𝕜 z y`, and the point `z`. Informally, `(x, y) ⊆ {z} ∪ (x, z) ∪ (z, y)`. -/
theorem openSegment_subset_union (x y : E) {z : E} (hz : z ∈ range (lineMap x y : 𝕜 → E)) :
    openSegment 𝕜 x y ⊆ insert z (openSegment 𝕜 x z ∪ openSegment 𝕜 z y) := by
  rcases hz with ⟨c, rfl⟩
  simp only [openSegment_eq_image_lineMap, ← mapsTo']
  rintro a ⟨h₀, h₁⟩
  rcases lt_trichotomy a c with (hac | rfl | hca)
  · right
    left
    have hc : 0 < c := h₀.trans hac
    refine' ⟨a / c, ⟨div_pos h₀ hc, (div_lt_one hc).2 hac⟩, _⟩
    simp only [← homothety_eq_lineMap, ← homothety_mul_apply, div_mul_cancel _ hc.ne']
  · left
    rfl
  · right
    right
    have hc : 0 < 1 - c := sub_pos.2 (hca.trans h₁)
    simp only [← lineMap_apply_one_sub y]
    refine'
      ⟨(a - c) / (1 - c), ⟨div_pos (sub_pos.2 hca) hc, (div_lt_one hc).2 <| sub_lt_sub_right h₁ _⟩,
        _⟩
    simp only [← homothety_eq_lineMap, ← homothety_mul_apply, sub_mul, one_mul,
      div_mul_cancel _ hc.ne', sub_sub_sub_cancel_right]
#align open_segment_subset_union openSegment_subset_union

end LinearOrderedField

/-!
#### Segments in an ordered space

Relates `segment`, `openSegment` and `set.Icc`, `set.Ico`, `set.Ioc`, `set.Ioo`
-/

section OrderedSemiring

variable [OrderedSemiring 𝕜]

section OrderedAddCommMonoid

variable [OrderedAddCommMonoid E] [Module 𝕜 E] [OrderedSMul 𝕜 E] {x y : E}

theorem segment_subset_Icc (h : x ≤ y) : [x -[𝕜] y] ⊆ Icc x y := by
  rintro z ⟨a, b, ha, hb, hab, rfl⟩
  constructor
  calc
    x = a • x + b • x := (Convex.combo_self hab _).symm
    _ ≤ a • x + b • y := add_le_add_left (smul_le_smul_of_nonneg h hb) _

  calc
    a • x + b • y ≤ a • y + b • y := add_le_add_right (smul_le_smul_of_nonneg h ha) _
    _ = y := Convex.combo_self hab _

#align segment_subset_Icc segment_subset_Icc

end OrderedAddCommMonoid

section OrderedCancelAddCommMonoid

variable [OrderedCancelAddCommMonoid E] [Module 𝕜 E] [OrderedSMul 𝕜 E] {x y : E}

theorem openSegment_subset_Ioo (h : x < y) : openSegment 𝕜 x y ⊆ Ioo x y := by
  rintro z ⟨a, b, ha, hb, hab, rfl⟩
  constructor
  calc
    x = a • x + b • x := (Convex.combo_self hab _).symm
    _ < a • x + b • y := add_lt_add_left (smul_lt_smul_of_pos h hb) _

  calc
    a • x + b • y < a • y + b • y := add_lt_add_right (smul_lt_smul_of_pos h ha) _
    _ = y := Convex.combo_self hab _

#align open_segment_subset_Ioo openSegment_subset_Ioo

end OrderedCancelAddCommMonoid

section LinearOrderedAddCommMonoid

variable [LinearOrderedAddCommMonoid E] [Module 𝕜 E] [OrderedSMul 𝕜 E] {a b : 𝕜}

theorem segment_subset_uIcc (x y : E) : [x -[𝕜] y] ⊆ uIcc x y := by
  cases' le_total x y with h h
  · rw [uIcc_of_le h]
    exact segment_subset_Icc h
  · rw [uIcc_of_ge h, segment_symm]
    exact segment_subset_Icc h
#align segment_subset_uIcc segment_subset_uIcc

theorem Convex.min_le_combo (x y : E) (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) :
    min x y ≤ a • x + b • y :=
  (segment_subset_uIcc x y ⟨_, _, ha, hb, hab, rfl⟩).1
#align convex.min_le_combo Convex.min_le_combo

theorem Convex.combo_le_max (x y : E) (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) :
    a • x + b • y ≤ max x y :=
  (segment_subset_uIcc x y ⟨_, _, ha, hb, hab, rfl⟩).2
#align convex.combo_le_max Convex.combo_le_max

end LinearOrderedAddCommMonoid

end OrderedSemiring

section LinearOrderedField

variable [LinearOrderedField 𝕜] {x y z : 𝕜}

theorem Icc_subset_segment : Icc x y ⊆ [x -[𝕜] y] := by
  rintro z ⟨hxz, hyz⟩
  obtain rfl | h := (hxz.trans hyz).eq_or_lt
  · rw [segment_same]
    exact hyz.antisymm hxz
  rw [← sub_nonneg] at hxz hyz
  rw [← sub_pos] at h
  refine' ⟨(y - z) / (y - x), (z - x) / (y - x), div_nonneg hyz h.le, div_nonneg hxz h.le, _, _⟩
  · rw [← add_div, sub_add_sub_cancel, div_self h.ne']
  ·
    rw [smul_eq_mul, smul_eq_mul, ← mul_div_right_comm, ← mul_div_right_comm, ← add_div,
      div_eq_iff h.ne', add_comm, sub_mul, sub_mul, mul_comm x, sub_add_sub_cancel, mul_sub]
#align Icc_subset_segment Icc_subset_segment

@[simp]
theorem segment_eq_Icc (h : x ≤ y) : [x -[𝕜] y] = Icc x y :=
  (segment_subset_Icc h).antisymm Icc_subset_segment
#align segment_eq_Icc segment_eq_Icc

theorem Ioo_subset_openSegment : Ioo x y ⊆ openSegment 𝕜 x y := fun _ hz =>
  mem_openSegment_of_ne_left_right hz.1.ne hz.2.ne' <| Icc_subset_segment <| Ioo_subset_Icc_self hz
#align Ioo_subset_open_segment Ioo_subset_openSegment

@[simp]
theorem openSegment_eq_Ioo (h : x < y) : openSegment 𝕜 x y = Ioo x y :=
  (openSegment_subset_Ioo h).antisymm Ioo_subset_openSegment
#align open_segment_eq_Ioo openSegment_eq_Ioo

theorem segment_eq_Icc' (x y : 𝕜) : [x -[𝕜] y] = Icc (min x y) (max x y) := by
  cases' le_total x y with h h
  · rw [segment_eq_Icc h, max_eq_right h, min_eq_left h]
  · rw [segment_symm, segment_eq_Icc h, max_eq_left h, min_eq_right h]
#align segment_eq_Icc' segment_eq_Icc'

theorem openSegment_eq_Ioo' (hxy : x ≠ y) : openSegment 𝕜 x y = Ioo (min x y) (max x y) := by
  cases' hxy.lt_or_lt with h h
  · rw [openSegment_eq_Ioo h, max_eq_right h.le, min_eq_left h.le]
  · rw [openSegment_symm, openSegment_eq_Ioo h, max_eq_left h.le, min_eq_right h.le]
#align open_segment_eq_Ioo' openSegment_eq_Ioo'

theorem segment_eq_uIcc (x y : 𝕜) : [x -[𝕜] y] = uIcc x y :=
  segment_eq_Icc' _ _
#align segment_eq_uIcc segment_eq_uIcc

/-- A point is in an `Icc` iff it can be expressed as a convex combination of the endpoints. -/
theorem Convex.mem_Icc (h : x ≤ y) :
    z ∈ Icc x y ↔ ∃ a b, 0 ≤ a ∧ 0 ≤ b ∧ a + b = 1 ∧ a * x + b * y = z := by
  rw [← segment_eq_Icc h]
  simp_rw [← exists_prop]
  rfl
#align convex.mem_Icc Convex.mem_Icc

/-- A point is in an `Ioo` iff it can be expressed as a strict convex combination of the endpoints.
-/
theorem Convex.mem_Ioo (h : x < y) :
    z ∈ Ioo x y ↔ ∃ a b, 0 < a ∧ 0 < b ∧ a + b = 1 ∧ a * x + b * y = z := by
  rw [← openSegment_eq_Ioo h]
  simp_rw [← exists_prop]
  rfl
#align convex.mem_Ioo Convex.mem_Ioo

/-- A point is in an `Ioc` iff it can be expressed as a semistrict convex combination of the
endpoints. -/
theorem Convex.mem_Ioc (h : x < y) :
    z ∈ Ioc x y ↔ ∃ a b, 0 ≤ a ∧ 0 < b ∧ a + b = 1 ∧ a * x + b * y = z := by
  refine' ⟨fun hz => _, _⟩
  · obtain ⟨a, b, ha, hb, hab, rfl⟩ := (Convex.mem_Icc h.le).1 (Ioc_subset_Icc_self hz)
    obtain rfl | hb' := hb.eq_or_lt
    · rw [add_zero] at hab
      rw [hab, one_mul, MulZeroClass.zero_mul, add_zero] at hz
      exact (hz.1.ne rfl).elim
    · exact ⟨a, b, ha, hb', hab, rfl⟩
  · rintro ⟨a, b, ha, hb, hab, rfl⟩
    obtain rfl | ha' := ha.eq_or_lt
    · rw [zero_add] at hab
      rwa [hab, one_mul, MulZeroClass.zero_mul, zero_add, right_mem_Ioc]
    · exact Ioo_subset_Ioc_self ((Convex.mem_Ioo h).2 ⟨a, b, ha', hb, hab, rfl⟩)
#align convex.mem_Ioc Convex.mem_Ioc

/-- A point is in an `Ico` iff it can be expressed as a semistrict convex combination of the
endpoints. -/
theorem Convex.mem_Ico (h : x < y) :
    z ∈ Ico x y ↔ ∃ a b, 0 < a ∧ 0 ≤ b ∧ a + b = 1 ∧ a * x + b * y = z := by
  refine' ⟨fun hz => _, _⟩
  · obtain ⟨a, b, ha, hb, hab, rfl⟩ := (Convex.mem_Icc h.le).1 (Ico_subset_Icc_self hz)
    obtain rfl | ha' := ha.eq_or_lt
    · rw [zero_add] at hab
      rw [hab, one_mul, MulZeroClass.zero_mul, zero_add] at hz
      exact (hz.2.ne rfl).elim
    · exact ⟨a, b, ha', hb, hab, rfl⟩
  · rintro ⟨a, b, ha, hb, hab, rfl⟩
    obtain rfl | hb' := hb.eq_or_lt
    · rw [add_zero] at hab
      rwa [hab, one_mul, MulZeroClass.zero_mul, add_zero, left_mem_Ico]
    · exact Ioo_subset_Ico_self ((Convex.mem_Ioo h).2 ⟨a, b, ha, hb', hab, rfl⟩)
#align convex.mem_Ico Convex.mem_Ico

end LinearOrderedField

namespace Prod

variable [OrderedSemiring 𝕜] [AddCommMonoid E] [AddCommMonoid F] [Module 𝕜 E] [Module 𝕜 F]

theorem segment_subset (x y : E × F) : segment 𝕜 x y ⊆ segment 𝕜 x.1 y.1 ×ˢ segment 𝕜 x.2 y.2 := by
  rintro z ⟨a, b, ha, hb, hab, hz⟩
  exact ⟨⟨a, b, ha, hb, hab, congr_arg Prod.fst hz⟩, a, b, ha, hb, hab, congr_arg Prod.snd hz⟩
#align prod.segment_subset Prod.segment_subset

theorem openSegment_subset (x y : E × F) :
    openSegment 𝕜 x y ⊆ openSegment 𝕜 x.1 y.1 ×ˢ openSegment 𝕜 x.2 y.2 := by
  rintro z ⟨a, b, ha, hb, hab, hz⟩
  exact ⟨⟨a, b, ha, hb, hab, congr_arg Prod.fst hz⟩, a, b, ha, hb, hab, congr_arg Prod.snd hz⟩
#align prod.open_segment_subset Prod.openSegment_subset

theorem image_mk_segment_left (x₁ x₂ : E) (y : F) :
    (fun x => (x, y)) '' [x₁ -[𝕜] x₂] = [(x₁, y) -[𝕜] (x₂, y)] := by
  ext ⟨x', y'⟩
  simp_rw [Set.mem_image, segment, Set.mem_setOf, Prod.smul_mk, Prod.mk_add_mk, Prod.mk.inj_iff, ←
    exists_and_right, @exists_comm E, exists_eq_left']
  refine' exists₅_congr fun a b ha hb hab => _
  rw [Convex.combo_self hab]
#align prod.image_mk_segment_left Prod.image_mk_segment_left

theorem image_mk_segment_right (x : E) (y₁ y₂ : F) :
    (fun y => (x, y)) '' [y₁ -[𝕜] y₂] = [(x, y₁) -[𝕜] (x, y₂)] := by
  ext ⟨x', y'⟩
  simp_rw [Set.mem_image, segment, Set.mem_setOf, Prod.smul_mk, Prod.mk_add_mk, Prod.mk.inj_iff, ←
    exists_and_right, @exists_comm F, exists_eq_left']
  refine' exists₅_congr fun a b ha hb hab => _
  rw [Convex.combo_self hab]
#align prod.image_mk_segment_right Prod.image_mk_segment_right

theorem image_mk_openSegment_left (x₁ x₂ : E) (y : F) :
    (fun x => (x, y)) '' openSegment 𝕜 x₁ x₂ = openSegment 𝕜 (x₁, y) (x₂, y) := by
  ext ⟨x', y'⟩
  simp_rw [Set.mem_image, openSegment, Set.mem_setOf, Prod.smul_mk, Prod.mk_add_mk, Prod.mk.inj_iff,
    ← exists_and_right, @exists_comm E, exists_eq_left']
  refine' exists₅_congr fun a b ha hb hab => _
  rw [Convex.combo_self hab]
#align prod.image_mk_open_segment_left Prod.image_mk_openSegment_left

@[simp]
theorem image_mk_openSegment_right (x : E) (y₁ y₂ : F) :
    (fun y => (x, y)) '' openSegment 𝕜 y₁ y₂ = openSegment 𝕜 (x, y₁) (x, y₂) := by
  ext ⟨x', y'⟩
  simp_rw [Set.mem_image, openSegment, Set.mem_setOf, Prod.smul_mk, Prod.mk_add_mk, Prod.mk.inj_iff,
    ← exists_and_right, @exists_comm F, exists_eq_left']
  refine' exists₅_congr fun a b ha hb hab => _
  rw [Convex.combo_self hab]
#align prod.image_mk_open_segment_right Prod.image_mk_openSegment_right

end Prod

namespace Pi

variable [OrderedSemiring 𝕜] [∀ i, AddCommMonoid (π i)] [∀ i, Module 𝕜 (π i)] {s : Set ι}

theorem segment_subset (x y : ∀ i, π i) : segment 𝕜 x y ⊆ s.pi fun i => segment 𝕜 (x i) (y i) := by
  rintro z ⟨a, b, ha, hb, hab, hz⟩ i -
  exact ⟨a, b, ha, hb, hab, congr_fun hz i⟩
#align pi.segment_subset Pi.segment_subset

theorem openSegment_subset (x y : ∀ i, π i) :
    openSegment 𝕜 x y ⊆ s.pi fun i => openSegment 𝕜 (x i) (y i) := by
  rintro z ⟨a, b, ha, hb, hab, hz⟩ i -
  exact ⟨a, b, ha, hb, hab, congr_fun hz i⟩
#align pi.open_segment_subset Pi.openSegment_subset

variable [DecidableEq ι]

theorem image_update_segment (i : ι) (x₁ x₂ : π i) (y : ∀ i, π i) :
    update y i '' [x₁ -[𝕜] x₂] = [update y i x₁ -[𝕜] update y i x₂] := by
  ext z
  simp_rw [Set.mem_image, segment, Set.mem_setOf, ← update_smul, ← update_add, update_eq_iff, ←
    exists_and_right, @exists_comm (π i), exists_eq_left']
  refine' exists₅_congr fun a b ha hb hab => _
  rw [Convex.combo_self hab]
#align pi.image_update_segment Pi.image_update_segment

theorem image_update_openSegment (i : ι) (x₁ x₂ : π i) (y : ∀ i, π i) :
    update y i '' openSegment 𝕜 x₁ x₂ = openSegment 𝕜 (update y i x₁) (update y i x₂) := by
  ext z
  simp_rw [Set.mem_image, openSegment, Set.mem_setOf, ← update_smul, ← update_add, update_eq_iff, ←
    exists_and_right, @exists_comm (π i), exists_eq_left']
  refine' exists₅_congr fun a b ha hb hab => _
  rw [Convex.combo_self hab]
#align pi.image_update_open_segment Pi.image_update_openSegment

end Pi


lemma or_symm (P Q : Prop) : P ∨ Q → Q ∨ P :=
begin
    intro fpq,
    cases fpq with p q,
    right,
    exact p,
    left,
    exact q,
end


/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import algebraic_geometry.Gamma_Spec_adjunction
import algebraic_geometry.open_immersion
import category_theory.limits.opposites
import ring_theory.localization.inv_submonoid

/-!
# Affine schemes

We define the category of `AffineScheme`s as the essential image of `Spec`.
We also define predicates about affine schemes and affine open sets.

## Main definitions

* `algebraic_geometry.AffineScheme`: The category of affine schemes.
* `algebraic_geometry.is_affine`: A scheme is affine if the canonical map `X ⟶ Spec Γ(X)` is an
  isomorphism.
* `algebraic_geometry.Scheme.iso_Spec`: The canonical isomorphism `X ≅ Spec Γ(X)` for an affine
  scheme.
* `algebraic_geometry.AffineScheme.equiv_CommRing`: The equivalence of categories
  `AffineScheme ≌ CommRingᵒᵖ` given by `AffineScheme.Spec : CommRingᵒᵖ ⥤ AffineScheme` and
  `AffineScheme.Γ : AffineSchemeᵒᵖ ⥤ CommRing`.
* `algebraic_geometry.is_affine_open`: An open subset of a scheme is affine if the open subscheme is
  affine.
* `algebraic_geometry.is_affine_open.from_Spec`: The immersion `Spec 𝒪ₓ(U) ⟶ X` for an affine `U`.

-/

noncomputable theory

open category_theory category_theory.limits opposite topological_space

universe u

namespace algebraic_geometry

open Spec (structure_sheaf)

/-- The category of affine schemes -/
@[derive category, nolint has_nonempty_instance]
def AffineScheme := Scheme.Spec.ess_image_subcategory

/-- A Scheme is affine if the canonical map `X ⟶ Spec Γ(X)` is an isomorphism. -/
class is_affine (X : Scheme) : Prop :=
(affine : is_iso (Γ_Spec.adjunction.unit.app X))

attribute [instance] is_affine.affine

/-- The canonical isomorphism `X ≅ Spec Γ(X)` for an affine scheme. -/
def Scheme.iso_Spec (X : Scheme) [is_affine X] :
  X ≅ Scheme.Spec.obj (op $ Scheme.Γ.obj $ op X) :=
as_iso (Γ_Spec.adjunction.unit.app X)

/-- Construct an affine scheme from a scheme and the information that it is affine.
Also see `AffineScheme.of` for a typclass version. -/
@[simps]
def AffineScheme.mk (X : Scheme) (h : is_affine X) : AffineScheme :=
⟨X, @@mem_ess_image_of_unit_is_iso _ _ _ _ h.1⟩

/-- Construct an affine scheme from a scheme. Also see `AffineScheme.mk` for a non-typeclass
version. -/
def AffineScheme.of (X : Scheme) [h : is_affine X] : AffineScheme :=
AffineScheme.mk X h

/-- Type check a morphism of schemes as a morphism in `AffineScheme`. -/
def AffineScheme.of_hom {X Y : Scheme} [is_affine X] [is_affine Y] (f : X ⟶ Y) :
  AffineScheme.of X ⟶ AffineScheme.of Y :=
f

lemma mem_Spec_ess_image (X : Scheme) : X ∈ Scheme.Spec.ess_image ↔ is_affine X :=
⟨λ h, ⟨functor.ess_image.unit_is_iso h⟩, λ h, @@mem_ess_image_of_unit_is_iso _ _ _ X h.1⟩

instance is_affine_AffineScheme (X : AffineScheme.{u}) : is_affine X.obj :=
⟨functor.ess_image.unit_is_iso X.property⟩

instance Spec_is_affine (R : CommRingᵒᵖ) : is_affine (Scheme.Spec.obj R) :=
algebraic_geometry.is_affine_AffineScheme ⟨_, Scheme.Spec.obj_mem_ess_image R⟩

lemma is_affine_of_iso {X Y : Scheme} (f : X ⟶ Y) [is_iso f] [h : is_affine Y] :
  is_affine X :=
by { rw [← mem_Spec_ess_image] at h ⊢, exact functor.ess_image.of_iso (as_iso f).symm h }

namespace AffineScheme

/-- The `Spec` functor into the category of affine schemes. -/
@[derive [full, faithful, ess_surj]]
def Spec : CommRingᵒᵖ ⥤ AffineScheme := Scheme.Spec.to_ess_image

/-- The forgetful functor `AffineScheme ⥤ Scheme`. -/
@[derive [full, faithful], simps]
def forget_to_Scheme : AffineScheme ⥤ Scheme := Scheme.Spec.ess_image_inclusion

/-- The global section functor of an affine scheme. -/
def Γ : AffineSchemeᵒᵖ ⥤ CommRing := forget_to_Scheme.op ⋙ Scheme.Γ

/-- The category of affine schemes is equivalent to the category of commutative rings. -/
def equiv_CommRing : AffineScheme ≌ CommRingᵒᵖ :=
equiv_ess_image_of_reflective.symm

instance Γ_is_equiv : is_equivalence Γ.{u} :=
begin
  haveI : is_equivalence Γ.{u}.right_op.op := is_equivalence.of_equivalence equiv_CommRing.op,
  exact (functor.is_equivalence_trans Γ.{u}.right_op.op (op_op_equivalence _).functor : _),
end

instance : has_colimits AffineScheme.{u} :=
begin
  haveI := adjunction.has_limits_of_equivalence.{u} Γ.{u},
  exactI adjunction.has_colimits_of_equivalence.{u} (op_op_equivalence AffineScheme.{u}).inverse
end

instance : has_limits AffineScheme.{u} :=
begin
  haveI := adjunction.has_colimits_of_equivalence Γ.{u},
  haveI : has_limits AffineScheme.{u} ᵒᵖᵒᵖ := limits.has_limits_op_of_has_colimits,
  exactI adjunction.has_limits_of_equivalence (op_op_equivalence AffineScheme.{u}).inverse
end

noncomputable
instance : preserves_limits Γ.{u}.right_op :=
@@adjunction.is_equivalence_preserves_limits _ _ Γ.right_op
  (is_equivalence.of_equivalence equiv_CommRing)

noncomputable
instance : preserves_limits forget_to_Scheme :=
begin
  apply_with (@@preserves_limits_of_nat_iso _ _
    (iso_whisker_right equiv_CommRing.unit_iso forget_to_Scheme).symm) { instances := ff },
  change preserves_limits (equiv_CommRing.functor ⋙ Scheme.Spec),
  apply_instance,
end

end AffineScheme

/-- An open subset of a scheme is affine if the open subscheme is affine. -/
def is_affine_open {X : Scheme} (U : opens X.carrier) : Prop :=
is_affine (X.restrict U.open_embedding)

/-- The set of affine opens as a subset of `opens X.carrier`. -/
def Scheme.affine_opens (X : Scheme) : set (opens X.carrier) :=
{ U : opens X.carrier | is_affine_open U }

lemma range_is_affine_open_of_open_immersion {X Y : Scheme} [is_affine X] (f : X ⟶ Y)
  [H : is_open_immersion f] : is_affine_open f.opens_range :=
begin
  refine is_affine_of_iso (is_open_immersion.iso_of_range_eq f (Y.of_restrict _) _).inv,
  exact subtype.range_coe.symm,
  apply_instance
end

lemma top_is_affine_open (X : Scheme) [is_affine X] : is_affine_open (⊤ : opens X.carrier) :=
begin
  convert range_is_affine_open_of_open_immersion (𝟙 X),
  ext1,
  exact set.range_id.symm
end

instance Scheme.affine_cover_is_affine (X : Scheme) (i : X.affine_cover.J) :
  is_affine (X.affine_cover.obj i) :=
algebraic_geometry.Spec_is_affine _

instance Scheme.affine_basis_cover_is_affine (X : Scheme) (i : X.affine_basis_cover.J) :
  is_affine (X.affine_basis_cover.obj i) :=
algebraic_geometry.Spec_is_affine _

lemma is_basis_affine_open (X : Scheme) :
  opens.is_basis X.affine_opens :=
begin
  rw opens.is_basis_iff_nbhd,
  rintros U x (hU : x ∈ (U : set X.carrier)),
  obtain ⟨S, hS, hxS, hSU⟩ := X.affine_basis_cover_is_basis.exists_subset_of_mem_open hU U.is_open,
  refine ⟨⟨S, X.affine_basis_cover_is_basis.is_open hS⟩, _, hxS, hSU⟩,
  rcases hS with ⟨i, rfl⟩,
  exact range_is_affine_open_of_open_immersion _,
end

/-- The open immersion `Spec 𝒪ₓ(U) ⟶ X` for an affine `U`. -/
def is_affine_open.from_Spec {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U) :
  Scheme.Spec.obj (op $ X.presheaf.obj $ op U) ⟶ X :=
begin
  haveI : is_affine (X.restrict U.open_embedding) := hU,
  have : U.open_embedding.is_open_map.functor.obj ⊤ = U,
  { ext1, exact set.image_univ.trans subtype.range_coe },
  exact Scheme.Spec.map (X.presheaf.map (eq_to_hom this.symm).op).op ≫
    (X.restrict U.open_embedding).iso_Spec.inv ≫ X.of_restrict _
end

instance is_affine_open.is_open_immersion_from_Spec {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) :
  is_open_immersion hU.from_Spec :=
by { delta is_affine_open.from_Spec, apply_instance }

lemma is_affine_open.from_Spec_range {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U) :
  set.range hU.from_Spec.1.base = (U : set X.carrier) :=
begin
  delta is_affine_open.from_Spec,
  erw [← category.assoc, Scheme.comp_val_base],
  rw [coe_comp, set.range_comp, set.range_iff_surjective.mpr, set.image_univ],
  exact subtype.range_coe,
  rw ← Top.epi_iff_surjective,
  apply_instance
end

lemma is_affine_open.from_Spec_image_top {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) :
  hU.is_open_immersion_from_Spec.base_open.is_open_map.functor.obj ⊤ = U :=
by { ext1, exact set.image_univ.trans hU.from_Spec_range }

lemma is_affine_open.is_compact {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U) :
  is_compact (U : set X.carrier) :=
begin
  convert @is_compact.image _ _ _ _ set.univ hU.from_Spec.1.base
    prime_spectrum.compact_space.1 (by continuity),
  convert hU.from_Spec_range.symm,
  exact set.image_univ
end

lemma is_affine_open.image_is_open_immersion {X Y : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U)
  (f : X ⟶ Y) [H : is_open_immersion f] : is_affine_open (f.opens_functor.obj U) :=
begin
  haveI : is_affine _ := hU,
  convert range_is_affine_open_of_open_immersion (X.of_restrict U.open_embedding ≫ f),
  ext1,
  exact set.image_eq_range _ _
end

lemma is_affine_open_iff_of_is_open_immersion {X Y : Scheme} (f : X ⟶ Y) [H : is_open_immersion f]
  (U : opens X.carrier) :
  is_affine_open (H.open_functor.obj U) ↔ is_affine_open U :=
begin
  refine ⟨λ hU, @@is_affine_of_iso _ _ hU, λ hU, hU.image_is_open_immersion f⟩,
  refine (is_open_immersion.iso_of_range_eq (X.of_restrict _ ≫ f) (Y.of_restrict _) _).hom,
  { rw [Scheme.comp_val_base, coe_comp, set.range_comp],
    dsimp [opens.inclusion],
    rw [subtype.range_coe, subtype.range_coe],
    refl },
  { apply_instance }
end

instance Scheme.quasi_compact_of_affine (X : Scheme) [is_affine X] : compact_space X.carrier :=
⟨(top_is_affine_open X).is_compact⟩

lemma is_affine_open.from_Spec_base_preimage
  {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U) :
    (opens.map hU.from_Spec.val.base).obj U = ⊤ :=
begin
  ext1,
  change hU.from_Spec.1.base ⁻¹' (U : set X.carrier) = set.univ,
  rw [← hU.from_Spec_range, ← set.image_univ],
  exact set.preimage_image_eq _ PresheafedSpace.is_open_immersion.base_open.inj
end

lemma Scheme.Spec_map_presheaf_map_eq_to_hom {X : Scheme} {U V : opens X.carrier} (h : U = V) (W) :
  (Scheme.Spec.map (X.presheaf.map (eq_to_hom h).op).op).val.c.app W =
    eq_to_hom (by { cases h, induction W using opposite.rec, dsimp, simp, refl }) :=
begin
  have : Scheme.Spec.map (X.presheaf.map (𝟙 (op U))).op = 𝟙 _,
  { rw [X.presheaf.map_id, op_id, Scheme.Spec.map_id]  },
  cases h,
  refine (Scheme.congr_app this _).trans _,
  erw category.id_comp,
  simpa [eq_to_hom_map],
end

lemma is_affine_open.Spec_Γ_identity_hom_app_from_Spec {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) :
  (Spec_Γ_identity.hom.app (X.presheaf.obj $ op U)) ≫ hU.from_Spec.1.c.app (op U) =
    (Scheme.Spec.obj _).presheaf.map (eq_to_hom hU.from_Spec_base_preimage).op :=
begin
  haveI : is_affine _ := hU,
  have e₁ :=
    Spec_Γ_identity.hom.naturality (X.presheaf.map (eq_to_hom U.open_embedding_obj_top).op),
  rw ← is_iso.comp_inv_eq at e₁,
  have e₂ := Γ_Spec.adjunction_unit_app_app_top (X.restrict U.open_embedding),
  erw ← e₂ at e₁,
  simp only [functor.id_map, quiver.hom.unop_op, functor.comp_map, ← functor.map_inv, ← op_inv,
    LocallyRingedSpace.Γ_map, category.assoc, functor.right_op_map, inv_eq_to_hom] at e₁,
  delta is_affine_open.from_Spec Scheme.iso_Spec,
  rw [Scheme.comp_val_c_app, Scheme.comp_val_c_app, ← e₁],
  simp_rw category.assoc,
  erw ← X.presheaf.map_comp_assoc,
  rw ← op_comp,
  have e₃ : U.open_embedding.is_open_map.adjunction.counit.app U ≫
    eq_to_hom U.open_embedding_obj_top.symm =
    U.open_embedding.is_open_map.functor.map (eq_to_hom U.inclusion_map_eq_top) :=
    subsingleton.elim _ _,
  have e₄ : X.presheaf.map _ ≫ _ = _ :=
    (as_iso (Γ_Spec.adjunction.unit.app (X.restrict U.open_embedding)))
    .inv.1.c.naturality_assoc (eq_to_hom U.inclusion_map_eq_top).op _,
  erw [e₃, e₄, ← Scheme.comp_val_c_app_assoc, iso.inv_hom_id],
  simp only [eq_to_hom_map, eq_to_hom_op, Scheme.Spec_map_presheaf_map_eq_to_hom],
  erw [Scheme.Spec_map_presheaf_map_eq_to_hom, category.id_comp],
  simpa only [eq_to_hom_trans]
end

@[elementwise]
lemma is_affine_open.from_Spec_app_eq {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) :
  hU.from_Spec.1.c.app (op U) = Spec_Γ_identity.inv.app (X.presheaf.obj $ op U) ≫
    (Scheme.Spec.obj _).presheaf.map (eq_to_hom hU.from_Spec_base_preimage).op :=
by rw [← hU.Spec_Γ_identity_hom_app_from_Spec, iso.inv_hom_id_app_assoc]

lemma is_affine_open.basic_open_is_affine {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) (f : X.presheaf.obj (op U)) : is_affine_open (X.basic_open f) :=
begin
  convert range_is_affine_open_of_open_immersion (Scheme.Spec.map (CommRing.of_hom
    (algebra_map (X.presheaf.obj (op U)) (localization.away f))).op ≫ hU.from_Spec),
  ext1,
  have : hU.from_Spec.val.base '' (hU.from_Spec.val.base ⁻¹' (X.basic_open f : set X.carrier)) =
    (X.basic_open f : set X.carrier),
  { rw [set.image_preimage_eq_inter_range, set.inter_eq_left_iff_subset, hU.from_Spec_range],
    exact Scheme.basic_open_le _ _ },
  rw [Scheme.hom.opens_range_coe, Scheme.comp_val_base, ← this, coe_comp, set.range_comp],
  congr' 1,
  refine (congr_arg coe $ Scheme.preimage_basic_open hU.from_Spec f).trans _,
  refine eq.trans _ (prime_spectrum.localization_away_comap_range (localization.away f) f).symm,
  congr' 1,
  have : (opens.map hU.from_Spec.val.base).obj U = ⊤,
  { ext1,
    change hU.from_Spec.1.base ⁻¹' (U : set X.carrier) = set.univ,
    rw [← hU.from_Spec_range, ← set.image_univ],
    exact set.preimage_image_eq _ PresheafedSpace.is_open_immersion.base_open.inj },
  refine eq.trans _ (basic_open_eq_of_affine f),
  have lm : ∀ s, (opens.map hU.from_Spec.val.base).obj U ⊓ s = s := λ s, this.symm ▸ top_inf_eq,
  refine eq.trans _ (lm _),
  refine eq.trans _
    ((Scheme.Spec.obj $ op $ X.presheaf.obj $ op U).basic_open_res _ (eq_to_hom this).op),
  rw ← comp_apply,
  congr' 2,
  rw iso.eq_inv_comp,
  erw hU.Spec_Γ_identity_hom_app_from_Spec,
end

lemma is_affine_open.map_restrict_basic_open {X : Scheme} (r : X.presheaf.obj (op ⊤))
  {U : opens X.carrier} (hU : is_affine_open U) :
  is_affine_open ((opens.map (X.of_restrict (X.basic_open r).open_embedding).1.base).obj U) :=
begin
  apply (is_affine_open_iff_of_is_open_immersion
    (X.of_restrict (X.basic_open r).open_embedding) _).mp,
  delta PresheafedSpace.is_open_immersion.open_functor,
  dsimp,
  erw [opens.functor_obj_map_obj, opens.open_embedding_obj_top, inf_comm,
    ← Scheme.basic_open_res _ _ (hom_of_le le_top).op],
  exact hU.basic_open_is_affine _,
end

lemma Scheme.map_prime_spectrum_basic_open_of_affine (X : Scheme) [is_affine X]
  (f : Scheme.Γ.obj (op X)) :
  (opens.map X.iso_Spec.hom.1.base).obj (prime_spectrum.basic_open f) = X.basic_open f :=
begin
  rw ← basic_open_eq_of_affine,
  transitivity (opens.map X.iso_Spec.hom.1.base).obj ((Scheme.Spec.obj
    (op (Scheme.Γ.obj (op X)))).basic_open ((inv (X.iso_Spec.hom.1.c.app
      (op ((opens.map (inv X.iso_Spec.hom).val.base).obj ⊤)))) ((X.presheaf.map (eq_to_hom _)) f))),
  congr,
  { rw [← is_iso.inv_eq_inv, is_iso.inv_inv, is_iso.iso.inv_inv, nat_iso.app_hom],
    erw ← Γ_Spec.adjunction_unit_app_app_top,
    refl },
  { rw eq_to_hom_map, refl },
  { dsimp, congr },
  { refine (Scheme.preimage_basic_open _ _).trans _,
    rw [is_iso.inv_hom_id_apply, Scheme.basic_open_res_eq] }
end

lemma is_basis_basic_open (X : Scheme) [is_affine X] :
  opens.is_basis (set.range (X.basic_open : X.presheaf.obj (op ⊤) → opens X.carrier)) :=
begin
  delta opens.is_basis,
  convert prime_spectrum.is_basis_basic_opens.inducing
    (Top.homeo_of_iso (Scheme.forget_to_Top.map_iso X.iso_Spec)).inducing using 1,
  ext,
  simp only [set.mem_image, exists_exists_eq_and],
  split,
  { rintro ⟨_, ⟨x, rfl⟩, rfl⟩,
    refine ⟨_, ⟨_, ⟨x, rfl⟩, rfl⟩, _⟩,
    exact congr_arg opens.carrier (X.map_prime_spectrum_basic_open_of_affine x) },
  { rintro ⟨_, ⟨_, ⟨x, rfl⟩, rfl⟩, rfl⟩,
    refine ⟨_, ⟨x, rfl⟩, _⟩,
    exact congr_arg opens.carrier (X.map_prime_spectrum_basic_open_of_affine x).symm }
end

lemma is_affine_open.exists_basic_open_le {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) {V : opens X.carrier} (x : V) (h : ↑x ∈ U) :
  ∃ f : X.presheaf.obj (op U), X.basic_open f ≤ V ∧ ↑x ∈ X.basic_open f :=
begin
  haveI : is_affine _ := hU,
  obtain ⟨_, ⟨_, ⟨r, rfl⟩, rfl⟩, h₁, h₂⟩ := (is_basis_basic_open (X.restrict U.open_embedding))
    .exists_subset_of_mem_open _ ((opens.map U.inclusion).obj V).is_open,
  swap, exact ⟨x, h⟩,
  have : U.open_embedding.is_open_map.functor.obj ((X.restrict U.open_embedding).basic_open r)
    = X.basic_open (X.presheaf.map (eq_to_hom U.open_embedding_obj_top.symm).op r),
  { refine (Scheme.image_basic_open (X.of_restrict U.open_embedding) r).trans _,
    erw ← Scheme.basic_open_res_eq _ _ (eq_to_hom U.open_embedding_obj_top).op,
    rw [← comp_apply, ← category_theory.functor.map_comp, ← op_comp, eq_to_hom_trans,
      eq_to_hom_refl, op_id, category_theory.functor.map_id, Scheme.hom.inv_app],
    erw PresheafedSpace.is_open_immersion.of_restrict_inv_app,
    congr },
  use X.presheaf.map (eq_to_hom U.open_embedding_obj_top.symm).op r,
  rw ← this,
  exact ⟨set.image_subset_iff.mpr h₂, set.mem_image_of_mem _ h₁⟩,
  exact x.prop,
end

instance {X : Scheme} {U : opens X.carrier} (f : X.presheaf.obj (op U)) :
  algebra (X.presheaf.obj (op U)) (X.presheaf.obj (op $ X.basic_open f)) :=
(X.presheaf.map (hom_of_le $ RingedSpace.basic_open_le _ f : _ ⟶ U).op).to_algebra

lemma is_affine_open.opens_map_from_Spec_basic_open {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) (f : X.presheaf.obj (op U)) :
  (opens.map hU.from_Spec.val.base).obj (X.basic_open f) =
    RingedSpace.basic_open _ (Spec_Γ_identity.inv.app (X.presheaf.obj $ op U) f) :=
begin
  erw LocallyRingedSpace.preimage_basic_open,
  refine eq.trans _ (RingedSpace.basic_open_res_eq (Scheme.Spec.obj $ op $ X.presheaf.obj (op U))
    .to_LocallyRingedSpace.to_RingedSpace (eq_to_hom hU.from_Spec_base_preimage).op _),
  congr,
  rw ← comp_apply,
  congr,
  erw ← hU.Spec_Γ_identity_hom_app_from_Spec,
  rw iso.inv_hom_id_app_assoc,
end

/-- The canonical map `Γ(𝒪ₓ, D(f)) ⟶ Γ(Spec 𝒪ₓ(U), D(Spec_Γ_identity.inv f))`
This is an isomorphism, as witnessed by an `is_iso` instance. -/
def basic_open_sections_to_affine {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U)
  (f : X.presheaf.obj (op U)) : X.presheaf.obj (op $ X.basic_open f) ⟶
    (Scheme.Spec.obj $ op $ X.presheaf.obj (op U)).presheaf.obj
      (op $ Scheme.basic_open _ $ Spec_Γ_identity.inv.app (X.presheaf.obj (op U)) f) :=
hU.from_Spec.1.c.app (op $ X.basic_open f) ≫ (Scheme.Spec.obj $ op $ X.presheaf.obj (op U))
  .presheaf.map (eq_to_hom $ (hU.opens_map_from_Spec_basic_open f).symm).op

instance {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U)
  (f : X.presheaf.obj (op U)) : is_iso (basic_open_sections_to_affine hU f) :=
begin
  delta basic_open_sections_to_affine,
  apply_with is_iso.comp_is_iso { instances := ff },
  { apply PresheafedSpace.is_open_immersion.is_iso_of_subset,
    rw hU.from_Spec_range,
    exact RingedSpace.basic_open_le _ _ },
  apply_instance
end

lemma is_localization_basic_open {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U)
  (f : X.presheaf.obj (op U)) :
  is_localization.away f (X.presheaf.obj (op $ X.basic_open f)) :=
begin
  apply (is_localization.is_localization_iff_of_ring_equiv (submonoid.powers f)
    (as_iso $ basic_open_sections_to_affine hU f ≫ (Scheme.Spec.obj _).presheaf.map
      (eq_to_hom (basic_open_eq_of_affine _).symm).op).CommRing_iso_to_ring_equiv).mpr,
  convert structure_sheaf.is_localization.to_basic_open _ f,
  change _ ≫ (basic_open_sections_to_affine hU f ≫ _) = _,
  delta basic_open_sections_to_affine,
  erw ring_hom.algebra_map_to_algebra,
  simp only [Scheme.comp_val_c_app, category.assoc],
  erw hU.from_Spec.val.c.naturality_assoc,
  rw hU.from_Spec_app_eq,
  dsimp,
  simp only [category.assoc, ← functor.map_comp, ← op_comp],
  apply structure_sheaf.to_open_res,
end

instance {X : Scheme} [is_affine X] (r : X.presheaf.obj (op ⊤)) :
  is_localization.away r (X.presheaf.obj (op $ X.basic_open r)) :=
is_localization_basic_open (top_is_affine_open X) r

lemma is_localization_of_eq_basic_open {X : Scheme} {U V : opens X.carrier} (i : V ⟶ U)
  (hU : is_affine_open U) (r : X.presheaf.obj (op U)) (e : V = X.basic_open r) :
  @@is_localization.away _ r (X.presheaf.obj (op V)) _ (X.presheaf.map i.op).to_algebra :=
by { subst e, convert is_localization_basic_open hU r using 3 }

instance Γ_restrict_algebra
  {X : Scheme} {Y : Top} {f : Y ⟶ X.carrier} (hf : open_embedding f) :
  algebra (Scheme.Γ.obj (op X)) (Scheme.Γ.obj (op $ X.restrict hf)) :=
(Scheme.Γ.map (X.of_restrict hf).op).to_algebra

instance Γ_restrict_is_localization (X : Scheme.{u}) [is_affine X] (r : Scheme.Γ.obj (op X)) :
   is_localization.away r (Scheme.Γ.obj (op $ X.restrict (X.basic_open r).open_embedding)) :=
 is_localization_of_eq_basic_open _ (top_is_affine_open X) r (opens.open_embedding_obj_top _)

lemma basic_open_basic_open_is_basic_open {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) (f : X.presheaf.obj (op U)) (g : X.presheaf.obj (op $ X.basic_open f)) :
  ∃ f' : X.presheaf.obj (op U), X.basic_open f' = X.basic_open g :=
begin
  haveI := is_localization_basic_open hU f,
  obtain ⟨x, ⟨_, n, rfl⟩, rfl⟩ := is_localization.surj' (submonoid.powers f) g,
  use f * x,
  rw [algebra.smul_def, Scheme.basic_open_mul, Scheme.basic_open_mul],
  erw Scheme.basic_open_res,
  refine (inf_eq_left.mpr _).symm,
  convert inf_le_left using 1,
  apply Scheme.basic_open_of_is_unit,
  apply submonoid.left_inv_le_is_unit _ (is_localization.to_inv_submonoid (submonoid.powers f)
    (X.presheaf.obj (op $ X.basic_open f)) _).prop
end

lemma exists_basic_open_le_affine_inter {X : Scheme} {U V : opens X.carrier}
  (hU : is_affine_open U) (hV : is_affine_open V) (x : X.carrier) (hx : x ∈ U ⊓ V) :
  ∃ (f : X.presheaf.obj $ op U) (g : X.presheaf.obj $ op V),
    X.basic_open f = X.basic_open g ∧ x ∈ X.basic_open f :=
begin
  obtain ⟨f, hf₁, hf₂⟩ := hU.exists_basic_open_le ⟨x, hx.2⟩ hx.1,
  obtain ⟨g, hg₁, hg₂⟩ := hV.exists_basic_open_le ⟨x, hf₂⟩ hx.2,
  obtain ⟨f', hf'⟩ := basic_open_basic_open_is_basic_open hU f
    (X.presheaf.map (hom_of_le hf₁ : _ ⟶ V).op g),
  replace hf' := (hf'.trans (RingedSpace.basic_open_res _ _ _)).trans (inf_eq_right.mpr hg₁),
  exact ⟨f', g, hf', hf'.symm ▸ hg₂⟩
end

/-- The prime ideal of `𝒪ₓ(U)` corresponding to a point `x : U`. -/
noncomputable
def is_affine_open.prime_ideal_of {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) (x : U) :
  prime_spectrum (X.presheaf.obj $ op U) :=
((Scheme.Spec.map (X.presheaf.map (eq_to_hom $
  show U.open_embedding.is_open_map.functor.obj ⊤ = U, from
    opens.ext (set.image_univ.trans subtype.range_coe)).op).op).1.base
  ((@@Scheme.iso_Spec (X.restrict U.open_embedding) hU).hom.1.base x))

lemma is_affine_open.from_Spec_prime_ideal_of {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) (x : U) :
  hU.from_Spec.val.base (hU.prime_ideal_of x) = x.1 :=
begin
  dsimp only [is_affine_open.from_Spec, subtype.coe_mk],
  erw [← Scheme.comp_val_base_apply, ← Scheme.comp_val_base_apply],
  simpa only [← functor.map_comp_assoc, ← functor.map_comp, ← op_comp, eq_to_hom_trans, op_id,
    eq_to_hom_refl, category_theory.functor.map_id, category.id_comp, iso.hom_inv_id_assoc]
end

lemma is_affine_open.is_localization_stalk_aux {X : Scheme} (U : opens X.carrier)
  [is_affine (X.restrict U.open_embedding)] :
  (inv (Γ_Spec.adjunction.unit.app (X.restrict U.open_embedding))).1.c.app
    (op ((opens.map U.inclusion).obj U)) =
      X.presheaf.map (eq_to_hom $ by rw opens.inclusion_map_eq_top :
        U.open_embedding.is_open_map.functor.obj ⊤ ⟶
          (U.open_embedding.is_open_map.functor.obj ((opens.map U.inclusion).obj U))).op ≫
      to_Spec_Γ (X.presheaf.obj $ op (U.open_embedding.is_open_map.functor.obj ⊤)) ≫
      (Scheme.Spec.obj $ op $ X.presheaf.obj $ _).presheaf.map
        (eq_to_hom (by { rw [opens.inclusion_map_eq_top], refl }) : unop _ ⟶ ⊤).op :=
begin
  have e : (opens.map (inv (Γ_Spec.adjunction.unit.app (X.restrict U.open_embedding))).1.base).obj
    ((opens.map U.inclusion).obj U) = ⊤,
  by { rw [opens.inclusion_map_eq_top], refl },
  rw [Scheme.inv_val_c_app, is_iso.comp_inv_eq, Scheme.app_eq _ e,
    Γ_Spec.adjunction_unit_app_app_top],
  simp only [category.assoc, eq_to_hom_op],
  erw ← functor.map_comp_assoc,
  rw [eq_to_hom_trans, eq_to_hom_refl, category_theory.functor.map_id,
    category.id_comp],
  erw Spec_Γ_identity.inv_hom_id_app_assoc,
  simp only [eq_to_hom_map, eq_to_hom_trans],
end

lemma is_affine_open.is_localization_stalk {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) (x : U) :
  is_localization.at_prime (X.presheaf.stalk x) (hU.prime_ideal_of x).as_ideal :=
begin
  haveI : is_affine _ := hU,
  haveI : nonempty U := ⟨x⟩,
  rcases x with ⟨x, hx⟩,
  let y := hU.prime_ideal_of ⟨x, hx⟩,
  have : hU.from_Spec.val.base y = x := hU.from_Spec_prime_ideal_of ⟨x, hx⟩,
  change is_localization y.as_ideal.prime_compl _,
  clear_value y,
  subst this,
  apply (is_localization.is_localization_iff_of_ring_equiv _
    (as_iso $ PresheafedSpace.stalk_map hU.from_Spec.1 y).CommRing_iso_to_ring_equiv).mpr,
  convert structure_sheaf.is_localization.to_stalk _ _ using 1,
  delta structure_sheaf.stalk_algebra,
  congr' 1,
  rw ring_hom.algebra_map_to_algebra,
  refine (PresheafedSpace.stalk_map_germ hU.from_Spec.1 _ ⟨_, _⟩).trans _,
  delta is_affine_open.from_Spec Scheme.iso_Spec structure_sheaf.to_stalk,
  simp only [Scheme.comp_val_c_app, category.assoc],
  dsimp only [functor.op, as_iso_inv, unop_op],
  erw is_affine_open.is_localization_stalk_aux,
  simp only [category.assoc],
  conv_lhs { rw ← category.assoc },
  erw [← X.presheaf.map_comp, Spec_Γ_naturality_assoc],
  congr' 1,
  simp only [← category.assoc],
  transitivity _ ≫ (structure_sheaf (X.presheaf.obj $ op U)).presheaf.germ ⟨_, _⟩,
  { refl },
  convert ((structure_sheaf (X.presheaf.obj $ op U)).presheaf.germ_res (hom_of_le le_top) ⟨_, _⟩)
    using 2,
  rw category.assoc,
  erw nat_trans.naturality,
  rw [← LocallyRingedSpace.Γ_map_op, ← LocallyRingedSpace.Γ.map_comp_assoc, ← op_comp],
  erw ← Scheme.Spec.map_comp,
  rw [← op_comp, ← X.presheaf.map_comp],
  transitivity LocallyRingedSpace.Γ.map (quiver.hom.op $ Scheme.Spec.map
    (X.presheaf.map (𝟙 (op U))).op) ≫ _,
  { congr },
  simp only [category_theory.functor.map_id, op_id],
  erw category_theory.functor.map_id,
  rw category.id_comp,
  refl
end

/-- The basic open set of a section `f` on an an affine open as an `X.affine_opens`. -/
@[simps]
def Scheme.affine_basic_open (X : Scheme) {U : X.affine_opens}
  (f : X.presheaf.obj $ op U) : X.affine_opens :=
⟨X.basic_open f, U.prop.basic_open_is_affine f⟩

@[simp]
lemma is_affine_open.basic_open_from_Spec_app {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) (f : X.presheaf.obj (op U)) :
  @Scheme.basic_open (Scheme.Spec.obj $ op (X.presheaf.obj $ op U))
    ((opens.map hU.from_Spec.1.base).obj U)
    (hU.from_Spec.1.c.app (op U) f) = prime_spectrum.basic_open f :=
begin
  rw [← Scheme.basic_open_res_eq _ _ (eq_to_hom hU.from_Spec_base_preimage.symm).op,
    basic_open_eq_of_affine', is_affine_open.from_Spec_app_eq],
  congr,
  rw [← comp_apply, ← comp_apply, category.assoc, ← functor.map_comp_assoc,
    eq_to_hom_op, eq_to_hom_op, eq_to_hom_trans, eq_to_hom_refl, category_theory.functor.map_id,
    category.id_comp, ← iso.app_inv, iso.inv_hom_id],
  refl
end

lemma is_affine_open.from_Spec_map_basic_open {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) (f : X.presheaf.obj (op U)) :
  (opens.map hU.from_Spec.val.base).obj (X.basic_open f) = prime_spectrum.basic_open f :=
by simp

lemma is_affine_open.basic_open_union_eq_self_iff {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) (s : set (X.presheaf.obj $ op U)) :
    (⨆ (f : s), X.basic_open (f : X.presheaf.obj $ op U)) = U ↔ ideal.span s = ⊤ :=
begin
  transitivity (⋃ (i : s), (prime_spectrum.basic_open i.1).1) = set.univ,
  transitivity hU.from_Spec.1.base ⁻¹' (⨆ (f : s), X.basic_open (f : X.presheaf.obj $ op U)).1 =
    hU.from_Spec.1.base ⁻¹' U.1,
  { refine ⟨λ h, by rw h, _⟩,
    intro h,
    apply_fun set.image hU.from_Spec.1.base at h,
    rw [set.image_preimage_eq_inter_range, set.image_preimage_eq_inter_range,
      hU.from_Spec_range] at h,
    simp only [set.inter_self, opens.carrier_eq_coe, set.inter_eq_right_iff_subset]
      at h,
    ext1,
    refine set.subset.antisymm _ h,
    simp only [set.Union_subset_iff, set_coe.forall, opens.coe_supr],
    intros x hx,
    exact X.basic_open_le x },
  { simp only [opens.supr_def, subtype.coe_mk, set.preimage_Union, subtype.val_eq_coe],
    congr' 3,
    { ext1 x,
      exact congr_arg opens.carrier (hU.from_Spec_map_basic_open _) },
    { exact congr_arg opens.carrier hU.from_Spec_base_preimage } },
  { simp only [opens.carrier_eq_coe, prime_spectrum.basic_open_eq_zero_locus_compl],
    rw [← set.compl_Inter, set.compl_univ_iff, ← prime_spectrum.zero_locus_Union,
      ← prime_spectrum.zero_locus_empty_iff_eq_top, prime_spectrum.zero_locus_span],
    simp only [set.Union_singleton_eq_range, subtype.range_val_subtype, set.set_of_mem_eq] }
end

lemma is_affine_open.self_le_basic_open_union_iff {X : Scheme} {U : opens X.carrier}
  (hU : is_affine_open U) (s : set (X.presheaf.obj $ op U)) :
    U ≤ (⨆ (f : s), X.basic_open (f : X.presheaf.obj $ op U)) ↔ ideal.span s = ⊤ :=
begin
  rw [← hU.basic_open_union_eq_self_iff, @comm _ eq],
  refine ⟨λ h, le_antisymm h _, le_of_eq⟩,
  simp only [supr_le_iff, set_coe.forall],
  intros x hx,
  exact X.basic_open_le x
end

/--
Let `P` be a predicate on the affine open sets of `X` satisfying
1. If `P` holds on `U`, then `P` holds on the basic open set of every section on `U`.
2. If `P` holds for a family of basic open sets covering `U`, then `P` holds for `U`.
3. There exists an affine open cover of `X` each satisfying `P`.

Then `P` holds for every affine open of `X`.

This is also known as the **Affine communication lemma** in [*The rising sea*][RisingSea]. -/
@[elab_as_eliminator]
lemma of_affine_open_cover {X : Scheme} (V : X.affine_opens) (S : set X.affine_opens)
  {P : X.affine_opens → Prop}
  (hP₁ : ∀ (U : X.affine_opens) (f : X.presheaf.obj $ op U.1), P U →
    P (X.affine_basic_open f))
  (hP₂ : ∀ (U : X.affine_opens) (s : finset (X.presheaf.obj $ op U))
    (hs : ideal.span (s : set (X.presheaf.obj $ op U)) = ⊤),
    (∀ (f : s), P (X.affine_basic_open f.1)) → P U)
  (hS : (⋃ (i : S), i : set X.carrier) = set.univ)
  (hS' : ∀ (U : S), P U) : P V :=
begin
  classical,
  have : ∀ (x : V), ∃ (f : X.presheaf.obj $ op V.1),
    ↑x ∈ (X.basic_open f) ∧ P (X.affine_basic_open f),
  { intro x,
    have : ↑x ∈ (set.univ : set X.carrier) := trivial,
    rw ← hS at this,
    obtain ⟨W, hW⟩ := set.mem_Union.mp this,
    obtain ⟨f, g, e, hf⟩ := exists_basic_open_le_affine_inter V.prop W.1.prop x ⟨x.prop, hW⟩,
    refine ⟨f, hf, _⟩,
    convert hP₁ _ g (hS' W) using 1,
    ext1,
    exact e },
  choose f hf₁ hf₂ using this,
  suffices : ideal.span (set.range f) = ⊤,
  { obtain ⟨t, ht₁, ht₂⟩ := (ideal.span_eq_top_iff_finite _).mp this,
    apply hP₂ V t ht₂,
    rintro ⟨i, hi⟩,
    obtain ⟨x, rfl⟩ := ht₁ hi,
    exact hf₂ x },
  rw ← V.prop.self_le_basic_open_union_iff,
  intros x hx,
  rw [supr_range', opens.mem_supr],
  exact ⟨_, hf₁ ⟨x, hx⟩⟩
end

end algebraic_geometry


import data.set.basic
import data.set.lattice
import order.antichain

lemma set_coe.exists_unique {α : Type*} (s: set α) (p: s → Prop):
  (∃! a : s, p a) ↔ ∃! a (h: a ∈ s), p ⟨a, h⟩ :=
by simp [set_coe.exists, exists_unique, and_assoc]

lemma set.sep_mem {α: Type*} (s: set α):
  {v : α | v ∈ s} = s := rfl

theorem set.disjoint_diff' {α: Type*} (a b : set α): disjoint (a \ b) b :=
begin
  apply disjoint.symm _,
  apply set.disjoint_diff,
end

theorem set.mem_image' {α β: Type*} (f : α → β) (s : set α) (y : β) :
  y ∈ f '' s ↔ ∃ x, f x = y ∧ x ∈ s := begin
  rw [set.mem_image f s y],
  conv_lhs { congr, funext, rw and_comm },
end

section

variables {α β : Type*} {r r₁ r₂ : α → α → Prop} {r' : β → β → Prop} {s t : set α} {a : α}

lemma is_antichain.not_mem (hs : is_antichain r s) {a b : α} (ha : a ∈ s) (hab: a ≠ b) (h : r a b) :
  b ∉ s := λ hb, hab (is_antichain.eq hs ha hb h)

end


theorem ex : ∀ a b c : Nat, a = b → a = c → c = b := by
  intros
  rename _ = c => h1
  apply Eq.symm
  assumption
  assumption