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

! This file was ported from Lean 3 source module combinatorics.hindman
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.StoneCech
import Mathbin.Topology.Algebra.Semigroup
import Mathbin.Data.Stream.Init

/-!
# Hindman's theorem on finite sums

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

We prove Hindman's theorem on finite sums, using idempotent ultrafilters.

Given an infinite sequence `a₀, a₁, a₂, …` of positive integers, the set `FS(a₀, …)` is the set
of positive integers that can be expressed as a finite sum of `aᵢ`'s, without repetition. Hindman's
theorem asserts that whenever the positive integers are finitely colored, there exists a sequence
`a₀, a₁, a₂, …` such that `FS(a₀, …)` is monochromatic. There is also a stronger version, saying
that whenever a set of the form `FS(a₀, …)` is finitely colored, there exists a sequence
`b₀, b₁, b₂, …` such that `FS(b₀, …)` is monochromatic and contained in `FS(a₀, …)`. We prove both
these versions for a general semigroup `M` instead of `ℕ+` since it is no harder, although this
special case implies the general case.

The idea of the proof is to extend the addition `(+) : M → M → M` to addition `(+) : βM → βM → βM`
on the space `βM` of ultrafilters on `M`. One can prove that if `U` is an _idempotent_ ultrafilter,
i.e. `U + U = U`, then any `U`-large subset of `M` contains some set `FS(a₀, …)` (see
`exists_FS_of_large`). And with the help of a general topological argument one can show that any set
of the form `FS(a₀, …)` is `U`-large according to some idempotent ultrafilter `U` (see
`exists_idempotent_ultrafilter_le_FS`). This is enough to prove the theorem since in any finite
partition of a `U`-large set, one of the parts is `U`-large.

## Main results

- `FS_partition_regular`: the strong form of Hindman's theorem
- `exists_FS_of_finite_cover`: the weak form of Hindman's theorem

## Tags

Ramsey theory, ultrafilter

-/

open Filter

#print Ultrafilter.mul /-
/-- Multiplication of ultrafilters given by `∀ᶠ m in U*V, p m ↔ ∀ᶠ m in U, ∀ᶠ m' in V, p (m*m')`. -/
@[to_additive
      "Addition of ultrafilters given by\n`∀ᶠ m in U+V, p m ↔ ∀ᶠ m in U, ∀ᶠ m' in V, p (m+m')`."]
def Ultrafilter.mul {M} [Mul M] : Mul (Ultrafilter M) where mul U V := (· * ·) <$> U <*> V
#align ultrafilter.has_mul Ultrafilter.mul
#align ultrafilter.has_add Ultrafilter.add
-/

attribute [local instance] Ultrafilter.mul Ultrafilter.add

#print Ultrafilter.eventually_mul /-
/- We could have taken this as the definition of `U * V`, but then we would have to prove that it
defines an ultrafilter. -/
@[to_additive]
theorem Ultrafilter.eventually_mul {M} [Mul M] (U V : Ultrafilter M) (p : M → Prop) :
    (∀ᶠ m in ↑(U * V), p m) ↔ ∀ᶠ m in U, ∀ᶠ m' in V, p (m * m') :=
  Iff.rfl
#align ultrafilter.eventually_mul Ultrafilter.eventually_mul
#align ultrafilter.eventually_add Ultrafilter.eventually_add
-/

#print Ultrafilter.semigroup /-
/-- Semigroup structure on `ultrafilter M` induced by a semigroup structure on `M`. -/
@[to_additive
      "Additive semigroup structure on `ultrafilter M` induced by an additive semigroup\nstructure on `M`."]
def Ultrafilter.semigroup {M} [Semigroup M] : Semigroup (Ultrafilter M) :=
  { Ultrafilter.mul with
    mul_assoc := fun U V W =>
      Ultrafilter.coe_inj.mp <|
        Filter.ext' fun p => by simp only [Ultrafilter.eventually_mul, mul_assoc] }
#align ultrafilter.semigroup Ultrafilter.semigroup
#align ultrafilter.add_semigroup Ultrafilter.addSemigroup
-/

attribute [local instance] Ultrafilter.semigroup Ultrafilter.addSemigroup

/- warning: ultrafilter.continuous_mul_left -> Ultrafilter.continuous_mul_left is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] (V : Ultrafilter.{u1} M), Continuous.{u1, u1} (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (Ultrafilter.topologicalSpace.{u1} M) (Ultrafilter.topologicalSpace.{u1} M) (fun (_x : Ultrafilter.{u1} M) => HMul.hMul.{u1, u1, u1} (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (instHMul.{u1} (Ultrafilter.{u1} M) (Ultrafilter.mul.{u1} M (Semigroup.toHasMul.{u1} M _inst_1))) _x V)
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] (V : Ultrafilter.{u1} M), Continuous.{u1, u1} (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (Ultrafilter.topologicalSpace.{u1} M) (Ultrafilter.topologicalSpace.{u1} M) (fun (_x : Ultrafilter.{u1} M) => HMul.hMul.{u1, u1, u1} (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (instHMul.{u1} (Ultrafilter.{u1} M) (Ultrafilter.mul.{u1} M (Semigroup.toMul.{u1} M _inst_1))) _x V)
Case conversion may be inaccurate. Consider using '#align ultrafilter.continuous_mul_left Ultrafilter.continuous_mul_leftₓ'. -/
-- We don't prove `continuous_mul_right`, because in general it is false!
@[to_additive]
theorem Ultrafilter.continuous_mul_left {M} [Semigroup M] (V : Ultrafilter M) :
    Continuous (· * V) :=
  TopologicalSpace.IsTopologicalBasis.continuous ultrafilterBasis_is_basis _ <|
    Set.forall_range_iff.mpr fun s => ultrafilter_isOpen_basic { m : M | ∀ᶠ m' in V, m * m' ∈ s }
#align ultrafilter.continuous_mul_left Ultrafilter.continuous_mul_left
#align ultrafilter.continuous_add_left Ultrafilter.continuous_add_left

namespace Hindman

#print Hindman.FS /-
/-- `FS a` is the set of finite sums in `a`, i.e. `m ∈ FS a` if `m` is the sum of a nonempty
subsequence of `a`. We give a direct inductive definition instead of talking about subsequences. -/
inductive FS {M} [AddSemigroup M] : Stream' M → Set M
  | head (a : Stream' M) : FS a a.headI
  | tail (a : Stream' M) (m : M) (h : FS a.tail m) : FS a m
  | cons (a : Stream' M) (m : M) (h : FS a.tail m) : FS a (a.headI + m)
#align hindman.FS Hindman.FS
-/

#print Hindman.FP /-
/-- `FP a` is the set of finite products in `a`, i.e. `m ∈ FP a` if `m` is the product of a nonempty
subsequence of `a`. We give a direct inductive definition instead of talking about subsequences. -/
@[to_additive FS]
inductive FP {M} [Semigroup M] : Stream' M → Set M
  | head (a : Stream' M) : FP a a.headI
  | tail (a : Stream' M) (m : M) (h : FP a.tail m) : FP a m
  | cons (a : Stream' M) (m : M) (h : FP a.tail m) : FP a (a.headI * m)
#align hindman.FP Hindman.FP
#align hindman.FS Hindman.FS
-/

/- warning: hindman.FP.mul -> Hindman.FP.mul is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] {a : Stream'.{u1} M} {m : M}, (Membership.Mem.{u1, u1} M (Set.{u1} M) (Set.hasMem.{u1} M) m (Hindman.FP.{u1} M _inst_1 a)) -> (Exists.{1} Nat (fun (n : Nat) => forall (m' : M), (Membership.Mem.{u1, u1} M (Set.{u1} M) (Set.hasMem.{u1} M) m' (Hindman.FP.{u1} M _inst_1 (Stream'.drop.{u1} M n a))) -> (Membership.Mem.{u1, u1} M (Set.{u1} M) (Set.hasMem.{u1} M) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toHasMul.{u1} M _inst_1)) m m') (Hindman.FP.{u1} M _inst_1 a))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] {a : Stream'.{u1} M} {m : M}, (Membership.mem.{u1, u1} M (Set.{u1} M) (Set.instMembershipSet.{u1} M) m (Hindman.FP.{u1} M _inst_1 a)) -> (Exists.{1} Nat (fun (n : Nat) => forall (m' : M), (Membership.mem.{u1, u1} M (Set.{u1} M) (Set.instMembershipSet.{u1} M) m' (Hindman.FP.{u1} M _inst_1 (Stream'.drop.{u1} M n a))) -> (Membership.mem.{u1, u1} M (Set.{u1} M) (Set.instMembershipSet.{u1} M) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toMul.{u1} M _inst_1)) m m') (Hindman.FP.{u1} M _inst_1 a))))
Case conversion may be inaccurate. Consider using '#align hindman.FP.mul Hindman.FP.mulₓ'. -/
/-- If `m` and `m'` are finite products in `M`, then so is `m * m'`, provided that `m'` is obtained
from a subsequence of `M` starting sufficiently late. -/
@[to_additive
      "If `m` and `m'` are finite sums in `M`, then so is `m + m'`, provided that `m'`\nis obtained from a subsequence of `M` starting sufficiently late."]
theorem FP.mul {M} [Semigroup M] {a : Stream' M} {m : M} (hm : m ∈ FP a) :
    ∃ n, ∀ m' ∈ FP (a.drop n), m * m' ∈ FP a :=
  by
  induction' hm with a a m hm ih a m hm ih
  · exact ⟨1, fun m hm => FP.cons a m hm⟩
  · cases' ih with n hn
    use n + 1
    intro m' hm'
    exact FP.tail _ _ (hn _ hm')
  · cases' ih with n hn
    use n + 1
    intro m' hm'
    rw [mul_assoc]
    exact FP.cons _ _ (hn _ hm')
#align hindman.FP.mul Hindman.FP.mul
#align hindman.FS.add Hindman.FS.add

/- warning: hindman.exists_idempotent_ultrafilter_le_FP -> Hindman.exists_idempotent_ultrafilter_le_FP is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] (a : Stream'.{u1} M), Exists.{succ u1} (Ultrafilter.{u1} M) (fun (U : Ultrafilter.{u1} M) => And (Eq.{succ u1} (Ultrafilter.{u1} M) (HMul.hMul.{u1, u1, u1} (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (instHMul.{u1} (Ultrafilter.{u1} M) (Ultrafilter.mul.{u1} M (Semigroup.toHasMul.{u1} M _inst_1))) U U) U) (Filter.Eventually.{u1} M (fun (m : M) => Membership.Mem.{u1, u1} M (Set.{u1} M) (Set.hasMem.{u1} M) m (Hindman.FP.{u1} M _inst_1 a)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Ultrafilter.{u1} M) (Filter.{u1} M) (HasLiftT.mk.{succ u1, succ u1} (Ultrafilter.{u1} M) (Filter.{u1} M) (CoeTCₓ.coe.{succ u1, succ u1} (Ultrafilter.{u1} M) (Filter.{u1} M) (Ultrafilter.Filter.hasCoeT.{u1} M))) U)))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] (a : Stream'.{u1} M), Exists.{succ u1} (Ultrafilter.{u1} M) (fun (U : Ultrafilter.{u1} M) => And (Eq.{succ u1} (Ultrafilter.{u1} M) (HMul.hMul.{u1, u1, u1} (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (instHMul.{u1} (Ultrafilter.{u1} M) (Ultrafilter.mul.{u1} M (Semigroup.toMul.{u1} M _inst_1))) U U) U) (Filter.Eventually.{u1} M (fun (m : M) => Membership.mem.{u1, u1} M (Set.{u1} M) (Set.instMembershipSet.{u1} M) m (Hindman.FP.{u1} M _inst_1 a)) (Ultrafilter.toFilter.{u1} M U)))
Case conversion may be inaccurate. Consider using '#align hindman.exists_idempotent_ultrafilter_le_FP Hindman.exists_idempotent_ultrafilter_le_FPₓ'. -/
@[to_additive exists_idempotent_ultrafilter_le_FS]
theorem exists_idempotent_ultrafilter_le_FP {M} [Semigroup M] (a : Stream' M) :
    ∃ U : Ultrafilter M, U * U = U ∧ ∀ᶠ m in U, m ∈ FP a :=
  by
  let S : Set (Ultrafilter M) := ⋂ n, { U | ∀ᶠ m in U, m ∈ FP (a.drop n) }
  obtain ⟨U, hU, U_idem⟩ := exists_idempotent_in_compact_subsemigroup _ S _ _ _
  · refine' ⟨U, U_idem, _⟩
    convert set.mem_Inter.mp hU 0
  · exact Ultrafilter.continuous_mul_left
  · apply IsCompact.nonempty_interᵢ_of_sequence_nonempty_compact_closed
    · intro n U hU
      apply eventually.mono hU
      rw [add_comm, ← Stream'.drop_drop, ← Stream'.tail_eq_drop]
      exact FP.tail _
    · intro n
      exact ⟨pure _, mem_pure.mpr <| FP.head _⟩
    · exact (ultrafilter_isClosed_basic _).IsCompact
    · intro n
      apply ultrafilter_isClosed_basic
  · exact IsClosed.isCompact (isClosed_interᵢ fun i => ultrafilter_isClosed_basic _)
  · intro U hU V hV
    rw [Set.mem_interᵢ] at *
    intro n
    rw [Set.mem_setOf_eq, Ultrafilter.eventually_mul]
    apply eventually.mono (hU n)
    intro m hm
    obtain ⟨n', hn⟩ := FP.mul hm
    apply eventually.mono (hV (n' + n))
    intro m' hm'
    apply hn
    simpa only [Stream'.drop_drop] using hm'
#align hindman.exists_idempotent_ultrafilter_le_FP Hindman.exists_idempotent_ultrafilter_le_FP
#align hindman.exists_idempotent_ultrafilter_le_FS Hindman.exists_idempotent_ultrafilter_le_FS

/- warning: hindman.exists_FP_of_large -> Hindman.exists_FP_of_large is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] (U : Ultrafilter.{u1} M), (Eq.{succ u1} (Ultrafilter.{u1} M) (HMul.hMul.{u1, u1, u1} (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (instHMul.{u1} (Ultrafilter.{u1} M) (Ultrafilter.mul.{u1} M (Semigroup.toHasMul.{u1} M _inst_1))) U U) U) -> (forall (s₀ : Set.{u1} M), (Membership.Mem.{u1, u1} (Set.{u1} M) (Ultrafilter.{u1} M) (Ultrafilter.hasMem.{u1} M) s₀ U) -> (Exists.{succ u1} (Stream'.{u1} M) (fun (a : Stream'.{u1} M) => HasSubset.Subset.{u1} (Set.{u1} M) (Set.hasSubset.{u1} M) (Hindman.FP.{u1} M _inst_1 a) s₀)))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] (U : Ultrafilter.{u1} M), (Eq.{succ u1} (Ultrafilter.{u1} M) (HMul.hMul.{u1, u1, u1} (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (Ultrafilter.{u1} M) (instHMul.{u1} (Ultrafilter.{u1} M) (Ultrafilter.mul.{u1} M (Semigroup.toMul.{u1} M _inst_1))) U U) U) -> (forall (s₀ : Set.{u1} M), (Membership.mem.{u1, u1} (Set.{u1} M) (Ultrafilter.{u1} M) (Ultrafilter.instMembershipSetUltrafilter.{u1} M) s₀ U) -> (Exists.{succ u1} (Stream'.{u1} M) (fun (a : Stream'.{u1} M) => HasSubset.Subset.{u1} (Set.{u1} M) (Set.instHasSubsetSet.{u1} M) (Hindman.FP.{u1} M _inst_1 a) s₀)))
Case conversion may be inaccurate. Consider using '#align hindman.exists_FP_of_large Hindman.exists_FP_of_largeₓ'. -/
@[to_additive exists_FS_of_large]
theorem exists_FP_of_large {M} [Semigroup M] (U : Ultrafilter M) (U_idem : U * U = U) (s₀ : Set M)
    (sU : s₀ ∈ U) : ∃ a, FP a ⊆ s₀ :=
  by
  /- Informally: given a `U`-large set `s₀`, the set `s₀ ∩ { m | ∀ᶠ m' in U, m * m' ∈ s₀ }` is also
  `U`-large (since `U` is idempotent). Thus in particular there is an `a₀` in this intersection. Now
  let `s₁` be the intersection `s₀ ∩ { m | a₀ * m ∈ s₀ }`. By choice of `a₀`, this is again `U`-large,
  so we can repeat the argument starting from `s₁`, obtaining `a₁`, `s₂`, etc. This gives the desired
  infinite sequence. -/
  have exists_elem : ∀ {s : Set M} (hs : s ∈ U), (s ∩ { m | ∀ᶠ m' in U, m * m' ∈ s }).Nonempty :=
    fun s hs =>
    Ultrafilter.nonempty_of_mem
      (inter_mem hs <| by
        rw [← U_idem] at hs
        exact hs)
  let elem : { s // s ∈ U } → M := fun p => (exists_elem p.property).some
  let succ : { s // s ∈ U } → { s // s ∈ U } := fun p =>
    ⟨p.val ∩ { m | elem p * m ∈ p.val },
      inter_mem p.2 <| show _ from Set.inter_subset_right _ _ (exists_elem p.2).some_mem⟩
  use Stream'.corec elem succ (Subtype.mk s₀ sU)
  suffices ∀ (a : Stream' M), ∀ m ∈ FP a, ∀ p, a = Stream'.corec elem succ p → m ∈ p.val
    by
    intro m hm
    exact this _ m hm ⟨s₀, sU⟩ rfl
  clear sU s₀
  intro a m h
  induction' h with b b n h ih b n h ih
  · rintro p rfl
    rw [Stream'.corec_eq, Stream'.head_cons]
    exact Set.inter_subset_left _ _ (Set.Nonempty.some_mem _)
  · rintro p rfl
    refine' Set.inter_subset_left _ _ (ih (succ p) _)
    rw [Stream'.corec_eq, Stream'.tail_cons]
  · rintro p rfl
    have := Set.inter_subset_right _ _ (ih (succ p) _)
    · simpa only using this
    rw [Stream'.corec_eq, Stream'.tail_cons]
#align hindman.exists_FP_of_large Hindman.exists_FP_of_large
#align hindman.exists_FS_of_large Hindman.exists_FS_of_large

/- warning: hindman.FP_partition_regular -> Hindman.FP_partition_regular is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] (a : Stream'.{u1} M) (s : Set.{u1} (Set.{u1} M)), (Set.Finite.{u1} (Set.{u1} M) s) -> (HasSubset.Subset.{u1} (Set.{u1} M) (Set.hasSubset.{u1} M) (Hindman.FP.{u1} M _inst_1 a) (Set.unionₛ.{u1} M s)) -> (Exists.{succ u1} (Set.{u1} M) (fun (c : Set.{u1} M) => Exists.{0} (Membership.Mem.{u1, u1} (Set.{u1} M) (Set.{u1} (Set.{u1} M)) (Set.hasMem.{u1} (Set.{u1} M)) c s) (fun (H : Membership.Mem.{u1, u1} (Set.{u1} M) (Set.{u1} (Set.{u1} M)) (Set.hasMem.{u1} (Set.{u1} M)) c s) => Exists.{succ u1} (Stream'.{u1} M) (fun (b : Stream'.{u1} M) => HasSubset.Subset.{u1} (Set.{u1} M) (Set.hasSubset.{u1} M) (Hindman.FP.{u1} M _inst_1 b) c))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] (a : Stream'.{u1} M) (s : Set.{u1} (Set.{u1} M)), (Set.Finite.{u1} (Set.{u1} M) s) -> (HasSubset.Subset.{u1} (Set.{u1} M) (Set.instHasSubsetSet.{u1} M) (Hindman.FP.{u1} M _inst_1 a) (Set.unionₛ.{u1} M s)) -> (Exists.{succ u1} (Set.{u1} M) (fun (c : Set.{u1} M) => And (Membership.mem.{u1, u1} (Set.{u1} M) (Set.{u1} (Set.{u1} M)) (Set.instMembershipSet.{u1} (Set.{u1} M)) c s) (Exists.{succ u1} (Stream'.{u1} M) (fun (b : Stream'.{u1} M) => HasSubset.Subset.{u1} (Set.{u1} M) (Set.instHasSubsetSet.{u1} M) (Hindman.FP.{u1} M _inst_1 b) c))))
Case conversion may be inaccurate. Consider using '#align hindman.FP_partition_regular Hindman.FP_partition_regularₓ'. -/
/-- The strong form of **Hindman's theorem**: in any finite cover of an FP-set, one the parts
contains an FP-set. -/
@[to_additive FS_partition_regular
      "The strong form of **Hindman's theorem**: in any finite cover of\nan FS-set, one the parts contains an FS-set."]
theorem FP_partition_regular {M} [Semigroup M] (a : Stream' M) (s : Set (Set M)) (sfin : s.Finite)
    (scov : FP a ⊆ ⋃₀ s) : ∃ c ∈ s, ∃ b : Stream' M, FP b ⊆ c :=
  let ⟨U, idem, aU⟩ := exists_idempotent_ultrafilter_le_FP a
  let ⟨c, cs, hc⟩ := (Ultrafilter.finite_unionₛ_mem_iff sfin).mp (mem_of_superset aU scov)
  ⟨c, cs, exists_FP_of_large U idem c hc⟩
#align hindman.FP_partition_regular Hindman.FP_partition_regular
#align hindman.FS_partition_regular Hindman.FS_partition_regular

/- warning: hindman.exists_FP_of_finite_cover -> Hindman.exists_FP_of_finite_cover is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] [_inst_2 : Nonempty.{succ u1} M] (s : Set.{u1} (Set.{u1} M)), (Set.Finite.{u1} (Set.{u1} M) s) -> (HasSubset.Subset.{u1} (Set.{u1} M) (Set.hasSubset.{u1} M) (Top.top.{u1} (Set.{u1} M) (CompleteLattice.toHasTop.{u1} (Set.{u1} M) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} M) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} M) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} M) (Set.completeBooleanAlgebra.{u1} M)))))) (Set.unionₛ.{u1} M s)) -> (Exists.{succ u1} (Set.{u1} M) (fun (c : Set.{u1} M) => Exists.{0} (Membership.Mem.{u1, u1} (Set.{u1} M) (Set.{u1} (Set.{u1} M)) (Set.hasMem.{u1} (Set.{u1} M)) c s) (fun (H : Membership.Mem.{u1, u1} (Set.{u1} M) (Set.{u1} (Set.{u1} M)) (Set.hasMem.{u1} (Set.{u1} M)) c s) => Exists.{succ u1} (Stream'.{u1} M) (fun (a : Stream'.{u1} M) => HasSubset.Subset.{u1} (Set.{u1} M) (Set.hasSubset.{u1} M) (Hindman.FP.{u1} M _inst_1 a) c))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] [_inst_2 : Nonempty.{succ u1} M] (s : Set.{u1} (Set.{u1} M)), (Set.Finite.{u1} (Set.{u1} M) s) -> (HasSubset.Subset.{u1} (Set.{u1} M) (Set.instHasSubsetSet.{u1} M) (Top.top.{u1} (Set.{u1} M) (CompleteLattice.toTop.{u1} (Set.{u1} M) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} M) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} M) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} M) (Set.instCompleteBooleanAlgebraSet.{u1} M)))))) (Set.unionₛ.{u1} M s)) -> (Exists.{succ u1} (Set.{u1} M) (fun (c : Set.{u1} M) => And (Membership.mem.{u1, u1} (Set.{u1} M) (Set.{u1} (Set.{u1} M)) (Set.instMembershipSet.{u1} (Set.{u1} M)) c s) (Exists.{succ u1} (Stream'.{u1} M) (fun (a : Stream'.{u1} M) => HasSubset.Subset.{u1} (Set.{u1} M) (Set.instHasSubsetSet.{u1} M) (Hindman.FP.{u1} M _inst_1 a) c))))
Case conversion may be inaccurate. Consider using '#align hindman.exists_FP_of_finite_cover Hindman.exists_FP_of_finite_coverₓ'. -/
/-- The weak form of **Hindman's theorem**: in any finite cover of a nonempty semigroup, one of the
parts contains an FP-set. -/
@[to_additive exists_FS_of_finite_cover
      "The weak form of **Hindman's theorem**: in any finite cover\nof a nonempty additive semigroup, one of the parts contains an FS-set."]
