/-- The **Four Functions Theorem**, aka **Ahlswede-Daykin Inequality**. -/
lemma four_functions_theorem (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 in s, f₁ a) * ∑ a in t, f₂ a ≤ (∑ a in s ⊼ t, f₃ a) * ∑ a in s ⊻ t, f₄ a := by
  classical
  set L : Sublattice α := ⟨latticeClosure (s ∪ t), isSublattice_latticeClosure.1,
    isSublattice_latticeClosure.2⟩
  have : Finite L := (s.finite_toSet.union t.finite_toSet).latticeClosure.to_subtype
  set s' : Finset L := s.preimage (↑) $ Subtype.coe_injective.injOn _
  set t' : Finset L := t.preimage (↑) $ Subtype.coe_injective.injOn _
  have hs' : s'.map ⟨L.subtype, Subtype.coe_injective⟩ = s := by
    simp [map_eq_image, image_preimage, filter_eq_self]
    exact fun a ha ↦ subset_latticeClosure $ Set.subset_union_left _ _ ha
  have ht' : t'.map ⟨L.subtype, Subtype.coe_injective⟩ = t := by
    simp [map_eq_image, image_preimage, filter_eq_self]
    exact fun a ha ↦ subset_latticeClosure $ Set.subset_union_right _ _ ha
  clear_value s' t'
  obtain ⟨β, _, _, g, hg⟩ := exists_birkhoff_representation L
  have := four_functions_theorem_aux (extend g (f₁ ∘ (↑)) 0) (extend g (f₂ ∘ (↑)) 0)
    (extend g (f₃ ∘ (↑)) 0) (extend g (f₄ ∘ (↑)) 0) (extend_nonneg (fun _ ↦ h₁ _) le_rfl)
    (extend_nonneg (fun _ ↦ h₂ _) le_rfl) (extend_nonneg (fun _ ↦ h₃ _) le_rfl)
    (extend_nonneg (fun _ ↦ h₄ _) le_rfl) ?_ (s'.map ⟨g, hg⟩) (t'.map ⟨g, hg⟩)
  

Proof state:
case intro.intro.intro.intro.refine_2
α : Type u_1
β✝ : Type u_2
inst✝³ : DistribLattice α
inst✝² : DecidableEq α
inst✝¹ : LinearOrderedCommSemiring β✝
inst✝ : ExistsAddOfLE β✝
f f₁ f₂ f₃ f₄ g✝ μ : α → β✝
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' := (_ : SupClosed (latticeClosure (↑s ∪ ↑t))),
    infClosed' := (_ : InfClosed (latticeClosure (↑s ∪ ↑t))) }
this✝ : Finite ↥L
t' : Finset ↥L
ht' : map { toFun := ⇑(Sublattice.subtype L), inj' := (_ : Injective fun a => ↑a) } t' = t
s' : Finset ↥L
hs' : map { toFun := ⇑(Sublattice.subtype L), inj' := (_ : Injective fun a => ↑a) } s' = s
β : Type u_1
w✝¹ : DecidableEq β
w✝ : Fintype β
g : LatticeHom (↥L) (Finset β)
hg : Injective ⇑g
this :
  (∑ s in map { toFun := ⇑g, inj' := hg } s', extend (⇑g) (f₁ ∘ Subtype.val) 0 s) *
      ∑ s in map { toFun := ⇑g, inj' := hg } t', extend (⇑g) (f₂ ∘ Subtype.val) 0 s ≤
    (∑ s in map { toFun := ⇑g, inj' := hg } s' ⊼ map { toFun := ⇑g, inj' := hg } t',
        extend (⇑g) (f₃ ∘ Subtype.val) 0 s) *
      ∑ s in map { toFun := ⇑g, inj' := hg } s' ⊻ map { toFun := ⇑g, inj' := hg } t', extend (⇑g) (f₄ ∘ Subtype.val) 0 s
⊢ (∑ a in s, f₁ a) * ∑ a in t, f₂ a ≤ (∑ a in s ⊼ t, f₃ a) * ∑ a in s ⊻ t, f₄ a
case intro.intro.intro.intro.refine_1
α : Type u_1
β✝ : Type u_2
inst✝³ : DistribLattice α
inst✝² : DecidableEq α
inst✝¹ : LinearOrderedCommSemiring β✝
inst✝ : ExistsAddOfLE β✝
f f₁ f₂ f₃ f₄ g✝ μ : α → β✝
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' := (_ : SupClosed (latticeClosure (↑s ∪ ↑t))),
    infClosed' := (_ : InfClosed (latticeClosure (↑s ∪ ↑t))) }
this : Finite ↥L
t' : Finset ↥L
ht' : map { toFun := ⇑(Sublattice.subtype L), inj' := (_ : Injective fun a => ↑a) } t' = t
s' : Finset ↥L
hs' : map { toFun := ⇑(Sublattice.subtype L), inj' := (_ : Injective fun a => ↑a) } s' = s
β : Type u_1
w✝¹ : DecidableEq β
w✝ : Fintype β
g : LatticeHom (↥L) (Finset β)
hg : Injective ⇑g
⊢ ∀ (s t : Finset β),
    extend (⇑g) (f₁ ∘ Subtype.val) 0 s * extend (⇑g) (f₂ ∘ Subtype.val) 0 t ≤
      extend (⇑g) (f₃ ∘ Subtype.val) 0 (s ∩ t) * extend (⇑g) (f₄ ∘ Subtype.val) 0 (s ∪ t)

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