/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
Amelia Livingston, Yury Kudryashov
-/

import group_theory.submonoid.basic
import data.equiv.mul_add
import algebra.group.prod
import algebra.group.inj_surj
import group_theory.group_action.defs

/-!
# Operations on `submonoid`s

In this file we define various operations on `submonoid`s and `monoid_hom`s.

## Main definitions

### Conversion between multiplicative and additive definitions

* `submonoid.to_add_submonoid`, `submonoid.to_add_submonoid'`, `add_submonoid.to_submonoid`,
  `add_submonoid.to_submonoid'`: convert between multiplicative and additive submonoids of `M`,
  `multiplicative M`, and `additive M`. These are stated as `order_iso`s.

### (Commutative) monoid structure on a submonoid

* `submonoid.to_monoid`, `submonoid.to_comm_monoid`: a submonoid inherits a (commutative) monoid
  structure.

### Group actions by submonoids

* `submonoid.mul_action`, `submonoid.distrib_mul_action`: a submonoid inherits (distributive)
  multiplicative actions.

### Operations on submonoids

* `submonoid.comap`: preimage of a submonoid under a monoid homomorphism as a submonoid of the
  domain;
* `submonoid.map`: image of a submonoid under a monoid homomorphism as a submonoid of the codomain;
* `submonoid.prod`: product of two submonoids `s : submonoid M` and `t : submonoid N` as a submonoid
  of `M × N`;

### Monoid homomorphisms between submonoid

* `submonoid.subtype`: embedding of a submonoid into the ambient monoid.
* `submonoid.inclusion`: given two submonoids `S`, `T` such that `S ≤ T`, `S.inclusion T` is the
  inclusion of `S` into `T` as a monoid homomorphism;
* `mul_equiv.submonoid_congr`: converts a proof of `S = T` into a monoid isomorphism between `S`
  and `T`.
* `submonoid.prod_equiv`: monoid isomorphism between `s.prod t` and `s × t`;

### Operations on `monoid_hom`s

* `monoid_hom.mrange`: range of a monoid homomorphism as a submonoid of the codomain;
* `monoid_hom.mker`: kernel of a monoid homomorphism as a submonoid of the domain;
* `monoid_hom.mrestrict`: restrict a monoid homomorphism to a submonoid;
* `monoid_hom.cod_mrestrict`: restrict the codomain of a monoid homomorphism to a submonoid;
* `monoid_hom.mrange_restrict`: restrict a monoid homomorphism to its range;

## Tags

submonoid, range, product, map, comap
-/

variables {M N P : Type*} [mul_one_class M] [mul_one_class N] [mul_one_class P] (S : submonoid M)

/-!
### Conversion to/from `additive`/`multiplicative`
-/

section

