import algebra.group.basic algebra.group.defs
import data.finset.card data.finset.basic data.set.function
import combinatorics.simple_graph.basic combinatorics.pigeonhole
import logic.function.basic logic.equiv.basic logic.equiv.defs
open function

theorem ssub_by_non_mem {α : Type} {A B : finset α} {a : α}
: A ⊆ B → a ∉ A → a ∈ B → A ⊂ B :=
begin
  intros A_sub_B ainA not_ainB,
  rw ssubset_iff_subset_ne,
  refine ⟨ A_sub_B, _ ⟩,
  intro A_eq_B,
  rw A_eq_B at ainA,
  contradiction,
end

lemma surj_on_of_image_B {α β : Type} [decidable_eq β] {A : finset α} {B : finset β} {f : α → β}
: set.maps_to f A B → set.surj_on f A B → (finset.image f A) = B :=
begin
  intros f_AtoB f_surj,
  rw finset.ext_iff,
  intros b,
  split,
  {
    intro b_in_image,
    rw finset.mem_image at b_in_image,
    rcases b_in_image with ⟨ a, ainA, H ⟩,
    rw ← H,
    exact f_AtoB ainA,
  },
  {
    intro binB,
    rw finset.mem_image,
    rcases f_surj binB with ⟨ a, ainA, H ⟩,
    exact ⟨ a, ainA, H ⟩,
  },
end

lemma image_B_of_surj_on {α β : Type} [decidable_eq β] {A : finset α} {B : finset β} {f : α → β}
: set.maps_to f A B → (finset.image f A) = B → set.surj_on f A B :=
begin
  intros f_AtoB image_eq_B b binB,
  rw set.mem_image,
  rw finset.ext_iff at image_eq_B,
  rw finset.mem_coe at binB,
  have := finset.mem_image.mp ((image_eq_B b).mpr binB),
  rcases this with ⟨ a, ainA, H ⟩,
  exact ⟨ a, ainA, H ⟩,
end

theorem surj_on_iff_image_B {α β : Type} [decidable_eq β] {A : finset α} {B : finset β} {f : α → β}
: set.maps_to f A B → (set.surj_on f A B ↔ (finset.image f A) = B) :=
begin
  intros f_AtoB,
  exact ⟨ surj_on_of_image_B f_AtoB, image_B_of_surj_on f_AtoB ⟩,
end

theorem inj_on_of_le_card {α β : Type} [decidable_eq β] {A : finset α} {B : finset β} {f : α → β}
: set.maps_to f A B → set.inj_on f A → A.card ≤ B.card :=
begin
  intros f_AtoB f_inj,
  exact finset.card_le_card_of_inj_on f f_AtoB f_inj,
end

theorem surj_on_of_le_card {α β : Type} [decidable_eq β] {A : finset α} {B : finset β} {f : α → β}
: set.maps_to f A B → set.surj_on f A B → B.card ≤ A.card :=
begin
  intros f_AtoB f_surj,
  rw ← surj_on_of_image_B f_AtoB f_surj,
  exact finset.card_image_le,
end

theorem bij_on_of_eq_card {α β : Type} [decidable_eq β] {A : finset α} {B : finset β} {f : α → β}
: set.bij_on f A B → A.card = B.card :=
begin
  intros H,
  rcases H with ⟨ f_AtoB, f_inj, f_surj ⟩,
  exact antisymm (inj_on_of_le_card f_AtoB f_inj) (surj_on_of_le_card f_AtoB f_surj),
end

lemma same_card_to_inj_surj {α β : Type}[decidable_eq β] {A : finset α} {B : finset β} {f : α → β}
: A.card = B.card → set.maps_to f A B → set.inj_on f A → set.surj_on f A B :=
begin
  intros same_card f_AtoB f_inj b binB,
  by_contra,
  have : finset.image f A ⊂ B,
  {
    apply ssub_by_non_mem (finset.image_subset_iff.mpr f_AtoB) _ binB,
    intro H,
    apply h,
    rw finset.mem_image at H,
    rcases H with ⟨ a, ainA, H ⟩,
    exact ⟨ a, ainA, H ⟩,
  },
  have card_lt := finset.card_lt_card this,
  rw finset.card_image_of_inj_on f_inj at card_lt,
  finish,