theorem exists_FP_of_finite_cover {M} [Semigroup M] [Nonempty M] (s : Set (Set M)) (sfin : s.Finite)
    (scov : ⊤ ⊆ ⋃₀ s) : ∃ c ∈ s, ∃ a : Stream' M, FP a ⊆ c :=
  let ⟨U, hU⟩ :=
    exists_idempotent_of_compact_t2_of_continuous_mul_left (@Ultrafilter.continuous_mul_left M _)
  let ⟨c, c_s, hc⟩ := (Ultrafilter.finite_unionₛ_mem_iff sfin).mp (mem_of_superset univ_mem scov)
  ⟨c, c_s, exists_FP_of_large U hU c hc⟩
#align hindman.exists_FP_of_finite_cover Hindman.exists_FP_of_finite_cover
#align hindman.exists_FS_of_finite_cover Hindman.exists_FS_of_finite_cover

#print Hindman.FP_drop_subset_FP /-
@[to_additive FS_iter_tail_sub_FS]
theorem FP_drop_subset_FP {M} [Semigroup M] (a : Stream' M) (n : ℕ) : FP (a.drop n) ⊆ FP a :=
  by
  induction' n with n ih; · rfl
  rw [Nat.succ_eq_one_add, ← Stream'.drop_drop]
  exact trans (FP.tail _) ih
#align hindman.FP_drop_subset_FP Hindman.FP_drop_subset_FP
#align hindman.FS_iter_tail_sub_FS Hindman.FS_iter_tail_sub_FS
-/

#print Hindman.FP.singleton /-
@[to_additive]
theorem FP.singleton {M} [Semigroup M] (a : Stream' M) (i : ℕ) : a.get? i ∈ FP a :=
  by
  induction' i with i ih generalizing a
  · apply FP.head
  · apply FP.tail
    apply ih
#align hindman.FP.singleton Hindman.FP.singleton
#align hindman.FS.singleton Hindman.FS.singleton
-/

/- warning: hindman.FP.mul_two -> Hindman.FP.mul_two is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] (a : Stream'.{u1} M) (i : Nat) (j : Nat), (LT.lt.{0} Nat Nat.hasLt i j) -> (Membership.Mem.{u1, u1} M (Set.{u1} M) (Set.hasMem.{u1} M) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toHasMul.{u1} M _inst_1)) (Stream'.nth.{u1} M a i) (Stream'.nth.{u1} M a j)) (Hindman.FP.{u1} M _inst_1 a))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] (a : Stream'.{u1} M) (i : Nat) (j : Nat), (LT.lt.{0} Nat instLTNat i j) -> (Membership.mem.{u1, u1} M (Set.{u1} M) (Set.instMembershipSet.{u1} M) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toMul.{u1} M _inst_1)) (Stream'.nth.{u1} M a i) (Stream'.nth.{u1} M a j)) (Hindman.FP.{u1} M _inst_1 a))
Case conversion may be inaccurate. Consider using '#align hindman.FP.mul_two Hindman.FP.mul_twoₓ'. -/
@[to_additive]
theorem FP.mul_two {M} [Semigroup M] (a : Stream' M) (i j : ℕ) (ij : i < j) :
    a.get? i * a.get? j ∈ FP a := by
  refine' FP_drop_subset_FP _ i _
  rw [← Stream'.head_drop]
  apply FP.cons
  rcases le_iff_exists_add.mp (Nat.succ_le_of_lt ij) with ⟨d, hd⟩
  have := FP.singleton (a.drop i).tail d
  rw [Stream'.tail_eq_drop, Stream'.nth_drop, Stream'.nth_drop] at this
  convert this
  rw [hd, add_comm, Nat.succ_add, Nat.add_succ]
#align hindman.FP.mul_two Hindman.FP.mul_two
#align hindman.FS.add_two Hindman.FS.add_two

#print Hindman.FP.finset_prod /-
@[to_additive]
theorem FP.finset_prod {M} [CommMonoid M] (a : Stream' M) (s : Finset ℕ) (hs : s.Nonempty) :
    (s.Prod fun i => a.get? i) ∈ FP a :=
  by
  refine' FP_drop_subset_FP _ (s.min' hs) _
  induction' s using Finset.strongInduction with s ih
  rw [← Finset.mul_prod_erase _ _ (s.min'_mem hs), ← Stream'.head_drop]
  cases' (s.erase (s.min' hs)).eq_empty_or_nonempty with h h
  · rw [h, Finset.prod_empty, mul_one]
    exact FP.head _
  · apply FP.cons
    rw [Stream'.tail_eq_drop, Stream'.drop_drop, add_comm]
    refine' Set.mem_of_subset_of_mem _ (ih _ (Finset.erase_ssubset <| s.min'_mem hs) h)
    have : s.min' hs + 1 ≤ (s.erase (s.min' hs)).min' h :=
      Nat.succ_le_of_lt (Finset.min'_lt_of_mem_erase_min' _ _ <| Finset.min'_mem _ _)
    cases' le_iff_exists_add.mp this with d hd
    rw [hd, add_comm, ← Stream'.drop_drop]
    apply FP_drop_subset_FP
#align hindman.FP.finset_prod Hindman.FP.finset_prod
#align hindman.FS.finset_sum Hindman.FS.finset_sum
-/

end Hindman


import topologia
import .separacio

open topological_space
open set

variables (X : Type) [topological_space X]

/-- A topological space is (quasi)compact if every open covering admits a finite subcovering -/
def is_compact :=
  ∀ 𝒰 : set (set X), (∀ U ∈ 𝒰, is_open U) →
  (⋃₀ 𝒰 = univ) → (∃ ℱ ⊆ 𝒰, finite ℱ ∧ ⋃₀ℱ = univ)

def is_compact_subset {X : Type} [topological_space X] (S : set X):=
  ∀ 𝒰 : set (set X), (∀ U ∈ 𝒰, is_open U) →
  (S ⊆ ⋃₀ 𝒰) → (∃ ℱ ⊆ 𝒰, finite ℱ ∧ S ⊆ ⋃₀ℱ )

lemma is_compact_set' {A : set X} {I : Type*} (h : is_compact_subset A) (U : I → set X)
(hU : ∀ i, is_open (U i)) (hcov : A ⊆ ⋃₀ (U '' univ)):
  ∃ (F : set I), F.finite ∧ (A ⊆ ⋃₀ (U '' F)) :=
begin
  unfold is_compact_subset at h,
  set 𝒰 := U '' univ with 𝒰def,
  have exists_preimage : ∀ Ui ∈ 𝒰, ∃ i : I, (U i) = Ui, by finish,
  let map_inverse : 𝒰 → I := λ Ui, classical.some (exists_preimage Ui.1 Ui.2),
  have map_inverse_spec : ∀ Ui, U (map_inverse Ui) = Ui :=
    λ Ui, classical.some_spec (exists_preimage Ui.1 Ui.2),
  have hU' : ∀ Ui ∈ 𝒰, is_open Ui,
  {
    intros Ui hUi,
    obtain ⟨i, hi⟩ := exists_preimage Ui hUi,
    rw ←hi,
    tauto,
  },
  obtain ⟨FF, ⟨hFF1, ⟨hFF2,hFF3⟩⟩⟩ := h 𝒰 hU' hcov,
  clear h,
  set F := map_inverse '' (coe ⁻¹' FF) with Fdef,
  use F,
  have Ffin : F.finite,
  {
    rw Fdef,
    refine finite.image map_inverse _,
    refine finite.preimage _ hFF2,
    intros x hx y hy,
    exact subtype.eq,
  },
  have hcov'' : U '' F = FF,
  {
    rw Fdef,
    ext V,
    split,
    {
      intro hV,
      simp at hV,
      obtain ⟨i, ⟨⟨Ui,⟨hUiF, ⟨⟨j, haj⟩, hh'⟩⟩⟩,h⟩⟩ := hV,
      subst h,
      suffices : U i = Ui, by simpa [this] using hUiF,
      apply (congr_arg U (eq.symm hh')).trans,
      apply map_inverse_spec,
    },
    {
      intro hV,
      simp only [mem_image, set_coe.exists, mem_univ, mem_preimage, subtype.coe_mk],
      have VinU : V ∈ 𝒰 := hFF1 hV,
      set i := map_inverse ⟨V, VinU⟩,
      use i, use V,
      { exact ⟨VinU, ⟨hV, rfl⟩⟩ },
      { exact_mod_cast map_inverse_spec ⟨V, VinU⟩ }
    }
  },
  simp [hcov''],
  tauto,
end

lemma compact_space_iff_univ_compact :  is_compact X ↔ is_compact_subset (univ :set X) :=
begin
  split; intros h I hI hIX,
  { obtain ⟨F, hF, hh⟩ := h I hI (univ_subset_iff.mp hIX),
    exact ⟨F, hF, hh.1, hh.2.symm.subset⟩},
  { obtain ⟨F, hF, hh⟩ := h I hI (eq.symm hIX).subset,
    exact ⟨F, hF, hh.1, univ_subset_iff.mp hh.2⟩},
end

lemma finite_set_is_compact (h : fintype X) : is_compact X :=
begin
  intros I hI huniv,
  exact ⟨I, rfl.subset, finite.of_fintype I, huniv⟩,
end

lemma union_of_compacts_is_compact {A B : set X} (hA : is_compact_subset A) (hB : is_compact_subset B) : is_compact_subset (A ∪ B) :=
begin
  intros I hI huI,
  have hinclAB := union_subset_iff.1 huI,
  obtain ⟨FA, hFA, hhFA⟩ := hA I hI hinclAB.1,
  obtain ⟨FB, hFB, hhFB⟩ := hB I hI hinclAB.2,
  have hunion : A ∪ B ⊆ ⋃₀(FA ∪ FB),
  { rw  (sUnion_union FA FB),
    exact union_subset_union hhFA.right hhFB.right},
  exact ⟨FA ∪ FB, union_subset hFA hFB, hhFA.left.union hhFB.left, hunion⟩,
end

lemma empty_is_compact : is_compact_subset (∅ : set X) :=
begin
  intros I hI hhI,
  use ∅,
  exact ⟨ empty_subset I, finite_empty, by tauto⟩,
end

lemma finite_union_of_compacts_is_compact {I : set(set X)} (h : ∀ s ∈ I, is_compact_subset s) (hI : finite I) : is_compact_subset (⋃₀I):=
begin
  revert h,
  apply finite.induction_on hI,
  { intros I,
    rw sUnion_empty,
    apply empty_is_compact},
  { intros V T hVT hT hUT hs,
    have t : (⋃₀insert V T) = ⋃₀ T ∪ V, by finish,
    have hsT: (∀ (s : set X), s ∈ T → is_compact_subset s),
    { intros s hhs,
      exact hs s (mem_insert_of_mem V hhs)},
    rw t,
    exact union_of_compacts_is_compact X (hUT hsT) (hs V (mem_insert V T))},
end

lemma singleton_is_compact (x : X) : is_compact_subset ({x} : set X) :=
begin
  intros I hI hIincl,
  cases (bex_def.mp (hIincl  rfl)) with U hU,
  have hsingUI : {x} ⊆ ⋃₀{U},
  { rw (sUnion_singleton U),
    exact singleton_subset_iff.mpr hU.right},
  exact ⟨{U}, singleton_subset_iff.mpr hU.1, finite_singleton U, hsingUI⟩,
end

lemma finite_subset_is_compact (A : set X): finite A → is_compact_subset A :=
begin
  intro h,
  apply finite.induction_on h,
  apply empty_is_compact,
  intros a s has hsfin hscpt,
  apply union_of_compacts_is_compact,
  apply singleton_is_compact,
  assumption,
end

lemma closed_subset_of_compact_is_compact {A B : set X} (hA : is_closed A) (hB : is_compact_subset B) (hAB : A ⊆ B) :
  is_compact_subset A :=
begin
  intros I hI hIA,
  have hF : ∀ (U : set X), U ∈ I ∪ {Aᶜ} → is_open U,
  { intros U hU,
    cases ((mem_union U I {Aᶜ}).mp hU) with h,
      {exact hI U h},
      {rwa (mem_singleton_iff.mp h)}},
  have hUnionB : B ⊆ ⋃₀(I ∪ {Aᶜ}),
  { rw [sUnion_union I {Aᶜ}, Aᶜ.sUnion_singleton, (union_diff_cancel hAB).symm],
    exact union_subset_union hIA (inter_subset_right B Aᶜ)},
  obtain ⟨F, hFA, hh⟩  := hB (I ∪ {Aᶜ}) hF hUnionB,
  have hFI : F \ {Aᶜ} ⊆ I,
  { intros x hx,
    cases ((mem_union x I {Aᶜ}).mp (hFA ((diff_subset F {Aᶜ})  hx))) with h,
      {exact h},
      {exfalso,
       exact (not_mem_of_mem_diff hx) h}},
  have hsubsetU : A ⊆ ⋃₀(F \ {Aᶜ}),
  { intros x hx,
    rcases (mem_sUnion.1 ((subset.trans hAB hh.right) hx)) with ⟨V, ⟨hV1, hV2⟩⟩,
    exact (@mem_sUnion X x (F \ {Aᶜ})).2 ⟨V, ⟨hV1, by finish⟩, hV2⟩},
  exact ⟨F\{Aᶜ}, hFI, hh.left.subset (diff_subset F {Aᶜ}), hsubsetU⟩,
end

/-
lemma finite_subset_is_compact_using_choice (A : set X) (h : finite A) : is_compact_subset A :=
begin
  intros I hI huniv,
  have H : ∀ a ∈ A, ∃ ia ∈ I, a ∈ ia, by assumption,
  let f : A → set X := λ ⟨x, hxA⟩, classical.some (H x hxA),
  have hf1 : ∀ (x : X) (hx : x ∈ A), x ∈ (f ⟨x, hx⟩),
  {
    intros x hx,
    have hh := classical.some_spec (H x hx),
    tauto,
  },
  have hf2 : ∀ (x : X) (hx : x ∈ A), (f ⟨x, hx⟩) ∈ I,
  {
    intros x hx,
    have hh := classical.some_spec (H x hx),
    tauto,
  },
  use f '' univ,
  simp,
  split,
  {
    intros i hi,
    simp at hi,
    obtain ⟨x, ⟨hx,h'⟩⟩ := hi,
    subst h',
    tauto,
  },
  split,
  {
    haveI : fintype {x : X // x ∈ A} := finite.fintype h,
    apply finite_range f,
  },
  {
    unfold Union,
    intros x hx,
    unfold supr,
    rw Sup_eq_supr,
    simp,
    use f ⟨x,hx⟩,
    use x,
    use hx,
    tauto,
  }
end
 -/
open hausdorff_space

-- X : Type, i A : set X
-- per cada a ∈ A, triem Ua, Va oberts amb a ∈ Ua, y ∈ Va, Ua ∩ Va = ∅.
-- A ⊆ ⋃ Ua. A compacte -> subrecobriment finit Ua1,..., Uan.
-- V = ⋂ Vai. obert perquè intersecció finita. Aquest V funciona.
-- U : {a : X // a ∈ A} → set X, a ↦ Ua
lemma for_compact_exist_open_disjont {A : set X} [hausdorff_space X] (h : is_compact_subset A)
  (y : X) (hyA : ¬ y ∈ A) :  ∃ (V : set X), is_open V ∧ V ∩ A = ∅ ∧ y ∈ V :=
begin
  have UV : ∀ a ∈ A, ∃ UVa : set X × set X,
    is_open UVa.fst ∧ is_open UVa.snd ∧ UVa.fst ∩ UVa.snd = ∅ ∧ a ∈ UVa.fst ∧ y ∈ UVa.snd,
  {
    intros a ha,
    have hya : y ≠ a,
    { intro h, subst h, contradiction },
    obtain ⟨U, V, _⟩ := t2 a y hya,
    exact ⟨⟨U, V⟩, by tauto⟩,
  },
  let U : A → set X := λ a, (classical.some (UV a.1 a.2)).fst,
  have hU : ∀ (a : A), is_open (U ⟨a.1, a.2⟩)
   := λ a, (classical.some_spec (UV a.1 a.2)).1,
  let V : A → set X := λ a, (classical.some (UV a.1 a.2)).snd,
  have hV : ∀ (a : A), is_open (V ⟨a.1, a.2⟩)
   := λ a, (classical.some_spec (UV a.1 a.2)).2.1,
  have hUV : ∀ (a : A), (U ⟨a.1, a.2⟩ ∩ V ⟨a.1, a.2⟩ = ∅)
   := λ a, (classical.some_spec (UV a.1 a.2)).2.2.1,
  have hUVa : ∀ (a : A), (a.1 ∈ U ⟨a.1, a.2⟩)
   := λ a, (classical.some_spec (UV a.1 a.2)).2.2.2.1,
  have hUVy : ∀ (a : A), (y ∈ V ⟨a.1, a.2⟩)
   := λ a, (classical.some_spec (UV a.1 a.2)).2.2.2.2,
  have hAcov : A ⊆ ⋃₀ (U '' univ),
  {
    intros a ha,
    specialize hUVa ⟨a, ha⟩,
    simp only [mem_Union, sUnion_range, image_univ, set_coe.exists],
    exact ⟨a, ha, by simp [hUVa]⟩,
  },
  have hfin : ∃ (F : set X), F.finite ∧ (A ⊆ ⋃₀ (U '' {x : A | x.1 ∈ F})),
  {
    obtain ⟨F, ⟨hF1,hF2⟩⟩ := is_compact_set' _ h U hU hAcov,
    use coe '' F,
    simpa [finite.image coe hF1] using hF2,
  },
  obtain ⟨F, ⟨hf, h'⟩⟩ := hfin,
  have : fintype {a // a ∈ F},
  {
    apply fintype.of_finset (finite.to_finset hf),
    finish,
  },
  haveI: fintype {a // a ∈ F} := this,
  use ⋂₀ (V '' {x : A | x.1 ∈ F}),
  repeat {split},
  {
    apply is_open_sInter,--open_of_finite_set_opens,
    {
      apply finite.image,
      refine finite.preimage _ hf,
      dsimp,
      intros x2 hx2 aa haa htmp,
      exact subtype.eq htmp,
    },
    intros s hs,
    simp at hs,
    obtain ⟨x, ⟨hx1, ⟨hxA, rfl⟩⟩⟩ := hs,
    finish,
  },
  {
    ext,
    simp,
    intros hx hxA,
    specialize h' hxA,
    simp only [exists_prop, mem_Union, sUnion_image, set_coe.exists] at h',
    obtain ⟨z, ⟨hz1, ⟨hz2, hz3⟩⟩⟩ := h',
    specialize hUV ⟨z, hz1⟩,
    suffices : (U ⟨z, hz1⟩ ∩ V ⟨z, hz1⟩) ≠ ∅, by contradiction,
    apply nonempty.ne_empty,
    exact ⟨x, ⟨hz3, hx z hz1 hz2⟩⟩,
  },
  { simpa using λ x hx1 hx2, hUVy ⟨x, hx1⟩ }
end

lemma compact_in_T2_is_closed {A : set X} [hausdorff_space X] (h : is_compact_subset A) : is_closed A :=
begin
  have hAc : interior Aᶜ = Aᶜ,
  { apply subset.antisymm,
      {exact interior_subset_self Aᶜ},
    { intros x hxA,
      cases (for_compact_exist_open_disjont X h) x hxA with V hV,
      have hVAc : V ⊆ Aᶜ,
      { intros y hy,
        have hynA : y ∉ A,
        { intro hyA,
          have hyVA : y ∈ V ∩ A, by exact ⟨hy, hyA⟩,
          have hIe : V ∩ A ≠ ∅, by finish,
          exact hIe hV.2.1},
        exact mem_compl hynA},
      exact ⟨V, hV.1, hV.2.2, hVAc⟩}},
  rw [is_closed, ← hAc],
  exact (interior_is_open Aᶜ),
end


import data.real.basic

-- BEGIN
example {x y : ℝ} : x ≤ y ∧ ¬ y ≤ x ↔ x ≤ y ∧ x ≠ y :=
begin
  split,
    intro hl,
    cases hl with hl1 hl2,
    split,
    exact hl1,
    contrapose! hl2,
    rw hl2,

    intro hr,
    cases hr with hr1 hr2,
    split,
    exact hr1,
    contrapose! hr2,
    exact le_antisymm hr1 hr2,
end
-- END


-- ---------------------------------------------------------------------
-- Ejercicio. Sean a y b números reales. Demostrar que
--    |a| - |b| ≤ |a - b|
-- ----------------------------------------------------------------------

import data.real.basic

variables a b : ℝ

example : |a| - |b| ≤ |a - b| :=
calc |a| - |b|
     = |a - b + b| - |b|     : by simp
 ... ≤ (|a - b| + |b|) - |b| : sub_le_sub_right (abs_add (a - b) b) (|b|)
 ... = |a - b|               : add_sub_cancel (|a - b|) (|b|)


/-
Design challenge: how to represent problems that require "determining" a set.
------------------------------------------------------------------------------

Consider the following problem:

"""
[IMO 2019, Problem 1]
Let ℤ be the set of integers. Determine all functions f : ℤ → ℤ such that, for all integers a and b,
f(2a) + 2f(b) = f(f(a+b))
"""
-/

-- Consider the following naive formulation:

notation `ℤ` := Int
def Set (X : Type) : Type := X → Prop
def Set.mem {X : Type} (x : X) (s : Set X) : Prop := s x

def determineNaive {X : Type} (s₀ : Set X) : Type :=
{ s : Set X // ∀ x, s.mem x ↔ s₀.mem x }

def IMO_2019_Problem_1_naive : Type :=
determineNaive $ λ (f : ℤ → ℤ) => ∀ (a b : ℤ), f (2 * a) + 2 * f b = f (f (a + b))

-- However, this formulation admits the following degenerate solution:

example : IMO_2019_Problem_1_naive :=
⟨ λ (f : ℤ → ℤ) => ∀ (a b : ℤ), f (2 * a) + 2 * f b = f (f (a + b)), λ _ => Iff.refl _ ⟩

-- Clearly this answer should not be accepted!
-- We could in principle require the witness to be a decidable set:

def DecidableSet (X : Type) : Type := X → Bool
def DecidableSet.mem {X : Type} (x : X) (s : DecidableSet X) : Bool := s x

def determineDecidable {X : Type} (s₀ : Set X) : Type :=
{ s : DecidableSet X // ∀ (x : X), s.mem x ↔ s₀.mem x }

def IMO_2019_Problem_1_decidable_set : Type :=
determineDecidable $ λ (f : ℤ → ℤ) => ∀ (a b : ℤ), f (2 * a) + 2 * f b = f (f (a + b))

-- Unfortunately, this formulation does not work either, since equality of functions is not decidable.

-- A third attempt is to wrap different types of acceptable solutions into an inductive type:

def List.mem {X : Type} (x₀ : X) : List X → Prop
| []    => false
| x::xs => x = x₀ ∨ List.mem xs

inductive SolutionSet (X : Type)
| finite            : List X → SolutionSet
| countablyInfinite : (Nat → X) → SolutionSet

def SolutionSet.mem {X : Type} (x : X) : SolutionSet X → Prop
| SolutionSet.finite xs            => List.mem x xs
| SolutionSet.countablyInfinite φ  => Exists $ λ (n : Nat) => x = φ n

def determineSolutionSet (X : Type) (s₀ : Set X) : Type :=
{ s : SolutionSet X // ∀ (x : X), s.mem x ↔ s₀.mem x }

-- Unfortunately, it is not obvious how to make this approach workable for uncountable sets.
-- (It seems reasonable for a solution to be e.g. { x : ℝ // x > 0 ∧ x < 1 })

-- Even worse, @fpvandoorn points out that choice could produce a SolutionSet that could
-- be proved correct from only a proof that the desired set is countable.
-- Similar issues could plague the other approaches as well.

-- From @fpvandoorn: "Even finiteness is too weak. Suppose a program
-- proves that if (n,k) is a solution to IMO 2019-4, then the
-- inequality n, k < 10^(10^100) holds. We can then apply the
-- degenerate solution. A human solution like that will be rejected
-- (you are not allowed to omit a finite but infeasible amount of
-- work)."

/-
Tentative proposal:

We fear it may be very difficult to formalize a "reasonable" solution
adequately, to simultaneously allow all acceptable solutions and to
disallow all degenerate ones, for all future problems. However, we
expect that for a given witness, there will be broad consensus on
whether or not it constitutes an acceptable solution.

Thus, in the absense of a solution to this design challenge, we
propose that witnesses will be inspected by humans and are required to
be deemed 'reasonable'. Note that proofs will not be inspected by
humans.
-/


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

! This file was ported from Lean 3 source module data.nat.psub
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Option.Basic
import Mathbin.Data.Nat.Basic

/-!
# Partial predecessor and partial subtraction on the natural numbers

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

The usual definition of natural number subtraction (`nat.sub`) returns 0 as a "garbage value" for
`a - b` when `a < b`. Similarly, `nat.pred 0` is defined to be `0`. The functions in this file
wrap the result in an `option` type instead:

## Main definitions

- `nat.ppred`: a partial predecessor operation
- `nat.psub`: a partial subtraction operation

-/

namespace Nat

#print Nat.ppred /-
/-- Partial predecessor operation. Returns `ppred n = some m`
  if `n = m + 1`, otherwise `none`. -/
@[simp]
def ppred : ℕ → Option ℕ
  | 0 => none
  | n + 1 => some n
#align nat.ppred Nat.ppred
-/

#print Nat.psub /-
/-- Partial subtraction operation. Returns `psub m n = some k`
  if `m = n + k`, otherwise `none`. -/
@[simp]
def psub (m : ℕ) : ℕ → Option ℕ
  | 0 => some m
  | n + 1 => psub n >>= ppred
#align nat.psub Nat.psub
-/

#print Nat.pred_eq_ppred /-
theorem pred_eq_ppred (n : ℕ) : pred n = (ppred n).getD 0 := by cases n <;> rfl
#align nat.pred_eq_ppred Nat.pred_eq_ppred
-/

#print Nat.sub_eq_psub /-
theorem sub_eq_psub (m : ℕ) : ∀ n, m - n = (psub m n).getD 0
  | 0 => rfl
  | n + 1 => (pred_eq_ppred (m - n)).trans <| by rw [sub_eq_psub, psub] <;> cases psub m n <;> rfl
#align nat.sub_eq_psub Nat.sub_eq_psub
-/

#print Nat.ppred_eq_some /-
@[simp]
theorem ppred_eq_some {m : ℕ} : ∀ {n}, ppred n = some m ↔ succ m = n
  | 0 => by constructor <;> intro h <;> contradiction
  | n + 1 => by dsimp <;> constructor <;> intro h <;> injection h <;> subst n
#align nat.ppred_eq_some Nat.ppred_eq_some
-/

#print Nat.ppred_eq_none /-
@[simp]
theorem ppred_eq_none : ∀ {n : ℕ}, ppred n = none ↔ n = 0
  | 0 => by simp
  | n + 1 => by dsimp <;> constructor <;> contradiction
#align nat.ppred_eq_none Nat.ppred_eq_none
-/

#print Nat.psub_eq_some /-
theorem psub_eq_some {m : ℕ} : ∀ {n k}, psub m n = some k ↔ k + n = m
  | 0, k => by simp [eq_comm]
  | n + 1, k => by
    dsimp
    apply option.bind_eq_some.trans
    simp [psub_eq_some, add_comm, add_left_comm, Nat.succ_eq_add_one]
#align nat.psub_eq_some Nat.psub_eq_some
-/

#print Nat.psub_eq_none /-
theorem psub_eq_none {m n : ℕ} : psub m n = none ↔ m < n :=
  by
  cases s : psub m n <;> simp [eq_comm]
  · show m < n
    refine' lt_of_not_ge fun h => _
    cases' le.dest h with k e
    injection s.symm.trans (psub_eq_some.2 <| (add_comm _ _).trans e)
  · show n ≤ m
    rw [← psub_eq_some.1 s]
    apply Nat.le_add_left
#align nat.psub_eq_none Nat.psub_eq_none
-/

#print Nat.ppred_eq_pred /-
theorem ppred_eq_pred {n} (h : 0 < n) : ppred n = some (pred n) :=
  ppred_eq_some.2 <| succ_pred_eq_of_pos h
#align nat.ppred_eq_pred Nat.ppred_eq_pred
-/

#print Nat.psub_eq_sub /-
theorem psub_eq_sub {m n} (h : n ≤ m) : psub m n = some (m - n) :=
  psub_eq_some.2 <| Nat.sub_add_cancel h
#align nat.psub_eq_sub Nat.psub_eq_sub
-/

/- warning: nat.psub_add -> Nat.psub_add is a dubious translation:
lean 3 declaration is
  forall (m : Nat) (n : Nat) (k : Nat), Eq.{1} (Option.{0} Nat) (Nat.psub m (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n k)) (Bind.bind.{0, 0} Option.{0} (Monad.toHasBind.{0, 0} Option.{0} Option.monad.{0}) Nat Nat (Nat.psub m n) (fun (x : Nat) => Nat.psub x k))
but is expected to have type
  forall (m : Nat) (n : Nat) (k : Nat), Eq.{1} (Option.{0} Nat) (Nat.psub m (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n k)) (Bind.bind.{0, 0} Option.{0} (Monad.toBind.{0, 0} Option.{0} instMonadOption.{0}) Nat Nat (Nat.psub m n) (fun (x : Nat) => Nat.psub x k))
Case conversion may be inaccurate. Consider using '#align nat.psub_add Nat.psub_addₓ'. -/
theorem psub_add (m n k) :
    psub m (n + k) = do
      let x ← psub m n
      psub x k :=
  by induction k <;> simp [*, add_succ, bind_assoc]
#align nat.psub_add Nat.psub_add

#print Nat.psub' /-
/-- Same as `psub`, but with a more efficient implementation. -/
@[inline]
def psub' (m n : ℕ) : Option ℕ :=
  if n ≤ m then some (m - n) else none
#align nat.psub' Nat.psub'
-/

#print Nat.psub'_eq_psub /-
theorem psub'_eq_psub (m n) : psub' m n = psub m n := by
  rw [psub'] <;> split_ifs <;> [exact (psub_eq_sub h).symm,
    exact (psub_eq_none.2 (not_le.1 h)).symm]
#align nat.psub'_eq_psub Nat.psub'_eq_psub
-/

end Nat


def egJsonSentenceSim : String := "[{'theorem': '{p : ℕ} [fact (nat.prime p)] : p % 2 = 1 ↔ p ≠ 2', 'doc_string': 'A prime `p` satisfies `p % 2 = 1` if and only if `p ≠ 2`.'}, {'theorem': '{n : ℕ} : n % 2 = 1 ↔ n % 4 = 1 ∨ n % 4 = 3', 'doc_string': 'A natural number is odd iff it has residue `1` or `3` mod `4`'}, {'theorem': '{p : ℕ} (hp : nat.prime p) : p.factorization = finsupp.single p 1', 'doc_string': 'The only prime factor of prime `p` is `p` itself, with multiplicity `1`'}, {'theorem': '{m n : ℕ} : even (m ^ n) ↔ even m ∧ n ≠ 0', 'doc_string': ' If `m` and `n` are natural numbers, then the natural number `m^n` is even if and only if `m` is even and `n` is positive.'}]"

def egSen : String := "[{\"statement\": \"theorem nat.prime.mod_two_eq_one_iff_ne_two {p : ℕ} [fact (nat.prime p)] : p % 2 = 1 ↔ p ≠ 2\", \"doc_string\": \"A prime `p` satisfies `p % 2 = 1` if and only if `p ≠ 2`.\", \"theorem\": \"{p : ℕ} [fact (nat.prime p)] : p % 2 = 1 ↔ p ≠ 2\"}, {\"statement\": \"theorem nat.odd_mod_four_iff {n : ℕ} : n % 2 = 1 ↔ n % 4 = 1 ∨ n % 4 = 3\", \"doc_string\": \"A natural number is odd iff it has residue `1` or `3` mod `4`\", \"theorem\": \"{n : ℕ} : n % 2 = 1 ↔ n % 4 = 1 ∨ n % 4 = 3\"}, {\"statement\": \"theorem nat.factorization_eq_zero_iff (n : ℕ) : n.factorization = 0 ↔ n = 0 ∨ n = 1\", \"doc_string\": \"The only numbers with empty prime factorization are `0` and `1`\", \"theorem\": \"(n : ℕ) : n.factorization = 0 ↔ n = 0 ∨ n = 1\"}, {\"statement\": \"theorem nat.prime.factorization {p : ℕ} (hp : nat.prime p) : p.factorization = finsupp.single p 1\", \"doc_string\": \"The only prime factor of prime `p` is `p` itself, with multiplicity `1`\", \"theorem\": \"{p : ℕ} (hp : nat.prime p) : p.factorization = finsupp.single p 1\"}, {\"statement\": \"theorem nat.even_pow {m n : ℕ} : even (m ^ n) ↔ even m ∧ n ≠ 0\", \"doc_string\": \" If `m` and `n` are natural numbers, then the natural number `m^n` is even if and only if `m` is even and `n` is positive.\", \"theorem\": \"{m n : ℕ} : even (m ^ n) ↔ even m ∧ n ≠ 0\"}, {\"statement\": \"theorem is_prime_pow_iff_unique_prime_dvd {n : ℕ} : is_prime_pow n ↔ ∃! (p : ℕ), nat.prime p ∧ p ∣ n\", \"doc_string\": \" An equivalent definition for prime powers: `n` is a prime power iff there is a unique prime dividing it.\", \"theorem\": \"{n : ℕ} : is_prime_pow n ↔ ∃! (p : ℕ), nat.prime p ∧ p ∣ n\"}, {\"statement\": \"theorem nat.factorization_inj  : set.inj_on nat.factorization {x : ℕ | x ≠ 0}\", \"doc_string\": \"Every nonzero natural number has a unique prime factorization\", \"theorem\": \" : set.inj_on nat.factorization {x : ℕ | x ≠ 0}\"}, {\"statement\": \"theorem nat.mem_factors_mul_left {p a b : ℕ} (hpa : p ∈ a.factors) (hb : b ≠ 0) : p ∈ (a * b).factors\", \"doc_string\": \"If `p` is a prime factor of `a` then `p` is also a prime factor of `a * b` for any `b > 0`\", \"theorem\": \"{p a b : ℕ} (hpa : p ∈ a.factors) (hb : b ≠ 0) : p ∈ (a * b).factors\"}, {\"statement\": \"theorem gaussian_int.prime_iff_mod_four_eq_three_of_nat_prime (p : ℕ) [hp : fact (nat.prime p)] : prime ↑p ↔ p % 4 = 3\", \"doc_string\": \"A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4`\", \"theorem\": \"(p : ℕ) [hp : fact (nat.prime p)] : prime ↑p ↔ p % 4 = 3\"}]"

def egBlob' := "[{ \"text\" : \"{p : ℕ} (hp : Nat.Prime p) :  p = 2 ∨ p % 2 = 1 \"},
   { \"text\" : \"(p : ℕ) :  Nat.Prime p ↔ p = 2 ∨ p % 2 = 1 \"},
   { \"text\" : \"{p : ℕ} (hp : Nat.Prime p) : p = 2 ∨ p % 2 = 1 \"},
   { \"text\" : \"(n : ℕ) (hp : Nat.Prime n) : n = 2 ∨ n % 2 = 1 \"},
   { \"text\" : \"{p : ℕ} (hp : Nat.Prime p) : p = 2 ∨ p % 2 = 1 \"},
   { \"text\" : \"Nonsense output to test filtering\"}]"


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.finset.basic
import data.multiset.fold

/-!
# The fold operation for a commutative associative operation over a finset.
-/

namespace finset
open multiset

variables {α β γ : Type*}

/-! ### fold -/
section fold
variables (op : β → β → β) [hc : is_commutative β op] [ha : is_associative β op]
local notation a * b := op a b
include hc ha

/-- `fold op b f s` folds the commutative associative operation `op` over the
  `f`-image of `s`, i.e. `fold (+) b f {1,2,3} = f 1 + f 2 + f 3 + b`. -/
def fold (b : β) (f : α → β) (s : finset α) : β := (s.1.map f).fold op b

variables {op} {f : α → β} {b : β} {s : finset α} {a : α}

@[simp] theorem fold_empty : (∅ : finset α).fold op b f = b := rfl

@[simp] theorem fold_cons (h : a ∉ s) : (cons a s h).fold op b f = f a * s.fold op b f :=
by { dunfold fold, rw [cons_val, map_cons, fold_cons_left], }

@[simp] theorem fold_insert [decidable_eq α] (h : a ∉ s) :
  (insert a s).fold op b f = f a * s.fold op b f :=
by unfold fold; rw [insert_val, ndinsert_of_not_mem h, map_cons, fold_cons_left]

@[simp] theorem fold_singleton : ({a} : finset α).fold op b f = f a * b := rfl

@[simp]

@[simp] theorem fold_image [decidable_eq α] {g : γ → α} {s : finset γ}
  (H : ∀ (x ∈ s) (y ∈ s), g x = g y → x = y) : (s.image g).fold op b f = s.fold op b (f ∘ g) :=
by simp only [fold, image_val_of_inj_on H, multiset.map_map]

@[congr] theorem fold_congr {g : α → β} (H : ∀ x ∈ s, f x = g x) : s.fold op b f = s.fold op b g :=
by rw [fold, fold, map_congr rfl H]

theorem fold_op_distrib {f g : α → β} {b₁ b₂ : β} :
  s.fold op (b₁ * b₂) (λx, f x * g x) = s.fold op b₁ f * s.fold op b₂ g :=
by simp only [fold, fold_distrib]

lemma fold_const [decidable (s = ∅)] (c : β) (h : op c (op b c) = op b c) :
  finset.fold op b (λ _, c) s = if s = ∅ then b else op b c :=
begin
  classical,
  unfreezingI { induction s using finset.induction_on with x s hx IH },
  { simp },
  { simp only [finset.fold_insert hx, IH, if_false, finset.insert_ne_empty],
    split_ifs,
    { rw hc.comm },
    { exact h } }
end

theorem fold_hom {op' : γ → γ → γ} [is_commutative γ op'] [is_associative γ op']
  {m : β → γ} (hm : ∀x y, m (op x y) = op' (m x) (m y)) :
  s.fold op' (m b) (λx, m (f x)) = m (s.fold op b f) :=
by rw [fold, fold, ← fold_hom op hm, multiset.map_map]

theorem fold_union_inter [decidable_eq α] {s₁ s₂ : finset α} {b₁ b₂ : β} :
  (s₁ ∪ s₂).fold op b₁ f * (s₁ ∩ s₂).fold op b₂ f = s₁.fold op b₂ f * s₂.fold op b₁ f :=
by unfold fold; rw [← fold_add op, ← multiset.map_add, union_val,
     inter_val, union_add_inter, multiset.map_add, hc.comm, fold_add]

@[simp] theorem fold_insert_idem [decidable_eq α] [hi : is_idempotent β op] :
  (insert a s).fold op b f = f a * s.fold op b f :=
begin
  by_cases (a ∈ s),
  { rw [← insert_erase h], simp [← ha.assoc, hi.idempotent] },
  { apply fold_insert h },
end

theorem fold_image_idem [decidable_eq α] {g : γ → α} {s : finset γ}
  [hi : is_idempotent β op] :
  (image g s).fold op b f = s.fold op b (f ∘ g) :=
begin
  induction s using finset.cons_induction with x xs hx ih,
  { rw [fold_empty, image_empty, fold_empty] },
  { haveI := classical.dec_eq γ,
    rw [fold_cons, cons_eq_insert, image_insert, fold_insert_idem, ih], }
end

/-- A stronger version of `finset.fold_ite`, but relies on
an explicit proof of idempotency on the seed element, rather
than relying on typeclass idempotency over the whole type. -/
lemma fold_ite' {g : α → β} (hb : op b b = b)
  (p : α → Prop) [decidable_pred p] :
  finset.fold op b (λ i, ite (p i) (f i) (g i)) s =
  op (finset.fold op b f (s.filter p)) (finset.fold op b g (s.filter (λ i, ¬ p i))) :=
begin
  classical,
  induction s using finset.induction_on with x s hx IH,
  { simp [hb] },
  { simp only [finset.filter_congr_decidable, finset.fold_insert hx],
    split_ifs with h h,
    { have : x ∉ finset.filter p s,
      { simp [hx] },
      simp [finset.filter_insert, h, finset.fold_insert this, ha.assoc, IH] },
    { have : x ∉ finset.filter (λ i, ¬ p i) s,
      { simp [hx] },
      simp [finset.filter_insert, h, finset.fold_insert this, IH, ←ha.assoc, hc.comm] } }
end

/-- A weaker version of `finset.fold_ite'`,
relying on typeclass idempotency over the whole type,
instead of solely on the seed element.
However, this is easier to use because it does not generate side goals. -/
lemma fold_ite [is_idempotent β op] {g : α → β}
  (p : α → Prop) [decidable_pred p] :
  finset.fold op b (λ i, ite (p i) (f i) (g i)) s =
  op (finset.fold op b f (s.filter p)) (finset.fold op b g (s.filter (λ i, ¬ p i))) :=
fold_ite' (is_idempotent.idempotent _) _

lemma fold_op_rel_iff_and
  {r : β → β → Prop} (hr : ∀ {x y z}, r x (op y z) ↔ (r x y ∧ r x z)) {c : β} :
  r c (s.fold op b f) ↔ (r c b ∧ ∀ x∈s, r c (f x)) :=
begin
  classical,
  apply finset.induction_on s, { simp },
  clear s, intros a s ha IH,
  rw [finset.fold_insert ha, hr, IH, ← and_assoc, and_comm (r c (f a)), and_assoc],
  apply and_congr iff.rfl,
  split,
  { rintro ⟨h₁, h₂⟩, intros b hb, rw finset.mem_insert at hb,
    rcases hb with rfl|hb; solve_by_elim },
  { intro h, split,
    { exact h a (finset.mem_insert_self _ _), },
    { intros b hb, apply h b, rw finset.mem_insert, right, exact hb } }
end

lemma fold_op_rel_iff_or
  {r : β → β → Prop} (hr : ∀ {x y z}, r x (op y z) ↔ (r x y ∨ r x z)) {c : β} :
  r c (s.fold op b f) ↔ (r c b ∨ ∃ x∈s, r c (f x)) :=
begin
  classical,
  apply finset.induction_on s, { simp },
  clear s, intros a s ha IH,
  rw [finset.fold_insert ha, hr, IH, ← or_assoc, or_comm (r c (f a)), or_assoc],
  apply or_congr iff.rfl,
  split,
  { rintro (h₁|⟨x, hx, h₂⟩),
    { use a, simp [h₁] },
    { refine ⟨x, by simp [hx], h₂⟩ } },
  { rintro ⟨x, hx, h⟩,
    rw mem_insert at hx, cases hx,
    { left, rwa hx at h },
    { right, exact ⟨x, hx, h⟩ } }
end

omit hc ha

@[simp]
lemma fold_union_empty_singleton [decidable_eq α] (s : finset α) :
  finset.fold (∪) ∅ singleton s = s :=
begin
  apply finset.induction_on s,
  { simp only [fold_empty], },
  { intros a s has ih, rw [fold_insert has, ih, insert_eq], }
end

lemma fold_sup_bot_singleton [decidable_eq α] (s : finset α) :
  finset.fold (⊔) ⊥ singleton s = s :=
fold_union_empty_singleton s

section order
variables [linear_order β] (c : β)

lemma le_fold_min : c ≤ s.fold min b f ↔ (c ≤ b ∧ ∀ x∈s, c ≤ f x) :=
fold_op_rel_iff_and $ λ x y z, le_min_iff

lemma fold_min_le : s.fold min b f ≤ c ↔ (b ≤ c ∨ ∃ x∈s, f x ≤ c) :=
begin
  show _ ≥ _ ↔ _,
  apply fold_op_rel_iff_or,
  intros x y z,
  show _ ≤ _ ↔ _,
  exact min_le_iff
end

lemma lt_fold_min : c < s.fold min b f ↔ (c < b ∧ ∀ x∈s, c < f x) :=
fold_op_rel_iff_and $ λ x y z, lt_min_iff

lemma fold_min_lt : s.fold min b f < c ↔ (b < c ∨ ∃ x∈s, f x < c) :=
begin
  show _ > _ ↔ _,
  apply fold_op_rel_iff_or,
  intros x y z,
  show _ < _ ↔ _,
  exact min_lt_iff
end

lemma fold_max_le : s.fold max b f ≤ c ↔ (b ≤ c ∧ ∀ x∈s, f x ≤ c) :=
begin
  show _ ≥ _ ↔ _,
  apply fold_op_rel_iff_and,
  intros x y z,
  show _ ≤ _ ↔ _,
  exact max_le_iff
end

lemma le_fold_max : c ≤ s.fold max b f ↔ (c ≤ b ∨ ∃ x∈s, c ≤ f x) :=
fold_op_rel_iff_or $ λ x y z, le_max_iff

lemma fold_max_lt : s.fold max b f < c ↔ (b < c ∧ ∀ x∈s, f x < c) :=
begin
  show _ > _ ↔ _,
  apply fold_op_rel_iff_and,
  intros x y z,
  show _ < _ ↔ _,
  exact max_lt_iff
end

lemma lt_fold_max : c < s.fold max b f ↔ (c < b ∨ ∃ x∈s, c < f x) :=
fold_op_rel_iff_or $ λ x y z, lt_max_iff

end order

end fold

end finset


import Std

inductive Expr where
  | var (i : Nat)
  | op  (lhs rhs : Expr)
  deriving Inhabited, Repr

def List.getIdx : List α → Nat → α → α
  | [],    i,   u => u
  | a::as, 0,   u => a
  | a::as, i+1, u => getIdx as i u

structure Context (α : Type u) where
  op      : α → α → α
  assoc   : (a b c : α) → op (op a b) c = op a (op b c)
  comm    : (a b : α) → op a b = op b a
  vars    : List α
  someVal : α

theorem Context.left_comm (ctx : Context α) (a b c : α) : ctx.op a (ctx.op b c) = ctx.op b (ctx.op a c) := by
  rw [← ctx.assoc, ctx.comm a b, ctx.assoc]

def Expr.denote (ctx : Context α) : Expr → α
  | Expr.op a b => ctx.op (denote ctx a) (denote ctx b)
  | Expr.var i  => ctx.vars.getIdx i ctx.someVal

theorem Expr.denote_op (ctx : Context α) (a b : Expr) : denote ctx (Expr.op a b) = ctx.op (denote ctx a) (denote ctx b) :=
  rfl

def Expr.concat : Expr → Expr → Expr
  | Expr.op a b, c => Expr.op a (concat b c)
  | Expr.var i, c  => Expr.op (Expr.var i) c

theorem Expr.denote_concat (ctx : Context α) (a b : Expr) : denote ctx (concat a b) = denote ctx (Expr.op a b) := by
  induction a with
  | var i => rfl
  | op _ _ _ ih => simp [denote, ih, ctx.assoc]

def Expr.flat : Expr → Expr
  | Expr.op a b => concat (flat a) (flat b)
  | Expr.var i  => Expr.var i

theorem Expr.denote_flat (ctx : Context α) (e : Expr) : denote ctx (flat e) = denote ctx e := by
  induction e with
  | var i => rfl
  | op a b ih₁ ih₂ => simp [flat, denote, denote_concat, ih₁, ih₂]

theorem Expr.eq_of_flat (ctx : Context α) (a b : Expr) (h : flat a = flat b) : denote ctx a = denote ctx b := by
  have h := congrArg (denote ctx) h
  simp [denote_flat] at h
  assumption

def Expr.length : Expr → Nat
  | op a b => 1 + b.length
  | _      => 1

def Expr.sort (e : Expr) : Expr :=
  loop e.length e
where
  loop : Nat → Expr → Expr
    | fuel+1, Expr.op a e =>
      let (e₁, e₂) := swap a e
      Expr.op e₁ (loop fuel e₂)
    | _, e => e

  swap : Expr → Expr → Expr × Expr
    | Expr.var i, Expr.op (Expr.var j) e =>
      if i > j then
        let (e₁, e₂) := swap (Expr.var j) e
        (e₁, Expr.op (Expr.var i) e₂)
      else
        let (e₁, e₂) := swap (Expr.var i) e
        (e₁, Expr.op (Expr.var j) e₂)
    | Expr.var i, Expr.var j =>
      if i > j then
        (Expr.var j, Expr.var i)
      else
        (Expr.var i, Expr.var j)
    | e₁, e₂ => (e₁, e₂)

theorem Expr.denote_sort (ctx : Context α) (e : Expr) : denote ctx (sort e) = denote ctx e := by
  apply denote_loop
where
  denote_loop (n : Nat) (e : Expr) : denote ctx (sort.loop n e) = denote ctx e := by
    induction n generalizing e with
    | zero => rfl
    | succ n ih =>
      match e with
      | var _  => rfl
      | op a b =>
        simp [denote, sort.loop]
        match h:sort.swap a b with
        | (r₁, r₂) =>
          have hs := denote_swap a b
          rw [h] at hs
          simp [denote] at hs
          simp [denote, ih]
          assumption

  denote_swap (e₁ e₂ : Expr) : denote ctx (Expr.op (sort.swap e₁ e₂).1 (sort.swap e₁ e₂).2) = denote ctx (Expr.op e₁ e₂) := by
    induction e₂ generalizing e₁ with
    | op a b ih' ih =>
      clear ih'
      cases e₁ with
      | var i =>
        cases a with
        | var j =>
          byCases h : i > j
          focus
            simp [sort.swap, h]
            match h:sort.swap (var j) b with
            | (r₁, r₂) => simp; rw [denote_op (a := var i), ← ih]; simp [h, denote]; rw [Context.left_comm]
          focus
            simp [sort.swap, h]
            match h:sort.swap (var i) b with
            | (r₁, r₂) =>
              simp
              rw [denote_op (a := var i), denote_op (a := var j), Context.left_comm, ← denote_op (a := var i), ← ih]
              simp [h, denote]
              rw [Context.left_comm]
        | _ => rfl
      | _ => rfl
    | var j =>
      cases e₁ with
      | var i =>
        byCases h : i > j
        focus simp [sort.swap, h, denote, Context.comm]
        focus simp [sort.swap, h]
      | _ => rfl

theorem Expr.eq_of_sort_flat (ctx : Context α) (a b : Expr) (h : sort (flat a) = sort (flat b)) : denote ctx a = denote ctx b := by
  have h := congrArg (denote ctx) h
  simp [denote_flat, denote_sort] at h
  assumption

theorem ex₁ (x₁ x₂ x₃ x₄ : Nat) : (x₁ + x₂) + (x₃ + x₄) = x₁ + x₂ + x₃ + x₄ :=
  Expr.eq_of_flat
    { op      := Nat.add
      assoc   := Nat.add_assoc
      comm    := Nat.add_comm
      vars    := [x₁, x₂, x₃, x₄],
      someVal := x₁ }
    (Expr.op (Expr.op (Expr.var 0) (Expr.var 1)) (Expr.op (Expr.var 2) (Expr.var 3)))
    (Expr.op (Expr.op (Expr.op (Expr.var 0) (Expr.var 1)) (Expr.var 2)) (Expr.var 3))
    rfl

theorem ex₂ (x₁ x₂ x₃ x₄ : Nat) : (x₁ + x₂) + (x₃ + x₄) = x₃ + x₁ + x₂ + x₄ :=
  Expr.eq_of_sort_flat
    { op      := Nat.add
      assoc   := Nat.add_assoc
      comm    := Nat.add_comm
      vars    := [x₁, x₂, x₃, x₄],
      someVal := x₁ }
    (Expr.op (Expr.op (Expr.var 0) (Expr.var 1)) (Expr.op (Expr.var 2) (Expr.var 3)))
    (Expr.op (Expr.op (Expr.op (Expr.var 2) (Expr.var 0)) (Expr.var 1)) (Expr.var 3))
    rfl

#print ex₂


/-
Copyright (c) 2020 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import logic.encodable.basic
import order.atoms
import order.upper_lower

/-!
# Order ideals, cofinal sets, and the Rasiowa–Sikorski lemma

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections require more
structure, such as a bottom element, a top element, or a join-semilattice structure.
- `order.ideal P`: the type of nonempty, upward directed, and downward closed subsets of `P`.
  Dual to the notion of a filter on a preorder.
- `order.is_ideal P`: a predicate for when a `set P` is an ideal.
- `order.ideal.principal p`: the principal ideal generated by `p : P`.
- `order.ideal.is_proper P`: a predicate for proper ideals.
  Dual to the notion of a proper filter.
- `order.ideal.is_maximal`: a predicate for maximal ideals.
  Dual to the notion of an ultrafilter.
- `order.cofinal P`: the type of subsets of `P` containing arbitrarily large elements.
  Dual to the notion of 'dense set' used in forcing.
- `order.ideal_of_cofinals p 𝒟`, where `p : P`, and `𝒟` is a countable family of cofinal
  subsets of P: an ideal in `P` which contains `p` and intersects every set in `𝒟`. (This a form
  of the Rasiowa–Sikorski lemma.)

## References

- <https://en.wikipedia.org/wiki/Ideal_(order_theory)>
- <https://en.wikipedia.org/wiki/Cofinal_(mathematics)>
- <https://en.wikipedia.org/wiki/Rasiowa%E2%80%93Sikorski_lemma>

Note that for the Rasiowa–Sikorski lemma, Wikipedia uses the opposite ordering on `P`,
in line with most presentations of forcing.

## Tags

ideal, cofinal, dense, countable, generic

-/

open function set

namespace order

variables {P : Type*}

/-- An ideal on an order `P` is a subset of `P` that is
  - nonempty
  - upward directed (any pair of elements in the ideal has an upper bound in the ideal)
  - downward closed (any element less than an element of the ideal is in the ideal). -/
structure ideal (P) [has_le P] extends lower_set P :=
(nonempty'  : carrier.nonempty)
(directed'  : directed_on (≤) carrier)

/-- A subset of a preorder `P` is an ideal if it is
  - nonempty
  - upward directed (any pair of elements in the ideal has an upper bound in the ideal)
  - downward closed (any element less than an element of the ideal is in the ideal). -/
@[mk_iff] structure is_ideal {P} [has_le P] (I : set P) : Prop :=
(is_lower_set : is_lower_set I)
(nonempty : I.nonempty)
(directed : directed_on (≤) I)

/-- Create an element of type `order.ideal` from a set satisfying the predicate
`order.is_ideal`. -/
def is_ideal.to_ideal [has_le P] {I : set P} (h : is_ideal I) : ideal P :=
⟨⟨I, h.is_lower_set⟩, h.nonempty, h.directed⟩

namespace ideal
section has_le
variables [has_le P]

section
variables {I J s t : ideal P} {x y : P}

lemma to_lower_set_injective : injective (to_lower_set : ideal P → lower_set P) :=
λ s t h, by { cases s, cases t, congr' }

instance : set_like (ideal P) P :=
{ coe := λ s, s.carrier,
  coe_injective' := λ s t h, to_lower_set_injective $ set_like.coe_injective h }

@[ext] lemma ext {s t : ideal P} : (s : set P) = t → s = t := set_like.ext'

@[simp] lemma carrier_eq_coe (s : ideal P) : s.carrier = s := rfl
@[simp] lemma coe_to_lower_set (s : ideal P) : (s.to_lower_set : set P) = s := rfl

protected lemma lower (s : ideal P) : is_lower_set (s : set P) := s.lower'
protected lemma nonempty (s : ideal P) : (s : set P).nonempty := s.nonempty'
protected lemma directed (s : ideal P) : directed_on (≤) (s : set P) := s.directed'
protected lemma is_ideal (s : ideal P) : is_ideal (s : set P) := ⟨s.lower, s.nonempty, s.directed⟩

lemma mem_compl_of_ge {x y : P} : x ≤ y → x ∈ (I : set P)ᶜ → y ∈ (I : set P)ᶜ := λ h, mt $ I.lower h

/-- The partial ordering by subset inclusion, inherited from `set P`. -/
instance : partial_order (ideal P) := partial_order.lift coe set_like.coe_injective

@[simp] lemma coe_subset_coe : (s : set P) ⊆ t ↔ s ≤ t := iff.rfl
@[simp] lemma coe_ssubset_coe : (s : set P) ⊂ t ↔ s < t := iff.rfl

@[trans] lemma mem_of_mem_of_le {x : P} {I J : ideal P} : x ∈ I → I ≤ J → x ∈ J :=
@set.mem_of_mem_of_subset P x I J

/-- A proper ideal is one that is not the whole set.
    Note that the whole set might not be an ideal. -/
@[mk_iff] class is_proper (I : ideal P) : Prop := (ne_univ : (I : set P) ≠ univ)

lemma is_proper_of_not_mem {I : ideal P} {p : P} (nmem : p ∉ I) : is_proper I :=
⟨λ hp, begin
  change p ∉ ↑I at nmem,
  rw hp at nmem,
  exact nmem (mem_univ p),
end⟩

/-- An ideal is maximal if it is maximal in the collection of proper ideals.

Note that `is_coatom` is less general because ideals only have a top element when `P` is directed
and nonempty. -/
@[mk_iff] class is_maximal (I : ideal P) extends is_proper I : Prop :=
(maximal_proper : ∀ ⦃J : ideal P⦄, I < J → (J : set P) = univ)

lemma inter_nonempty [is_directed P (≥)] (I J : ideal P) : (I ∩ J : set P).nonempty :=
begin
  obtain ⟨a, ha⟩ := I.nonempty,
  obtain ⟨b, hb⟩ := J.nonempty,
  obtain ⟨c, hac, hbc⟩ := exists_le_le a b,
  exact ⟨c, I.lower hac ha, J.lower hbc hb⟩,
end

end

section directed
variables [is_directed P (≤)] [nonempty P] {I : ideal P}

/-- In a directed and nonempty order, the top ideal of a is `univ`. -/
instance : order_top (ideal P) :=
{ top := ⟨⊤, univ_nonempty, directed_on_univ⟩,
  le_top := λ I, le_top }

@[simp] lemma top_to_lower_set : (⊤ : ideal P).to_lower_set = ⊤ := rfl
@[simp] lemma coe_top : ((⊤ : ideal P) : set P) = univ := rfl

lemma is_proper_of_ne_top (ne_top : I ≠ ⊤) : is_proper I := ⟨λ h, ne_top $ ext h⟩

lemma is_proper.ne_top (hI : is_proper I) : I ≠ ⊤ := λ h, is_proper.ne_univ $ congr_arg coe h

lemma _root_.is_coatom.is_proper (hI : is_coatom I) : is_proper I := is_proper_of_ne_top hI.1

lemma is_proper_iff_ne_top : is_proper I ↔ I ≠ ⊤ := ⟨λ h, h.ne_top, λ h, is_proper_of_ne_top h⟩

lemma is_maximal.is_coatom (h : is_maximal I) : is_coatom I :=
⟨is_maximal.to_is_proper.ne_top, λ J h, ext $ is_maximal.maximal_proper h⟩

lemma is_maximal.is_coatom' [is_maximal I] : is_coatom I := is_maximal.is_coatom ‹_›

lemma _root_.is_coatom.is_maximal (hI : is_coatom I) : is_maximal I :=
{ maximal_proper := λ _ _, by simp [hI.2 _ ‹_›],
  ..is_coatom.is_proper ‹_› }

lemma is_maximal_iff_is_coatom : is_maximal I ↔ is_coatom I := ⟨λ h, h.is_coatom, λ h, h.is_maximal⟩

end directed

section order_bot
variables [order_bot P]

@[simp] lemma bot_mem (s : ideal P) : ⊥ ∈ s := s.lower bot_le s.nonempty.some_mem

end order_bot

section order_top
variables [order_top P] {I : ideal P}

lemma top_of_top_mem (h : ⊤ ∈ I) : I = ⊤ := by { ext, exact iff_of_true (I.lower le_top h) trivial }

lemma is_proper.top_not_mem (hI : is_proper I) : ⊤ ∉ I := λ h, hI.ne_top $ top_of_top_mem h

end order_top
end has_le

section preorder
variables [preorder P]

section
variables {I J : ideal P} {x y : P}

/-- The smallest ideal containing a given element. -/
@[simps] def principal (p : P) : ideal P :=
{ to_lower_set := lower_set.Iic p,
  nonempty' := nonempty_Iic,
  directed' := λ x hx y hy, ⟨p, le_rfl, hx, hy⟩ }

instance [inhabited P] : inhabited (ideal P) := ⟨ideal.principal default⟩

@[simp] lemma principal_le_iff : principal x ≤ I ↔ x ∈ I :=
⟨λ h, h le_rfl, λ hx y hy, I.lower hy hx⟩

@[simp] lemma mem_principal : x ∈ principal y ↔ x ≤ y := iff.rfl

end

section order_bot
variables [order_bot P]

/-- There is a bottom ideal when `P` has a bottom element. -/
instance : order_bot (ideal P) :=
{ bot := principal ⊥,
  bot_le := by simp }

@[simp] lemma principal_bot : principal (⊥ : P) = ⊥ := rfl

end order_bot

section order_top
variables [order_top P]

@[simp] lemma principal_top : principal (⊤ : P) = ⊤ := to_lower_set_injective $ lower_set.Iic_top

end order_top
end preorder

section semilattice_sup
variables [semilattice_sup P] {x y : P} {I s : ideal P}

/-- A specific witness of `I.directed` when `P` has joins. -/
lemma sup_mem (hx : x ∈ s) (hy : y ∈ s) : x ⊔ y ∈ s :=
let ⟨z, hz, hx, hy⟩ := s.directed x hx y hy in s.lower (sup_le hx hy) hz

@[simp] lemma sup_mem_iff : x ⊔ y ∈ I ↔ x ∈ I ∧ y ∈ I :=
⟨λ h, ⟨I.lower le_sup_left h, I.lower le_sup_right h⟩, λ h, sup_mem h.1 h.2⟩

end semilattice_sup

section semilattice_sup_directed
variables [semilattice_sup P] [is_directed P (≥)] {x : P} {I J K s t : ideal P}

/-- The infimum of two ideals of a co-directed order is their intersection. -/
instance : has_inf (ideal P) :=
⟨λ I J, { to_lower_set := I.to_lower_set ⊓ J.to_lower_set,
  nonempty' := inter_nonempty I J,
  directed' := λ x hx y hy, ⟨x ⊔ y, ⟨sup_mem hx.1 hy.1, sup_mem hx.2 hy.2⟩, by simp⟩ }⟩

/-- The supremum of two ideals of a co-directed order is the union of the down sets of the pointwise
supremum of `I` and `J`. -/
instance : has_sup (ideal P) :=
⟨λ I J, { carrier   := {x | ∃ (i ∈ I) (j ∈ J), x ≤ i ⊔ j},
  nonempty' := by { cases inter_nonempty I J, exact ⟨w, w, h.1, w, h.2, le_sup_left⟩ },
  directed' := λ x ⟨xi, _, xj, _, _⟩ y ⟨yi, _, yj, _, _⟩,
    ⟨x ⊔ y,
     ⟨xi ⊔ yi, sup_mem ‹_› ‹_›,
      xj ⊔ yj, sup_mem ‹_› ‹_›,
      sup_le
        (calc x ≤ xi ⊔ xj               : ‹_›
         ...    ≤ (xi ⊔ yi) ⊔ (xj ⊔ yj) : sup_le_sup le_sup_left le_sup_left)
        (calc y ≤ yi ⊔ yj               : ‹_›
         ...    ≤ (xi ⊔ yi) ⊔ (xj ⊔ yj) : sup_le_sup le_sup_right le_sup_right)⟩,
     le_sup_left, le_sup_right⟩,
  lower' := λ x y h ⟨yi, _, yj, _, _⟩, ⟨yi, ‹_›, yj, ‹_›, h.trans ‹_›⟩ }⟩

instance : lattice (ideal P) :=
{ sup          := (⊔),
  le_sup_left  := λ I J (i ∈ I), by { cases J.nonempty, exact ⟨i, ‹_›, w, ‹_›, le_sup_left⟩ },
  le_sup_right := λ I J (j ∈ J), by { cases I.nonempty, exact ⟨w, ‹_›, j, ‹_›, le_sup_right⟩ },
  sup_le       := λ I J K hIK hJK a ⟨i, hi, j, hj, ha⟩,
    K.lower ha $ sup_mem (mem_of_mem_of_le hi hIK) (mem_of_mem_of_le hj hJK),
  inf          := (⊓),
  inf_le_left  := λ I J, inter_subset_left I J,
  inf_le_right := λ I J, inter_subset_right I J,
  le_inf       := λ I J K, subset_inter,
  .. ideal.partial_order }

@[simp] lemma coe_sup : ↑(s ⊔ t) = {x | ∃ (a ∈ s) (b ∈ t), x ≤ a ⊔ b} := rfl
@[simp] lemma coe_inf : (↑(s ⊓ t) : set P) = s ∩ t := rfl
@[simp] lemma mem_inf : x ∈ I ⊓ J ↔ x ∈ I ∧ x ∈ J := iff.rfl
@[simp] lemma mem_sup : x ∈ I ⊔ J ↔ ∃ (i ∈ I) (j ∈ J), x ≤ i ⊔ j := iff.rfl

lemma lt_sup_principal_of_not_mem (hx : x ∉ I) : I < I ⊔ principal x :=
le_sup_left.lt_of_ne $ λ h, hx $ by simpa only [left_eq_sup, principal_le_iff] using h

end semilattice_sup_directed

section semilattice_sup_order_bot
variables [semilattice_sup P] [order_bot P] {x : P} {I J K : ideal P}

instance : has_Inf (ideal P) :=
⟨λ S, { to_lower_set := ⨅ s ∈ S, to_lower_set s,
  nonempty' := ⟨⊥, begin
    rw [lower_set.carrier_eq_coe, lower_set.coe_infi₂, set.mem_Inter₂],
    exact λ s _, s.bot_mem,
  end⟩,
  directed' := λ a ha b hb, ⟨a ⊔ b, ⟨
    begin
      rw [lower_set.carrier_eq_coe, lower_set.coe_infi₂, set.mem_Inter₂] at ⊢ ha hb,
      exact λ s hs, sup_mem (ha _ hs) (hb _ hs),
    end,
    le_sup_left, le_sup_right⟩⟩ }⟩

variables {S : set (ideal P)}

@[simp] lemma coe_Inf : (↑(Inf S) : set P) = ⋂ s ∈ S, ↑s := lower_set.coe_infi₂ _

@[simp] lemma mem_Inf : x ∈ Inf S ↔ ∀ s ∈ S, x ∈ s :=
by simp_rw [←set_like.mem_coe, coe_Inf, mem_Inter₂]

instance : complete_lattice (ideal P) :=
{ ..ideal.lattice,
  ..complete_lattice_of_Inf (ideal P) (λ S, begin
    refine ⟨λ s hs, _, λ s hs, by rwa [←coe_subset_coe, coe_Inf, subset_Inter₂_iff]⟩,
    rw [←coe_subset_coe, coe_Inf],
    exact bInter_subset_of_mem hs,
  end) }

end semilattice_sup_order_bot

section distrib_lattice

variables [distrib_lattice P]
variables {I J : ideal P}

lemma eq_sup_of_le_sup {x i j: P} (hi : i ∈ I) (hj : j ∈ J) (hx : x ≤ i ⊔ j) :
  ∃ (i' ∈ I) (j' ∈ J), x = i' ⊔ j' :=
begin
  refine ⟨x ⊓ i, I.lower inf_le_right hi, x ⊓ j, J.lower inf_le_right hj, _⟩,
  calc
  x    = x ⊓ (i ⊔ j)       : left_eq_inf.mpr hx
  ...  = (x ⊓ i) ⊔ (x ⊓ j) : inf_sup_left,
end

lemma coe_sup_eq : ↑(I ⊔ J) = {x | ∃ i ∈ I, ∃ j ∈ J, x = i ⊔ j} :=
set.ext $ λ _, ⟨λ ⟨_, _, _, _, _⟩, eq_sup_of_le_sup ‹_› ‹_› ‹_›,
  λ ⟨i, _, j, _, _⟩, ⟨i, ‹_›, j, ‹_›, le_of_eq ‹_›⟩⟩

end distrib_lattice

section boolean_algebra

variables [boolean_algebra P] {x : P} {I : ideal P}

lemma is_proper.not_mem_of_compl_mem (hI : is_proper I) (hxc : xᶜ ∈ I) : x ∉ I :=
begin
  intro hx,
  apply hI.top_not_mem,
  have ht : x ⊔ xᶜ ∈ I := sup_mem ‹_› ‹_›,
  rwa sup_compl_eq_top at ht,
end

lemma is_proper.not_mem_or_compl_not_mem (hI : is_proper I) : x ∉ I ∨ xᶜ ∉ I :=
have h : xᶜ ∈ I → x ∉ I := hI.not_mem_of_compl_mem, by tauto

end boolean_algebra

end ideal

/-- For a preorder `P`, `cofinal P` is the type of subsets of `P`
  containing arbitrarily large elements. They are the dense sets in
  the topology whose open sets are terminal segments. -/
structure cofinal (P) [preorder P] :=
(carrier : set P)
(mem_gt  : ∀ x : P, ∃ y ∈ carrier, x ≤ y)

namespace cofinal

variables [preorder P]

instance : inhabited (cofinal P) :=
⟨{ carrier := univ, mem_gt := λ x, ⟨x, trivial, le_rfl⟩ }⟩

instance : has_mem P (cofinal P) := ⟨λ x D, x ∈ D.carrier⟩

variables (D : cofinal P) (x : P)
/-- A (noncomputable) element of a cofinal set lying above a given element. -/
noncomputable def above : P := classical.some $ D.mem_gt x

lemma above_mem : D.above x ∈ D :=
exists.elim (classical.some_spec $ D.mem_gt x) $ λ a _, a

lemma le_above : x ≤ D.above x :=
exists.elim (classical.some_spec $ D.mem_gt x) $ λ _ b, b

end cofinal

section ideal_of_cofinals

variables [preorder P] (p : P) {ι : Type*} [encodable ι] (𝒟 : ι → cofinal P)

/-- Given a starting point, and a countable family of cofinal sets,
  this is an increasing sequence that intersects each cofinal set. -/
noncomputable def sequence_of_cofinals : ℕ → P
| 0 := p
| (n+1) := match encodable.decode ι n with
           | none   := sequence_of_cofinals n
           | some i := (𝒟 i).above (sequence_of_cofinals n)
           end

lemma sequence_of_cofinals.monotone : monotone (sequence_of_cofinals p 𝒟) :=
by { apply monotone_nat_of_le_succ, intros n, dunfold sequence_of_cofinals,
  cases encodable.decode ι n, { refl }, { apply cofinal.le_above }, }

lemma sequence_of_cofinals.encode_mem (i : ι) :
  sequence_of_cofinals p 𝒟 (encodable.encode i + 1) ∈ 𝒟 i :=
by { dunfold sequence_of_cofinals, rw encodable.encodek, apply cofinal.above_mem, }

/-- Given an element `p : P` and a family `𝒟` of cofinal subsets of a preorder `P`,
  indexed by a countable type, `ideal_of_cofinals p 𝒟` is an ideal in `P` which
  - contains `p`, according to `mem_ideal_of_cofinals p 𝒟`, and
  - intersects every set in `𝒟`, according to `cofinal_meets_ideal_of_cofinals p 𝒟`.

  This proves the Rasiowa–Sikorski lemma. -/
def ideal_of_cofinals : ideal P :=
{ carrier   := { x : P | ∃ n, x ≤ sequence_of_cofinals p 𝒟 n },
  lower'     := λ x y hxy ⟨n, hn⟩, ⟨n, le_trans hxy hn⟩,
  nonempty' := ⟨p, 0, le_rfl⟩,
  directed' := λ x ⟨n, hn⟩ y ⟨m, hm⟩,
               ⟨_, ⟨max n m, le_rfl⟩,
               le_trans hn $ sequence_of_cofinals.monotone p 𝒟 (le_max_left _ _),
               le_trans hm $ sequence_of_cofinals.monotone p 𝒟 (le_max_right _ _) ⟩ }

lemma mem_ideal_of_cofinals : p ∈ ideal_of_cofinals p 𝒟 := ⟨0, le_rfl⟩

/-- `ideal_of_cofinals p 𝒟` is `𝒟`-generic. -/
lemma cofinal_meets_ideal_of_cofinals (i : ι) : ∃ x : P, x ∈ 𝒟 i ∧ x ∈ ideal_of_cofinals p 𝒟 :=
⟨_, sequence_of_cofinals.encode_mem p 𝒟 i, _, le_rfl⟩

end ideal_of_cofinals

end order


/-
Copyright (c) 2020 Ruben Van de Velde. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import data.int.parity
import ring_theory.int.basic
import ring_theory.prime

/-- Being equal to `4` or odd. -/
def odd_prime_or_four (z : ℤ) : Prop :=
  z = 4 ∨ (prime z ∧ odd z)

lemma odd_prime_or_four.ne_zero {z : ℤ} (h : odd_prime_or_four z) : z ≠ 0 :=
begin
  obtain rfl|⟨h, -⟩ := h,
  { norm_num },
  { exact h.ne_zero }
end

lemma odd_prime_or_four.ne_one {z : ℤ} (h : odd_prime_or_four z) : z ≠ 1 :=
begin
  obtain rfl|⟨h, -⟩ := h,
  { norm_num },
  { exact h.ne_one }
end

lemma odd_prime_or_four.one_lt_abs {z : ℤ} (h : odd_prime_or_four z) : 1 < abs z :=
begin
  obtain rfl|⟨h, -⟩ := h,
  { rw int.abs_eq_nat_abs, norm_cast, norm_num },
  { rw int.abs_eq_nat_abs,
    rw int.prime_iff_nat_abs_prime at h,
    norm_cast,
    exact h.one_lt, }
end

lemma odd_prime_or_four.not_unit {z : ℤ} (h : odd_prime_or_four z) : ¬ is_unit z :=
begin
  obtain rfl|⟨h, -⟩ := h,
  { rw is_unit_iff_dvd_one, norm_num },
  { exact h.not_unit }
end

lemma odd_prime_or_four.abs {z : ℤ} (h : odd_prime_or_four z) : odd_prime_or_four (abs z) :=
begin
  obtain rfl|⟨hp, ho⟩ := h,
  { left, rw abs_eq_self, norm_num },
  { right, exact ⟨hp.abs, odd_abs.mpr ho⟩ }
end

lemma odd_prime_or_four.exists_and_dvd
  {n : ℤ} (n2 : 2 < n) : ∃ p, p ∣ n ∧ odd_prime_or_four p :=
begin
  lift n to ℕ using (zero_lt_two.trans n2).le,
  norm_cast at n2,
  obtain ⟨k, rfl⟩|⟨p, hp, hdvd, hodd⟩ := n.eq_two_pow_or_exists_odd_prime_and_dvd,
  { refine ⟨4, ⟨2 ^ (k - 2), _⟩, or.inl rfl⟩,
    norm_cast,
    calc 2 ^ k
        = 2 ^ 2 * 2 ^ (k - 2) : (pow_mul_pow_sub _ _).symm
    ... = 4 * 2 ^ (k - 2) : by norm_num,

    rcases k with (_|_|_),
    { exfalso, norm_num at n2 },
    { exfalso, exact lt_irrefl _ n2 },
    { exact le_add_self } },
  { rw nat.prime_iff_prime_int at hp,
    rw ←int.odd_coe_nat at hodd,
    exact ⟨p, int.coe_nat_dvd.mpr hdvd, or.inr ⟨hp, hodd⟩⟩ },
end

lemma associated_of_dvd {a p : ℤ}
  (ha : odd_prime_or_four a)
  (hp : odd_prime_or_four p)
  (h: p ∣ a) : associated p a :=
begin
  obtain (rfl|⟨ap, aodd⟩) := ha;
  obtain (rfl|⟨pp, podd⟩) := hp,
  { refl },
  { exfalso,
    have h0 : (4 : ℤ) = 2 ^ 2,
    { norm_num },
    rw h0 at h,
    refine int.even_iff_not_odd.mp _ podd,
    rw even_iff_two_dvd,
    apply (associated.dvd _),
    exact ((pp.dvd_prime_iff_associated int.prime_two).mp (pp.dvd_of_dvd_pow h)).symm },
  { exfalso,
    rw int.odd_iff_not_even at aodd,
    refine aodd _,
    rw even_iff_two_dvd,
    refine (dvd_trans _ h),
    norm_num },
  { rwa prime.dvd_prime_iff_associated pp ap at h }
end

lemma dvd_or_dvd {a p x : ℤ}
  (ha : odd_prime_or_four a)
  (hp : odd_prime_or_four p)
  (hdvd : p ∣ a * x) : p ∣ a ∨ p ∣ x :=
begin
  obtain (rfl|⟨pp, podd⟩) := hp,
  { obtain (rfl|⟨ap, aodd⟩) := ha,
    { exact or.inl dvd_rfl },
    { right,
      have : (4 : ℤ) = 2 ^ 2,
      { norm_num },
      rw this at hdvd ⊢,
      apply int.prime_two.pow_dvd_of_dvd_mul_left _ _ hdvd,
      rwa [←even_iff_two_dvd, ←int.odd_iff_not_even] } },
  { exact (pp.dvd_or_dvd hdvd) }
end

lemma exists_associated_mem_of_dvd_prod''
  {p : ℤ} (hp : odd_prime_or_four p)
  {s : multiset ℤ}
  (hs : ∀ r ∈ s, odd_prime_or_four r)
  (hdvd : p ∣ s.prod) :
  ∃ q ∈ s, associated p q :=
begin
  induction s using multiset.induction_on with a s ih hs generalizing hs hdvd,
  { simpa [hp.not_unit, ←is_unit_iff_dvd_one] using hdvd },
  { rw [multiset.prod_cons] at hdvd,
    have := hs a (multiset.mem_cons_self _ _),
    obtain h|h := dvd_or_dvd this hp hdvd,
    { exact ⟨a, multiset.mem_cons_self _ _, associated_of_dvd this hp h⟩ },
    { obtain ⟨q, hq₁, hq₂⟩ := ih (λ r hr, hs _ (multiset.mem_cons_of_mem hr)) h,
      exact ⟨q, multiset.mem_cons_of_mem hq₁, hq₂⟩ } }
end

lemma factors_unique_prod' : ∀{f g : multiset ℤ},
  (∀x∈f, odd_prime_or_four x) →
  (∀x∈g, odd_prime_or_four x) →
  (associated f.prod g.prod) →
  multiset.rel associated f g :=
begin
  intros f,
  refine multiset.induction_on f _ _,
  { rintros g - hg h,
    rw [multiset.prod_zero] at h,
    rw [multiset.rel_zero_left],
    apply multiset.eq_zero_of_forall_not_mem,
    intros x hx,
    apply (hg x hx).not_unit,
    rw is_unit_iff_dvd_one,
    exact dvd_trans (multiset.dvd_prod hx) h.symm.dvd },
  { intros p f ih g hf hg hfg,
    have hp := hf p (multiset.mem_cons_self _ _),
    have hdvd : p ∣ g.prod,
    { rw [←hfg.dvd_iff_dvd_right, multiset.prod_cons],
      exact dvd_mul_right _ _ },
    obtain ⟨b, hbg, hb⟩ := exists_associated_mem_of_dvd_prod'' hp hg hdvd,
    rw ← multiset.cons_erase hbg,
    apply multiset.rel.cons hb,
    apply ih _ _ _,
    { exact (λ q hq, hf _ (multiset.mem_cons_of_mem hq)) },
    { exact (λ q (hq : q ∈ g.erase b), hg q (multiset.mem_of_mem_erase hq)) },
    { apply associated.of_mul_left _ hb hp.ne_zero,
      rwa [← multiset.prod_cons, ← multiset.prod_cons, multiset.cons_erase hbg] } },
end

/-- The odd factors. -/
noncomputable def odd_factors (x : ℤ) := multiset.filter odd (unique_factorization_monoid.normalized_factors x)

lemma odd_factors.zero : odd_factors 0 = 0 := rfl

lemma odd_factors.not_two_mem (x : ℤ) : (2 : ℤ) ∉ odd_factors x :=
begin
  simp only [odd_factors, even_bit0, not_true, not_false_iff, int.odd_iff_not_even, and_false,
    multiset.mem_filter],
end

lemma odd_factors.nonneg {z a : ℤ} (ha : a ∈ odd_factors z) : 0 ≤ a :=
begin
  simp only [odd_factors, multiset.mem_filter] at ha,
  exact int.nonneg_of_normalize_eq_self
    (unique_factorization_monoid.normalize_normalized_factor a ha.1)
end

lemma odd_factors.pow (z : ℤ) (n : ℕ) : odd_factors (z ^ n) = n • odd_factors z :=
begin
  simp only [odd_factors],
  rw [unique_factorization_monoid.normalized_factors_pow, multiset.filter_nsmul],
end

/-- The exponent of `2` in the factorization. -/
noncomputable def even_factor_exp (x : ℤ) := multiset.count 2 (unique_factorization_monoid.normalized_factors x)

lemma even_factor_exp.def (x : ℤ) : even_factor_exp x = multiset.count 2 (unique_factorization_monoid.normalized_factors x) := rfl

lemma even_factor_exp.zero : even_factor_exp 0 = 0 := rfl

lemma even_factor_exp.pow (z : ℤ) (n : ℕ) : even_factor_exp (z ^ n) = n * even_factor_exp z :=
begin
  simp only [even_factor_exp],
  rw [unique_factorization_monoid.normalized_factors_pow, multiset.count_nsmul]
end

lemma even_and_odd_factors'' (x : ℤ) :
  unique_factorization_monoid.normalized_factors x = (unique_factorization_monoid.normalized_factors x).filter (eq 2) + odd_factors x :=
begin
  by_cases hx : x = 0,
  { rw [hx, unique_factorization_monoid.normalized_factors_zero, odd_factors.zero, multiset.filter_zero,
    add_zero] },
  simp [even_factor_exp, odd_factors],
  rw multiset.filter_add_filter,
  convert (add_zero _).symm,
  { rw multiset.filter_eq_self,
    intros a ha,
    have hprime : prime a := unique_factorization_monoid.prime_of_normalized_factor a ha,
    have := unique_factorization_monoid.normalize_normalized_factor a ha,
    rw [← int.abs_eq_normalize, ← int.coe_nat_abs] at this,
    rw [← this],
    rw [int.prime_iff_nat_abs_prime] at hprime,
    rcases nat.prime.eq_two_or_odd' hprime with (h2 | hodd),
    { simp [h2] },
    { right,
      rw [this],
      exact int.nat_abs_odd.1 hodd } },
  { rw multiset.filter_eq_nil,
    rintros a ha ⟨rfl, hodd⟩,
    norm_num at hodd },
end

lemma even_and_odd_factors' (x : ℤ) :
  unique_factorization_monoid.normalized_factors x =
  multiset.replicate (even_factor_exp x) 2 + odd_factors x :=
begin
  convert even_and_odd_factors'' x,
  simp [even_factor_exp, ←multiset.filter_eq],
end

lemma even_and_odd_factors (x : ℤ) (hx : x ≠ 0) : associated x (2 ^ (even_factor_exp x) * (odd_factors x).prod) :=
begin
  convert (unique_factorization_monoid.normalized_factors_prod hx).symm,
  simp [even_factor_exp],
  rw [multiset.pow_count, ←multiset.prod_add, ←even_and_odd_factors'' x]
end

lemma factors_2_even {z : ℤ} (hz : z ≠ 0) : even_factor_exp (4 * z) = 2 + even_factor_exp z :=
begin
  have h₀ : (4 : ℤ) ≠ 0 := four_ne_zero,
  have h₁ : (2 : int) ^ 2 = 4,
  { norm_num },
  simp [even_factor_exp],
  rw [unique_factorization_monoid.normalized_factors_mul h₀ hz, multiset.count_add, ←h₁,
    unique_factorization_monoid.normalized_factors_pow, multiset.count_nsmul,
    unique_factorization_monoid.normalized_factors_irreducible int.prime_two.irreducible,
    int.normalize_of_nonneg zero_le_two, multiset.count_singleton_self, mul_one],
end

-- most useful with  (hz : even (even_factor_exp z))
/-- Odd factors or `4`. -/
noncomputable def factors_odd_prime_or_four (z : ℤ) : multiset ℤ :=
  multiset.replicate (even_factor_exp z / 2) 4 + odd_factors z

lemma factors_odd_prime_or_four.nonneg {z a : ℤ} (ha : a ∈ factors_odd_prime_or_four z) : 0 ≤ a :=
begin
  simp only [factors_odd_prime_or_four, multiset.mem_add] at ha,
  cases ha,
  { rw multiset.eq_of_mem_replicate ha, norm_num },
  { exact odd_factors.nonneg ha }
end

lemma factors_odd_prime_or_four.prod'
  {a : ℤ}
  (ha : 0 < a)
  (heven : even (even_factor_exp a)) :
  (factors_odd_prime_or_four a).prod = a :=
begin
  apply int.eq_of_associated_of_nonneg,
  { have := unique_factorization_monoid.normalized_factors_prod ha.ne',
    apply associated.trans _ this,
    obtain ⟨m, hm⟩ := even_iff_two_dvd.mp heven,
    rw [even_and_odd_factors' _, multiset.prod_add, factors_odd_prime_or_four, multiset.prod_add,
      hm, nat.mul_div_right _ zero_lt_two, multiset.prod_replicate, multiset.prod_replicate,
      pow_mul],
    exact associated.refl _ },
  { apply multiset.prod_nonneg,
    apply factors_odd_prime_or_four.nonneg },
  { exact ha.le },
end

lemma factors_odd_prime_or_four.associated'
  {a : ℤ}
  {f : multiset ℤ}
  (hf : ∀x∈f, odd_prime_or_four x)
  (ha : 0 < a)
  (heven : even (even_factor_exp a))
  (hassoc : associated f.prod a) :
  multiset.rel associated f (factors_odd_prime_or_four a) :=
begin
  apply factors_unique_prod' hf,
  { intros x hx,
    simp only [factors_odd_prime_or_four, multiset.mem_add] at hx,
    apply or.imp _ _ hx,
    { exact multiset.eq_of_mem_replicate },
    { simp only [odd_factors, multiset.mem_filter],
      exact and.imp_left (unique_factorization_monoid.prime_of_normalized_factor _) } },
  { rwa factors_odd_prime_or_four.prod' ha heven, }
end

lemma factors_odd_prime_or_four.unique'
  {a : ℤ}
  {f : multiset ℤ}
  (hf : ∀x∈f, odd_prime_or_four x)
  (hf' : ∀x∈f, (0 : ℤ) ≤ x)
  (ha : 0 < a)
  (heven : even (even_factor_exp a))
  (hassoc : associated f.prod a) :
  f = (factors_odd_prime_or_four a) :=
begin
  rw ←multiset.rel_eq,
  apply multiset.rel.mono (factors_odd_prime_or_four.associated' hf ha heven hassoc),
  intros x hx y hy hxy,
  exact int.eq_of_associated_of_nonneg hxy (hf' x hx) (factors_odd_prime_or_four.nonneg hy)
end

lemma factors_odd_prime_or_four.pow
  (z : ℤ) (n : ℕ) (hz : even (even_factor_exp z)) :
  factors_odd_prime_or_four (z ^ n) = n • factors_odd_prime_or_four z :=
begin
  simp only [factors_odd_prime_or_four, nsmul_add, multiset.nsmul_replicate, even_factor_exp.pow,
    nat.mul_div_assoc _ (even_iff_two_dvd.mp hz), odd_factors.pow],
end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/

import algebra.char_p.basic
import linear_algebra.finsupp_vector_space

/-!
# Multivariate polynomials over commutative rings

This file contains basic facts about multivariate polynomials over commutative rings, for example
that the monomials form a basis.

## Main definitions

* `restrict_total_degree σ R m`: the subspace of multivariate polynomials indexed by `σ` over the
  commutative ring `R` of total degree at most `m`.
* `restrict_degree σ R m`: the subspace of multivariate polynomials indexed by `σ` over the
  commutative ring `R` such that the degree in each individual variable is at most `m`.

## Main statements

* The multivariate polynomial ring over a commutative ring of positive characteristic has positive
  characteristic.
* `basis_monomials`: shows that the monomials form a basis of the vector space of multivariate
  polynomials.

## TODO

Generalise to noncommutative (semi)rings
-/

noncomputable theory

open_locale classical

open set linear_map submodule
open_locale big_operators

universes u v
variables (σ : Type u) (R : Type v) [comm_ring R] (p m : ℕ)

namespace mv_polynomial

section char_p

instance [char_p R p] : char_p (mv_polynomial σ R) p :=
{ cast_eq_zero_iff := λ n, by rw [← C_eq_coe_nat, ← C_0, C_inj, char_p.cast_eq_zero_iff R p] }

end char_p

section homomorphism

lemma map_range_eq_map {R S : Type*} [comm_ring R] [comm_ring S] (p : mv_polynomial σ R)
  (f : R →+* S) :
  finsupp.map_range f f.map_zero p = map f p :=
begin
  -- `finsupp.map_range_finset_sum` expects `f : R →+ S`
  change finsupp.map_range (f : R →+ S) (f : R →+ S).map_zero p = map f p,
  rw [p.as_sum, finsupp.map_range_finset_sum, (map f).map_sum],
  refine finset.sum_congr rfl (assume n _, _),
  rw [map_monomial, ← single_eq_monomial, finsupp.map_range_single, single_eq_monomial,
    f.coe_add_monoid_hom],
end

end homomorphism

section degree

/-- The submodule of polynomials of total degree less than or equal to `m`.-/
def restrict_total_degree : submodule R (mv_polynomial σ R) :=
finsupp.supported _ _ {n | n.sum (λn e, e) ≤ m }

/-- The submodule of polynomials such that the degree with respect to each individual variable is
less than or equal to `m`.-/
def restrict_degree (m : ℕ) : submodule R (mv_polynomial σ R) :=
finsupp.supported _ _ {n | ∀i, n i ≤ m }

variable {R}

lemma mem_restrict_total_degree (p : mv_polynomial σ R) :
  p ∈ restrict_total_degree σ R m ↔ p.total_degree ≤ m :=
begin
  rw [total_degree, finset.sup_le_iff],
  refl
end

lemma mem_restrict_degree (p : mv_polynomial σ R) (n : ℕ) :
  p ∈ restrict_degree σ R n ↔ (∀s ∈ p.support, ∀i, (s : σ →₀ ℕ) i ≤ n) :=
begin
  rw [restrict_degree, finsupp.mem_supported],
  refl
end

lemma mem_restrict_degree_iff_sup (p : mv_polynomial σ R) (n : ℕ) :
  p ∈ restrict_degree σ R n ↔ ∀i, p.degrees.count i ≤ n :=
begin
  simp only [mem_restrict_degree, degrees, multiset.count_sup, finsupp.count_to_multiset,
    finset.sup_le_iff],
  exact ⟨assume h n s hs, h s hs n, assume h s hs n, h n s hs⟩
end

variables (σ R)

/-- The monomials form a basis on `mv_polynomial σ R`. -/
def basis_monomials : basis (σ →₀ ℕ) R (mv_polynomial σ R) := finsupp.basis_single_one

@[simp] lemma coe_basis_monomials :
  (basis_monomials σ R : (σ →₀ ℕ) → mv_polynomial σ R) = λ s, monomial s 1 :=
rfl

lemma linear_independent_X : linear_independent R (X : σ → mv_polynomial σ R) :=
(basis_monomials σ R).linear_independent.comp
  (λ s : σ, finsupp.single s 1) (finsupp.single_left_injective one_ne_zero)

end degree

end mv_polynomial

/- this is here to avoid import cycle issues -/
namespace polynomial

/-- The monomials form a basis on `polynomial R`. -/
noncomputable def basis_monomials : basis ℕ R (polynomial R) :=
finsupp.basis_single_one.map (to_finsupp_iso_alg R).to_linear_equiv.symm

@[simp] lemma coe_basis_monomials :
  (basis_monomials R : ℕ → polynomial R) = λ s, monomial s 1 :=
_root_.funext $ λ n, to_finsupp_iso_symm_single

end polynomial


import data.real.basic
import tactic

namespace vilnius

local notation `|` x `|` := abs x

/-- `l` is the limit of the sequence `a` of reals -/
definition is_limit (a : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, | a n - l | < ε

/-- The limit of a constant sequence is the constant. -/
theorem is_limit_const (c : ℝ) : is_limit (λ n, c) c :=
begin
  sorry,
end

-- We will chose ε later...
theorem is_limit_add {a b : ℕ → ℝ} {l m : ℝ}
  (h1 : is_limit a l) (h2 : is_limit b m) :
  is_limit (a + b) (l + m) :=
begin
  sorry,
end

-- Helpful things:
-- `abs_pos : 0 < |a| ↔ a ≠ 0`
-- `div_pos : 0 < a → 0 < b → 0 < a / b`
-- `abs_mul x y : |x * y| = |x| * |y|`
-- `lt_div_iff' : 0 < c → (a < b / c ↔ c * a < b)`
-- I typically find these things myself with a combination of
-- the "guess the name of the lemma" game (and ctrl-space).

-- A hint for starting:
-- It might be worth dealing with `c = 0` as a special case. You
-- can start with
-- `by_cases hc : c = 0`

theorem is_limit_mul_const_left {a : ℕ → ℝ} {l c : ℝ} (h : is_limit a l) :
  is_limit (λ n, c * (a n)) (c * l) :=
begin
  sorry,
end

theorem sandwich (a b c : ℕ → ℝ)
  (l : ℝ) (ha : is_limit a l) (hc : is_limit c l)
  (hab : ∀ n, a n ≤ b n) (hbc : ∀ n, b n ≤ c n) : is_limit b l :=
begin
  sorry,
end

end vilnius


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

import linear_algebra.free_module.basic
import linear_algebra.matrix.to_lin
import ring_theory.finiteness

/-!
# Finite and free modules

We provide some instances for finite and free modules.

## Main results

* `module.free.choose_basis_index.fintype` : If a free module is finite, then any basis is
  finite.
* `module.free.linear_map.free ` : if `M` and `N` are finite and free, then `M →ₗ[R] N` is free.
* `module.finite.of_basis` : A free module with a basis indexed by a `fintype` is finite.
* `module.free.linear_map.module.finite` : if `M` and `N` are finite and free, then `M →ₗ[R] N`
  is finite.
-/

universes u v w

variables (R : Type u) (M : Type v) (N : Type w)

namespace module.free

section ring

variables [ring R] [add_comm_group M] [module R M] [module.free R M]

/-- If a free module is finite, then any basis is finite. -/
noncomputable
instance [nontrivial R] [module.finite R M] :
  fintype (module.free.choose_basis_index R M) :=
begin
  obtain ⟨h⟩ := id ‹module.finite R M›,
  choose s hs using h,
  exact basis_fintype_of_finite_spans ↑s hs (choose_basis _ _),
end

end ring

section comm_ring

variables [comm_ring R] [add_comm_group M] [module R M] [module.free R M]
variables [add_comm_group N] [module R N] [module.free R N]

instance linear_map [module.finite R M] [module.finite R N] : module.free R (M →ₗ[R] N) :=
begin
  casesI subsingleton_or_nontrivial R,
  { apply module.free.of_subsingleton' },
  classical,
  exact of_equiv
    (linear_map.to_matrix (module.free.choose_basis R M) (module.free.choose_basis R N)).symm,
end

variables {R M}

/-- A free module with a basis indexed by a `fintype` is finite. -/
lemma _root_.module.finite.of_basis {R : Type*} {M : Type*} {ι : Type*} [comm_ring R]
  [add_comm_group M] [module R M] [fintype ι] (b : basis ι R M) : module.finite R M :=
begin
  classical,
  refine ⟨⟨finset.univ.image b, _⟩⟩,
  simp only [set.image_univ, finset.coe_univ, finset.coe_image, basis.span_eq],
end

instance _root_.module.finite.matrix {ι₁ : Type*} [fintype ι₁] {ι₂ : Type*} [fintype ι₂] :
  module.finite R (matrix ι₁ ι₂ R) :=
module.finite.of_basis $ pi.basis $ λ i, pi.basis_fun R _

variables (M)

instance _root_.module.finite.linear_map [module.finite R M] [module.finite R N] :
  module.finite R (M →ₗ[R] N) :=
begin
  casesI subsingleton_or_nontrivial R,
  { apply_instance },
  classical,
  have f := (linear_map.to_matrix (choose_basis R M) (choose_basis R N)).symm,
  exact module.finite.of_surjective f.to_linear_map (linear_equiv.surjective f),
end

end comm_ring

section integer

variables [add_comm_group M] [module.finite ℤ M] [module.free ℤ M]
variables [add_comm_group N] [module.finite ℤ N] [module.free ℤ N]

instance _root_.module.finite.add_monoid_hom : module.finite ℤ (M →+ N) :=
module.finite.equiv (add_monoid_hom_lequiv_int ℤ).symm

instance add_monoid_hom : module.free ℤ (M →+ N) :=
begin
  letI : module.free ℤ (M →ₗ[ℤ] N) := module.free.linear_map _ _ _,
  exact module.free.of_equiv (add_monoid_hom_lequiv_int ℤ).symm
end

end integer

end module.free