-- Mathlib/Combinatorics/SetFamily/FourFunctions.lean
/-- The **Four Functions Theorem**, aka **Ahlswede-Daykin Inequality**. -/
lemma four_functions_theorem [DecidableEq α] (h₁ : 0 ≤ f₁) (h₂ : 0 ≤ f₂) (h₃ : 0 ≤ f₃) (h₄ : 0 ≤ f₄)
    (h : ∀ a b, f₁ a * f₂ b ≤ f₃ (a ⊓ b) * f₄ (a ⊔ b)) (s t : Finset α) :
    (∑ a ∈ s, f₁ a) * ∑ a ∈ t, f₂ a ≤ (∑ a ∈ s ⊼ t, f₃ a) * ∑ a ∈ s ⊻ t, f₄ a

Proof state:
α : Type u_1
β : Type u_2
inst✝³ : DistribLattice α
inst✝² : LinearOrderedCommSemiring β
inst✝¹ : ExistsAddOfLE β
f₁ f₂ f₃ f₄ : α → β
inst✝ : DecidableEq α
h₁ : 0 ≤ f₁
h₂ : 0 ≤ f₂
h₃ : 0 ≤ f₃
h₄ : 0 ≤ f₄
h : ∀ (a b : α), f₁ a * f₂ b ≤ f₃ (a ⊓ b) * f₄ (a ⊔ b)
s t : Finset α
L : Sublattice α := { carrier := latticeClosure (↑s ∪ ↑t), supClosed' := ⋯, infClosed' := ⋯ }
this : Finite ↥L
s' : Finset ↥L := s.preimage Subtype.val ⋯
⊢ (∑ a ∈ s, f₁ a) * ∑ a ∈ t, f₂ a ≤ (∑ a ∈ s ⊼ t, f₃ a) * ∑ a ∈ s ⊻ t, f₄ a

Tactic:
set t' : Finset L := t.preimage (↑) Subtype.coe_injective.injOn

Result:
α : Type u_1
β : Type u_2
inst✝³ : DistribLattice α
inst✝² : LinearOrderedCommSemiring β
inst✝¹ : ExistsAddOfLE β
f₁ f₂ f₃ f₄ : α → β
inst✝ : DecidableEq α
h₁ : 0 ≤ f₁
h₂ : 0 ≤ f₂
h₃ : 0 ≤ f₃
h₄ : 0 ≤ f₄
h : ∀ (a b : α), f₁ a * f₂ b ≤ f₃ (a ⊓ b) * f₄ (a ⊔ b)
s t : Finset α
L : Sublattice α := { carrier := latticeClosure (↑s ∪ ↑t), supClosed' := ⋯, infClosed' := ⋯ }
this : Finite ↥L
s' : Finset ↥L := s.preimage Subtype.val ⋯
t' : Finset ↥L := t.preimage Subtype.val ⋯
⊢ (∑ a ∈ s, f₁ a) * ∑ a ∈ t, f₂ a ≤ (∑ a ∈ s ⊼ t, f₃ a) * ∑ a ∈ s ⊻ t, f₄ a

Proof state:
α : Type u_1
β : Type u_2
inst✝³ : DistribLattice α
inst✝² : LinearOrderedCommSemiring β
inst✝¹ : ExistsAddOfLE β
f₁ f₂ f₃ f₄ : α → β
inst✝ : DecidableEq α
h₁ : 0 ≤ f₁
h₂ : 0 ≤ f₂
h₃ : 0 ≤ f₃
h₄ : 0 ≤ f₄
h : ∀ (a b : α), f₁ a * f₂ b ≤ f₃ (a ⊓ b) * f₄ (a ⊔ b)
s t : Finset α
L : Sublattice α := { carrier := latticeClosure (↑s ∪ ↑t), supClosed' := ⋯, infClosed' := ⋯ }
this : Finite ↥L
s' : Finset ↥L := s.preimage Subtype.val ⋯
t' : Finset ↥L := t.preimage Subtype.val ⋯
hs' : map { toFun := ⇑L.subtype, inj' := ⋯ } s' = s
⊢ (∑ a ∈ s, f₁ a) * ∑ a ∈ t, f₂ a ≤ (∑ a ∈ s ⊼ t, f₃ a) * ∑ a ∈ s ⊻ t, f₄ a

