import measure_theory.measure.measure_space
import probability_theory.independence

namespace ennreal

lemma inv_mul_eq_iff_eq_mul {x y z : ennreal} (hnz : z ≠ 0) (hnt : z ≠ ⊤) :
  x = z * y ↔ z ⁻¹ * x = y :=
by split; rintro rfl; simp [←mul_assoc, inv_mul_cancel, mul_inv_cancel, hnt, hnz]

lemma to_nnreal_ne_zero {a : ennreal} (hnz : a ≠ 0) (hnt : a ≠ ⊤) :
  a.to_nnreal ≠ 0 :=
begin
  intro haz,
  have : ↑(a.to_nnreal) = (0 : ennreal) := coe_eq_zero.mpr haz,
  rw coe_to_nnreal hnt at this,
  contradiction
end

lemma coe_to_nnreal_inv {a : ennreal} (hnz : a ≠ 0) (hnt : a ≠ ⊤) :
  ↑(a.to_nnreal)⁻¹ = a⁻¹ :=
begin
  convert coe_inv _,
    exact (coe_to_nnreal hnt).symm,
  exact to_nnreal_ne_zero hnz hnt
end

@[simp]
lemma ennreal.mul_inv {a b : ennreal} (ha : a ≠ 0) (hb : b ≠ 0) (hx : a ≠ ⊤) (hy : b ≠ ⊤) :
  (a * b)⁻¹ = a⁻¹ * b⁻¹ :=
begin
  rw [← coe_to_nnreal_inv (mul_ne_zero ha hb) (mul_ne_top hx hy),
    to_nnreal_mul, mul_inv₀, coe_mul,
    coe_to_nnreal_inv ha hx, coe_to_nnreal_inv hb hy],
end

end ennreal

noncomputable theory

open measure_theory measurable_space

namespace probability_theory

section

variables {α : Type*} [m : measurable_space α] (μ : measure α)

section definitions

include μ

/-- The conditional probability measure of measure `μ` on set `s` is `μ` restricted to `s`
and scaled by the inverse of `μ s` (to make it a probability measure). -/
def cond_measure (s : set α) : measure α :=
  (μ s)⁻¹ • μ.restrict s

end definitions

localized "notation  μ `[` s `|` t `]` := cond_measure μ t s" in probability_theory
localized "notation  μ `[|` t`]` := cond_measure μ t" in probability_theory

/-- The conditional probability measure of any finite measure on any conditionable set
is a probability measure. -/
instance cond_prob_meas [is_finite_measure μ] {s : set α} (hcs : μ s ≠ 0) :
  is_probability_measure (μ[|s]) :=
  ⟨by rw [cond_measure, measure.smul_apply, measure.restrict_apply measurable_set.univ,
    set.univ_inter, ennreal.inv_mul_cancel hcs (measure_ne_top _ s)]⟩

variable [is_probability_measure μ]

section bayes

@[simp] lemma cond_univ [is_probability_measure μ] : μ[|set.univ] = μ :=
by simp [cond_measure, measure_univ, measure.restrict_univ]

/-- The axiomatic definition of conditional probability derived from a measure-theoretic one. -/
@[simp] lemma cond_measure_def {a : set α} (hma : measurable_set a) (b : set α) :
  μ[b|a] = (μ a)⁻¹ * μ (a ∩ b) :=