/-- Submonoids of monoid `M` are isomorphic to additive submonoids of `additive M`. -/
@[simps]
def submonoid.to_add_submonoid : submonoid M ≃o add_submonoid (additive M) :=
{ to_fun := λ S,
  { carrier := additive.to_mul ⁻¹' S,
    zero_mem' := S.one_mem',
    add_mem' := S.mul_mem' },
  inv_fun := λ S,
  { carrier := additive.of_mul ⁻¹' S,
    one_mem' := S.zero_mem',
    mul_mem' := S.add_mem' },
  left_inv := λ x, by cases x; refl,
  right_inv := λ x, by cases x; refl,
  map_rel_iff' := λ a b, iff.rfl, }

/-- Additive submonoids of an additive monoid `additive M` are isomorphic to submonoids of `M`. -/
abbreviation add_submonoid.to_submonoid' : add_submonoid (additive M) ≃o submonoid M :=
submonoid.to_add_submonoid.symm

lemma submonoid.to_add_submonoid_closure (S : set M) :
  (submonoid.closure S).to_add_submonoid = add_submonoid.closure (additive.to_mul ⁻¹' S) :=
le_antisymm
  (submonoid.to_add_submonoid.le_symm_apply.1 $
    submonoid.closure_le.2 add_submonoid.subset_closure)
  (add_submonoid.closure_le.2 submonoid.subset_closure)

lemma add_submonoid.to_submonoid'_closure (S : set (additive M)) :
  (add_submonoid.closure S).to_submonoid' = submonoid.closure (multiplicative.of_add ⁻¹' S) :=
le_antisymm
  (add_submonoid.to_submonoid'.le_symm_apply.1 $
    add_submonoid.closure_le.2 submonoid.subset_closure)
  (submonoid.closure_le.2 add_submonoid.subset_closure)

end

section

variables {A : Type*} [add_zero_class A]

/-- Additive submonoids of an additive monoid `A` are isomorphic to
multiplicative submonoids of `multiplicative A`. -/
@[simps]
def add_submonoid.to_submonoid : add_submonoid A ≃o submonoid (multiplicative A) :=
{ to_fun := λ S,
  { carrier := multiplicative.to_add ⁻¹' S,
    one_mem' := S.zero_mem',
    mul_mem' := S.add_mem' },
  inv_fun := λ S,
  { carrier := multiplicative.of_add ⁻¹' S,
    zero_mem' := S.one_mem',
    add_mem' := S.mul_mem' },
  left_inv := λ x, by cases x; refl,
  right_inv := λ x, by cases x; refl,
  map_rel_iff' := λ a b, iff.rfl, }

/-- Submonoids of a monoid `multiplicative A` are isomorphic to additive submonoids of `A`. -/
abbreviation submonoid.to_add_submonoid' : submonoid (multiplicative A) ≃o add_submonoid A :=
add_submonoid.to_submonoid.symm

lemma add_submonoid.to_submonoid_closure (S : set A) :
  (add_submonoid.closure S).to_submonoid = submonoid.closure (multiplicative.to_add ⁻¹' S) :=
le_antisymm
  (add_submonoid.to_submonoid.to_galois_connection.l_le $
    add_submonoid.closure_le.2 submonoid.subset_closure)
  (submonoid.closure_le.2 add_submonoid.subset_closure)

lemma submonoid.to_add_submonoid'_closure (S : set (multiplicative A)) :
  (submonoid.closure S).to_add_submonoid' = add_submonoid.closure (additive.of_mul ⁻¹' S) :=
le_antisymm
  (submonoid.to_add_submonoid'.to_galois_connection.l_le $
    submonoid.closure_le.2 add_submonoid.subset_closure)
  (add_submonoid.closure_le.2 submonoid.subset_closure)

end

namespace submonoid

open set

/-!
### `comap` and `map`
-/

/-- The preimage of a submonoid along a monoid homomorphism is a submonoid. -/
@[to_additive "The preimage of an `add_submonoid` along an `add_monoid` homomorphism is an
`add_submonoid`."]
def comap (f : M →* N) (S : submonoid N) : submonoid M :=
{ carrier := (f ⁻¹' S),
  one_mem' := show f 1 ∈ S, by rw f.map_one; exact S.one_mem,
  mul_mem' := λ a b ha hb,
    show f (a * b) ∈ S, by rw f.map_mul; exact S.mul_mem ha hb }

@[simp, to_additive]
lemma coe_comap (S : submonoid N) (f : M →* N) : (S.comap f : set M) = f ⁻¹' S := rfl

@[simp, to_additive]
lemma mem_comap {S : submonoid N} {f : M →* N} {x : M} : x ∈ S.comap f ↔ f x ∈ S := iff.rfl

@[to_additive]
lemma comap_comap (S : submonoid P) (g : N →* P) (f : M →* N) :
  (S.comap g).comap f = S.comap (g.comp f) :=
rfl

@[simp, to_additive]
lemma comap_id (S : submonoid P) : S.comap (monoid_hom.id _) = S :=
ext (by simp)

/-- The image of a submonoid along a monoid homomorphism is a submonoid. -/
@[to_additive "The image of an `add_submonoid` along an `add_monoid` homomorphism is
an `add_submonoid`."]
def map (f : M →* N) (S : submonoid M) : submonoid N :=
{ carrier := (f '' S),
  one_mem' := ⟨1, S.one_mem, f.map_one⟩,
  mul_mem' := begin rintros _ _ ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩, exact ⟨x * y, S.mul_mem hx hy,
    by rw f.map_mul; refl⟩ end }

@[simp, to_additive]
lemma coe_map (f : M →* N) (S : submonoid M) :
  (S.map f : set N) = f '' S := rfl

@[simp, to_additive]
lemma mem_map {f : M →* N} {S : submonoid M} {y : N} :
  y ∈ S.map f ↔ ∃ x ∈ S, f x = y :=
mem_image_iff_bex

@[to_additive]
lemma mem_map_of_mem (f : M →* N) {S : submonoid M} {x : M} (hx : x ∈ S) : f x ∈ S.map f :=
mem_image_of_mem f hx

@[to_additive]
lemma apply_coe_mem_map (f : M →* N) (S : submonoid M) (x : S) : f x ∈ S.map f :=
mem_map_of_mem f x.prop

@[to_additive]
lemma map_map (g : N →* P) (f : M →* N) : (S.map f).map g = S.map (g.comp f) :=
set_like.coe_injective $ image_image _ _ _

@[to_additive]
lemma mem_map_iff_mem {f : M →* N} (hf : function.injective f) {S : submonoid M} {x : M} :
  f x ∈ S.map f ↔ x ∈ S :=
hf.mem_set_image

@[to_additive]
lemma map_le_iff_le_comap {f : M →* N} {S : submonoid M} {T : submonoid N} :
  S.map f ≤ T ↔ S ≤ T.comap f :=
image_subset_iff

@[to_additive]
lemma gc_map_comap (f : M →* N) : galois_connection (map f) (comap f) :=
λ S T, map_le_iff_le_comap

@[to_additive]
lemma map_le_of_le_comap {T : submonoid N} {f : M →* N} : S ≤ T.comap f → S.map f ≤ T :=
(gc_map_comap f).l_le

@[to_additive]
lemma le_comap_of_map_le {T : submonoid N} {f : M →* N} : S.map f ≤ T → S ≤ T.comap f :=
(gc_map_comap f).le_u

@[to_additive]
lemma le_comap_map {f : M →* N} : S ≤ (S.map f).comap f :=
(gc_map_comap f).le_u_l _

@[to_additive]
lemma map_comap_le {S : submonoid N} {f : M →* N} : (S.comap f).map f ≤ S :=
(gc_map_comap f).l_u_le _

@[to_additive]
lemma monotone_map {f : M →* N} : monotone (map f) :=
(gc_map_comap f).monotone_l

@[to_additive]
lemma monotone_comap {f : M →* N} : monotone (comap f) :=
(gc_map_comap f).monotone_u

@[simp, to_additive]
lemma map_comap_map {f : M →* N} : ((S.map f).comap f).map f = S.map f :=
(gc_map_comap f).l_u_l_eq_l _

@[simp, to_additive]
lemma comap_map_comap {S : submonoid N} {f : M →* N} : ((S.comap f).map f).comap f = S.comap f :=
(gc_map_comap f).u_l_u_eq_u _

@[to_additive]
lemma map_sup (S T : submonoid M) (f : M →* N) : (S ⊔ T).map f = S.map f ⊔ T.map f :=
(gc_map_comap f).l_sup

@[to_additive]
lemma map_supr {ι : Sort*} (f : M →* N) (s : ι → submonoid M) :
  (supr s).map f = ⨆ i, (s i).map f :=
(gc_map_comap f).l_supr

@[to_additive]
lemma comap_inf (S T : submonoid N) (f : M →* N) : (S ⊓ T).comap f = S.comap f ⊓ T.comap f :=
(gc_map_comap f).u_inf

@[to_additive]
lemma comap_infi {ι : Sort*} (f : M →* N) (s : ι → submonoid N) :
  (infi s).comap f = ⨅ i, (s i).comap f :=
(gc_map_comap f).u_infi

@[simp, to_additive] lemma map_bot (f : M →* N) : (⊥ : submonoid M).map f = ⊥ :=
(gc_map_comap f).l_bot

@[simp, to_additive]

@[simp, to_additive] lemma map_id (S : submonoid M) : S.map (monoid_hom.id M) = S :=
ext (λ x, ⟨λ ⟨_, h, rfl⟩, h, λ h, ⟨_, h, rfl⟩⟩)

section galois_coinsertion

variables {ι : Type*} {f : M →* N} (hf : function.injective f)

include hf

/-- `map f` and `comap f` form a `galois_coinsertion` when `f` is injective. -/
@[to_additive /-" `map f` and `comap f` form a `galois_coinsertion` when `f` is injective. "-/]
def gci_map_comap : galois_coinsertion (map f) (comap f) :=
(gc_map_comap f).to_galois_coinsertion
  (λ S x, by simp [mem_comap, mem_map, hf.eq_iff])

@[to_additive]
lemma comap_map_eq_of_injective (S : submonoid M) : (S.map f).comap f = S :=
(gci_map_comap hf).u_l_eq _

@[to_additive]
lemma comap_surjective_of_injective : function.surjective (comap f) :=
(gci_map_comap hf).u_surjective

@[to_additive]
lemma map_injective_of_injective : function.injective (map f) :=
(gci_map_comap hf).l_injective

@[to_additive]
lemma comap_inf_map_of_injective (S T : submonoid M) : (S.map f ⊓ T.map f).comap f = S ⊓ T :=
(gci_map_comap hf).u_inf_l _ _

@[to_additive]
lemma comap_infi_map_of_injective (S : ι → submonoid M) : (⨅ i, (S i).map f).comap f = infi S :=
(gci_map_comap hf).u_infi_l _

@[to_additive]
lemma comap_sup_map_of_injective (S T : submonoid M) : (S.map f ⊔ T.map f).comap f = S ⊔ T :=
(gci_map_comap hf).u_sup_l _ _

@[to_additive]
lemma comap_supr_map_of_injective (S : ι → submonoid M) : (⨆ i, (S i).map f).comap f = supr S :=
(gci_map_comap hf).u_supr_l _

@[to_additive]
lemma map_le_map_iff_of_injective {S T : submonoid M} : S.map f ≤ T.map f ↔ S ≤ T :=
(gci_map_comap hf).l_le_l_iff

@[to_additive]
lemma map_strict_mono_of_injective : strict_mono (map f) :=
(gci_map_comap hf).strict_mono_l

end galois_coinsertion

section galois_insertion

variables {ι : Type*} {f : M →* N} (hf : function.surjective f)

include hf

/-- `map f` and `comap f` form a `galois_insertion` when `f` is surjective. -/
@[to_additive /-" `map f` and `comap f` form a `galois_insertion` when `f` is surjective. "-/]
def gi_map_comap : galois_insertion (map f) (comap f) :=
(gc_map_comap f).to_galois_insertion
  (λ S x h, let ⟨y, hy⟩ := hf x in mem_map.2 ⟨y, by simp [hy, h]⟩)

@[to_additive]
lemma map_comap_eq_of_surjective (S : submonoid N) : (S.comap f).map f = S :=
(gi_map_comap hf).l_u_eq _

@[to_additive]
lemma map_surjective_of_surjective : function.surjective (map f) :=
(gi_map_comap hf).l_surjective

@[to_additive]
lemma comap_injective_of_surjective : function.injective (comap f) :=
(gi_map_comap hf).u_injective

@[to_additive]
lemma map_inf_comap_of_surjective (S T : submonoid N) : (S.comap f ⊓ T.comap f).map f = S ⊓ T :=
(gi_map_comap hf).l_inf_u _ _

@[to_additive]
lemma map_infi_comap_of_surjective (S : ι → submonoid N) : (⨅ i, (S i).comap f).map f = infi S :=
(gi_map_comap hf).l_infi_u _

@[to_additive]
lemma map_sup_comap_of_surjective (S T : submonoid N) : (S.comap f ⊔ T.comap f).map f = S ⊔ T :=
(gi_map_comap hf).l_sup_u _ _

@[to_additive]
lemma map_supr_comap_of_surjective (S : ι → submonoid N) : (⨆ i, (S i).comap f).map f = supr S :=
(gi_map_comap hf).l_supr_u _

@[to_additive]
lemma comap_le_comap_iff_of_surjective {S T : submonoid N} : S.comap f ≤ T.comap f ↔ S ≤ T :=
(gi_map_comap hf).u_le_u_iff

@[to_additive]
lemma comap_strict_mono_of_surjective : strict_mono (comap f) :=
(gi_map_comap hf).strict_mono_u

end galois_insertion

/-- A submonoid of a monoid inherits a multiplication. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits an addition."]
instance has_mul : has_mul S := ⟨λ a b, ⟨a.1 * b.1, S.mul_mem a.2 b.2⟩⟩

/-- A submonoid of a monoid inherits a 1. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits a zero."]
instance has_one : has_one S := ⟨⟨_, S.one_mem⟩⟩

@[simp, norm_cast, to_additive] lemma coe_mul (x y : S) : (↑(x * y) : M) = ↑x * ↑y := rfl
@[simp, norm_cast, to_additive] lemma coe_one : ((1 : S) : M) = 1 := rfl

@[simp, to_additive] lemma mk_mul_mk (x y : M) (hx : x ∈ S) (hy : y ∈ S) :
  (⟨x, hx⟩ : S) * ⟨y, hy⟩ = ⟨x * y, S.mul_mem hx hy⟩ := rfl

@[to_additive] lemma mul_def (x y : S) : x * y = ⟨x * y, S.mul_mem x.2 y.2⟩ := rfl
@[to_additive] lemma one_def : (1 : S) = ⟨1, S.one_mem⟩ := rfl

/-- A submonoid of a unital magma inherits a unital magma structure. -/
@[to_additive "An `add_submonoid` of an unital additive magma inherits an unital additive magma
structure."]
instance to_mul_one_class {M : Type*} [mul_one_class M] (S : submonoid M) : mul_one_class S :=
subtype.coe_injective.mul_one_class coe rfl (λ _ _, rfl)

/-- A submonoid of a monoid inherits a monoid structure. -/
@[to_additive "An `add_submonoid` of an `add_monoid` inherits an `add_monoid`
structure."]
instance to_monoid {M : Type*} [monoid M] (S : submonoid M) : monoid S :=
subtype.coe_injective.monoid coe rfl (λ _ _, rfl)

/-- A submonoid of a `comm_monoid` is a `comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `add_comm_monoid` is
an `add_comm_monoid`."]
instance to_comm_monoid {M} [comm_monoid M] (S : submonoid M) : comm_monoid S :=
subtype.coe_injective.comm_monoid coe rfl (λ _ _, rfl)

/-- A submonoid of an `ordered_comm_monoid` is an `ordered_comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `ordered_add_comm_monoid` is
an `ordered_add_comm_monoid`."]
instance to_ordered_comm_monoid {M} [ordered_comm_monoid M] (S : submonoid M) :
  ordered_comm_monoid S :=
subtype.coe_injective.ordered_comm_monoid coe rfl (λ _ _, rfl)

/-- A submonoid of a `linear_ordered_comm_monoid` is a `linear_ordered_comm_monoid`. -/
@[to_additive "An `add_submonoid` of a `linear_ordered_add_comm_monoid` is
a `linear_ordered_add_comm_monoid`."]
instance to_linear_ordered_comm_monoid {M} [linear_ordered_comm_monoid M] (S : submonoid M) :
  linear_ordered_comm_monoid S :=
subtype.coe_injective.linear_ordered_comm_monoid coe rfl (λ _ _, rfl)

/-- A submonoid of an `ordered_cancel_comm_monoid` is an `ordered_cancel_comm_monoid`. -/
@[to_additive "An `add_submonoid` of an `ordered_cancel_add_comm_monoid` is
an `ordered_cancel_add_comm_monoid`."]
instance to_ordered_cancel_comm_monoid {M} [ordered_cancel_comm_monoid M] (S : submonoid M) :
  ordered_cancel_comm_monoid S :=
subtype.coe_injective.ordered_cancel_comm_monoid coe rfl (λ _ _, rfl)

/-- A submonoid of a `linear_ordered_cancel_comm_monoid` is a `linear_ordered_cancel_comm_monoid`.
-/
@[to_additive "An `add_submonoid` of a `linear_ordered_cancel_add_comm_monoid` is
a `linear_ordered_cancel_add_comm_monoid`."]
instance to_linear_ordered_cancel_comm_monoid {M} [linear_ordered_cancel_comm_monoid M]
  (S : submonoid M) : linear_ordered_cancel_comm_monoid S :=
subtype.coe_injective.linear_ordered_cancel_comm_monoid coe rfl (λ _ _, rfl)

/-- The natural monoid hom from a submonoid of monoid `M` to `M`. -/
@[to_additive "The natural monoid hom from an `add_submonoid` of `add_monoid` `M` to `M`."]
def subtype : S →* M := ⟨coe, rfl, λ _ _, rfl⟩

@[simp, to_additive] theorem coe_subtype : ⇑S.subtype = coe := rfl

/-- A submonoid is isomorphic to its image under an injective function -/
@[to_additive "An additive submonoid is isomorphic to its image under an injective function"]
noncomputable def equiv_map_of_injective
  (f : M →* N) (hf : function.injective f) : S ≃* S.map f :=
{ map_mul' := λ _ _, subtype.ext (f.map_mul _ _), ..equiv.set.image f S hf }

@[simp, to_additive] lemma coe_equiv_map_of_injective_apply
  (f : M →* N) (hf : function.injective f) (x : S) :
  (equiv_map_of_injective S f hf x : N) = f x := rfl

/-- An induction principle on elements of the type `submonoid.closure s`.
If `p` holds for `1` and all elements of `s`, and is preserved under multiplication, then `p`
holds for all elements of the closure of `s`.

The difference with `submonoid.closure_induction` is that this acts on the subtype.
-/
@[elab_as_eliminator, to_additive "An induction principle on elements of the type
`add_submonoid.closure s`.  If `p` holds for `0` and all elements of `s`, and is preserved under
addition, then `p` holds for all elements of the closure of `s`.

The difference with `add_submonoid.closure_induction` is that this acts on the subtype."]
lemma closure_induction' (s : set M) {p : closure s → Prop}
  (Hs : ∀ x (h : x ∈ s), p ⟨x, subset_closure h⟩)
  (H1 : p 1)
  (Hmul : ∀ x y, p x → p y → p (x * y))
  (x : closure s) :
  p x :=
subtype.rec_on x $ λ x hx, begin
  refine exists.elim _ (λ (hx : x ∈ closure s) (hc : p ⟨x, hx⟩), hc),
  exact closure_induction hx
    (λ x hx, ⟨subset_closure hx, Hs x hx⟩)
    ⟨one_mem _, H1⟩
    (λ x y hx hy, exists.elim hx $ λ hx' hx, exists.elim hy $ λ hy' hy,
      ⟨mul_mem _ hx' hy', Hmul _ _ hx hy⟩),
end

@[simp, to_additive]
lemma closure_closure_coe_preimage {s : set M} : closure ((coe : closure s → M) ⁻¹' s) = ⊤ :=
begin
  refine eq_top_iff.2 (λ x hx, closure_induction' (λ x, _) _ _ (λ g₁ g₂ hg₁ hg₂, _) x),
  { intros g hg,
    exact subset_closure hg },
  { exact submonoid.one_mem _ },
  { exact submonoid.mul_mem _ hg₁ hg₂ },
end

/-- Given `submonoid`s `s`, `t` of monoids `M`, `N` respectively, `s × t` as a submonoid
of `M × N`. -/
@[to_additive prod "Given `add_submonoid`s `s`, `t` of `add_monoid`s `A`, `B` respectively, `s × t`
as an `add_submonoid` of `A × B`."]
def prod (s : submonoid M) (t : submonoid N) : submonoid (M × N) :=
{ carrier := (s : set M).prod t,
  one_mem' := ⟨s.one_mem, t.one_mem⟩,
  mul_mem' := λ p q hp hq, ⟨s.mul_mem hp.1 hq.1, t.mul_mem hp.2 hq.2⟩ }

@[to_additive coe_prod]
lemma coe_prod (s : submonoid M) (t : submonoid N) :
 (s.prod t : set (M × N)) = (s : set M).prod (t : set N) :=
rfl

@[to_additive mem_prod]
lemma mem_prod {s : submonoid M} {t : submonoid N} {p : M × N} :
  p ∈ s.prod t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl

@[to_additive prod_mono]
lemma prod_mono {s₁ s₂ : submonoid M} {t₁ t₂ : submonoid N} (hs : s₁ ≤ s₂) (ht : t₁ ≤ t₂) :
  s₁.prod t₁ ≤ s₂.prod t₂ :=
set.prod_mono hs ht

@[to_additive prod_top]
lemma prod_top (s : submonoid M) :
  s.prod (⊤ : submonoid N) = s.comap (monoid_hom.fst M N) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_fst]

@[to_additive top_prod]
lemma top_prod (s : submonoid N) :
  (⊤ : submonoid M).prod s = s.comap (monoid_hom.snd M N) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_snd]

@[simp, to_additive top_prod_top]
lemma top_prod_top : (⊤ : submonoid M).prod (⊤ : submonoid N) = ⊤ :=
(top_prod _).trans $ comap_top _

@[to_additive] lemma bot_prod_bot : (⊥ : submonoid M).prod (⊥ : submonoid N) = ⊥ :=
set_like.coe_injective $ by simp [coe_prod, prod.one_eq_mk]

/-- The product of submonoids is isomorphic to their product as monoids. -/
@[to_additive prod_equiv "The product of additive submonoids is isomorphic to their product
as additive monoids"]
def prod_equiv (s : submonoid M) (t : submonoid N) : s.prod t ≃* s × t :=
{ map_mul' := λ x y, rfl, .. equiv.set.prod ↑s ↑t }

open monoid_hom

@[to_additive]
lemma map_inl (s : submonoid M) : s.map (inl M N) = s.prod ⊥ :=
ext $ λ p, ⟨λ ⟨x, hx, hp⟩, hp ▸ ⟨hx, set.mem_singleton 1⟩,
  λ ⟨hps, hp1⟩, ⟨p.1, hps, prod.ext rfl $ (set.eq_of_mem_singleton hp1).symm⟩⟩

@[to_additive]
lemma map_inr (s : submonoid N) : s.map (inr M N) = prod ⊥ s :=
ext $ λ p, ⟨λ ⟨x, hx, hp⟩, hp ▸ ⟨set.mem_singleton 1, hx⟩,
  λ ⟨hp1, hps⟩, ⟨p.2, hps, prod.ext (set.eq_of_mem_singleton hp1).symm rfl⟩⟩

@[simp, to_additive prod_bot_sup_bot_prod]
lemma prod_bot_sup_bot_prod (s : submonoid M) (t : submonoid N) :
  (s.prod ⊥) ⊔ (prod ⊥ t) = s.prod t :=
le_antisymm (sup_le (prod_mono (le_refl s) bot_le) (prod_mono bot_le (le_refl t))) $
assume p hp, prod.fst_mul_snd p ▸ mul_mem _
  ((le_sup_left : s.prod ⊥ ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨hp.1, set.mem_singleton 1⟩)
  ((le_sup_right : prod ⊥ t ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨set.mem_singleton 1, hp.2⟩)

@[to_additive]
lemma mem_map_equiv {f : M ≃* N} {K : submonoid M} {x : N} :
  x ∈ K.map f.to_monoid_hom ↔ f.symm x ∈ K :=
@set.mem_image_equiv _ _ ↑K f.to_equiv x

@[to_additive]
lemma map_equiv_eq_comap_symm (f : M ≃* N) (K : submonoid M) :
  K.map f.to_monoid_hom = K.comap f.symm.to_monoid_hom :=
set_like.coe_injective (f.to_equiv.image_eq_preimage K)

@[to_additive]
lemma comap_equiv_eq_map_symm (f : N ≃* M) (K : submonoid M) :
  K.comap f.to_monoid_hom = K.map f.symm.to_monoid_hom :=
(map_equiv_eq_comap_symm f.symm K).symm

end submonoid

namespace monoid_hom

open submonoid

/-- For many categories (monoids, modules, rings, ...) the set-theoretic image of a morphism `f` is
a subobject of the codomain. When this is the case, it is useful to define the range of a morphism
in such a way that the underlying carrier set of the range subobject is definitionally
`set.range f`. In particular this means that the types `↥(set.range f)` and `↥f.range` are
interchangeable without proof obligations.

A convenient candidate definition for range which is mathematically correct is `map ⊤ f`, just as
`set.range` could have been defined as `f '' set.univ`. However, this lacks the desired definitional
convenience, in that it both does not match `set.range`, and that it introduces a redudant `x ∈ ⊤`
term which clutters proofs. In such a case one may resort to the `copy`
pattern. A `copy` function converts the definitional problem for the carrier set of a subobject
into a one-off propositional proof obligation which one discharges while writing the definition of
the definitionally convenient range (the parameter `hs` in the example below).

A good example is the case of a morphism of monoids. A convenient definition for
`monoid_hom.mrange` would be `(⊤ : submonoid M).map f`. However since this lacks the required
definitional convenience, we first define `submonoid.copy` as follows:
```lean
protected def copy (S : submonoid M) (s : set M) (hs : s = S) : submonoid M :=
{ carrier  := s,
  one_mem' := hs.symm ▸ S.one_mem',
  mul_mem' := hs.symm ▸ S.mul_mem' }
```
and then finally define:
```lean
def mrange (f : M →* N) : submonoid N :=
((⊤ : submonoid M).map f).copy (set.range f) set.image_univ.symm
```
-/
library_note "range copy pattern"

/-- The range of a monoid homomorphism is a submonoid. See Note [range copy pattern]. -/
@[to_additive "The range of an `add_monoid_hom` is an `add_submonoid`."]
def mrange (f : M →* N) : submonoid N :=
((⊤ : submonoid M).map f).copy (set.range f) set.image_univ.symm

@[simp, to_additive]
lemma coe_mrange (f : M →* N) :
  (f.mrange : set N) = set.range f :=
rfl

@[simp, to_additive] lemma mem_mrange {f : M →* N} {y : N} :
  y ∈ f.mrange ↔ ∃ x, f x = y :=
iff.rfl

@[to_additive] lemma mrange_eq_map (f : M →* N) : f.mrange = (⊤ : submonoid M).map f :=
copy_eq _

@[to_additive]
lemma map_mrange (g : N →* P) (f : M →* N) : f.mrange.map g = (g.comp f).mrange :=
by simpa only [mrange_eq_map] using (⊤ : submonoid M).map_map g f

@[to_additive]
lemma mrange_top_iff_surjective {N} [mul_one_class N] {f : M →* N} :
  f.mrange = (⊤ : submonoid N) ↔ function.surjective f :=
set_like.ext'_iff.trans $ iff.trans (by rw [coe_mrange, coe_top]) set.range_iff_surjective

/-- The range of a surjective monoid hom is the whole of the codomain. -/
@[to_additive "The range of a surjective `add_monoid` hom is the whole of the codomain."]
lemma mrange_top_of_surjective {N} [mul_one_class N] (f : M →* N) (hf : function.surjective f) :
  f.mrange = (⊤ : submonoid N) :=
mrange_top_iff_surjective.2 hf

@[to_additive]
lemma mclosure_preimage_le (f : M →* N) (s : set N) :
  closure (f ⁻¹' s) ≤ (closure s).comap f :=
closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx

/-- The image under a monoid hom of the submonoid generated by a set equals the submonoid generated
    by the image of the set. -/
@[to_additive "The image under an `add_monoid` hom of the `add_submonoid` generated by a set equals
the `add_submonoid` generated by the image of the set."]
lemma map_mclosure (f : M →* N) (s : set M) :
  (closure s).map f = closure (f '' s) :=
le_antisymm
  (map_le_iff_le_comap.2 $ le_trans (closure_mono $ set.subset_preimage_image _ _)
    (mclosure_preimage_le _ _))
  (closure_le.2 $ set.image_subset _ subset_closure)

/-- Restriction of a monoid hom to a submonoid of the domain. -/
@[to_additive "Restriction of an add_monoid hom to an `add_submonoid` of the domain."]
def mrestrict {N : Type*} [mul_one_class N] (f : M →* N) (S : submonoid M) : S →* N :=
f.comp S.subtype

@[simp, to_additive]
lemma mrestrict_apply {N : Type*} [mul_one_class N] (f : M →* N) (x : S) : f.mrestrict S x = f x :=
rfl

/-- Restriction of a monoid hom to a submonoid of the codomain. -/
@[to_additive "Restriction of an `add_monoid` hom to an `add_submonoid` of the codomain.", simps]
def cod_mrestrict (f : M →* N) (S : submonoid N) (h : ∀ x, f x ∈ S) : M →* S :=
{ to_fun := λ n, ⟨f n, h n⟩,
  map_one' := subtype.eq f.map_one,
  map_mul' := λ x y, subtype.eq (f.map_mul x y) }

/-- Restriction of a monoid hom to its range interpreted as a submonoid. -/
@[to_additive "Restriction of an `add_monoid` hom to its range interpreted as a submonoid."]
def mrange_restrict {N} [mul_one_class N] (f : M →* N) : M →* f.mrange :=
f.cod_mrestrict f.mrange $ λ x, ⟨x, rfl⟩

@[simp, to_additive]
lemma coe_mrange_restrict {N} [mul_one_class N] (f : M →* N) (x : M) :
  (f.mrange_restrict x : N) = f x :=
rfl

/-- The multiplicative kernel of a monoid homomorphism is the submonoid of elements `x : G` such
that `f x = 1` -/
@[to_additive "The additive kernel of an `add_monoid` homomorphism is the `add_submonoid` of
elements such that `f x = 0`"]
def mker (f : M →* N) : submonoid M := (⊥ : submonoid N).comap f

@[to_additive]
lemma mem_mker (f : M →* N) {x : M} : x ∈ f.mker ↔ f x = 1 := iff.rfl

@[to_additive]
lemma coe_mker (f : M →* N) : (f.mker : set M) = (f : M → N) ⁻¹' {1} := rfl

@[to_additive]
instance decidable_mem_mker [decidable_eq N] (f : M →* N) :
  decidable_pred (∈ f.mker) :=
λ x, decidable_of_iff (f x = 1) f.mem_mker

@[to_additive]
lemma comap_mker (g : N →* P) (f : M →* N) : g.mker.comap f = (g.comp f).mker := rfl

@[simp, to_additive] lemma comap_bot' (f : M →* N) :
  (⊥ : submonoid N).comap f = f.mker := rfl

@[to_additive] lemma range_restrict_mker (f : M →* N) : mker (mrange_restrict f) = mker f :=
begin
  ext,
  change (⟨f x, _⟩ : mrange f) = ⟨1, _⟩ ↔ f x = 1,
  simp only [],
end

@[simp, to_additive]
lemma mker_one : (1 : M →* N).mker = ⊤ :=
by { ext, simp [mem_mker] }

@[to_additive]
lemma prod_map_comap_prod' {M' : Type*} {N' : Type*} [mul_one_class M'] [mul_one_class N']
  (f : M →* N) (g : M' →* N') (S : submonoid N) (S' : submonoid N') :
  (S.prod S').comap (prod_map f g) = (S.comap f).prod (S'.comap g) :=
set_like.coe_injective $ set.preimage_prod_map_prod f g _ _

@[to_additive]
lemma mker_prod_map {M' : Type*} {N' : Type*} [mul_one_class M'] [mul_one_class N'] (f : M →* N)
  (g : M' →* N') : (prod_map f g).mker = f.mker.prod g.mker :=
by rw [←comap_bot', ←comap_bot', ←comap_bot', ←prod_map_comap_prod', bot_prod_bot]

end monoid_hom

namespace submonoid
open monoid_hom

@[to_additive]
lemma mrange_inl : (inl M N).mrange = prod ⊤ ⊥ :=
by simpa only [mrange_eq_map] using map_inl ⊤

@[to_additive]
lemma mrange_inr : (inr M N).mrange = prod ⊥ ⊤ :=
by simpa only [mrange_eq_map] using map_inr ⊤

@[to_additive]
lemma mrange_inl' : (inl M N).mrange = comap (snd M N) ⊥ := mrange_inl.trans (top_prod _)

@[to_additive]
lemma mrange_inr' : (inr M N).mrange = comap (fst M N) ⊥ := mrange_inr.trans (prod_top _)

@[simp, to_additive]
lemma mrange_fst : (fst M N).mrange = ⊤ :=
(fst M N).mrange_top_of_surjective $ @prod.fst_surjective _ _ ⟨1⟩

@[simp, to_additive]
lemma mrange_snd : (snd M N).mrange = ⊤ :=
(snd M N).mrange_top_of_surjective $ @prod.snd_surjective _ _ ⟨1⟩
@[simp, to_additive]

lemma mrange_inl_sup_mrange_inr : (inl M N).mrange ⊔ (inr M N).mrange = ⊤ :=
by simp only [mrange_inl, mrange_inr, prod_bot_sup_bot_prod, top_prod_top]

/-- The monoid hom associated to an inclusion of submonoids. -/
@[to_additive "The `add_monoid` hom associated to an inclusion of submonoids."]
def inclusion {S T : submonoid M} (h : S ≤ T) : S →* T :=
S.subtype.cod_mrestrict _ (λ x, h x.2)

@[simp, to_additive]
lemma range_subtype (s : submonoid M) : s.subtype.mrange = s :=
set_like.coe_injective $ (coe_mrange _).trans $ subtype.range_coe

@[to_additive] lemma eq_top_iff' : S = ⊤ ↔ ∀ x : M, x ∈ S :=
eq_top_iff.trans ⟨λ h m, h $ mem_top m, λ h m _, h m⟩

@[to_additive] lemma eq_bot_iff_forall : S = ⊥ ↔ ∀ x ∈ S, x = (1 : M) :=
set_like.ext_iff.trans $ by simp [iff_def, S.one_mem] { contextual := tt }

@[to_additive] lemma nontrivial_iff_exists_ne_one (S : submonoid M) :
  nontrivial S ↔ ∃ x ∈ S, x ≠ (1:M) :=
calc nontrivial S ↔ ∃ x : S, x ≠ 1                                   : nontrivial_iff_exists_ne 1
              ... ↔ ∃ x (hx : x ∈ S), (⟨x, hx⟩ : S) ≠ ⟨1, S.one_mem⟩ : subtype.exists
              ... ↔ ∃ x ∈ S, x ≠ (1 : M)                             : by simp only [ne.def]

/-- A submonoid is either the trivial submonoid or nontrivial. -/
@[to_additive] lemma bot_or_nontrivial (S : submonoid M) : S = ⊥ ∨ nontrivial S :=
by simp only [eq_bot_iff_forall, nontrivial_iff_exists_ne_one, ← not_forall, classical.em]

/-- A submonoid is either the trivial submonoid or contains a nonzero element. -/
@[to_additive] lemma bot_or_exists_ne_one (S : submonoid M) : S = ⊥ ∨ ∃ x ∈ S, x ≠ (1:M) :=
S.bot_or_nontrivial.imp_right S.nontrivial_iff_exists_ne_one.mp

end submonoid

namespace mul_equiv

variables {S} {T : submonoid M}

/-- Makes the identity isomorphism from a proof that two submonoids of a multiplicative
    monoid are equal. -/
@[to_additive "Makes the identity additive isomorphism from a proof two
submonoids of an additive monoid are equal."]
def submonoid_congr (h : S = T) : S ≃* T :=
{ map_mul' :=  λ _ _, rfl, ..equiv.set_congr $ congr_arg _ h }

-- this name is primed so that the version to `f.range` instead of `f.mrange` can be unprimed.
/-- A monoid homomorphism `f : M →* N` with a left-inverse `g : N → M` defines a multiplicative
equivalence between `M` and `f.mrange`.

This is a bidirectional version of `monoid_hom.mrange_restrict`. -/
@[to_additive /-"
An additive monoid homomorphism `f : M →+ N` with a left-inverse `g : N → M` defines an additive
equivalence between `M` and `f.mrange`.

This is a bidirectional version of `add_monoid_hom.mrange_restrict`. "-/, simps {simp_rhs := tt}]
def of_left_inverse' (f : M →* N) {g : N → M} (h : function.left_inverse g f) : M ≃* f.mrange :=
{ to_fun := f.mrange_restrict,
  inv_fun := g ∘ f.mrange.subtype,
  left_inv := h,
  right_inv := λ x, subtype.ext $
    let ⟨x', hx'⟩ := monoid_hom.mem_mrange.mp x.prop in
    show f (g x) = x, by rw [←hx', h x'],
  .. f.mrange_restrict }

/-- A `mul_equiv` `φ` between two monoids `M` and `N` induces a `mul_equiv` between
a submonoid `S ≤ M` and the submonoid `φ(S) ≤ N`. -/
@[to_additive "An `add_equiv` `φ` between two additive monoids `M` and `N` induces an `add_equiv`
between a submonoid `S ≤ M` and the submonoid `φ(S) ≤ N`. ", simps]
def submonoid_equiv_map (e : M ≃* N) (S : submonoid M) : S ≃* S.map e.to_monoid_hom :=
{ to_fun := λ x, ⟨e x, _⟩,
  inv_fun := λ x, ⟨e.symm x, _⟩, -- we restate this for `simps` to avoid `⇑e.symm.to_equiv x`
  map_mul' := λ _ _, subtype.ext (e.map_mul _ _), ..equiv.image e.to_equiv S }

end mul_equiv

section actions
/-! ### Actions by `submonoid`s

These instances tranfer the action by an element `m : M` of a monoid `M` written as `m • a` onto the
action by an element `s : S` of a submonoid `S : submonoid M` such that `s • a = (s : M) • a`.

These instances work particularly well in conjunction with `monoid.to_mul_action`, enabling
`s • m` as an alias for `↑s * m`.
-/

namespace submonoid

variables {M' : Type*} {α β : Type*} [monoid M']

/-- The action by a submonoid is the action by the underlying monoid. -/
@[to_additive /-"The additive action by an add_submonoid is the action by the underlying
add_monoid. "-/]
instance [mul_action M' α] (S : submonoid M') : mul_action S α :=
mul_action.comp_hom _ S.subtype

@[to_additive]
lemma smul_def [mul_action M' α] {S : submonoid M'} (g : S) (m : α) : g • m = (g : M') • m := rfl

/-- The action by a submonoid is the action by the underlying monoid. -/
instance [add_monoid α] [distrib_mul_action M' α] (S : submonoid M') : distrib_mul_action S α :=
distrib_mul_action.comp_hom _ S.subtype

/-- The action by a submonoid is the action by the underlying monoid. -/
instance [monoid α] [mul_distrib_mul_action M' α] (S : submonoid M') : mul_distrib_mul_action S α :=
mul_distrib_mul_action.comp_hom _ S.subtype

@[to_additive]
instance smul_comm_class_left
  [mul_action M' β] [has_scalar α β] [smul_comm_class M' α β] (S : submonoid M') :
  smul_comm_class S α β :=
⟨λ a, (smul_comm (a : M') : _)⟩

@[to_additive]
instance smul_comm_class_right
  [has_scalar α β] [mul_action M' β] [smul_comm_class α M' β] (S : submonoid M') :
  smul_comm_class α S β :=
⟨λ a s, (smul_comm a (s : M') : _)⟩

/-- Note that this provides `is_scalar_tower S M' M'` which is needed by `smul_mul_assoc`. -/
instance
  [has_scalar α β] [mul_action M' α] [mul_action M' β] [is_scalar_tower M' α β] (S : submonoid M') :
  is_scalar_tower S α β :=
⟨λ a, (smul_assoc (a : M') : _)⟩

example {S : submonoid M'} : is_scalar_tower S M' M' := by apply_instance

instance [mul_action M' α] [has_faithful_scalar M' α] (S : submonoid M') :
  has_faithful_scalar S α :=
{ eq_of_smul_eq_smul := λ x y h, subtype.ext (eq_of_smul_eq_smul h) }

end submonoid

end actions


import .basic .simplify_eq  .init_last .map_accum_lemmas .repeat_lemmas .rotate .tail_lemmas .zero_length_lemmas

universe variables u

namespace vector

variable {α : Type u}

section ind

open nat

parameter {α' : Type u}

variables {P : ∀ {n : ℕ}, vector α' n → Prop}
variables {n : ℕ} (v : vector α' n)
variables h₀ : P nil
variables hn : ∀ {n : ℕ} (x : α') (v : vector α' n), P v → P (x :: v)

include hn

lemma induction : ∀ {n : ℕ} (v : vector α' n), P v
 | 0 ⟨[],P⟩ := h₀
 | (succ n) ⟨x :: xs, P⟩ :=
 begin
   apply hn x ⟨xs,_⟩ (induction ⟨xs, _⟩),
   have P' : succ (list.length xs) = succ n, { apply P },
   injection P',
 end

lemma induction_on : P v := induction h₀ @hn v

end ind

end vector


import data.zmod.basic order.basic

def int32 := zmod (2^32)

namespace int32

local attribute [instance]
def int32_pos : fact (0 < 2 ^ 32) := nat.pow_pos dec_trivial _

instance : has_coe int32 ℤ :=
⟨λ i, if i.val < 2^31 then i.val else i.val - 2^32⟩

instance : comm_ring int32 := by unfold int32; apply_instance

instance : decidable_eq int32 :=
λ x y, decidable_of_iff _ (zmod.val_injective _).eq_iff

theorem coe_inj {i j : int32} : (i : ℤ) = j ↔ i = j :=
⟨λ h : (ite (i.val < 2 ^ 31) i.val (i.val - 2 ^ 32) : ℤ) =
       ite (j.val < 2 ^ 31) j.val (j.val - 2 ^ 32), begin
  rw ← (_ : ((2 ^ 32 : ℕ) : ℤ) = 2 ^ 32) at h,
  swap, {apply int.coe_nat_pow},
  split_ifs at h with h₁ h₂,
  { exact zmod.val_injective _ (int.coe_nat_inj h) },
  { have := int.coe_nat_nonneg i.val,
    rw [h, sub_nonneg, int.coe_nat_le] at this,
    cases not_lt_of_le this j.val_lt },
  { have := int.coe_nat_nonneg j.val,
    rw [← h, sub_nonneg, int.coe_nat_le] at this,
    cases not_lt_of_le this i.val_lt },
  { rw sub_left_inj at h,
    exact zmod.val_injective _ (int.coe_nat_inj h) }
end, congr_arg _⟩

instance : decidable_linear_order int32 :=
{ decidable_le := λ x y, int.decidable_le _ _,
  decidable_eq := int32.decidable_eq,
  ..linear_order.lift (coe : int32 → ℤ) (λ _ _, coe_inj.1) }

theorem coe_le {i j : int32} : (i : ℤ) ≤ j ↔ i ≤ j := iff.rfl

theorem coe_lt {i j : int32} : (i : ℤ) < j ↔ i < j :=
by rw [← not_le, coe_le, not_le]

theorem coe_zero : ((0 : int32) : ℤ) = 0 :=
by unfold_coes; exact if_pos (nat.pow_pos dec_trivial _)

def of_int (n : ℤ) : option int32 :=
if -2^31 ≤ n ∧ n < 2^31 then some n else none

def div (m n : int32) : option int32 :=
if n = 0 then none else of_int (m / n)

def mod (m n : int32) : option int32 :=
if n = 0 then none else of_int (m % n)

def shl (m n : int32) : option int32 :=
if 0 ≤ n ∧ n < 32 then of_int (int.shiftl m n) else none

def shr (m n : int32) : option int32 :=
if 0 ≤ n ∧ n < 32 then of_int (int.shiftr m n) else none

def bitwise_and (m n : int32) : int32 := int.land m n
def bitwise_xor (m n : int32) : int32 := int.lxor m n
def bitwise_or (m n : int32) : int32 := int.lor m n
def bitwise_not (n : int32) : int32 := int.lnot n

end int32


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

/-!
## Definitions on Lists

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

namespace List

/-- Split a list at an index.
```
splitAt 2 [a, b, c] = ([a, b], [c])
``` -/
def splitAt : ℕ → List α → List α × List α
| n+1, x :: xs => let (l, r) := splitAt n xs; (x :: l, r)
| _, xs => ([], xs)

/-- Split a list at an index. Ensures the left list always has the specified length
by right padding with the provided default element.
```
splitAtD 2 [a, b, c] x = ([a, b], [c])
splitAtD 4 [a, b, c] x = ([a, b, c, x], [])
``` -/
def splitAtD : ℕ → List α → α → List α × List α
| 0, xs, a => ([], xs)
| n+1, [], a => let (l, r) := splitAtD n [] a; (a :: l, r)
| n+1, x :: xs, a => let (l, r) := splitAtD n xs a; (x :: l, r)

/-- An auxiliary function for `splitOnP`. -/
def splitOnPAux {α : Type u} (P : α → Prop) [DecidablePred P] : List α → (List α → List α) → List (List α)
| [], f => [f []]
| h :: t, f => if P h then f [] :: splitOnPAux P t id else splitOnPAux P t fun l => f (h :: l)

/-- Split a list at every element satisfying a predicate. -/
def splitOnP {α : Type u} (P : α → Prop) [DecidablePred P] (l : List α) : List (List α) :=
  splitOnPAux P l id

/-- Split a list at every occurrence of an element.
```
[1,1,2,3,2,4,4].split_on 2 = [[1,1],[3],[4,4]]
``` -/
def splitOn {α : Type u} [DecidableEq α] (a : α) (as : List α) : List (List α) :=
  as.splitOnP (· = a)

/-- Apply a function to the nth tail of `l`. Returns the input without
  using `f` if the index is larger than the length of the List.
```
modifyNthTail f 2 [a, b, c] = [a, b] ++ f [c]
``` -/
@[simp]
def modifyNthTail (f : List α → List α) : ℕ → List α → List α
| 0, l => f l
| n+1, [] => []
| n+1, a :: l => a :: modifyNthTail f n l

/-- Apply `f` to the head of the list, if it exists. -/
@[simp]
def modifyHead (f : α → α) : List α → List α
| [] => []
| a :: l => f a :: l

/-- Apply `f` to the nth element of the list, if it exists. -/
def modifyNth (f : α → α) : ℕ → List α → List α :=
  modifyNthTail (modifyHead f)

/-- Apply `f` to the last element of `l`, if it exists. -/
@[simp]
def modifyLast (f : α → α) : List α → List α
| [] => []
| [x] => [f x]
| x :: xs => x :: modifyLast f xs

/-- `insertNth n a l` inserts `a` into the list `l` after the first `n` elements of `l`
```
insertNth 2 1 [1, 2, 3, 4] = [1, 2, 1, 3, 4]
``` -/
def insertNth (n : ℕ) (a : α) : List α → List α :=
  modifyNthTail (cons a) n

/-- Take `n` elements from a list `l`. If `l` has less than `n` elements, append `n - length l`
elements `x`. -/
def takeD : ∀ n : ℕ, List α → α → List α
| 0, l, _ => []
| n+1, l, x => l.headD x :: takeD n l.tail x

/-- Fold a function `f` over the list from the left, returning the list
  of partial results.
```
scanl (+) 0 [1, 2, 3] = [0, 1, 3, 6]
``` -/
def scanl (f : α → β → α) : α → List β → List α
| a, [] => [a]
| a, b :: l => a :: scanl f (f a b) l

/-- Auxiliary definition used to define `scanr`. If `scanrAux f b l = (b', l')`
then `scanr f b l = b' :: l'` -/
def scanrAux (f : α → β → β) (b : β) : List α → β × List β
| [] => (b, [])
| a :: l =>
  let (b', l') := scanrAux f b l
  (f a b', b' :: l')

/-- Fold a function `f` over the list from the right, returning the list of partial results.
```
scanr (+) 0 [1, 2, 3] = [6, 5, 3, 0]
``` -/
def scanr (f : α → β → β) (b : β) (l : List α) : List β :=
  let (b', l') := scanrAux f b l
  b' :: l'

/-- Given a function `f : α → β ⊕ γ`, `partitionMap f l` maps the list by `f`
  whilst partitioning the result it into a pair of lists, `list β × list γ`,
  partitioning the `sum.inl _` into the left list, and the `sum.inr _` into the right List.
  `partitionMap (id : ℕ ⊕ ℕ → ℕ ⊕ ℕ) [inl 0, inr 1, inl 2] = ([0,2], [1])`    -/
def partitionMap (f : α → β ⊕ γ) : List α → List β × List γ
| [] => ([], [])
| x :: xs =>
  match f x with
  | Sum.inr r => Prod.map id (cons r) $ partitionMap f xs
  | Sum.inl l => Prod.map (cons l) id $ partitionMap f xs

/-- `find p l` is the first element of `l` satisfying `p`, or `none` if no such
  element exists. -/
def find (p : α → Prop) [DecidablePred p] : List α → Option α
| [] => none
| a :: l => if p a then some a else find p l

/-- Auxiliary definition for `foldlIdx`. -/
def foldlIdxAux (f : ℕ → α → β → α) : ℕ → α → List β → α
| _, a, [] => a
| i, a, b :: l => foldlIdxAux f (i+1) (f i a b) l

/-- Fold a list from left to right as with `foldl`, but the combining function
also receives each element's index. -/
def foldlIdx (f : ℕ → α → β → α) (a : α) (l : List β) : α :=
  foldlIdxAux f 0 a l

/-- Auxiliary definition for `foldrIdx`. -/
def foldrIdxAux (f : ℕ → α → β → β) : ℕ → β → List α → β
| _, b, [] => b
| i, b, a :: l => f i a (foldrIdxAux f (i+1) b l)

/-- Fold a list from right to left as with `foldr`, but the combining function
also receives each element's index. -/
def foldrIdx (f : ℕ → α → β → β) (b : β) (l : List α) : β :=
  foldrIdxAux f 0 b l

/-- `findIdxs p l` is the list of indexes of elements of `l` that satisfy `p`. -/
def findIdxs (p : α → Prop) [DecidablePred p] (l : List α) : List Nat :=
  foldrIdx (fun i a is => if p a then i :: is else is) [] l

/-- Returns the elements of `l` that satisfy `p` together with their indexes in
`l`. The returned list is ordered by index. -/
def indexesValues (p : α → Prop) [DecidablePred p] (l : List α) : List (ℕ × α) :=
  foldrIdx (fun i a l => if p a then (i, a) :: l else l) [] l

/-- `indexesOf a l` is the list of all indexes of `a` in `l`. For example:

    indexesOf a [a, b, a, a] = [0, 2, 3] -/
def indexesOf [DecidableEq α] (a : α) : List α → List Nat :=
  findIdxs (Eq a)

/-- `lookmap` is a combination of `lookup` and `filterMap`.
  `lookmap f l` will apply `f : α → option α` to each element of the list,
  replacing `a → b` at the first value `a` in the list such that `f a = some b`. -/
def lookmap (f : α → Option α) : List α → List α
| [] => []
| a :: l =>
  match f a with
  | some b => b :: l
  | none => a :: lookmap f l

/-- `countp p l` is the number of elements of `l` that satisfy `p`. -/
def countp (p : α → Prop) [DecidablePred p] : List α → Nat
| [] => 0
| x :: xs => if p x then countp p xs + 1 else countp p xs

/-- `count a l` is the number of occurrences of `a` in `l`. -/
def count [DecidableEq α] (a : α) : List α → Nat :=
  countp (Eq a)

/-- `isPrefix l₁ l₂`, or `l₁ <+: l₂`, means that `l₁` is a prefix of `l₂`,
  that is, `l₂` has the form `l₁ ++ t` for some `t`. -/
def isPrefix (l₁ : List α) (l₂ : List α) : Prop :=
  ∃ t, l₁ ++ t = l₂

/-- `isSuffix l₁ l₂`, or `l₁ <:+ l₂`, means that `l₁` is a suffix of `l₂`,
  that is, `l₂` has the form `t ++ l₁` for some `t`. -/
def isSuffix (l₁ : List α) (l₂ : List α) : Prop :=
  ∃ t, t ++ l₁ = l₂

/-- `isInfix l₁ l₂`, or `l₁ <:+: l₂`, means that `l₁` is a contiguous
  substring of `l₂`, that is, `l₂` has the form `s ++ l₁ ++ t` for some `s, t`. -/
def isInfix (l₁ : List α) (l₂ : List α) : Prop :=
  ∃ s t, s ++ l₁ ++ t = l₂

infixl:50 " <+: " => isPrefix

infixl:50 " <:+ " => isSuffix

infixl:50 " <:+: " => isInfix

/-- `inits l` is the list of initial segments of `l`.
```
inits [1, 2, 3] = [[], [1], [1, 2], [1, 2, 3]]
``` -/
@[simp] def inits : List α → List (List α)
| [] => [[]]
| a :: l => [] :: map (fun t => a :: t) (inits l)

/-- `tails l` is the list of terminal segments of `l`.
```
tails [1, 2, 3] = [[1, 2, 3], [2, 3], [3], []]
``` -/
@[simp] def tails : List α → List (List α)
| [] => [[]]
| a :: l => (a :: l) :: tails l

def sublists'Aux : List α → (List α → List β) → List (List β) → List (List β)
| [], f, r => f [] :: r
| a :: l, f, r => sublists'Aux l f (sublists'Aux l (f ∘ cons a) r)

/-- `sublists' l` is the list of all (non-contiguous) sublists of `l`.
  It differs from `sublists` only in the order of appearance of the sublists;
  `sublists'` uses the first element of the list as the MSB,
  `sublists` uses the first element of the list as the LSB.
```
sublists' [1, 2, 3] = [[], [3], [2], [2, 3], [1], [1, 3], [1, 2], [1, 2, 3]]
``` -/
def sublists' (l : List α) : List (List α) :=
  sublists'Aux l id []

def sublistsAux : List α → (List α → List β → List β) → List β
| [], f => []
| a :: l, f => f [a] (sublistsAux l fun ys r => f ys (f (a :: ys) r))

/-- `sublists l` is the list of all (non-contiguous) sublists of `l`; cf. `sublists'`
  for a different ordering.
```
sublists [1, 2, 3] = [[], [1], [2], [1, 2], [3], [1, 3], [2, 3], [1, 2, 3]]
``` -/
def sublists (l : List α) : List (List α) :=
  [] :: sublistsAux l cons

def sublistsAux₁ : List α → (List α → List β) → List β
| [], f => []
| a :: l, f => f [a] ++ sublistsAux₁ l fun ys => f ys ++ f (a :: ys)

section Forall₂

variable {r : α → β → Prop} {p : γ → δ → Prop}

/-- `Forall₂ R l₁ l₂` means that `l₁` and `l₂` have the same length,
  and whenever `a` is the nth element of `l₁`, and `b` is the nth element of `l₂`,
  then `R a b` is satisfied. -/
inductive Forall₂ (R : α → β → Prop) : List α → List β → Prop
  | nil : Forall₂ R [] []
  | cons {a b l₁ l₂} : R a b → Forall₂ R l₁ l₂ → Forall₂ R (a :: l₁) (b :: l₂)

attribute [simp] Forall₂.nil

end Forall₂

/-- Auxiliary definition used to define `transpose`.
  `transposeAux l L` takes each element of `l` and appends it to the start of
  each element of `L`.
  `transposeAux [a, b, c] [l₁, l₂, l₃] = [a::l₁, b::l₂, c::l₃]` -/
def transposeAux : List α → List (List α) → List (List α)
| [], ls => ls
| a :: i, [] => [a] :: transposeAux i []
| a :: i, l :: ls => (a :: l) :: transposeAux i ls

/-- transpose of a list of lists, treated as a matrix.
```
transpose [[1, 2], [3, 4], [5, 6]] = [[1, 3, 5], [2, 4, 6]]
``` -/
def transpose : List (List α) → List (List α)
| [] => []
| l :: ls => transposeAux l (transpose ls)

/-- List of all sections through a list of lists. A section
  of `[L₁, L₂, ..., Lₙ]` is a list whose first element comes from
  `L₁`, whose second element comes from `L₂`, and so on. -/
def sections : List (List α) → List (List α)
| [] => [[]]
| l :: L => (sections L).bind fun s => l.map fun a => a :: s

/-- `erasep p l` removes the first element of `l` satisfying the predicate `p`. -/
def erasep (p : α → Prop) [DecidablePred p] : List α → List α
| [] => []
| a :: l => if p a then l else a :: erasep p l

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

/-- `revzip l` returns a list of pairs of the elements of `l` paired
  with the elements of `l` in reverse order.
```
revzip [1,2,3,4,5] = [(1, 5), (2, 4), (3, 3), (4, 2), (5, 1)]
``` -/
def revzip (l : List α) : List (α × α) :=
  zip l l.reverse

/-- `product l₁ l₂` is the list of pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂`.
```
product [1, 2] [5, 6] = [(1, 5), (1, 6), (2, 5), (2, 6)]
``` -/
def product (l₁ : List α) (l₂ : List β) : List (α × β) :=
  l₁.bind $ fun a => l₂.map $ Prod.mk a

/-- `sigma l₁ l₂` is the list of dependent pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂ a`.
```
sigma [1, 2] (λ_, [(5 : ℕ), 6]) = [(1, 5), (1, 6), (2, 5), (2, 6)]
``` -/
protected def sigma {σ : α → Type _} (l₁ : List α) (l₂ : ∀ a, List (σ a)) : List (Σ a, σ a) :=
  l₁.bind $ fun a => (l₂ a).map $ Sigma.mk a

/-- Auxliary definition used to define `ofFn`.
  `ofFnAux f m h l` returns the first `m` elements of `ofFn f`
  appended to `l` -/
def ofFnAux {n} (f : Fin n → α) : ∀ m, m ≤ n → List α → List α
| 0, h, l => l
| m+1, h, l => ofFnAux f m (Nat.le_of_lt h) (f ⟨m, h⟩ :: l)

/-- `ofFn f` with `f : fin n → α` returns the list whose ith element is `f i`
```
ofFn f = [f 0, f 1, ... , f(n - 1)]
``` -/
def ofFn {n} (f : Fin n → α) : List α :=
  ofFnAux f n (Nat.le_refl _) []

/-- `ofFnNthVal f i` returns `some (f i)` if `i < n` and `none` otherwise. -/
def ofFnNthVal {n} (f : Fin n → α) (i : ℕ) : Option α :=
  if h : i < n then some (f ⟨i, h⟩) else none

/-- `disjoint l₁ l₂` means that `l₁` and `l₂` have no elements in common. -/
def disjoint (l₁ l₂ : List α) : Prop :=
  ∀ ⦃a⦄, a ∈ l₁ → a ∈ l₂ → False

section Pairwise

variable (R : α → α → Prop)

-- ././Mathport/Syntax/Translate/Basic.lean:452:2: warning: expanding binder collection (a' «expr ∈ » l)
/-- `Pairwise R l` means that all the elements with earlier indexes are
  `R`-related to all the elements with later indexes.
     Pairwise R [1, 2, 3] ↔ R 1 2 ∧ R 1 3 ∧ R 2 3
  For example if `R = (≠)` then it asserts `l` has no duplicates,
  and if `R = (<)` then it asserts that `l` is (strictly) sorted. -/
inductive Pairwise : List α → Prop
  | nil : Pairwise []
  | cons : ∀ {a : α} {l : List α}, (∀ a' ∈ l, R a a') → Pairwise l → Pairwise (a :: l)

end Pairwise

-- ././Mathport/Syntax/Translate/Basic.lean:452:2: warning: expanding binder collection (y «expr ∈ » IH)
/-- `pwFilter R l` is a maximal sublist of `l` which is `Pairwise R`.
  `pwFilter (≠)` is the erase duplicates function (cf. `eraseDup`), and `pwFilter (<)` finds
  a maximal increasing subsequence in `l`. For example,
     pwFilter (<) [0, 1, 5, 2, 6, 3, 4] = [0, 1, 2, 3, 4] -/
def pwFilter (R : α → α → Prop) [DecidableRel R] : List α → List α
| [] => []
| x :: xs =>
  let IH := pwFilter R xs
  if ∀ y ∈ IH, R x y then x :: IH else IH

section Chain

variable (R : α → α → Prop)

/-- `Chain R a l` means that `R` holds between adjacent elements of `a::l`.
```
Chain R a [b, c, d] ↔ R a b ∧ R b c ∧ R c d
``` -/
inductive Chain : α → List α → Prop
  | nil {a : α} : Chain a []
  | cons : ∀ {a b : α} {l : List α}, R a b → Chain b l → Chain a (b :: l)

/-- `Chain' R l` means that `R` holds between adjacent elements of `l`.
```
Chain' R [a, b, c, d] ↔ R a b ∧ R b c ∧ R c d
``` -/
def Chain' : List α → Prop
| [] => True
| a :: l => Chain R a l

end Chain

/-- `Nodup l` means that `l` has no duplicates, that is, any element appears at most
  once in the List. It is defined as `Pairwise (≠)`. -/
def Nodup : List α → Prop :=
  Pairwise (· ≠ ·)

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

    eraseDup [1, 0, 2, 2, 1] = [0, 2, 1] -/
def eraseDup [DecidableEq α] : List α → List α :=
  pwFilter (· ≠ ·)

/-- `range' s n` is the list of numbers `[s, s+1, ..., s+n-1]`.
  It is intended mainly for proving properties of `range` and `iota`. -/
@[simp]
def range' : ℕ → ℕ → List ℕ
| s, 0 => []
| s, n+1 => s :: range' (s+1) n

/-- Drop `none`s from a list, and replace each remaining `some a` with `a`. -/
def reduceOption {α} : List (Option α) → List α :=
  List.filterMap id

/-- `ilast' x xs` returns the last element of `xs` if `xs` is non-empty;
it returns `x` otherwise -/
@[simp]
def ilast' {α} : α → List α → α
| a, [] => a
| a, b :: l => ilast' b l

/-- `last' xs` returns the last element of `xs` if `xs` is non-empty;
it returns `none` otherwise -/
@[simp]
def last' {α} : List α → Option α
| [] => none
| [a] => some a
| b :: l => last' l

/-- `rotate l n` rotates the elements of `l` to the left by `n`
```
rotate [0, 1, 2, 3, 4, 5] 2 = [2, 3, 4, 5, 0, 1]
``` -/
def rotate (l : List α) (n : ℕ) : List α :=
  let (l₁, l₂) := List.splitAt (n % l.length) l
  l₂ ++ l₁

/-- rotate' is the same as `rotate`, but slower. Used for proofs about `rotate`-/
def rotate' : List α → ℕ → List α
| [], n => []
| l, 0 => l
| a :: l, n+1 => rotate' (l ++ [a]) n

def mmap {m : Type u → Type v} [Monad m] {α β} (f : α → m β) : List α → m (List β)
| [] => pure []
| h :: t => return (← f h) :: (← mmap f t)

def mmap' {m : Type → Type v} [Monad m] {α β} (f : α → m β) : List α → m Unit
| [] => pure ()
| h :: t => f h *> t.mmap' f

/-- Filters and maps elements of a list -/
def mmapFilter {m : Type → Type v} [Monad m] {α β} (f : α → m (Option β)) : List α → m (List β)
| [] => pure []
| h :: t => do
  let b ← f h
  let t' ← t.mmapFilter f
  pure $ match b with
  | none => t'
  | some x => x :: t'

/--
`mmapUpperTriangle f l` calls `f` on all elements in the upper triangular part of `l × l`.
That is, for each `e ∈ l`, it will run `f e e` and then `f e e'`
for each `e'` that appears after `e` in `l`.
```
mmapUpperTriangle f [1, 2, 3] =
  return [← f 1 1, ← f 1 2, ← f 1 3, ← f 2 2, ← f 2 3, ← f 3 3]
``` -/
def mmapUpperTriangle {m} [Monad m] {α β : Type u} (f : α → α → m β) : List α → m (List β)
| [] => pure []
| h :: t => return (← f h h) :: (← t.mmap (f h)) ++ (← t.mmapUpperTriangle f)

/--
`mmap'Diag f l` calls `f` on all elements in the upper triangular part of `l × l`.
That is, for each `e ∈ l`, it will run `f e e` and then `f e e'`
for each `e'` that appears after `e` in `l`.
```
mmap'Diag f [1, 2, 3] = do f 1 1; f 1 2; f 1 3; f 2 2; f 2 3; f 3 3
``` -/
def mmap'Diag {m} [Monad m] {α} (f : α → α → m Unit) : List α → m Unit
| [] => return ()
| h :: t => do f h h; t.mmap' (f h); t.mmap'Diag f

protected def traverse {F : Type u → Type v} [Applicative F] {α β} (f : α → F β) : List α → F (List β)
| [] => pure []
| x :: xs => cons <$> f x <*> List.traverse f xs

/-- `getRest l l₁` returns `some l₂` if `l = l₁ ++ l₂`.
  If `l₁` is not a prefix of `l`, returns `none` -/
def getRest [DecidableEq α] : List α → List α → Option (List α)
| l, [] => some l
| [], _ => none
| x :: l, y :: l₁ => if x = y then getRest l l₁ else none

/--
`List.slice n m xs` removes a slice of length `m` at index `n` in list `xs`.
-/
def slice {α} : ℕ → ℕ → List α → List α
| 0, n, xs => xs.drop n
| n+1, m, [] => []
| n+1, m, x :: xs => x :: slice n m xs

/--
Left-biased version of `List.map₂`. `map₂Left' f as bs` applies `f` to each
pair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, `f` is
applied to `none` for the remaining `aᵢ`. Returns the results of the `f`
applications and the remaining `bs`.
```
map₂Left' prod.mk [1, 2] ['a'] = ([(1, some 'a'), (2, none)], [])
map₂Left' prod.mk [1] ['a', 'b'] = ([(1, some 'a')], ['b'])
```
-/
@[simp]
def map₂Left' (f : α → Option β → γ) : List α → List β → List γ × List β
| [], bs => ([], bs)
| a :: as, [] => ((a :: as).map fun a => f a none, [])
| a :: as, b :: bs => let r := map₂Left' f as bs; (f a (some b) :: r.1, r.2)

/--
Right-biased version of `List.map₂`. `map₂Right' f as bs` applies `f` to each
pair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, `f` is
applied to `none` for the remaining `bᵢ`. Returns the results of the `f`
applications and the remaining `as`.
```
map₂Right' prod.mk [1] ['a', 'b'] = ([(some 1, 'a'), (none, 'b')], [])
map₂Right' prod.mk [1, 2] ['a'] = ([(some 1, 'a')], [2])
```
-/
def map₂Right' (f : Option α → β → γ) (as : List α) (bs : List β) : List γ × List α :=
  map₂Left' (flip f) bs as

/--
Left-biased version of `List.zip`. `zipLeft' as bs` returns the list of
pairs `(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, the
remaining `aᵢ` are paired with `none`. Also returns the remaining `bs`.
```
zipLeft' [1, 2] ['a'] = ([(1, some 'a'), (2, none)], [])
zipLeft' [1] ['a', 'b'] = ([(1, some 'a')], ['b'])
zipLeft' = map₂Left' prod.mk
```
-/
def zipLeft' : List α → List β → List (α × Option β) × List β :=
  map₂Left' Prod.mk

/--
Right-biased version of `List.zip`. `zipRight' as bs` returns the list of
pairs `(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, the
remaining `bᵢ` are paired with `none`. Also returns the remaining `as`.
```
zipRight' [1] ['a', 'b'] = ([(some 1, 'a'), (none, 'b')], [])
zipRight' [1, 2] ['a'] = ([(some 1, 'a')], [2])
zipRight' = map₂Right' prod.mk
```
-/
def zipRight' : List α → List β → List (Option α × β) × List α :=
  map₂Right' Prod.mk

/--
Left-biased version of `List.map₂`. `map₂Left f as bs` applies `f` to each pair
`aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, `f` is applied to `none`
for the remaining `aᵢ`.
```
map₂Left prod.mk [1, 2] ['a'] = [(1, some 'a'), (2, none)]
map₂Left prod.mk [1] ['a', 'b'] = [(1, some 'a')]
map₂Left f as bs = (map₂Left' f as bs).fst
```
-/
@[simp]
def map₂Left (f : α → Option β → γ) : List α → List β → List γ
| [], _ => []
| a :: as, [] => (a :: as).map fun a => f a none
| a :: as, b :: bs => f a (some b) :: map₂Left f as bs

/--
Right-biased version of `List.map₂`. `map₂Right f as bs` applies `f` to each
pair `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, `f` is applied to
`none` for the remaining `bᵢ`.
```
map₂Right prod.mk [1, 2] ['a'] = [(some 1, 'a')]
map₂Right prod.mk [1] ['a', 'b'] = [(some 1, 'a'), (none, 'b')]
map₂Right f as bs = (map₂Right' f as bs).fst
```
-/
def map₂Right (f : Option α → β → γ) (as : List α) (bs : List β) : List γ :=
  map₂Left (flip f) bs as

/--
Left-biased version of `List.zip`. `zipLeft as bs` returns the list of pairs
`(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, the
remaining `aᵢ` are paired with `none`.
```
zipLeft [1, 2] ['a'] = [(1, some 'a'), (2, none)]
zipLeft [1] ['a', 'b'] = [(1, some 'a')]
zipLeft = map₂Left prod.mk
```
-/
def zipLeft : List α → List β → List (α × Option β) :=
  map₂Left Prod.mk

/--
Right-biased version of `List.zip`. `zipRight as bs` returns the list of pairs
`(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, the
remaining `bᵢ` are paired with `none`.
```
zipRight [1, 2] ['a'] = [(some 1, 'a')]
zipRight [1] ['a', 'b'] = [(some 1, 'a'), (none, 'b')]
zipRight = map₂Right prod.mk
```
-/
def zipRight : List α → List β → List (Option α × β) :=
  map₂Right Prod.mk

/--
If all elements of `xs` are `some xᵢ`, `allSome xs` returns the `xᵢ`. Otherwise
it returns `none`.
```
allSome [some 1, some 2] = some [1, 2]
allSome [some 1, none  ] = none
```
-/
def allSome : List (Option α) → Option (List α)
| [] => some []
| some a :: as => cons a <$> allSome as
| none :: as => none

/--
`fillNones xs ys` replaces the `none`s in `xs` with elements of `ys`. If there
are not enough `ys` to replace all the `none`s, the remaining `none`s are
dropped from `xs`.
```
fillNones [none, some 1, none, none] [2, 3] = [2, 1, 3]
```
-/
def fillNones {α} : List (Option α) → List α → List α
| [], _ => []
| some a :: as, as' => a :: fillNones as as'
| none :: as, [] => as.reduceOption
| none :: as, a :: as' => a :: fillNones as as'

/--
`takeList as ns` extracts successive sublists from `as`. For `ns = n₁ ... nₘ`,
it first takes the `n₁` initial elements from `as`, then the next `n₂` ones,
etc. It returns the sublists of `as` -- one for each `nᵢ` -- and the remaining
elements of `as`. If `as` does not have at least as many elements as the sum of
the `nᵢ`, the corresponding sublists will have less than `nᵢ` elements.
```
takeList ['a', 'b', 'c', 'd', 'e'] [2, 1, 1] = ([['a', 'b'], ['c'], ['d']], ['e'])
takeList ['a', 'b'] [3, 1] = ([['a', 'b'], []], [])
```
-/
def takeList {α} : List α → List ℕ → List (List α) × List α
| xs, [] => ([], xs)
| xs, n :: ns =>
  let ⟨xs₁, xs₂⟩ := xs.splitAt n
  let ⟨xss, rest⟩ := takeList xs₂ ns
  (xs₁ :: xss, rest)

/-- Auxliary definition used to define `toChunks`.
  `toChunksAux n xs i` returns `(xs.take i, (xs.drop i).toChunks (n+1))`,
  that is, the first `i` elements of `xs`, and the remaining elements chunked into
  sublists of length `n+1`. -/
def toChunksAux {α} (n : ℕ) : List α → ℕ → List α × List (List α)
| [], i => ([], [])
| x :: xs, 0 =>
  let (l, L) := toChunksAux n xs n
  ([], (x :: l) :: L)
| x :: xs, i+1 =>
  let (l, L) := toChunksAux n xs i
  (x :: l, L)

/--
`xs.toChunks n` splits the list into sublists of size at most `n`,
such that `(xs.toChunks n).join = xs`.
```
[1, 2, 3, 4, 5, 6, 7, 8].toChunks 10 = [[1, 2, 3, 4, 5, 6, 7, 8]]
[1, 2, 3, 4, 5, 6, 7, 8].toChunks 3 = [[1, 2, 3], [4, 5, 6], [7, 8]]
[1, 2, 3, 4, 5, 6, 7, 8].toChunks 2 = [[1, 2], [3, 4], [5, 6], [7, 8]]
[1, 2, 3, 4, 5, 6, 7, 8].toChunks 0 = [[1, 2, 3, 4, 5, 6, 7, 8]]
```
-/
def toChunks {α} : ℕ → List α → List (List α)
| _, [] => []
| 0, xs => [xs]
| n+1, x :: xs =>
  let (l, L) := toChunksAux n xs n
  (x :: l) :: L

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

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

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

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

/-- An auxiliary function for `List.mapWithPrefixSuffix`. -/
def mapWithPrefixSuffixAux {α β} (f : List α → α → List α → β) : List α → List α → List β
| prev, [] => []
| prev, h :: t => f prev h t :: mapWithPrefixSuffixAux f (prev.concat h) t

/--
`List.mapWithPrefixSuffix f l` maps `f` across a list `l`.
For each `a ∈ l` with `l = pref ++ [a] ++ suff`, `a` is mapped to `f pref a suff`.
Example: if `f : list ℕ → ℕ → list ℕ → β`,
`List.mapWithPrefixSuffix f [1, 2, 3]` will produce the list
`[f [] 1 [2, 3], f [1] 2 [3], f [1, 2] 3 []]`.
-/
def mapWithPrefixSuffix {α β} (f : List α → α → List α → β) (l : List α) : List β :=
  mapWithPrefixSuffixAux f [] l

/--
`List.mapWithComplement f l` is a variant of `List.mapWithPrefixSuffix`
that maps `f` across a list `l`.
For each `a ∈ l` with `l = pref ++ [a] ++ suff`, `a` is mapped to `f a (pref ++ suff)`,
i.e., the list input to `f` is `l` with `a` removed.
Example: if `f : ℕ → list ℕ → β`, `List.mapWithComplement f [1, 2, 3]` will produce the list
`[f 1 [2, 3], f 2 [1, 3], f 3 [1, 2]]`.
-/
def mapWithComplement {α β} (f : α → List α → β) : List α → List β :=
  mapWithPrefixSuffix fun pref a suff => f a (pref ++ suff)

end List


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

! This file was ported from Lean 3 source module data.list.alist
! leanprover-community/mathlib commit f808feb6c18afddb25e66a71d317643cf7fb5fbb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Sigma

/-!
# Association Lists

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

This file defines association lists. An association list is a list where every element consists of
a key and a value, and no two entries have the same key. The type of the value is allowed to be
dependent on the type of the key.

This type dependence is implemented using `sigma`: The elements of the list are of type `sigma β`,
for some type index `β`.

## Main definitions

Association lists are represented by the `alist` structure. This file defines this structure and
provides ways to access, modify, and combine `alist`s.

* `alist.keys` returns a list of keys of the alist.
* `alist.has_mem` returns membership in the set of keys.
* `alist.erase` removes a certain key.
* `alist.insert` adds a key-value mapping to the list.
* `alist.union` combines two association lists.

## References

* <https://en.wikipedia.org/wiki/Association_list>

-/

universe u v w

open List

variable {α : Type u} {β : α → Type v}

#print AList /-
/-- `alist β` is a key-value map stored as a `list` (i.e. a linked list).
  It is a wrapper around certain `list` functions with the added constraint
  that the list have unique keys. -/
structure AList (β : α → Type v) : Type max u v where
  entries : List (Sigma β)
  NodupKeys : entries.NodupKeys
#align alist AList
-/

#print List.toAList /-
/-- Given `l : list (sigma β)`, create a term of type `alist β` by removing
entries with duplicate keys. -/
def List.toAList [DecidableEq α] {β : α → Type v} (l : List (Sigma β)) : AList β
    where
  entries := _
  NodupKeys := nodupKeys_dedupKeys l
#align list.to_alist List.toAList
-/

namespace AList

#print AList.ext /-
@[ext]
theorem ext : ∀ {s t : AList β}, s.entries = t.entries → s = t
  | ⟨l₁, h₁⟩, ⟨l₂, h₂⟩, H => by congr
#align alist.ext AList.ext
-/

#print AList.ext_iff /-
theorem ext_iff {s t : AList β} : s = t ↔ s.entries = t.entries :=
  ⟨congr_arg _, ext⟩
#align alist.ext_iff AList.ext_iff
-/

instance [DecidableEq α] [∀ a, DecidableEq (β a)] : DecidableEq (AList β) := fun xs ys => by
  rw [ext_iff] <;> infer_instance

/-! ### keys -/

#print AList.keys /-
/-- The list of keys of an association list. -/
def keys (s : AList β) : List α :=
  s.entries.keys
#align alist.keys AList.keys
-/

#print AList.keys_nodup /-
theorem keys_nodup (s : AList β) : s.keys.Nodup :=
  s.NodupKeys
#align alist.keys_nodup AList.keys_nodup
-/

/-! ### mem -/

/-- The predicate `a ∈ s` means that `s` has a value associated to the key `a`. -/
instance : Membership α (AList β) :=
  ⟨fun a s => a ∈ s.keys⟩

#print AList.mem_keys /-
theorem mem_keys {a : α} {s : AList β} : a ∈ s ↔ a ∈ s.keys :=
  Iff.rfl
#align alist.mem_keys AList.mem_keys
-/

#print AList.mem_of_perm /-
theorem mem_of_perm {a : α} {s₁ s₂ : AList β} (p : s₁.entries ~ s₂.entries) : a ∈ s₁ ↔ a ∈ s₂ :=
  (p.map Sigma.fst).mem_iff
#align alist.mem_of_perm AList.mem_of_perm
-/

/-! ### empty -/

/-- The empty association list. -/
instance : EmptyCollection (AList β) :=
  ⟨⟨[], nodupKeys_nil⟩⟩

instance : Inhabited (AList β) :=
  ⟨∅⟩

#print AList.not_mem_empty /-
@[simp]
theorem not_mem_empty (a : α) : a ∉ (∅ : AList β) :=
  not_mem_nil a
#align alist.not_mem_empty AList.not_mem_empty
-/

#print AList.empty_entries /-
@[simp]
theorem empty_entries : (∅ : AList β).entries = [] :=
  rfl
#align alist.empty_entries AList.empty_entries
-/

#print AList.keys_empty /-
@[simp]
theorem keys_empty : (∅ : AList β).keys = [] :=
  rfl
#align alist.keys_empty AList.keys_empty
-/

/-! ### singleton -/

#print AList.singleton /-
/-- The singleton association list. -/
def singleton (a : α) (b : β a) : AList β :=
  ⟨[⟨a, b⟩], nodupKeys_singleton _⟩
#align alist.singleton AList.singleton
-/

#print AList.singleton_entries /-
@[simp]
theorem singleton_entries (a : α) (b : β a) : (singleton a b).entries = [Sigma.mk a b] :=
  rfl
#align alist.singleton_entries AList.singleton_entries
-/

#print AList.keys_singleton /-
@[simp]
theorem keys_singleton (a : α) (b : β a) : (singleton a b).keys = [a] :=
  rfl
#align alist.keys_singleton AList.keys_singleton
-/

/-! ### lookup -/

section

variable [DecidableEq α]

#print AList.lookup /-
/-- Look up the value associated to a key in an association list. -/
def lookup (a : α) (s : AList β) : Option (β a) :=
  s.entries.dlookup a
#align alist.lookup AList.lookup
-/

#print AList.lookup_empty /-
@[simp]
theorem lookup_empty (a) : lookup a (∅ : AList β) = none :=
  rfl
#align alist.lookup_empty AList.lookup_empty
-/

#print AList.lookup_isSome /-
theorem lookup_isSome {a : α} {s : AList β} : (s.dlookup a).isSome ↔ a ∈ s :=
  dlookup_isSome
#align alist.lookup_is_some AList.lookup_isSome
-/

#print AList.lookup_eq_none /-
theorem lookup_eq_none {a : α} {s : AList β} : lookup a s = none ↔ a ∉ s :=
  dlookup_eq_none
#align alist.lookup_eq_none AList.lookup_eq_none
-/

#print AList.mem_lookup_iff /-
theorem mem_lookup_iff {a : α} {b : β a} {s : AList β} :
    b ∈ lookup a s ↔ Sigma.mk a b ∈ s.entries :=
  mem_dlookup_iff s.NodupKeys
#align alist.mem_lookup_iff AList.mem_lookup_iff
-/

#print AList.perm_lookup /-
theorem perm_lookup {a : α} {s₁ s₂ : AList β} (p : s₁.entries ~ s₂.entries) :
    s₁.dlookup a = s₂.dlookup a :=
  perm_dlookup _ s₁.NodupKeys s₂.NodupKeys p
#align alist.perm_lookup AList.perm_lookup
-/

instance (a : α) (s : AList β) : Decidable (a ∈ s) :=
  decidable_of_iff _ lookup_isSome

/-! ### replace -/

#print AList.replace /-
/-- Replace a key with a given value in an association list.
  If the key is not present it does nothing. -/
def replace (a : α) (b : β a) (s : AList β) : AList β :=
  ⟨kreplace a b s.entries, (kreplace_nodupKeys a b).2 s.NodupKeys⟩
#align alist.replace AList.replace
-/

#print AList.keys_replace /-
@[simp]
theorem keys_replace (a : α) (b : β a) (s : AList β) : (replace a b s).keys = s.keys :=
  keys_kreplace _ _ _
#align alist.keys_replace AList.keys_replace
-/

#print AList.mem_replace /-
@[simp]
theorem mem_replace {a a' : α} {b : β a} {s : AList β} : a' ∈ replace a b s ↔ a' ∈ s := by
  rw [mem_keys, keys_replace, ← mem_keys]
#align alist.mem_replace AList.mem_replace
-/

#print AList.perm_replace /-
theorem perm_replace {a : α} {b : β a} {s₁ s₂ : AList β} :
    s₁.entries ~ s₂.entries → (replace a b s₁).entries ~ (replace a b s₂).entries :=
  Perm.kreplace s₁.NodupKeys
#align alist.perm_replace AList.perm_replace
-/

end

#print AList.foldl /-
/-- Fold a function over the key-value pairs in the map. -/
def foldl {δ : Type w} (f : δ → ∀ a, β a → δ) (d : δ) (m : AList β) : δ :=
  m.entries.foldl (fun r a => f r a.1 a.2) d
#align alist.foldl AList.foldl
-/

/-! ### erase -/

section

variable [DecidableEq α]

#print AList.erase /-
/-- Erase a key from the map. If the key is not present, do nothing. -/
def erase (a : α) (s : AList β) : AList β :=
  ⟨s.entries.kerase a, s.NodupKeys.kerase a⟩
#align alist.erase AList.erase
-/

/- warning: alist.keys_erase -> AList.keys_erase is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] (a : α) (s : AList.{u1, u2} α β), Eq.{succ u1} (List.{u1} α) (AList.keys.{u1, u2} α β (AList.erase.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) a s)) (List.eraseₓ.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (AList.keys.{u1, u2} α β s) a)
but is expected to have type
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] (a : α) (s : AList.{u1, u2} α β), Eq.{succ u1} (List.{u1} α) (AList.keys.{u1, u2} α β (AList.erase.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) a s)) (List.erase.{u1} α (instBEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) (AList.keys.{u1, u2} α β s) a)
Case conversion may be inaccurate. Consider using '#align alist.keys_erase AList.keys_eraseₓ'. -/
@[simp]
theorem keys_erase (a : α) (s : AList β) : (erase a s).keys = s.keys.eraseₓ a :=
  keys_kerase
#align alist.keys_erase AList.keys_erase

#print AList.mem_erase /-
@[simp]
theorem mem_erase {a a' : α} {s : AList β} : a' ∈ erase a s ↔ a' ≠ a ∧ a' ∈ s := by
  rw [mem_keys, keys_erase, s.keys_nodup.mem_erase_iff, ← mem_keys]
#align alist.mem_erase AList.mem_erase
-/

#print AList.perm_erase /-
theorem perm_erase {a : α} {s₁ s₂ : AList β} :
    s₁.entries ~ s₂.entries → (erase a s₁).entries ~ (erase a s₂).entries :=
  Perm.kerase s₁.NodupKeys
#align alist.perm_erase AList.perm_erase
-/

#print AList.lookup_erase /-
@[simp]
theorem lookup_erase (a) (s : AList β) : lookup a (erase a s) = none :=
  dlookup_kerase a s.NodupKeys
#align alist.lookup_erase AList.lookup_erase
-/

#print AList.lookup_erase_ne /-
@[simp]
theorem lookup_erase_ne {a a'} {s : AList β} (h : a ≠ a') : lookup a (erase a' s) = lookup a s :=
  dlookup_kerase_ne h
#align alist.lookup_erase_ne AList.lookup_erase_ne
-/

#print AList.erase_erase /-
theorem erase_erase (a a' : α) (s : AList β) : (s.eraseₓ a).eraseₓ a' = (s.eraseₓ a').eraseₓ a :=
  ext <| kerase_kerase
#align alist.erase_erase AList.erase_erase
-/

/-! ### insert -/

#print AList.insert /-
/-- Insert a key-value pair into an association list and erase any existing pair
  with the same key. -/
def insert (a : α) (b : β a) (s : AList β) : AList β :=
  ⟨kinsert a b s.entries, kinsert_nodupKeys a b s.NodupKeys⟩
#align alist.insert AList.insert
-/

#print AList.insert_entries /-
@[simp]
theorem insert_entries {a} {b : β a} {s : AList β} :
    (insert a b s).entries = Sigma.mk a b :: kerase a s.entries :=
  rfl
#align alist.insert_entries AList.insert_entries
-/

#print AList.insert_entries_of_neg /-
theorem insert_entries_of_neg {a} {b : β a} {s : AList β} (h : a ∉ s) :
    (insert a b s).entries = ⟨a, b⟩ :: s.entries := by rw [insert_entries, kerase_of_not_mem_keys h]
#align alist.insert_entries_of_neg AList.insert_entries_of_neg
-/

#print AList.insert_of_neg /-
-- Todo: rename to `insert_of_not_mem`.
theorem insert_of_neg {a} {b : β a} {s : AList β} (h : a ∉ s) :
    insert a b s = ⟨⟨a, b⟩ :: s.entries, nodupKeys_cons.2 ⟨h, s.2⟩⟩ :=
  ext <| insert_entries_of_neg h
#align alist.insert_of_neg AList.insert_of_neg
-/

#print AList.insert_empty /-
@[simp]
theorem insert_empty (a) (b : β a) : insert a b ∅ = singleton a b :=
  rfl
#align alist.insert_empty AList.insert_empty
-/

#print AList.mem_insert /-
@[simp]
theorem mem_insert {a a'} {b' : β a'} (s : AList β) : a ∈ insert a' b' s ↔ a = a' ∨ a ∈ s :=
  mem_keys_kinsert
#align alist.mem_insert AList.mem_insert
-/

/- warning: alist.keys_insert -> AList.keys_insert is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {a : α} {b : β a} (s : AList.{u1, u2} α β), Eq.{succ u1} (List.{u1} α) (AList.keys.{u1, u2} α (fun {a : α} => β a) (AList.insert.{u1, u2} α (fun {a : α} => β a) (fun (a : α) (b : α) => _inst_1 a b) a b s)) (List.cons.{u1} α a (List.eraseₓ.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (AList.keys.{u1, u2} α β s) a))
but is expected to have type
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {a : α} {b : β a} (s : AList.{u1, u2} α β), Eq.{succ u1} (List.{u1} α) (AList.keys.{u1, u2} α β (AList.insert.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) a b s)) (List.cons.{u1} α a (List.erase.{u1} α (instBEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) (AList.keys.{u1, u2} α β s) a))
Case conversion may be inaccurate. Consider using '#align alist.keys_insert AList.keys_insertₓ'. -/
@[simp]
theorem keys_insert {a} {b : β a} (s : AList β) : (insert a b s).keys = a :: s.keys.eraseₓ a := by
  simp [insert, keys, keys_kerase]
#align alist.keys_insert AList.keys_insert

#print AList.perm_insert /-
theorem perm_insert {a} {b : β a} {s₁ s₂ : AList β} (p : s₁.entries ~ s₂.entries) :
    (insert a b s₁).entries ~ (insert a b s₂).entries := by
  simp only [insert_entries] <;> exact p.kinsert s₁.nodupkeys
#align alist.perm_insert AList.perm_insert
-/

#print AList.lookup_insert /-
@[simp]
theorem lookup_insert {a} {b : β a} (s : AList β) : lookup a (insert a b s) = some b := by
  simp only [lookup, insert, lookup_kinsert]
#align alist.lookup_insert AList.lookup_insert
-/

#print AList.lookup_insert_ne /-
@[simp]
theorem lookup_insert_ne {a a'} {b' : β a'} {s : AList β} (h : a ≠ a') :
    lookup a (insert a' b' s) = lookup a s :=
  dlookup_kinsert_ne h
#align alist.lookup_insert_ne AList.lookup_insert_ne
-/

#print AList.lookup_to_alist /-
@[simp]
theorem lookup_to_alist {a} (s : List (Sigma β)) : lookup a s.toAList = s.dlookup a := by
  rw [List.toAList, lookup, lookup_dedupkeys]
#align alist.lookup_to_alist AList.lookup_to_alist
-/

#print AList.insert_insert /-
@[simp]
theorem insert_insert {a} {b b' : β a} (s : AList β) : (s.insert a b).insert a b' = s.insert a b' :=
  by
  ext : 1 <;> simp only [AList.insert_entries, List.kerase_cons_eq] <;> constructorm*_ ∧ _ <;> rfl
#align alist.insert_insert AList.insert_insert
-/

#print AList.insert_insert_of_ne /-
theorem insert_insert_of_ne {a a'} {b : β a} {b' : β a'} (s : AList β) (h : a ≠ a') :
    ((s.insert a b).insert a' b').entries ~ ((s.insert a' b').insert a b).entries := by
  simp only [insert_entries] <;> rw [kerase_cons_ne, kerase_cons_ne, kerase_comm] <;>
    [apply perm.swap, exact h, exact h.symm]
#align alist.insert_insert_of_ne AList.insert_insert_of_ne
-/

#print AList.insert_singleton_eq /-
@[simp]
theorem insert_singleton_eq {a : α} {b b' : β a} : insert a b (singleton a b') = singleton a b :=
  ext <| by
    simp only [AList.insert_entries, List.kerase_cons_eq, and_self_iff, AList.singleton_entries,
      heq_iff_eq, eq_self_iff_true]
#align alist.insert_singleton_eq AList.insert_singleton_eq
-/

#print AList.entries_toAList /-
@[simp]
theorem entries_toAList (xs : List (Sigma β)) : (List.toAList xs).entries = dedupKeys xs :=
  rfl
#align alist.entries_to_alist AList.entries_toAList
-/

#print AList.toAList_cons /-
theorem toAList_cons (a : α) (b : β a) (xs : List (Sigma β)) :
    List.toAList (⟨a, b⟩ :: xs) = insert a b xs.toAList :=
  rfl
#align alist.to_alist_cons AList.toAList_cons
-/

#print AList.mk_cons_eq_insert /-
theorem mk_cons_eq_insert (c : Sigma β) (l : List (Sigma β)) (h : (c :: l).NodupKeys) :
    (⟨c :: l, h⟩ : AList β) = insert c.1 c.2 ⟨l, nodupKeys_of_nodupKeys_cons h⟩ := by
  simpa [insert] using (kerase_of_not_mem_keys <| not_mem_keys_of_nodupkeys_cons h).symm
#align alist.mk_cons_eq_insert AList.mk_cons_eq_insert
-/

#print AList.insertRec /-
/-- Recursion on an `alist`, using `insert`. Use as `induction l using alist.insert_rec`. -/
@[elab_as_elim]
def insertRec {C : AList β → Sort _} (H0 : C ∅)
    (IH : ∀ (a : α) (b : β a) (l : AList β) (h : a ∉ l), C l → C (l.insert a b)) :
    ∀ l : AList β, C l
  | ⟨[], _⟩ => H0
  | ⟨c :: l, h⟩ => by
    rw [mk_cons_eq_insert]
    refine' IH _ _ _ _ (insert_rec _)
    exact not_mem_keys_of_nodupkeys_cons h
#align alist.insert_rec AList.insertRec
-/

-- Test that the `induction` tactic works on `insert_rec`.
example (l : AList β) : True := by induction l using AList.insertRec <;> trivial

/- warning: alist.insert_rec_empty -> AList.insertRec_empty is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {C : (AList.{u1, u2} α β) -> Sort.{u3}} (H0 : C (EmptyCollection.emptyCollection.{max u1 u2} (AList.{u1, u2} α β) (AList.hasEmptyc.{u1, u2} α β))) (IH : forall (a : α) (b : β a) (l : AList.{u1, u2} α β), (Not (Membership.Mem.{u1, max u1 u2} α (AList.{u1, u2} α β) (AList.hasMem.{u1, u2} α β) a l)) -> (C l) -> (C (AList.insert.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) a b l))), Eq.{u3} (C (EmptyCollection.emptyCollection.{max u1 u2} (AList.{u1, u2} α β) (AList.hasEmptyc.{u1, u2} α β))) (AList.insertRec.{u1, u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) C H0 IH (EmptyCollection.emptyCollection.{max u1 u2} (AList.{u1, u2} α β) (AList.hasEmptyc.{u1, u2} α β))) H0
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u3}} [_inst_1 : DecidableEq.{succ u2} α] {C : (AList.{u2, u3} α β) -> Sort.{u1}} (H0 : C (EmptyCollection.emptyCollection.{max u2 u3} (AList.{u2, u3} α β) (AList.instEmptyCollectionAList.{u2, u3} α β))) (IH : forall (a : α) (b : β a) (l : AList.{u2, u3} α β), (Not (Membership.mem.{u2, max u2 u3} α (AList.{u2, u3} α β) (AList.instMembershipAList.{u2, u3} α β) a l)) -> (C l) -> (C (AList.insert.{u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) a b l))), Eq.{u1} (C (EmptyCollection.emptyCollection.{max u2 u3} (AList.{u2, u3} α β) (AList.instEmptyCollectionAList.{u2, u3} α β))) (AList.insertRec.{u2, u3, u1} α β (fun (a : α) (b : α) => _inst_1 a b) C H0 IH (EmptyCollection.emptyCollection.{max u2 u3} (AList.{u2, u3} α β) (AList.instEmptyCollectionAList.{u2, u3} α β))) H0
Case conversion may be inaccurate. Consider using '#align alist.insert_rec_empty AList.insertRec_emptyₓ'. -/
@[simp]
theorem insertRec_empty {C : AList β → Sort _} (H0 : C ∅)
    (IH : ∀ (a : α) (b : β a) (l : AList β) (h : a ∉ l), C l → C (l.insert a b)) :
    @insertRec α β _ C H0 IH ∅ = H0 :=
  by
  change @insert_rec α β _ C H0 IH ⟨[], _⟩ = H0
  rw [insert_rec]
#align alist.insert_rec_empty AList.insertRec_empty

/- warning: alist.insert_rec_insert -> AList.insertRec_insert is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {C : (AList.{u1, u2} α β) -> Sort.{u3}} (H0 : C (EmptyCollection.emptyCollection.{max u1 u2} (AList.{u1, u2} α β) (AList.hasEmptyc.{u1, u2} α β))) (IH : forall (a : α) (b : β a) (l : AList.{u1, u2} α β), (Not (Membership.Mem.{u1, max u1 u2} α (AList.{u1, u2} α β) (AList.hasMem.{u1, u2} α β) a l)) -> (C l) -> (C (AList.insert.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) a b l))) {c : Sigma.{u1, u2} α β} {l : AList.{u1, u2} α β} (h : Not (Membership.Mem.{u1, max u1 u2} α (AList.{u1, u2} α β) (AList.hasMem.{u1, u2} α β) (Sigma.fst.{u1, u2} α β c) l)), Eq.{u3} (C (AList.insert.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) (Sigma.fst.{u1, u2} α β c) (Sigma.snd.{u1, u2} α β c) l)) (AList.insertRec.{u1, u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) C H0 IH (AList.insert.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) (Sigma.fst.{u1, u2} α β c) (Sigma.snd.{u1, u2} α β c) l)) (IH (Sigma.fst.{u1, u2} α β c) (Sigma.snd.{u1, u2} α β c) l h (AList.insertRec.{u1, u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) C H0 IH l))
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u3}} [_inst_1 : DecidableEq.{succ u2} α] {C : (AList.{u2, u3} α β) -> Sort.{u1}} (H0 : C (EmptyCollection.emptyCollection.{max u2 u3} (AList.{u2, u3} α β) (AList.instEmptyCollectionAList.{u2, u3} α β))) (IH : forall (a : α) (b : β a) (l : AList.{u2, u3} α β), (Not (Membership.mem.{u2, max u2 u3} α (AList.{u2, u3} α β) (AList.instMembershipAList.{u2, u3} α β) a l)) -> (C l) -> (C (AList.insert.{u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) a b l))) {c : Sigma.{u2, u3} α β} {l : AList.{u2, u3} α β} (h : Not (Membership.mem.{u2, max u2 u3} α (AList.{u2, u3} α β) (AList.instMembershipAList.{u2, u3} α β) (Sigma.fst.{u2, u3} α β c) l)), Eq.{u1} (C (AList.insert.{u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) (Sigma.fst.{u2, u3} α β c) (Sigma.snd.{u2, u3} α β c) l)) (AList.insertRec.{u2, u3, u1} α β (fun (a : α) (b : α) => _inst_1 a b) C H0 IH (AList.insert.{u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) (Sigma.fst.{u2, u3} α β c) (Sigma.snd.{u2, u3} α β c) l)) (IH (Sigma.fst.{u2, u3} α β c) (Sigma.snd.{u2, u3} α β c) l h (AList.insertRec.{u2, u3, u1} α β (fun (a : α) (b : α) => _inst_1 a b) C H0 IH l))
Case conversion may be inaccurate. Consider using '#align alist.insert_rec_insert AList.insertRec_insertₓ'. -/
theorem insertRec_insert {C : AList β → Sort _} (H0 : C ∅)
    (IH : ∀ (a : α) (b : β a) (l : AList β) (h : a ∉ l), C l → C (l.insert a b)) {c : Sigma β}
    {l : AList β} (h : c.1 ∉ l) :
    @insertRec α β _ C H0 IH (l.insert c.1 c.2) = IH c.1 c.2 l h (@insertRec α β _ C H0 IH l) :=
  by
  cases' l with l hl
  suffices
    HEq (@insert_rec α β _ C H0 IH ⟨c :: l, nodupkeys_cons.2 ⟨h, hl⟩⟩)
      (IH c.1 c.2 ⟨l, hl⟩ h (@insert_rec α β _ C H0 IH ⟨l, hl⟩))
    by
    cases c
    apply eq_of_hEq
    convert this <;> rw [insert_of_neg h]
  rw [insert_rec]
  apply cast_hEq
#align alist.insert_rec_insert AList.insertRec_insert

/- warning: alist.recursion_insert_mk -> AList.insertRec_insert_mk is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {C : (AList.{u1, u2} α β) -> Sort.{u3}} (H0 : C (EmptyCollection.emptyCollection.{max u1 u2} (AList.{u1, u2} α β) (AList.hasEmptyc.{u1, u2} α β))) (IH : forall (a : α) (b : β a) (l : AList.{u1, u2} α β), (Not (Membership.Mem.{u1, max u1 u2} α (AList.{u1, u2} α β) (AList.hasMem.{u1, u2} α β) a l)) -> (C l) -> (C (AList.insert.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) a b l))) {a : α} (b : β a) {l : AList.{u1, u2} α β} (h : Not (Membership.Mem.{u1, max u1 u2} α (AList.{u1, u2} α β) (AList.hasMem.{u1, u2} α β) a l)), Eq.{u3} (C (AList.insert.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) a b l)) (AList.insertRec.{u1, u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) C H0 IH (AList.insert.{u1, u2} α β (fun (a : α) (b : α) => _inst_1 a b) a b l)) (IH a b l h (AList.insertRec.{u1, u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) C H0 IH l))
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u3}} [_inst_1 : DecidableEq.{succ u2} α] {C : (AList.{u2, u3} α β) -> Sort.{u1}} (H0 : C (EmptyCollection.emptyCollection.{max u2 u3} (AList.{u2, u3} α β) (AList.instEmptyCollectionAList.{u2, u3} α β))) (IH : forall (a : α) (b : β a) (l : AList.{u2, u3} α β), (Not (Membership.mem.{u2, max u2 u3} α (AList.{u2, u3} α β) (AList.instMembershipAList.{u2, u3} α β) a l)) -> (C l) -> (C (AList.insert.{u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) a b l))) {a : α} (b : β a) {l : AList.{u2, u3} α β} (h : Not (Membership.mem.{u2, max u2 u3} α (AList.{u2, u3} α β) (AList.instMembershipAList.{u2, u3} α β) a l)), Eq.{u1} (C (AList.insert.{u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) a b l)) (AList.insertRec.{u2, u3, u1} α β (fun (a : α) (b : α) => _inst_1 a b) C H0 IH (AList.insert.{u2, u3} α β (fun (a : α) (b : α) => _inst_1 a b) a b l)) (IH a b l h (AList.insertRec.{u2, u3, u1} α β (fun (a : α) (b : α) => _inst_1 a b) C H0 IH l))
Case conversion may be inaccurate. Consider using '#align alist.recursion_insert_mk AList.insertRec_insert_mkₓ'. -/
theorem insertRec_insert_mk {C : AList β → Sort _} (H0 : C ∅)
    (IH : ∀ (a : α) (b : β a) (l : AList β) (h : a ∉ l), C l → C (l.insert a b)) {a : α} (b : β a)
    {l : AList β} (h : a ∉ l) :
    @insertRec α β _ C H0 IH (l.insert a b) = IH a b l h (@insertRec α β _ C H0 IH l) :=
  @insertRec_insert α β _ C H0 IH ⟨a, b⟩ l h
#align alist.recursion_insert_mk AList.insertRec_insert_mk

/-! ### extract -/

#print AList.extract /-
/-- Erase a key from the map, and return the corresponding value, if found. -/
def extract (a : α) (s : AList β) : Option (β a) × AList β :=
  have : (kextract a s.entries).2.NodupKeys := by
    rw [kextract_eq_lookup_kerase] <;> exact s.nodupkeys.kerase _
  match kextract a s.entries, this with
  | (b, l), h => (b, ⟨l, h⟩)
#align alist.extract AList.extract
-/

#print AList.extract_eq_lookup_erase /-
@[simp]
theorem extract_eq_lookup_erase (a : α) (s : AList β) : extract a s = (lookup a s, erase a s) := by
  simp [extract] <;> constructor <;> rfl
#align alist.extract_eq_lookup_erase AList.extract_eq_lookup_erase
-/

/-! ### union -/

#print AList.union /-
/-- `s₁ ∪ s₂` is the key-based union of two association lists. It is
left-biased: if there exists an `a ∈ s₁`, `lookup a (s₁ ∪ s₂) = lookup a s₁`.
-/
def union (s₁ s₂ : AList β) : AList β :=
  ⟨s₁.entries.kunion s₂.entries, s₁.NodupKeys.kunion s₂.NodupKeys⟩
#align alist.union AList.union
-/

instance : Union (AList β) :=
  ⟨union⟩

#print AList.union_entries /-
@[simp]
theorem union_entries {s₁ s₂ : AList β} : (s₁ ∪ s₂).entries = kunion s₁.entries s₂.entries :=
  rfl
#align alist.union_entries AList.union_entries
-/

#print AList.empty_union /-
@[simp]
theorem empty_union {s : AList β} : (∅ : AList β) ∪ s = s :=
  ext rfl
#align alist.empty_union AList.empty_union
-/

#print AList.union_empty /-
@[simp]
theorem union_empty {s : AList β} : s ∪ (∅ : AList β) = s :=
  ext <| by simp
#align alist.union_empty AList.union_empty
-/

#print AList.mem_union /-
@[simp]
theorem mem_union {a} {s₁ s₂ : AList β} : a ∈ s₁ ∪ s₂ ↔ a ∈ s₁ ∨ a ∈ s₂ :=
  mem_keys_kunion
#align alist.mem_union AList.mem_union
-/

#print AList.perm_union /-
theorem perm_union {s₁ s₂ s₃ s₄ : AList β} (p₁₂ : s₁.entries ~ s₂.entries)
    (p₃₄ : s₃.entries ~ s₄.entries) : (s₁ ∪ s₃).entries ~ (s₂ ∪ s₄).entries := by
  simp [p₁₂.kunion s₃.nodupkeys p₃₄]
#align alist.perm_union AList.perm_union
-/

#print AList.union_erase /-
theorem union_erase (a : α) (s₁ s₂ : AList β) : erase a (s₁ ∪ s₂) = erase a s₁ ∪ erase a s₂ :=
  ext kunion_kerase.symm
#align alist.union_erase AList.union_erase
-/

#print AList.lookup_union_left /-
@[simp]
theorem lookup_union_left {a} {s₁ s₂ : AList β} : a ∈ s₁ → lookup a (s₁ ∪ s₂) = lookup a s₁ :=
  dlookup_kunion_left
#align alist.lookup_union_left AList.lookup_union_left
-/

#print AList.lookup_union_right /-
@[simp]
theorem lookup_union_right {a} {s₁ s₂ : AList β} : a ∉ s₁ → lookup a (s₁ ∪ s₂) = lookup a s₂ :=
  dlookup_kunion_right
#align alist.lookup_union_right AList.lookup_union_right
-/

#print AList.mem_lookup_union /-
@[simp]
theorem mem_lookup_union {a} {b : β a} {s₁ s₂ : AList β} :
    b ∈ lookup a (s₁ ∪ s₂) ↔ b ∈ lookup a s₁ ∨ a ∉ s₁ ∧ b ∈ lookup a s₂ :=
  mem_dlookup_kunion
#align alist.mem_lookup_union AList.mem_lookup_union
-/

#print AList.mem_lookup_union_middle /-
theorem mem_lookup_union_middle {a} {b : β a} {s₁ s₂ s₃ : AList β} :
    b ∈ lookup a (s₁ ∪ s₃) → a ∉ s₂ → b ∈ lookup a (s₁ ∪ s₂ ∪ s₃) :=
  mem_dlookup_kunion_middle
#align alist.mem_lookup_union_middle AList.mem_lookup_union_middle
-/

#print AList.insert_union /-
theorem insert_union {a} {b : β a} {s₁ s₂ : AList β} : insert a b (s₁ ∪ s₂) = insert a b s₁ ∪ s₂ :=
  by ext <;> simp
#align alist.insert_union AList.insert_union
-/

#print AList.union_assoc /-
theorem union_assoc {s₁ s₂ s₃ : AList β} : (s₁ ∪ s₂ ∪ s₃).entries ~ (s₁ ∪ (s₂ ∪ s₃)).entries :=
  lookup_ext (AList.nodupKeys _) (AList.nodupKeys _)
    (by simp [Decidable.not_or_iff_and_not, or_assoc', and_or_left, and_assoc'])
#align alist.union_assoc AList.union_assoc
-/

end

/-! ### disjoint -/

#print AList.Disjoint /-
/-- Two associative lists are disjoint if they have no common keys. -/
def Disjoint (s₁ s₂ : AList β) : Prop :=
  ∀ k ∈ s₁.keys, ¬k ∈ s₂.keys
#align alist.disjoint AList.Disjoint
-/

variable [DecidableEq α]

#print AList.union_comm_of_disjoint /-
theorem union_comm_of_disjoint {s₁ s₂ : AList β} (h : Disjoint s₁ s₂) :
    (s₁ ∪ s₂).entries ~ (s₂ ∪ s₁).entries :=
  lookup_ext (AList.nodupKeys _) (AList.nodupKeys _)
    (by
      intros ; simp
      constructor <;> intro h'
      cases h'
      · right
        refine' ⟨_, h'⟩
        apply h
        rw [keys, ← List.dlookup_isSome, h']
        exact rfl
      · left
        rw [h'.2]
      cases h'
      · right
        refine' ⟨_, h'⟩
        intro h''
        apply h _ h''
        rw [keys, ← List.dlookup_isSome, h']
        exact rfl
      · left
        rw [h'.2])
#align alist.union_comm_of_disjoint AList.union_comm_of_disjoint
-/

end AList