Tactic:
have ht' : t'.map ⟨L.subtype, Subtype.coe_injective⟩ = t := by
  simp [t', map_eq_image, image_preimage, filter_eq_self]
  exact fun a ha ↦ subset_latticeClosure <| Set.subset_union_right ha

Result:
α : Type u_1
β : Type u_2
inst✝³ : DistribLattice α
inst✝² : LinearOrderedCommSemiring β
inst✝¹ : ExistsAddOfLE β
f₁ f₂ f₃ f₄ : α → β
inst✝ : DecidableEq α
h₁ : 0 ≤ f₁
h₂ : 0 ≤ f₂
h₃ : 0 ≤ f₃
h₄ : 0 ≤ f₄
h : ∀ (a b : α), f₁ a * f₂ b ≤ f₃ (a ⊓ b) * f₄ (a ⊔ b)
s t : Finset α
L : Sublattice α := { carrier := latticeClosure (↑s ∪ ↑t), supClosed' := ⋯, infClosed' := ⋯ }
this : Finite ↥L
s' : Finset ↥L := s.preimage Subtype.val ⋯
t' : Finset ↥L := t.preimage Subtype.val ⋯
hs' : map { toFun := ⇑L.subtype, inj' := ⋯ } s' = s
ht' : map { toFun := ⇑L.subtype, inj' := ⋯ } t' = t
⊢ (∑ a ∈ s, f₁ a) * ∑ a ∈ t, f₂ a ≤ (∑ a ∈ s ⊼ t, f₃ a) * ∑ a ∈ s ⊻ t, f₄ a

Proof state:
case intro.intro.intro.intro.refine_1.inl.intro.inl.intro
α : Type u_1
β✝ : Type u_2
inst✝³ : DistribLattice α
inst✝² : LinearOrderedCommSemiring β✝
inst✝¹ : ExistsAddOfLE β✝
f₁ f₂ f₃ f₄ : α → β✝
inst✝ : DecidableEq α
h₁ : 0 ≤ f₁
h₂ : 0 ≤ f₂
h₃ : 0 ≤ f₃
h₄ : 0 ≤ f₄
h : ∀ (a b : α), f₁ a * f₂ b ≤ f₃ (a ⊓ b) * f₄ (a ⊔ b)
s t : Finset α
L : Sublattice α := { carrier := latticeClosure (↑s ∪ ↑t), supClosed' := ⋯, infClosed' := ⋯ }
this : Finite ↥L
t' : Finset ↥L
ht' : map { toFun := ⇑L.subtype, inj' := ⋯ } t' = t
s' : Finset ↥L
hs' : map { toFun := ⇑L.subtype, inj' := ⋯ } s' = s
β : Type u_1
w✝¹ : DecidableEq β
w✝ : Fintype β
g : LatticeHom (↥L) (Finset β)
hg : Injective ⇑g
a b : ↥L
⊢ extend (⇑g) (f₁ ∘ Subtype.val) 0 (g a) * extend (⇑g) (f₂ ∘ Subtype.val) 0 (g b) ≤
    extend (⇑g) (f₃ ∘ Subtype.val) 0 (g a ∩ g b) * extend (⇑g) (f₄ ∘ Subtype.val) 0 (g a ∪ g b)

Tactic:
simp_rw [← sup_eq_union, ← inf_eq_inter, ← map_sup, ← map_inf, hg.extend_apply]

Result:
case intro.intro.intro.intro.refine_1.inl.intro.inl.intro
α : Type u_1
β✝ : Type u_2
inst✝³ : DistribLattice α
inst✝² : LinearOrderedCommSemiring β✝
inst✝¹ : ExistsAddOfLE β✝
f₁ f₂ f₃ f₄ : α → β✝
inst✝ : DecidableEq α
h₁ : 0 ≤ f₁
h₂ : 0 ≤ f₂
h₃ : 0 ≤ f₃
h₄ : 0 ≤ f₄
h : ∀ (a b : α), f₁ a * f₂ b ≤ f₃ (a ⊓ b) * f₄ (a ⊔ b)
s t : Finset α
L : Sublattice α := { carrier := latticeClosure (↑s ∪ ↑t), supClosed' := ⋯, infClosed' := ⋯ }
this : Finite ↥L
t' : Finset ↥L
ht' : map { toFun := ⇑L.subtype, inj' := ⋯ } t' = t
s' : Finset ↥L
hs' : map { toFun := ⇑L.subtype, inj' := ⋯ } s' = s
β : Type u_1
w✝¹ : DecidableEq β
w✝ : Fintype β
g : LatticeHom (↥L) (Finset β)
hg : Injective ⇑g
a b : ↥L
⊢ (f₁ ∘ Subtype.val) a * (f₂ ∘ Subtype.val) b ≤ (f₃ ∘ Subtype.val) (a ⊓ b) * (f₄ ∘ Subtype.val) (a ⊔ b)

Proof state:
α : Type u_1
β : Type u_2
inst✝³ : DistribLattice α
inst✝² : LinearOrderedCommSemiring β
inst✝¹ : ExistsAddOfLE β
f₁ f₂ f₃ f₄ : α → β
inst✝ : DecidableEq α
h₁ : 0 ≤ f₁
h₂ : 0 ≤ f₂
h₃ : 0 ≤ f₃
h₄ : 0 ≤ f₄
h : ∀ (a b : α), f₁ a * f₂ b ≤ f₃ (a ⊓ b) * f₄ (a ⊔ b)
s t : Finset α
L : Sublattice α := { carrier := latticeClosure (↑s ∪ ↑t), supClosed' := ⋯, infClosed' := ⋯ }
this : Finite ↥L
s' : Finset ↥L := s.preimage Subtype.val ⋯
t' : Finset ↥L := t.preimage Subtype.val ⋯
hs' : map { toFun := ⇑L.subtype, inj' := ⋯ } s' = s
⊢ ∀ x ∈ t, x ∈ L