by rw [cond_measure, measure.smul_apply, measure.restrict_apply' hma, set.inter_comm]

lemma cond_cond_meas_of_cond_meas_inter {s t : set α} (hms : measurable_set s)
  (hci : μ (s ∩ t) ≠ 0) : μ[|s] t ≠ 0 :=
begin
  rw cond_measure_def,
  refine mul_ne_zero _ _,
  exact ennreal.inv_ne_zero.mpr (measure_ne_top _ _),
  all_goals {assumption}
end

lemma cond_meas_inter_of_cond_cond_meas {s t : set α} (hms : measurable_set s)
  (hctcs : (μ[|s]) t ≠ 0) : μ (s ∩ t) ≠ 0 :=
begin
  refine (right_ne_zero_of_mul _),
  exact (μ s)⁻¹,
  convert hctcs,
  change μ (s ∩ t) = (μ.restrict s) t,
  rw [measure.restrict_apply' hms, set.inter_comm]
end

lemma meas_subset_ne {a b : set α} (hs : a ⊆ b) (hnz : μ a ≠ 0) : μ b ≠ 0 :=
  pos_iff_ne_zero.mp (gt_of_ge_of_gt (μ.mono hs) (pos_iff_ne_zero.mpr hnz))

/-- Conditioning first on `a` and then on `b` results in the same measure as conditioning
on `a ∩ b`. -/
@[simp] lemma cond_cond_eq_cond_inter {a : set α} {b : set α} (hma : measurable_set a) (hmb : measurable_set b) (hca : μ a ≠ 0)
  (hci : μ (a ∩ b) ≠ 0) :
  μ[|a][|b] = (μ[|(a ∩ b)]) :=
begin
  apply measure.ext,
  intros s hms,
  haveI := probability_theory.cond_prob_meas μ (meas_subset_ne μ (set.inter_subset_left _ _) hci),
  simp [*, measure_ne_top],
  conv { to_lhs, rw mul_assoc, congr, skip, rw mul_comm },
  simp_rw ← mul_assoc,
  rw [ennreal.mul_inv_cancel hca (measure_ne_top _ a), one_mul,
    ← set.inter_assoc, mul_comm]
end

@[simp] lemma cond_inter {a : set α} (hma : measurable_set a) (hca : μ a ≠ 0) (b : set α) :
  μ[b|a] * μ a = μ (a ∩ b) :=
by rw [cond_measure_def μ hma b, mul_comm, ←mul_assoc,
  ennreal.mul_inv_cancel hca (measure_ne_top _ a), one_mul]

/-- Bayes' Theorem. -/
theorem bayes (a : set α) (hma : measurable_set a)
  (b : set α) (hmb : measurable_set b) (hcb : μ b ≠ 0) :
  μ[b|a] = (μ a)⁻¹ * μ[a|b] * (μ b) :=
by rw [mul_assoc, cond_inter μ hmb hcb a, set.inter_comm, cond_measure_def _ hma]; apply_instance

section indep

/-- Two measurable sets are independent if and only if conditioning on one
is irrelevant to the probability of the other. -/
theorem indep_set_iff_cond_irrel {a : set α} (hma : measurable_set a)
  {b : set α} (hmb : measurable_set b) :
  indep_set a b μ ↔ μ a ≠ 0 → μ[b|a] = μ b :=
begin
  split; intro h,
    intro hca,
    rw [cond_measure_def _ hma, (indep_set_iff_measure_inter_eq_mul hma hmb μ).mp h,
      ← mul_assoc, ennreal.inv_mul_cancel hca (measure_ne_top _ _), one_mul], apply_instance,
  by_cases hca : μ a = 0,
  { rw indep_set_iff_measure_inter_eq_mul hma hmb μ,
    simp [measure_inter_null_of_null_left, hca] },
  { have hcond := h hca,
    refine (indep_set_iff_measure_inter_eq_mul hma hmb μ).mpr _,
    rwa [ ennreal.inv_mul_eq_iff_eq_mul hca (measure_ne_top _ _), set.inter_comm,
      ← measure.restrict_apply' hma] },
end

lemma symm_iff {α} {s₁ s₂ : set (set α)} [measurable_space α] {μ : measure α} :
  indep_sets s₁ s₂ μ ↔ indep_sets s₂ s₁ μ :=
⟨indep_sets.symm, indep_sets.symm⟩

theorem indep_set_iff_cond_irrel' (a : set α) (hma : measurable_set a) (b : set α) (hmb : measurable_set b) :
  indep_set b a μ ↔ μ a ≠ 0 → μ[b|a] = μ b :=
iff.trans symm_iff (indep_set_iff_cond_irrel _ hma hmb)

def cond_Indep_sets {α ι} [measurable_space α] (π : ι → set (set α))
  (C : set (set α)) (μ : measure α . volume_tac) : Prop :=
∀ (c ∈ C), Indep_sets π (μ[|c])

def cond_indep_sets {α} [measurable_space α] (s1 s2 : set (set α)) (C : set (set α))
  (μ : measure α . volume_tac) : Prop :=
∀ (c ∈ C), indep_sets s1 s2 (μ[|c])

def cond_Indep {α ι} (m : ι → measurable_space α) [measurable_space α] (C : set (set α))
  (μ : measure α . volume_tac) : Prop :=
cond_Indep_sets (λ x, (m x).measurable_set') C μ

lemma cond_Indep_def {α ι} (m : ι → measurable_space α) [measurable_space α]
  (C : set (set α)) (μ : measure α . volume_tac) :
  cond_Indep m C μ = ∀ c ∈ C, Indep m (μ[|c]) := rfl

def cond_indep {α} (m₁ m₂ : measurable_space α) [measurable_space α] (C : set (set α))
  (μ : measure α . volume_tac) : Prop :=
cond_indep_sets (m₁.measurable_set') (m₂.measurable_set') C μ

lemma cond_indep_def {α} (m₁ m₂ : measurable_space α) [measurable_space α] (C : set (set α))
  (μ : measure α . volume_tac) :
  cond_indep m₁ m₂ C μ = ∀ c ∈ C, indep m₁ m₂ (μ[|c]) := rfl

def cond_Indep_set {α ι} [measurable_space α] (s : ι → set α) (C : set (set α))
  (μ : measure α . volume_tac) : Prop :=
cond_Indep (λ i, generate_from {s i}) C μ

lemma cond_Indep_set_def {α ι} [measurable_space α] (s : ι → set α) (C : set (set α))
  (μ : measure α . volume_tac) : cond_Indep_set s C μ = ∀ c ∈ C, Indep_set s (μ[|c]) := rfl

def cond_indep_set {α} [measurable_space α] (s t : set α) (C : set (set α))
  (μ : measure α . volume_tac) : Prop :=
cond_indep (generate_from {s}) (generate_from {t}) C μ

def cond_indep_set' {α} [measurable_space α] (s t : set α) (c : set α)
  (μ : measure α . volume_tac) : Prop :=
cond_indep_set s t {c} μ

lemma cond_indep_set'.symm {α} {s t c : set α} [measurable_space α] {μ : measure α}
  (h : cond_indep_set' s t c μ) : cond_indep_set' t s c μ :=
by { intros c hc a b ha hb, rw [set.inter_comm, mul_comm], exact h c hc b a hb ha }

lemma cond_indep_set'.symm_iff {α} {s t c : set α} [measurable_space α] {μ : measure α} :
  cond_indep_set' s t c μ ↔ cond_indep_set' t s c μ :=
⟨cond_indep_set'.symm, cond_indep_set'.symm⟩

def cond_indep_set_def {α} [measurable_space α] (s t : set α) (C : set (set α))
  (μ : measure α . volume_tac) :
  cond_indep_set s t C μ = ∀ c ∈ C, indep_set s t (μ[|c]) := rfl

def cond_indep_set_def' {α} [measurable_space α] (s t : set α) (c : set α)
  (μ : measure α . volume_tac) :
  cond_indep_set' s t c μ = indep_set s t (μ[|c]) :=
by have : cond_indep_set' s t c μ = ∀ (x ∈ {x | x = c}), indep_set s t (μ[|x]) := rfl;
  simp [this]

def cond_Indep_fun {α ι} [measurable_space α] {β : ι → Type*}
  (m : Π (x : ι), measurable_space (β x))
  (f : Π (x : ι), α → β x) (C : set (set α)) (μ : measure α . volume_tac) : Prop :=
cond_Indep (λ x, measurable_space.comap (f x) (m x)) C μ

def cond_Indep_fun_def {α ι} [measurable_space α] {β : ι → Type*}
  (m : Π (x : ι), measurable_space (β x))
  (f : Π (x : ι), α → β x) (C : set (set α)) (μ : measure α . volume_tac) :
  cond_Indep_fun m f C μ = ∀ c ∈ C, Indep_fun m f (μ[|c]) := rfl

def cond_indep_fun {α β γ} [measurable_space α] [mβ : measurable_space β]
  [mγ : measurable_space γ]
  (f : α → β) (g : α → γ) (C : set (set α)) (μ : measure α . volume_tac) : Prop :=
cond_indep (measurable_space.comap f mβ) (measurable_space.comap g mγ) C μ

def cond_indep_fun_def {α ι} [measurable_space α] {β : ι → Type*}
  (m : Π (x : ι), measurable_space (β x))
  (f : Π (x : ι), α → β x) (C : set (set α)) (μ : measure α . volume_tac) :
  cond_Indep_fun m f C μ = ∀ c ∈ C, Indep_fun m f (μ[|c]) := rfl

theorem cond_meas_inter (a : set α) {b : set α} (hmb : measurable_set b) :
  μ (b ∩ a) ≠ 0 ↔ (μ[|b] a ≠ 0) :=
begin
  split; intro hc,
    simp [*, measure_ne_top],
  simp [*, not_or_distrib] at hc,
  exact hc.2
end

lemma indep_set_of_cond_null_measure (a b c : set α) (hmc : measurable_set c) (h : μ c = 0) : indep_set a b (μ [| c]) :=
by rw [indep_set, indep, indep_sets]; intros; simp [hmc, h, measure_inter_null_of_null_left]

lemma indep_sets_of_cond_null_measure (a b : set (set α)) (c : set α) (hmc : measurable_set c) (h : μ c = 0) : indep_sets a b (μ [| c]) :=
by intros _ _ _ _; simp [hmc, h, measure_inter_null_of_null_left]

lemma cond_indep_sets_univ_iff_indep_sets (s1 s2 : set (set α)) :
  cond_indep_sets s1 s2 {set.univ} μ ↔ indep_sets s1 s2 μ :=
by simp [cond_indep_sets]

lemma cond_indep_univ_iff_indep_set (m₁ m₂ : measurable_space α) :
  @cond_indep _ m₁ m₂ m {set.univ} μ ↔ @indep _ m₁ m₂ m μ :=
by apply cond_indep_sets_univ_iff_indep_sets

theorem cond_indep_set_iff_cond_inter_irrel {a : set α} (hma : measurable_set a)
  {b : set α} (hmb : measurable_set b) {c : set α} (hmc : measurable_set c) :
  cond_indep_set' a b c μ ↔ μ (c ∩ a) ≠ 0 → μ[b|c ∩ a] = μ[b|c] :=
begin
  by_cases h : μ c = 0,
  { rw [cond_indep_set_def'],
    refine iff_of_true (indep_set_of_cond_null_measure _ _ _ _ hmc h) _,
    { refine not.elim _,
      intro,
      have := measure_inter_null_of_null_left a h,
      contradiction } },
  { have : μ (c ∩ a) ≠ 0 → (μ[b|c ∩ a] = μ[b|c] ↔ (μ[|c][|a]) b = μ[b|c]),
    { intro h, haveI := h,
      rw ← cond_cond_eq_cond_inter μ hmc hma _ h,
      exact (meas_subset_ne _ (set.inter_subset_left _ _) h) },
    haveI := probability_theory.cond_prob_meas μ h,
    rw [cond_indep_set_def', forall_congr this, cond_meas_inter, indep_set_iff_cond_irrel];
    assumption }
end

theorem cond_indep_set_iff_cond_inter_irrel' {a : set α} (hma : measurable_set a)
  {b : set α} (hmb : measurable_set b) {c : set α} (hmc : measurable_set c)
  : cond_indep_set' b a c μ ↔ μ (c ∩ a) ≠ 0 → μ[b|c ∩ a] = μ[b|c] :=
iff.trans cond_indep_set'.symm_iff (cond_indep_set_iff_cond_inter_irrel _ hma hmb hmc)

end indep

end bayes

end

end probability_theory


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

! This file was ported from Lean 3 source module ring_theory.fintype
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Units

/-!
# Some facts about finite rings

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

open Classical

/- warning: card_units_lt -> card_units_lt is a dubious translation:
lean 3 declaration is
  forall (M₀ : Type.{u1}) [_inst_1 : MonoidWithZero.{u1} M₀] [_inst_2 : Nontrivial.{u1} M₀] [_inst_3 : Fintype.{u1} M₀], LT.lt.{0} Nat Nat.hasLt (Fintype.card.{u1} (Units.{u1} M₀ (MonoidWithZero.toMonoid.{u1} M₀ _inst_1)) (Units.fintype.{u1} M₀ (MonoidWithZero.toMonoid.{u1} M₀ _inst_1) _inst_3 (fun (a : M₀) (b : M₀) => Classical.propDecidable (Eq.{succ u1} M₀ a b)))) (Fintype.card.{u1} M₀ _inst_3)
but is expected to have type
  forall (M₀ : Type.{u1}) [_inst_1 : MonoidWithZero.{u1} M₀] [_inst_2 : Nontrivial.{u1} M₀] [_inst_3 : Fintype.{u1} M₀], LT.lt.{0} Nat instLTNat (Fintype.card.{u1} (Units.{u1} M₀ (MonoidWithZero.toMonoid.{u1} M₀ _inst_1)) (instFintypeUnits.{u1} M₀ (MonoidWithZero.toMonoid.{u1} M₀ _inst_1) _inst_3 (fun (a : M₀) (b : M₀) => Classical.propDecidable (Eq.{succ u1} M₀ a b)))) (Fintype.card.{u1} M₀ _inst_3)
Case conversion may be inaccurate. Consider using '#align card_units_lt card_units_ltₓ'. -/
theorem card_units_lt (M₀ : Type _) [MonoidWithZero M₀] [Nontrivial M₀] [Fintype M₀] :
    Fintype.card M₀ˣ < Fintype.card M₀ :=
  Fintype.card_lt_of_injective_of_not_mem (coe : M₀ˣ → M₀) Units.ext not_isUnit_zero
#align card_units_lt card_units_lt


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

! This file was ported from Lean 3 source module computability.language
! leanprover-community/mathlib commit a239cd3e7ac2c7cde36c913808f9d40c411344f6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Ring
import Mathlib.Algebra.Order.Kleene
import Mathlib.Data.List.Join
import Mathlib.Data.Set.Lattice

/-!
# Languages

This file contains the definition and operations on formal languages over an alphabet. Note strings
are implemented as lists over the alphabet.
The operations in this file define a [Kleene algebra](https://en.wikipedia.org/wiki/Kleene_algebra)
over the languages.
-/

open List Set Computability

universe v

variable {α β γ : Type _}

/-- A language is a set of strings over an alphabet. -/
def Language (α) :=
  Set (List α)
#align language Language

instance : Membership (List α) (Language α) := ⟨Set.Mem⟩
instance : Singleton (List α) (Language α) := ⟨Set.singleton⟩
instance : Insert (List α) (Language α) := ⟨Set.insert⟩
instance : CompleteBooleanAlgebra (Language α) := Set.instCompleteBooleanAlgebraSet

namespace Language

variable {l m : Language α} {a b x : List α}

-- Porting note: `reducible` attribute cannot be local.
-- attribute [local reducible] Language

/-- Zero language has no elements. -/
instance : Zero (Language α) :=
  ⟨fun _ => False⟩

/-- `1 : Language α` contains only one element `[]`. -/
instance : One (Language α) :=
  ⟨fun l => l = []⟩

instance : Inhabited (Language α) :=
  ⟨fun _ => False⟩

/-- The sum of two languages is their union. -/
instance : Add (Language α) :=
  ⟨((· ∪ ·) : Set (List α) → Set (List α) → Set (List α))⟩

/-- The product of two languages `l` and `m` is the language made of the strings `x ++ y` where
`x ∈ l` and `y ∈ m`. -/
instance : Mul (Language α) :=
  ⟨image2 (· ++ ·)⟩

theorem zero_def : (0 : Language α) = (∅ : Set _) :=
  rfl
#align language.zero_def Language.zero_def

theorem one_def : (1 : Language α) = ({[]} : Set (List α)) :=
  rfl
#align language.one_def Language.one_def

theorem add_def (l m : Language α) : l + m = (l ∪ m : Set (List α)) :=
  rfl
#align language.add_def Language.add_def

theorem mul_def (l m : Language α) : l * m = image2 (· ++ ·) l m :=
  rfl
#align language.mul_def Language.mul_def

/-- The Kleene star of a language `L` is the set of all strings which can be written by
concatenating strings from `L`. -/
instance : KStar (Language α) := ⟨fun l ↦ {x | ∃ L : List (List α), x = L.join ∧ ∀ y ∈ L, y ∈ l}⟩

lemma kstar_def (l : Language α) : l∗ = {x | ∃ L : List (List α), x = L.join ∧ ∀ y ∈ L, y ∈ l} :=
  rfl
#align language.kstar_def Language.kstar_def

-- Porting note: `reducible` attribute cannot be local,
--               so this new theorem is required in place of `Set.ext`.
@[ext]
theorem ext {l m : Language α} (h : ∀ (x : List α), x ∈ l ↔ x ∈ m) : l = m :=
  Set.ext h

@[simp]
theorem not_mem_zero (x : List α) : x ∉ (0 : Language α) :=
  id
#align language.not_mem_zero Language.not_mem_zero

@[simp]
theorem mem_one (x : List α) : x ∈ (1 : Language α) ↔ x = [] := by rfl
#align language.mem_one Language.mem_one

theorem nil_mem_one : [] ∈ (1 : Language α) :=
  Set.mem_singleton _
#align language.nil_mem_one Language.nil_mem_one

theorem mem_add (l m : Language α) (x : List α) : x ∈ l + m ↔ x ∈ l ∨ x ∈ m :=
  Iff.rfl
#align language.mem_add Language.mem_add

theorem mem_mul : x ∈ l * m ↔ ∃ a b, a ∈ l ∧ b ∈ m ∧ a ++ b = x :=
  mem_image2
#align language.mem_mul Language.mem_mul

theorem append_mem_mul : a ∈ l → b ∈ m → a ++ b ∈ l * m :=
  mem_image2_of_mem
#align language.append_mem_mul Language.append_mem_mul

theorem mem_kstar : x ∈ l∗ ↔ ∃ L : List (List α), x = L.join ∧ ∀ y ∈ L, y ∈ l :=
  Iff.rfl
#align language.mem_kstar Language.mem_kstar

theorem join_mem_kstar {L : List (List α)} (h : ∀ y ∈ L, y ∈ l) : L.join ∈ l∗ :=
  ⟨L, rfl, h⟩
#align language.join_mem_kstar Language.join_mem_kstar

theorem nil_mem_kstar (l : Language α) : [] ∈ l∗ :=
  ⟨[], rfl, fun _ h ↦ by contradiction⟩
#align language.nil_mem_kstar Language.nil_mem_kstar

instance : Semiring (Language α) where
  add := (· + ·)
  add_assoc := union_assoc
  zero := 0
  zero_add := empty_union
  add_zero := union_empty
  add_comm := union_comm
  mul := (· * ·)
  mul_assoc _ _ _ := image2_assoc append_assoc
  zero_mul _ := image2_empty_left
  mul_zero _ := image2_empty_right
  one := 1
  one_mul l := by simp [mul_def, one_def]
  mul_one l := by simp [mul_def, one_def]
  natCast n := if n = 0 then 0 else 1
  natCast_zero := rfl
  natCast_succ n := by cases n <;> simp [Nat.cast, add_def, zero_def]
  left_distrib _ _ _ := image2_union_right
  right_distrib _ _ _ := image2_union_left

@[simp]
theorem add_self (l : Language α) : l + l = l :=
  sup_idem
#align language.add_self Language.add_self

/-- Maps the alphabet of a language. -/
def map (f : α → β) : Language α →+* Language β where
  toFun := image (List.map f)
  map_zero' := image_empty _
  map_one' := image_singleton
  map_add' := image_union _
  map_mul' _ _ := image_image2_distrib <| map_append _
#align language.map Language.map

@[simp]
theorem map_id (l : Language α) : map id l = l := by simp [map]
#align language.map_id Language.map_id

@[simp]
theorem map_map (g : β → γ) (f : α → β) (l : Language α) : map g (map f l) = map (g ∘ f) l := by
  simp [map, image_image]
#align language.map_map Language.map_map

theorem kstar_def_nonempty (l : Language α) :
    l∗ = { x | ∃ S : List (List α), x = S.join ∧ ∀ y ∈ S, y ∈ l ∧ y ≠ [] } := by
  ext x
  constructor
  · rintro ⟨S, rfl, h⟩
    refine' ⟨S.filter fun l ↦ ¬List.isEmpty l, by simp, fun y hy ↦ _⟩
    simp [mem_filter, List.isEmpty_iff_eq_nil] at hy
    -- Porting note: The previous code was:
    -- exact ⟨h y hy.1, hy.2⟩
    --
    -- The goal `y ≠ []` for the second argument cannot be resolved
    -- by `hy.2 : isEmpty y = false`.
    let ⟨hyl, hyr⟩ := hy
    apply And.intro (h y hyl)
    cases y <;> simp only [ne_eq, not_true, not_false_iff]
    contradiction
  · rintro ⟨S, hx, h⟩
    exact ⟨S, hx, fun y hy ↦ (h y hy).1⟩
#align language.kstar_def_nonempty Language.kstar_def_nonempty

theorem le_iff (l m : Language α) : l ≤ m ↔ l + m = m :=
  sup_eq_right.symm
#align language.le_iff Language.le_iff

theorem le_mul_congr {l₁ l₂ m₁ m₂ : Language α} : l₁ ≤ m₁ → l₂ ≤ m₂ → l₁ * l₂ ≤ m₁ * m₂ := by
  intro h₁ h₂ x hx
  simp only [mul_def, exists_and_left, mem_image2, image_prod] at hx⊢
  tauto
#align language.le_mul_congr Language.le_mul_congr

theorem le_add_congr {l₁ l₂ m₁ m₂ : Language α} : l₁ ≤ m₁ → l₂ ≤ m₂ → l₁ + l₂ ≤ m₁ + m₂ :=
  sup_le_sup
#align language.le_add_congr Language.le_add_congr

theorem mem_supᵢ {ι : Sort v} {l : ι → Language α} {x : List α} : (x ∈ ⨆ i, l i) ↔ ∃ i, x ∈ l i :=
  mem_unionᵢ
#align language.mem_supr Language.mem_supᵢ

theorem supᵢ_mul {ι : Sort v} (l : ι → Language α) (m : Language α) :
    (⨆ i, l i) * m = ⨆ i, l i * m :=
  image2_unionᵢ_left _ _ _
#align language.supr_mul Language.supᵢ_mul

theorem mul_supᵢ {ι : Sort v} (l : ι → Language α) (m : Language α) :
    (m * ⨆ i, l i) = ⨆ i, m * l i :=
  image2_unionᵢ_right _ _ _
#align language.mul_supr Language.mul_supᵢ

theorem supᵢ_add {ι : Sort v} [Nonempty ι] (l : ι → Language α) (m : Language α) :
    (⨆ i, l i) + m = ⨆ i, l i + m :=
  supᵢ_sup
#align language.supr_add Language.supᵢ_add

theorem add_supᵢ {ι : Sort v} [Nonempty ι] (l : ι → Language α) (m : Language α) :
    (m + ⨆ i, l i) = ⨆ i, m + l i :=
  sup_supᵢ
#align language.add_supr Language.add_supᵢ

theorem mem_pow {l : Language α} {x : List α} {n : ℕ} :
    x ∈ l ^ n ↔ ∃ S : List (List α), x = S.join ∧ S.length = n ∧ ∀ y ∈ S, y ∈ l := by
  induction' n with n ihn generalizing x
  · simp only [mem_one, pow_zero, length_eq_zero]
    constructor
    · rintro rfl
      exact ⟨[], rfl, rfl, fun _ h ↦ by contradiction⟩
    · -- Porting note: The previous code was:
      -- rintro ⟨_, rfl, rfl, _⟩
      -- rfl
      --
      -- The code reports an error for the second `rfl`.
      rintro ⟨_, rfl, h₀, _⟩
      simp; intros _ h₁
      rw [length_eq_zero] at h₀
      rw [h₀] at h₁
      contradiction
  · simp only [pow_succ, mem_mul, ihn]
    constructor
    · rintro ⟨a, b, ha, ⟨S, rfl, rfl, hS⟩, rfl⟩
      exact ⟨a :: S, rfl, rfl, forall_mem_cons.2 ⟨ha, hS⟩⟩
    · rintro ⟨_ | ⟨a, S⟩, rfl, hn, hS⟩ <;> cases hn
      rw [forall_mem_cons] at hS
      exact ⟨a, _, hS.1, ⟨S, rfl, rfl, hS.2⟩, rfl⟩
#align language.mem_pow Language.mem_pow

theorem kstar_eq_supᵢ_pow (l : Language α) : l∗ = ⨆ i : ℕ, l ^ i := by
  ext x
  simp only [mem_kstar, mem_supᵢ, mem_pow]
  constructor
  · rintro ⟨S, rfl, hS⟩
    exact ⟨_, S, rfl, rfl, hS⟩
  · rintro ⟨_, S, rfl, rfl, hS⟩
    exact ⟨S, rfl, hS⟩
#align language.kstar_eq_supr_pow Language.kstar_eq_supᵢ_pow

@[simp]
theorem map_kstar (f : α → β) (l : Language α) : map f l∗ = (map f l)∗ := by
  rw [kstar_eq_supᵢ_pow, kstar_eq_supᵢ_pow]
  simp_rw [← map_pow]
  exact image_unionᵢ
#align language.map_kstar Language.map_kstar

theorem mul_self_kstar_comm (l : Language α) : l∗ * l = l * l∗ := by
  simp only [kstar_eq_supᵢ_pow, mul_supᵢ, supᵢ_mul, ← pow_succ, ← pow_succ']
#align language.mul_self_kstar_comm Language.mul_self_kstar_comm

@[simp]
theorem one_add_self_mul_kstar_eq_kstar (l : Language α) : 1 + l * l∗ = l∗ := by
  simp only [kstar_eq_supᵢ_pow, mul_supᵢ, ← pow_succ, ← pow_zero l]
  exact sup_supᵢ_nat_succ _
#align language.one_add_self_mul_kstar_eq_kstar Language.one_add_self_mul_kstar_eq_kstar

@[simp]
theorem one_add_kstar_mul_self_eq_kstar (l : Language α) : 1 + l∗ * l = l∗ := by
  rw [mul_self_kstar_comm, one_add_self_mul_kstar_eq_kstar]
#align language.one_add_kstar_mul_self_eq_kstar Language.one_add_kstar_mul_self_eq_kstar

-- Porting note: `noncomputable` required.
noncomputable instance : KleeneAlgebra (Language α) :=
  { Language.instSemiringLanguage, Set.instCompleteBooleanAlgebraSet,
      Language.instKStarLanguage with
    one_le_kstar := fun a l hl ↦ ⟨[], hl, by simp⟩,
    mul_kstar_le_kstar := fun a ↦ (one_add_self_mul_kstar_eq_kstar a).le.trans' le_sup_right,
    kstar_mul_le_kstar := fun a ↦ (one_add_kstar_mul_self_eq_kstar a).le.trans' le_sup_right,
    kstar_mul_le_self := fun l m h ↦ by
      rw [kstar_eq_supᵢ_pow, supᵢ_mul]
      refine' supᵢ_le (fun n ↦ _)
      induction' n with n ih
      · simp
      rw [pow_succ', mul_assoc (l^n) l m]
      exact le_trans (le_mul_congr le_rfl h) ih,
    mul_kstar_le_self := fun l m h ↦ by
      rw [kstar_eq_supᵢ_pow, mul_supᵢ]
      refine' supᵢ_le (fun n ↦ _)
      induction' n with n ih
      · simp
      rw [pow_succ, ←mul_assoc m l (l^n)]
      exact le_trans (le_mul_congr h le_rfl) ih }

end Language