end

lemma same_card_to_surj_inj {α β : Type} [decidable_eq β] {A : finset α} {B : finset β} {f : α → β}
: A.card = B.card → set.maps_to f A B → set.surj_on f A B → set.inj_on f A :=
begin
  intros same_card f_AtoB f_surj,
  rw ← surj_on_of_image_B f_AtoB f_surj at same_card,
  exact finset.inj_on_of_card_image_eq same_card.symm,
end

theorem same_card_of_inj_iff_surj {α β : Type} [decidable_eq β] {A : finset α} {B : finset β} {f : α → β}
: A.card = B.card → set.maps_to f A B → (set.inj_on f A ↔ set.surj_on f A B) :=
begin
  intros same_card f_AtoB,
  split,
  exact same_card_to_inj_surj same_card f_AtoB,
  exact same_card_to_surj_inj same_card f_AtoB,
end

-- lemma smth {α : Type} [fintype α] {f : α → α}
-- : set.maps_to f (coe finset.univ) (coe (finset.image f finset.univ))

-------------------------------------------------------------------------------------------------
-- Define latin square object
structure latin_function (len : ℕ):=
(nonempty : len > 0)
(map : (fin len) → (fin len))
(is_inj : injective map)

theorem image_eq_domain (n : ℕ) (L : latin_function n) :
  (finset.image L.map finset.univ) = finset.univ :=
begin
  have image_sub_domain : (finset.image L.map finset.univ) ⊆ finset.univ := (finset.image L.map finset.univ).subset_univ,
  cases has_subset.subset.eq_or_ssubset image_sub_domain with image_eq_domain image_ssub_domain;
  clear image_sub_domain,
  exact image_eq_domain,

  exfalso,
  have maps_to : set.maps_to L.map (coe finset.univ) (coe (finset.image L.map finset.univ)),
  {
    intros a ha,
    rw finset.mem_coe at ha,
    rw finset.mem_coe,
    rw finset.mem_image,
    use a,
    exact ⟨ ha, rfl ⟩,
  },

  have card_image_ssub_domain := finset.card_lt_card image_ssub_domain,
  have := finset.exists_ne_map_eq_of_card_lt_of_maps_to card_image_ssub_domain maps_to,
  rcases this with ⟨ a, a_ext, b, b_ext, a_neq_b, H ⟩,
  exact a_neq_b (L.is_inj H),
end

lemma latin_function_injective (len : ℕ) (f : latin_function len) : injective f.map :=
begin
  intros i j h,
  exact f.is_inj h,
end

lemma latin_function_surjective (len : ℕ) (f : latin_function len) : surjective f.map :=
begin
  intros i,
  have i_in_image : i ∈ finset.univ := finset.mem_univ i,
  rw ← image_eq_domain len f at i_in_image,
  rw finset.mem_image at i_in_image,
  rcases i_in_image with ⟨ j, j_in_univ, j_maps_to_i ⟩,
  exact ⟨ j, j_maps_to_i ⟩,
end

theorem latin_function_bijective (len : ℕ) (f : latin_function len) : bijective f.map :=
begin
  split,
  exact latin_function_injective len f,
  exact latin_function_surjective len f,
end

def permute_index {len : ℕ} (f : latin_function len) {g : (fin len) → (fin len)} (g_inj : injective g) :
 latin_function len :=
begin
  refine ⟨ f.nonempty, (g ∘ f.map), _ ⟩,

  rw injective.of_comp_iff,
  exact f.is_inj,
  exact g_inj,