Tactic:
exact fun a ha ↦ subset_latticeClosure <| Set.subset_union_right ha

Result:
no goals

Proof state:
α : Type u_1
β : Type u_2
inst✝³ : DistribLattice α
inst✝² : LinearOrderedCommSemiring β
inst✝¹ : ExistsAddOfLE β
f₁ f₂ f₃ f₄ : α → β
inst✝ : DecidableEq α
h₁ : 0 ≤ f₁
h₂ : 0 ≤ f₂
h₃ : 0 ≤ f₃
h₄ : 0 ≤ f₄
h : ∀ (a b : α), f₁ a * f₂ b ≤ f₃ (a ⊓ b) * f₄ (a ⊔ b)
s t : Finset α
L : Sublattice α := { carrier := latticeClosure (↑s ∪ ↑t), supClosed' := ⋯, infClosed' := ⋯ }
this : Finite ↥L
s' : Finset ↥L := s.preimage Subtype.val ⋯
t' : Finset ↥L := t.preimage Subtype.val ⋯
⊢ map { toFun := ⇑L.subtype, inj' := ⋯ } s' = s

Tactic:
simp [s', map_eq_image, image_preimage, filter_eq_self]

Result:
α : Type u_1
β : Type u_2
inst✝³ : DistribLattice α
inst✝² : LinearOrderedCommSemiring β
inst✝¹ : ExistsAddOfLE β
f₁ f₂ f₃ f₄ : α → β
inst✝ : DecidableEq α
h₁ : 0 ≤ f₁
h₂ : 0 ≤ f₂
h₃ : 0 ≤ f₃
h₄ : 0 ≤ f₄
h : ∀ (a b : α), f₁ a * f₂ b ≤ f₃ (a ⊓ b) * f₄ (a ⊔ b)
s t : Finset α
L : Sublattice α := { carrier := latticeClosure (↑s ∪ ↑t), supClosed' := ⋯, infClosed' := ⋯ }
this : Finite ↥L
s' : Finset ↥L := s.preimage Subtype.val ⋯
t' : Finset ↥L := t.preimage Subtype.val ⋯
⊢ ∀ x ∈ s, x ∈ L

Proof state:
case intro.intro.intro.intro.refine_2
α : Type u_1
β✝ : Type u_2
inst✝³ : DistribLattice α
inst✝² : LinearOrderedCommSemiring β✝
inst✝¹ : ExistsAddOfLE β✝
f₁ f₂ f₃ f₄ : α → β✝
inst✝ : DecidableEq α
h₁ : 0 ≤ f₁
h₂ : 0 ≤ f₂
h₃ : 0 ≤ f₃
h₄ : 0 ≤ f₄
h : ∀ (a b : α), f₁ a * f₂ b ≤ f₃ (a ⊓ b) * f₄ (a ⊔ b)
s t : Finset α
L : Sublattice α := { carrier := latticeClosure (↑s ∪ ↑t), supClosed' := ⋯, infClosed' := ⋯ }
this✝ : Finite ↥L
t' : Finset ↥L
ht' : map { toFun := ⇑L.subtype, inj' := ⋯ } t' = t
s' : Finset ↥L
hs' : map { toFun := ⇑L.subtype, inj' := ⋯ } s' = s
β : Type u_1
w✝¹ : DecidableEq β
w✝ : Fintype β
g : LatticeHom (↥L) (Finset β)
hg : Injective ⇑g
this :
  (∑ s ∈ map { toFun := ⇑g, inj' := hg } s', extend (⇑g) (f₁ ∘ Subtype.val) 0 s) *
      ∑ s ∈ map { toFun := ⇑g, inj' := hg } t', extend (⇑g) (f₂ ∘ Subtype.val) 0 s ≤
    (∑ s ∈ map { toFun := ⇑g, inj' := hg } s' ⊼ map { toFun := ⇑g, inj' := hg } t',
        extend (⇑g) (f₃ ∘ Subtype.val) 0 s) *
      ∑ s ∈ map { toFun := ⇑g, inj' := hg } s' ⊻ map { toFun := ⇑g, inj' := hg } t', extend (⇑g) (f₄ ∘ Subtype.val) 0 s
⊢ (∑ a ∈ s, f₁ a) * ∑ a ∈ t, f₂ a ≤ (∑ a ∈ s ⊼ t, f₃ a) * ∑ a ∈ s ⊻ t, f₄ a

Tactic:
simpa only [← hs', ← ht', ← map_sups, ← map_infs, sum_map, Embedding.coeFn_mk, hg.extend_apply]
  using this

Result:
no goals