end

def latin_function_equiv (len : ℕ) (f : latin_function len) : equiv (fin len) (fin len) :=
begin
  refl,
end

noncomputable def transpose (len : ℕ) (f : latin_function len) : latin_function len :=
{
  map :=
  begin
    choose g hg using function.bijective_iff_has_inverse.1 (latin_function_bijective len f),
    exact g,
  end,

  is_inj :=
  begin
    intros a b H,
    have _x : left_inverse (classical.some _) f.map ∧ right_inverse (classical.some _) f.map :=
    classical.some_spec (function.bijective_iff_has_inverse.1 (latin_function_bijective len f)),
    rcases _x with ⟨ left_inverse, right_inverse ⟩,
    have left_inverse_r := function.right_inverse.left_inverse right_inverse,
    exact (function.left_inverse.injective left_inverse_r) H,
  end,

  nonempty := f.nonempty,
}

-- define hypercube object where each side has length len and takes dim number of inputs
structure hypercube_dim2 (len : ℕ) :=
(nonempty : len > 0)
(map : (fin len) → (fin len) → (fin len))
(is_inj : injective map)

structure hypercube_dim3 (len : ℕ) :=
(nonempty : len > 0)
(map : (fin len) → (fin len) → (fin len) → (fin len))
(is_inj : injective map)

structure hypercube_dim4 (len : ℕ) :=
(nonempty : len > 0)
(map : (fin len) → (fin len) → (fin len) → (fin len) → (fin len))
(is_inj : injective map)


import game.max.level04 -- hide

open_locale classical -- hide

noncomputable theory -- hide

namespace xena -- hide

/-
# Chapter ? : Max and abs

## Level 5

`max_le` is really useful; it says that if `a ≤ c` and `b ≤ c`
then `max a b ≤ c`.

Note that in the Lean formulation, the variables are *implicit*,
meaning that Lean will guess them.
-/

/- Lemma
If $a$, $b$, $c$ are real numbers with $a\leq c$ and $b\leq c$,
then $\max(a,b)\leq c.$
-/
theorem max_le {a b c : ℝ} (hac : a ≤ c) (hbc : b ≤ c) : max a b ≤ c :=
begin
  cases max_choice a b with ha hb,
  { rw ha,
    assumption
  },
  { rw hb,
    assumption
  }

end

end xena --hide


import semantics.playability
import semantics.model
import syntax.formula
local attribute [instance] classical.prop_decidable

variable {agents : Type}

open set

-- φ is valid in a model M = (f,v), if it is entailed by every state of the model
def valid_m_formula {form: Type} (ft: formula form) (m: model) (φ : form) :=
  ∀ s, ft.s_entails m s φ

-- φ is globally valid, if it is valid in all models
def global_valid {form: Type} (ft: formula form) (φ : form):=
  ∀ m, valid_m_formula ft m φ

lemma not_s_entails_imp {form: Type} (ft: formula form) (m: model) :
  ∀ s φ, (¬(ft.s_entails m s φ)) ↔ (ft.s_entails m s (ft.not φ)) :=
begin
intros s φ,
rw ft.notdef,
split,
repeat { rw ←(ft.s_entails_imp m s φ ft.bot),
  rw ←(ft.s_entails_bot m s),
  intros h1 h2,
  exact h1 h2, },

end


import ring_theory.ideal.basic
import ring_theory.principal_ideal_domain

theorem submodule.is_principal.prime_generator_of_prime {α} [comm_ring α] (I: ideal α)
  [submodule.is_principal I] [is_prime: ideal.is_prime I] (ne_bot: I ≠ ⊥):
  prime (submodule.is_principal.generator I) :=
⟨
  by {
    intro h,
    rw ← submodule.is_principal.eq_bot_iff_generator_eq_zero I at h,
    exact ne_bot h,
  },
  by {
    intro h,
    have p₁: I = ⊤,
    from ideal.eq_top_of_is_unit_mem I (submodule.is_principal.generator_mem I) h,
    exact ideal.is_prime.ne_top is_prime p₁,
  },
  by {
    simp only [← submodule.is_principal.mem_iff_generator_dvd I],
    exact is_prime.2,
  }
⟩


/-
Copyright (c) 2022 Martin Zinkevich. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Martin Zinkevich
-/
import measure_theory.measure.measure_space

/-!
# Subtraction of measures

In this file we define `μ - ν` to be the least measure `τ` such that `μ ≤ τ + ν`.
It is the equivalent of `(μ - ν) ⊔ 0` if `μ` and `ν` were signed measures.
Compare with `ennreal.has_sub`.
Specifically, note that if you have `α = {1,2}`, and  `μ {1} = 2`, `μ {2} = 0`, and
`ν {2} = 2`, `ν {1} = 0`, then `(μ - ν) {1, 2} = 2`. However, if `μ ≤ ν`, and
`ν univ ≠ ∞`, then `(μ - ν) + ν = μ`.
-/

open set

namespace measure_theory

namespace measure

/-- The measure `μ - ν` is defined to be the least measure `τ` such that `μ ≤ τ + ν`.
It is the equivalent of `(μ - ν) ⊔ 0` if `μ` and `ν` were signed measures.
Compare with `ennreal.has_sub`.
Specifically, note that if you have `α = {1,2}`, and  `μ {1} = 2`, `μ {2} = 0`, and
`ν {2} = 2`, `ν {1} = 0`, then `(μ - ν) {1, 2} = 2`. However, if `μ ≤ ν`, and
`ν univ ≠ ∞`, then `(μ - ν) + ν = μ`. -/
noncomputable instance has_sub {α : Type*} [measurable_space α] : has_sub (measure α) :=
⟨λ μ ν, Inf {τ | μ ≤ τ + ν} ⟩

variables {α : Type*} {m : measurable_space α} {μ ν : measure α} {s : set α}

lemma sub_def : μ - ν = Inf {d | μ ≤ d + ν} := rfl

lemma sub_le_of_le_add {d} (h : μ ≤ d + ν) : μ - ν ≤ d := Inf_le h

lemma sub_eq_zero_of_le (h : μ ≤ ν) : μ - ν = 0 :=
nonpos_iff_eq_zero'.1 $ sub_le_of_le_add $ by rwa zero_add

lemma sub_le : μ - ν ≤ μ :=
sub_le_of_le_add $ measure.le_add_right le_rfl

@[simp] lemma sub_top : μ - ⊤ = 0 := sub_eq_zero_of_le le_top
@[simp] lemma zero_sub : 0 - μ = 0 := sub_eq_zero_of_le μ.zero_le
@[simp] lemma sub_self : μ - μ = 0 := sub_eq_zero_of_le le_rfl

/-- This application lemma only works in special circumstances. Given knowledge of
when `μ ≤ ν` and `ν ≤ μ`, a more general application lemma can be written. -/
lemma sub_apply [is_finite_measure ν] (h₁ : measurable_set s) (h₂ : ν ≤ μ) :
  (μ - ν) s = μ s - ν s :=
begin
  -- We begin by defining `measure_sub`, which will be equal to `(μ - ν)`.
  let measure_sub : measure α := @measure_theory.measure.of_measurable α _
    (λ (t : set α) (h_t_measurable_set : measurable_set t), (μ t - ν t))
    begin
      simp
    end
    begin
      intros g h_meas h_disj, simp only, rw ennreal.tsum_sub,
      repeat { rw ← measure_theory.measure_Union h_disj h_meas },
      exacts [measure_theory.measure_ne_top _ _, λ i, h₂ _ (h_meas _)]
    end,
  -- Now, we demonstrate `μ - ν = measure_sub`, and apply it.
  begin
    have h_measure_sub_add : (ν + measure_sub = μ),
    { ext t h_t_measurable_set,
      simp only [pi.add_apply, coe_add],
      rw [measure_theory.measure.of_measurable_apply _ h_t_measurable_set, add_comm,
        tsub_add_cancel_of_le (h₂ t h_t_measurable_set)] },
    have h_measure_sub_eq : (μ - ν) = measure_sub,
    { rw measure_theory.measure.sub_def, apply le_antisymm,
      { apply @Inf_le (measure α) measure.complete_semilattice_Inf,
        simp [le_refl, add_comm, h_measure_sub_add] },
      apply @le_Inf (measure α) measure.complete_semilattice_Inf,
      intros d h_d, rw [← h_measure_sub_add, mem_set_of_eq, add_comm d] at h_d,
      apply measure.le_of_add_le_add_left h_d },
    rw h_measure_sub_eq,
    apply measure.of_measurable_apply _ h₁,
  end
end

lemma sub_add_cancel_of_le [is_finite_measure ν] (h₁ : ν ≤ μ) : μ - ν + ν = μ :=
begin
  ext s h_s_meas,
  rw [add_apply, sub_apply h_s_meas h₁, tsub_add_cancel_of_le (h₁ s h_s_meas)],
end

lemma restrict_sub_eq_restrict_sub_restrict (h_meas_s : measurable_set s) :
  (μ - ν).restrict s = (μ.restrict s) - (ν.restrict s) :=
begin
  repeat {rw sub_def},
  have h_nonempty : {d | μ ≤ d + ν}.nonempty, from ⟨μ, measure.le_add_right le_rfl⟩,
  rw restrict_Inf_eq_Inf_restrict h_nonempty h_meas_s,
  apply le_antisymm,
  { refine Inf_le_Inf_of_forall_exists_le _,
    intros ν' h_ν'_in, rw mem_set_of_eq at h_ν'_in,
    refine ⟨ν'.restrict s, _, restrict_le_self⟩,
    refine ⟨ν' + (⊤ : measure α).restrict sᶜ, _, _⟩,
    { rw [mem_set_of_eq, add_right_comm, measure.le_iff],
      intros t h_meas_t,
      repeat { rw ← measure_inter_add_diff t h_meas_s },
      refine add_le_add _ _,
      { rw [add_apply, add_apply],
        apply le_add_right _,
        rw [← restrict_eq_self μ (inter_subset_right _ _),
          ← restrict_eq_self ν (inter_subset_right _ _)],
        apply h_ν'_in _ (h_meas_t.inter h_meas_s) },
      { rw [add_apply, restrict_apply (h_meas_t.diff h_meas_s), diff_eq, inter_assoc,
          inter_self, ← add_apply],
        have h_mu_le_add_top : μ ≤ ν' + ν + ⊤, by simp only [add_top, le_top],
        exact measure.le_iff'.1 h_mu_le_add_top _ } },
    { ext1 t h_meas_t,
      simp [restrict_apply h_meas_t, restrict_apply (h_meas_t.inter h_meas_s), inter_assoc] } },
  { refine Inf_le_Inf_of_forall_exists_le _,
    refine ball_image_iff.2 (λ t h_t_in, ⟨t.restrict s, _, le_rfl⟩),
    rw [set.mem_set_of_eq, ← restrict_add],
    exact restrict_mono subset.rfl h_t_in }
end

lemma sub_apply_eq_zero_of_restrict_le_restrict
  (h_le : μ.restrict s ≤ ν.restrict s) (h_meas_s : measurable_set s) :
  (μ - ν) s = 0 :=
by rw [← restrict_apply_self, restrict_sub_eq_restrict_sub_restrict, sub_eq_zero_of_le]; simp *

instance is_finite_measure_sub [is_finite_measure μ] : is_finite_measure (μ - ν) :=
is_finite_measure_of_le μ sub_le

end measure

end measure_theory