import data.nat.prime data.finset
open nat

def island_rules : ℕ → ℕ → ℕ → Prop
| 0       b B := (B = b ∨ B = b - 1) ∧ B > 0
| (d + 1) b B := island_rules d b B ∧
 ((∀ C, island_rules d b C → C = b) ↔ ∀ C, island_rules d B C → C = B)

def island_rules2 : ℕ → ℕ → finset ℕ
| 0     b := ({b - 1, b} : finset ℕ).filter (> 0)
| (d+1) b := (island_rules2 d b).filter
  (λ B, (∀ C ∈ island_rules2 d b, C = b) ↔ (∀ C ∈ island_rules2 d B, C = B))

lemma island_rules_iff (d : ℕ) : ∀ b B, island_rules d b B ↔ B ∈ island_rules2 d b :=
by induction d; simp [island_rules, island_rules2, *]; tauto

lemma island_rules_iff' (d : ℕ) : ∀ b, (∀ B, island_rules d b B → B = b) ↔ (∀ B ∈ island_rules2 d b, B = b) :=
by simp [island_rules_iff]

instance decg : decidable_rel (λ d b, ∀ B, island_rules d b B → B = b) :=
λ d b, decidable_of_iff _ (island_rules_iff' d b).symm

lemma blue_eyed_islander : ∀ d < 100, (∀ B, island_rules d 100 B → B = 100) ↔ d = 99 := dec_trivial

#print axioms blue_eyed_islander
#exit
theorem blue_eyed_islander : ∀ d b, b > 0 → d + 1 ≥ b → ∀ B, island_rules d b B → B = b := λ d,
 nat.rec_on d (λ b, nat.cases_on b (λ h, absurd h (dec_trivial : ¬0 > 0)) (λ b, nat.cases_on b
 (λ h h B hB, or.by_cases hB.left (λ h1, h1) (λ h1, false.elim ((dec_trivial : ¬1 - 1 > 0) (h1 ▸
 hB.right)))) (λ b h h2, absurd h2 (dec_trivial : ¬0 + 1 ≥ succ (succ b))))) (λ d hi b hb hd B hB,
 have h_i : (B = b ∨ B = b - 1) ∧ B > 0 := nat.rec_on d (λ h, h) (λ d hi h, hi h.left) hB.left,
 or.by_cases h_i.left (λ h, h) (λ h, hB.right.mpr (hi B h_i.right (le_of_succ_le_succ (((
 (nat.sub_eq_iff_eq_add (succ_le_of_lt hb)).mp h.symm) ▸ hd) : d + 2 ≥ B + 1))) B hB.left))

theorem init_island {d b B} : island_rules d b B → (B = b ∨ B = b - 1) ∧ B > 0 :=
 nat.rec_on d (λ h, h) (λ d hi h, hi h.left)

theorem blue_eyed_islander1 : ∀ d b, b > 0 → (d + 1 ≥ b ↔ ∀ B, island_rules d b B → B = b) :=
 λ d, nat.rec_on d (λ b, nat.cases_on b (λ h, absurd h (dec_trivial : ¬0 > 0)) $ λ b, nat.cases_on
 b (λ h, ⟨λ h B hB, or.by_cases hB.left (λ h1, h1) (λ h1, false.elim $ (dec_trivial : ¬1 - 1 > 0) $
 h1 ▸ hB.right), λ h, dec_trivial⟩) $ λ b h, ⟨λ h2, false.elim ((dec_trivial : ¬0 + 1 ≥ succ (succ
 b)) h2), λ hB, false.elim $ (succ_ne_self $ succ b).symm $ hB (succ b) ⟨or.inr (succ_sub_one $
 succ b).symm, dec_trivial⟩⟩) $ λ d hi b hb, ⟨λ hd, or.by_cases (lt_or_eq_of_le hd) (λ h B hB, (hi
 b hb).mp (le_of_succ_le_succ $ succ_le_of_lt h) B hB.left) $ λ h B hB, or.by_cases (init_island
 hB.left).left (λ h, h) $ λ h, hB.right.mpr ((hi B (init_island hB.left).right).mp $
 le_of_succ_le_succ $ (((nat.sub_eq_iff_eq_add $ succ_le_of_lt hb).mp h.symm).trans $ add_one B) ▸
 hd) B hB.left, λ hB, by_contradiction $ begin
   rw island_rules2_iff_island_rules at hB,
 end

#print axioms blue_eyed_islander1


-- what they need to know before they embark on this:
-- x ∈ A ∩ B → x ∈ A
-- x ∈ A → x ∈ A ∪ B
-- A ⊆ C ∧ x ∈ A ∧ x ∉ C → false
-- B = {-1,0,1} (only way to prove (d))
-- rw an iff
-- real_half_not_an_integer : ¬∃ (n : ℤ), 1 / 2 = ↑n
-- ¬ x is the same as x → false
-- x ∈ C ∧ x ∉ A ∧ x ∉ B ∧ C ⊆ A ∪ B → false
-- what to do with H : x = a ∨ x = b
-- rw H at H'

/-
  Examples from basic logic.
-/

import data.nat.sqrt

example (P Q R : Prop) (HP : P) (HQ : Q) : P :=
begin
  -- proof starts here
  exact HP
end

export nat

example (P Q : Prop) (H1 : P) (H2 : P → Q) : Q :=
begin
  apply H2,
  exact H1
end

example (P Q : Prop) (H1 : P) (H2 : P → Q) : Q :=
begin
  exact H2 H1
end

example (P Q R : Prop) (H1 : P → Q) (H2 : P → (Q → R)) : P → R :=
begin
  intro HP,
  have HQ : Q,
    exact H1 HP,
  have HQR : Q → R,
    exact H2 HP,
  apply HQR,
  exact HQ
end

example (P Q R : Prop) (H1 : P → Q) (H2 : P → (Q → R)) : P → R :=
begin
  intro HP,
  apply H2,
    exact HP,
  apply H1,
  apply HP
end

example (P Q : Prop) (H1 : P → Q) : ¬ Q → ¬ P :=
begin
  intro HNQ,
  show P → false,
  intro HP,
  apply HNQ,
  apply H1,
  exact HP
end

example (P Q : Prop) (HPQ : P ∧ Q) : P :=
begin
  cases HPQ with HP HQ,
  exact HP
end

example (P Q : Prop) (HP : P) : P ∨ Q :=
begin
  left,
  exact HP
end

example (P Q R : Prop) (HPQR : P ∧ Q ∧ R) : (P ∧ Q) ∧ (P ∧ R) :=
begin
  cases HPQR with HP HQR,
  cases HQR with HQ HR,
  split,
    split,
      exact HP,
    exact HQ,
  split,
    exact HP,
  exact HR
end

example (P Q R : Prop) (HPQR : P ∧ Q ∧ R) : (P ∧ Q) ∧ (P ∧ R) :=
begin
  cases HPQR with HP HQR,
  cases HQR with HQ HR,
  split,
    split,
      assumption,
    assumption,
  split,
    assumption,
  assumption
end

example (P Q R : Prop) (HPQR : P ∧ Q ∧ R) : (P ∧ Q) ∧ (P ∧ R) :=
begin
  cases HPQR with HP HQR,cases HQR,
  split;split;assumption
end

-- see TPIL
example (P Q R : Prop) (HPQR : P ∧ Q ∧ R) : (P ∧ Q) ∧ (P ∧ R) :=
⟨⟨HPQR.1,HPQR.2.1⟩,HPQR.1,HPQR.2.2⟩

example (P Q : Prop) : P ∨ Q → Q ∨ P :=
begin
  intro HPQ,
  cases HPQ with HP HQ,
    right,
    assumption,
  left,
  assumption
end

example (P Q : Prop) (H : P → ¬ Q) : Q → ¬ P :=
begin
  intro HQ,
  intro HP,
  apply H;assumption
end

local attribute [instance] classical.prop_decidable

example (P Q : Prop) (H : ¬ P → ¬ Q) : Q → P :=
begin
  intro HQ,
  by_cases HP : P,
    exact HP,
  by_contradiction,
  apply H HP,
  assumption,

end


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module order.hom.lattice
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Lattice
import Mathlib.Order.Hom.Bounded
import Mathlib.Order.SymmDiff

/-!
# Lattice homomorphisms

This file defines (bounded) lattice homomorphisms.

We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
be satisfied by itself and all stricter types.

## Types of morphisms

* `SupHom`: Maps which preserve `⊔`.
* `InfHom`: Maps which preserve `⊓`.
* `SupBotHom`: Finitary supremum homomorphisms. Maps which preserve `⊔` and `⊥`.
* `InfTopHom`: Finitary infimum homomorphisms. Maps which preserve `⊓` and `⊤`.
* `LatticeHom`: Lattice homomorphisms. Maps which preserve `⊔` and `⊓`.
* `BoundedLatticeHom`: Bounded lattice homomorphisms. Maps which preserve `⊤`, `⊥`, `⊔` and `⊓`.

## Typeclasses

* `SupHomClass`
* `InfHomClass`
* `SupBotHomClass`
* `InfTopHomClass`
* `LatticeHomClass`
* `BoundedLatticeHomClass`

## TODO

Do we need more intersections between `BotHom`, `TopHom` and lattice homomorphisms?
-/

open Function OrderDual

variable {F ι α β γ δ : Type _}

/-- The type of `⊔`-preserving functions from `α` to `β`. -/
structure SupHom (α β : Type _) [Sup α] [Sup β] where
  /-- The underlying function of a `SupHom` -/
  toFun : α → β
  /-- A `SupHom` preserves suprema. -/
  map_sup' (a b : α) : toFun (a ⊔ b) = toFun a ⊔ toFun b
#align sup_hom SupHom

/-- The type of `⊓`-preserving functions from `α` to `β`. -/
structure InfHom (α β : Type _) [Inf α] [Inf β] where
  /-- The underlying function of an `InfHom` -/
  toFun : α → β
  /-- An `InfHom` preserves infima. -/
  map_inf' (a b : α) : toFun (a ⊓ b) = toFun a ⊓ toFun b
#align inf_hom InfHom

/-- The type of finitary supremum-preserving homomorphisms from `α` to `β`. -/
structure SupBotHom (α β : Type _) [Sup α] [Sup β] [Bot α] [Bot β] extends SupHom α β where
  /-- A `SupBotHom` preserves the bottom element. -/
  map_bot' : toFun ⊥ = ⊥
#align sup_bot_hom SupBotHom

/-- The type of finitary infimum-preserving homomorphisms from `α` to `β`. -/
structure InfTopHom (α β : Type _) [Inf α] [Inf β] [Top α] [Top β] extends InfHom α β where
  /-- An `InfTopHom` preserves the top element. -/
  map_top' : toFun ⊤ = ⊤
#align inf_top_hom InfTopHom

/-- The type of lattice homomorphisms from `α` to `β`. -/
structure LatticeHom (α β : Type _) [Lattice α] [Lattice β] extends SupHom α β where
  /-- A `LatticeHom` preserves infima. -/
  map_inf' (a b : α) : toFun (a ⊓ b) = toFun a ⊓ toFun b
#align lattice_hom LatticeHom

/-- The type of bounded lattice homomorphisms from `α` to `β`. -/
structure BoundedLatticeHom (α β : Type _) [Lattice α] [Lattice β] [BoundedOrder α]
  [BoundedOrder β] extends LatticeHom α β where
  /-- A `BoundedLatticeHom` preserves the top element. -/
  map_top' : toFun ⊤ = ⊤
  /-- A `BoundedLatticeHom` preserves the bottom element. -/
  map_bot' : toFun ⊥ = ⊥
#align bounded_lattice_hom BoundedLatticeHom

-- Porting note: todo: remove this configuration and use the default configuration.
-- We keep this to be consistent with Lean 3.
initialize_simps_projections SupBotHom (+toSupHom, -toFun)
initialize_simps_projections InfTopHom (+toInfHom, -toFun)
initialize_simps_projections LatticeHom (+toSupHom, -toFun)
initialize_simps_projections BoundedLatticeHom (+toLatticeHom, -toFun)

section

/-- `SupHomClass F α β` states that `F` is a type of `⊔`-preserving morphisms.

You should extend this class when you extend `SupHom`. -/
class SupHomClass (F : Type _) (α β : outParam <| Type _) [Sup α] [Sup β] extends
  FunLike F α fun _ => β where
  /-- A `SupHomClass` morphism preserves suprema. -/
  map_sup (f : F) (a b : α) : f (a ⊔ b) = f a ⊔ f b
#align sup_hom_class SupHomClass

/-- `InfHomClass F α β` states that `F` is a type of `⊓`-preserving morphisms.

You should extend this class when you extend `InfHom`. -/
class InfHomClass (F : Type _) (α β : outParam <| Type _) [Inf α] [Inf β] extends
  FunLike F α fun _ => β where
  /-- An `InfHomClass` morphism preserves infima. -/
  map_inf (f : F) (a b : α) : f (a ⊓ b) = f a ⊓ f b
#align inf_hom_class InfHomClass

/-- `SupBotHomClass F α β` states that `F` is a type of finitary supremum-preserving morphisms.

You should extend this class when you extend `SupBotHom`. -/
class SupBotHomClass (F : Type _) (α β : outParam <| Type _) [Sup α] [Sup β] [Bot α]
  [Bot β] extends SupHomClass F α β where
  /-- A `SupBotHomClass` morphism preserves the bottom element. -/
  map_bot (f : F) : f ⊥ = ⊥
#align sup_bot_hom_class SupBotHomClass

/-- `InfTopHomClass F α β` states that `F` is a type of finitary infimum-preserving morphisms.

You should extend this class when you extend `SupBotHom`. -/
class InfTopHomClass (F : Type _) (α β : outParam <| Type _) [Inf α] [Inf β] [Top α]
  [Top β] extends InfHomClass F α β where
  /-- An `InfTopHomClass` morphism preserves the top element. -/
  map_top (f : F) : f ⊤ = ⊤
#align inf_top_hom_class InfTopHomClass

/-- `LatticeHomClass F α β` states that `F` is a type of lattice morphisms.

You should extend this class when you extend `LatticeHom`. -/
class LatticeHomClass (F : Type _) (α β : outParam <| Type _) [Lattice α] [Lattice β] extends
  SupHomClass F α β where
  /-- A `LatticeHomClass` morphism preserves infima. -/
  map_inf (f : F) (a b : α) : f (a ⊓ b) = f a ⊓ f b
#align lattice_hom_class LatticeHomClass

/-- `BoundedLatticeHomClass F α β` states that `F` is a type of bounded lattice morphisms.

You should extend this class when you extend `BoundedLatticeHom`. -/
class BoundedLatticeHomClass (F : Type _) (α β : outParam <| Type _) [Lattice α] [Lattice β]
  [BoundedOrder α] [BoundedOrder β] extends LatticeHomClass F α β where
  /-- A `BoundedLatticeHomClass` morphism preserves the top element. -/
  map_top (f : F) : f ⊤ = ⊤
  /-- A `BoundedLatticeHomClass` morphism preserves the bottom element. -/
  map_bot (f : F) : f ⊥ = ⊥
#align bounded_lattice_hom_class BoundedLatticeHomClass

end

export SupHomClass (map_sup)

export InfHomClass (map_inf)

attribute [simp] map_top map_bot map_sup map_inf

-- porting note: changes to the typeclass inference system mean that we need to
-- make a lot of changes here, adding `outParams`, changing `[]`s into `{}` and
-- so on.
-- See note [lower instance priority]
instance (priority := 100) SupHomClass.toOrderHomClass {_ : SemilatticeSup α} {_ : SemilatticeSup β}
    [SupHomClass F α β] : OrderHomClass F α β :=
  { ‹SupHomClass F α β› with
    map_rel := fun f a b h => by rw [← sup_eq_right, ← map_sup, sup_eq_right.2 h] }
#align sup_hom_class.to_order_hom_class SupHomClass.toOrderHomClass

-- See note [lower instance priority]
instance (priority := 100) InfHomClass.toOrderHomClass {_ : SemilatticeInf α} {_ : SemilatticeInf β}
    [InfHomClass F α β] : OrderHomClass F α β :=
  { ‹InfHomClass F α β› with
    map_rel := fun f a b h => by rw [← inf_eq_left, ← map_inf, inf_eq_left.2 h] }
#align inf_hom_class.to_order_hom_class InfHomClass.toOrderHomClass

-- See note [lower instance priority]
instance (priority := 100) SupBotHomClass.toBotHomClass {_ : Sup α} {_ : Sup β} {_ : Bot α}
    {_ : Bot β} [SupBotHomClass F α β] : BotHomClass F α β :=
  { ‹SupBotHomClass F α β› with }
#align sup_bot_hom_class.to_bot_hom_class SupBotHomClass.toBotHomClass

-- See note [lower instance priority]
instance (priority := 100) InfTopHomClass.toTopHomClass {_ : Inf α} {_ : Inf β} {_ : Top α}
    {_ : Top β} [InfTopHomClass F α β] : TopHomClass F α β :=
  { ‹InfTopHomClass F α β› with }
#align inf_top_hom_class.to_top_hom_class InfTopHomClass.toTopHomClass

-- See note [lower instance priority]
instance (priority := 100) LatticeHomClass.toInfHomClass {_ : Lattice α} {_ : Lattice β}
    [LatticeHomClass F α β] : InfHomClass F α β :=
  { ‹LatticeHomClass F α β› with }
#align lattice_hom_class.to_inf_hom_class LatticeHomClass.toInfHomClass

-- See note [lower instance priority]
instance (priority := 100) BoundedLatticeHomClass.toSupBotHomClass {_ : Lattice α} {_ : Lattice β}
    {_ : BoundedOrder α} {_ : BoundedOrder β} [BoundedLatticeHomClass F α β] :
    SupBotHomClass F α β :=
  { ‹BoundedLatticeHomClass F α β› with }
#align bounded_lattice_hom_class.to_sup_bot_hom_class BoundedLatticeHomClass.toSupBotHomClass

-- See note [lower instance priority]
instance (priority := 100) BoundedLatticeHomClass.toInfTopHomClass {_ : Lattice α} {_ : Lattice β}
    {_ : BoundedOrder α} {_ : BoundedOrder β} [BoundedLatticeHomClass F α β] :
    InfTopHomClass F α β :=
  { ‹BoundedLatticeHomClass F α β› with }
#align bounded_lattice_hom_class.to_inf_top_hom_class BoundedLatticeHomClass.toInfTopHomClass

-- See note [lower instance priority]
instance (priority := 100) BoundedLatticeHomClass.toBoundedOrderHomClass {_ : Lattice α}
    {_ : Lattice β} {_ : BoundedOrder α} {_ : BoundedOrder β} [BoundedLatticeHomClass F α β] :
    BoundedOrderHomClass F α β :=
{ show OrderHomClass F α β from inferInstance, ‹BoundedLatticeHomClass F α β› with }
#align
  bounded_lattice_hom_class.to_bounded_order_hom_class BoundedLatticeHomClass.toBoundedOrderHomClass

-- See note [lower instance priority]
instance (priority := 100) OrderIsoClass.toSupHomClass {_ : SemilatticeSup α} {_ : SemilatticeSup β}
    [OrderIsoClass F α β] : SupHomClass F α β :=
  { show OrderHomClass F α β from inferInstance with
    map_sup := fun f a b =>
      eq_of_forall_ge_iff fun c => by simp only [← le_map_inv_iff, sup_le_iff] }
#align order_iso_class.to_sup_hom_class OrderIsoClass.toSupHomClass

-- See note [lower instance priority]
instance (priority := 100) OrderIsoClass.toInfHomClass {_ : SemilatticeInf α} {_ : SemilatticeInf β}
    [OrderIsoClass F α β] : InfHomClass F α β :=
  { show OrderHomClass F α β from inferInstance with
    map_inf := fun f a b =>
      eq_of_forall_le_iff fun c => by simp only [← map_inv_le_iff, le_inf_iff] }
#align order_iso_class.to_inf_hom_class OrderIsoClass.toInfHomClass

/- The `SemilatticeSup` parameters can't be `[]` because `outParam`s would make them metavariables,
and can't be `{}` because they don't appear in the goal or the `OrderIsoClass` parameter.
We choose `{}` since it fails faster. -/
@[nolint dangerousInstance]
-- See note [lower instance priority]
instance (priority := 100) OrderIsoClass.toSupBotHomClass {_ : SemilatticeSup α} {_ : OrderBot α}
    {_ : SemilatticeSup β} {_ : OrderBot β} [OrderIsoClass F α β] : SupBotHomClass F α β :=
  { OrderIsoClass.toSupHomClass, OrderIsoClass.toBotHomClass with }
#align order_iso_class.to_sup_bot_hom_class OrderIsoClass.toSupBotHomClass

/- The `SemilatticeInf` parameters can't be `[]` because `outParam`s would make them metavariables,
and can't be `{}` because they don't appear in the goal or the `OrderIsoClass` parameter.
We choose `{}` since it fails faster. -/
@[nolint dangerousInstance]
-- See note [lower instance priority]
instance (priority := 100) OrderIsoClass.toInfTopHomClass {_ : SemilatticeInf α} {_ : OrderTop α}
    {_ : SemilatticeInf β} {_ : OrderTop β} [OrderIsoClass F α β] : InfTopHomClass F α β :=
  { OrderIsoClass.toInfHomClass, OrderIsoClass.toTopHomClass with }
#align order_iso_class.to_inf_top_hom_class OrderIsoClass.toInfTopHomClass

-- See note [lower instance priority]
instance (priority := 100) OrderIsoClass.toLatticeHomClass {_ : Lattice α} {_ : Lattice β}
    [OrderIsoClass F α β] : LatticeHomClass F α β :=
  { OrderIsoClass.toSupHomClass, OrderIsoClass.toInfHomClass with }
#align order_iso_class.to_lattice_hom_class OrderIsoClass.toLatticeHomClass

/- The `Lattice` parameters can't be `[]` because `outParam`s would make them metavariables,
and can't be `{}` because they don't appear in the goal or the `OrderIsoClass` parameter.
We choose `{}` since it fails faster. -/
@[nolint dangerousInstance]
-- See note [lower instance priority]
instance (priority := 100) OrderIsoClass.toBoundedLatticeHomClass {_ : Lattice α} {_ : Lattice β}
    {_ : BoundedOrder α} {_ : BoundedOrder β} [OrderIsoClass F α β] :
    BoundedLatticeHomClass F α β :=
  { OrderIsoClass.toLatticeHomClass, OrderIsoClass.toBoundedOrderHomClass with }
#align order_iso_class.to_bounded_lattice_hom_class OrderIsoClass.toBoundedLatticeHomClass

@[simp]
theorem map_finset_sup [SemilatticeSup α] [OrderBot α] [SemilatticeSup β] [OrderBot β]
    [SupBotHomClass F α β] (f : F) (s : Finset ι) (g : ι → α) : f (s.sup g) = s.sup (f ∘ g) :=
  Finset.cons_induction_on s (map_bot f) fun i s _ h => by
    rw [Finset.sup_cons, Finset.sup_cons, map_sup, h, Function.comp_apply]
#align map_finset_sup map_finset_sup

@[simp]
theorem map_finset_inf [SemilatticeInf α] [OrderTop α] [SemilatticeInf β] [OrderTop β]
    [InfTopHomClass F α β] (f : F) (s : Finset ι) (g : ι → α) : f (s.inf g) = s.inf (f ∘ g) :=
  Finset.cons_induction_on s (map_top f) fun i s _ h => by
    rw [Finset.inf_cons, Finset.inf_cons, map_inf, h, Function.comp_apply]
#align map_finset_inf map_finset_inf

section BoundedLattice

variable [Lattice α] [BoundedOrder α] [Lattice β] [BoundedOrder β] [BoundedLatticeHomClass F α β]
  (f : F) {a b : α}

theorem Disjoint.map (h : Disjoint a b) : Disjoint (f a) (f b) := by
  rw [disjoint_iff, ← map_inf, h.eq_bot, map_bot]
#align disjoint.map Disjoint.map

theorem Codisjoint.map (h : Codisjoint a b) : Codisjoint (f a) (f b) := by
  rw [codisjoint_iff, ← map_sup, h.eq_top, map_top]
#align codisjoint.map Codisjoint.map

theorem IsCompl.map (h : IsCompl a b) : IsCompl (f a) (f b) :=
  ⟨h.1.map _, h.2.map _⟩
#align is_compl.map IsCompl.map

end BoundedLattice

section BooleanAlgebra

variable [BooleanAlgebra α] [BooleanAlgebra β] [BoundedLatticeHomClass F α β] (f : F)

/-- Special case of `map_compl` for boolean algebras. -/
theorem map_compl' (a : α) : f (aᶜ) = f aᶜ :=
  (isCompl_compl.map _).compl_eq.symm
#align map_compl' map_compl'

/-- Special case of `map_sdiff` for boolean algebras. -/
theorem map_sdiff' (a b : α) : f (a \ b) = f a \ f b := by
  rw [sdiff_eq, sdiff_eq, map_inf, map_compl']
#align map_sdiff' map_sdiff'

/-- Special case of `map_symm_diff` for boolean algebras. -/
theorem map_symm_diff' (a b : α) : f (a ∆ b) = f a ∆ f b := by
  rw [symmDiff, symmDiff, map_sup, map_sdiff', map_sdiff']
#align map_symm_diff' map_symm_diff'

end BooleanAlgebra

instance [Sup α] [Sup β] [SupHomClass F α β] : CoeTC F (SupHom α β) :=
  ⟨fun f => ⟨f, map_sup f⟩⟩

instance [Inf α] [Inf β] [InfHomClass F α β] : CoeTC F (InfHom α β) :=
  ⟨fun f => ⟨f, map_inf f⟩⟩

instance [Sup α] [Sup β] [Bot α] [Bot β] [SupBotHomClass F α β] : CoeTC F (SupBotHom α β) :=
  ⟨fun f => ⟨f, map_bot f⟩⟩

instance [Inf α] [Inf β] [Top α] [Top β] [InfTopHomClass F α β] : CoeTC F (InfTopHom α β) :=
  ⟨fun f => ⟨f, map_top f⟩⟩

instance [Lattice α] [Lattice β] [LatticeHomClass F α β] : CoeTC F (LatticeHom α β) :=
  ⟨fun f =>
    { toFun := f
      map_sup' := map_sup f
      map_inf' := map_inf f }⟩

instance [Lattice α] [Lattice β] [BoundedOrder α] [BoundedOrder β] [BoundedLatticeHomClass F α β] :
    CoeTC F (BoundedLatticeHom α β) :=
  ⟨fun f =>
    { (f : LatticeHom α β) with
      toFun := f
      map_top' := map_top f
      map_bot' := map_bot f }⟩

/-! ### Supremum homomorphisms -/

namespace SupHom

variable [Sup α]

section Sup

variable [Sup β] [Sup γ] [Sup δ]

instance : SupHomClass (SupHom α β) α β where
  coe := SupHom.toFun
  coe_injective' f g h := by cases f; cases g; congr
  map_sup := SupHom.map_sup'

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
-- porting note: replaced `CoeFun` with `FunLike` so that we use `FunLike.coe` instead of `toFun`
instance : FunLike (SupHom α β) α fun _ => β :=
  SupHomClass.toFunLike

@[simp]
theorem toFun_eq_coe {f : SupHom α β} : f.toFun = (f : α → β) :=
  rfl
#align sup_hom.to_fun_eq_coe SupHom.toFun_eq_coe

@[ext]
theorem ext {f g : SupHom α β} (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext f g h
#align sup_hom.ext SupHom.ext

/-- Copy of a `SupHom` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : SupHom α β) (f' : α → β) (h : f' = f) : SupHom α β where
  toFun := f'
  map_sup' := h.symm ▸ f.map_sup'
#align sup_hom.copy SupHom.copy

@[simp]
theorem coe_copy (f : SupHom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align sup_hom.coe_copy SupHom.coe_copy

theorem copy_eq (f : SupHom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align sup_hom.copy_eq SupHom.copy_eq

variable (α)

/-- `id` as a `SupHom`. -/
protected def id : SupHom α α :=
  ⟨id, fun _ _ => rfl⟩
#align sup_hom.id SupHom.id

instance : Inhabited (SupHom α α) :=
  ⟨SupHom.id α⟩

@[simp]
theorem coe_id : ⇑(SupHom.id α) = id :=
  rfl
#align sup_hom.coe_id SupHom.coe_id

variable {α}

@[simp]
theorem id_apply (a : α) : SupHom.id α a = a :=
  rfl
#align sup_hom.id_apply SupHom.id_apply

/-- Composition of `SupHom`s as a `SupHom`. -/
def comp (f : SupHom β γ) (g : SupHom α β) : SupHom α γ where
  toFun := f ∘ g
  map_sup' a b := by rw [comp_apply, map_sup, map_sup]; rfl
#align sup_hom.comp SupHom.comp

@[simp]
theorem coe_comp (f : SupHom β γ) (g : SupHom α β) : (f.comp g : α → γ) = f ∘ g :=
  rfl
#align sup_hom.coe_comp SupHom.coe_comp

@[simp]
theorem comp_apply (f : SupHom β γ) (g : SupHom α β) (a : α) : (f.comp g) a = f (g a) :=
  rfl
#align sup_hom.comp_apply SupHom.comp_apply

@[simp]
theorem comp_assoc (f : SupHom γ δ) (g : SupHom β γ) (h : SupHom α β) :
    (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align sup_hom.comp_assoc SupHom.comp_assoc

@[simp] theorem comp_id (f : SupHom α β) : f.comp (SupHom.id α) = f := rfl
#align sup_hom.comp_id SupHom.comp_id

@[simp] theorem id_comp (f : SupHom α β) : (SupHom.id β).comp f = f := rfl
#align sup_hom.id_comp SupHom.id_comp

theorem cancel_left {g : SupHom β γ} {f₁ f₂ : SupHom α β} (hg : Injective g) :
    g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => SupHom.ext fun a => hg <| by rw [← SupHom.comp_apply, h, SupHom.comp_apply],
    congr_arg _⟩
#align sup_hom.cancel_left SupHom.cancel_left

end Sup

variable (α) [SemilatticeSup β]

/-- The constant function as a `SupHom`. -/
def const (b : β) : SupHom α β :=
  ⟨fun _ => b, fun _ _ => sup_idem.symm⟩
#align sup_hom.const SupHom.const

@[simp]
theorem coe_const (b : β) : ⇑(const α b) = Function.const α b :=
  rfl
#align sup_hom.coe_const SupHom.coe_const

@[simp]
theorem const_apply (b : β) (a : α) : const α b a = b :=
  rfl
#align sup_hom.const_apply SupHom.const_apply

variable {α}

instance : Sup (SupHom α β) :=
  ⟨fun f g =>
    ⟨f ⊔ g, fun a b => by
      rw [Pi.sup_apply, map_sup, map_sup]
      exact sup_sup_sup_comm _ _ _ _⟩⟩

instance : SemilatticeSup (SupHom α β) :=
  (FunLike.coe_injective.semilatticeSup _) fun _ _ => rfl

instance [Bot β] : Bot (SupHom α β) :=
  ⟨SupHom.const α ⊥⟩

instance [Top β] : Top (SupHom α β) :=
  ⟨SupHom.const α ⊤⟩

instance [OrderBot β] : OrderBot (SupHom α β) :=
  OrderBot.lift ((↑) : _ → α → β) (fun _ _ => id) rfl

instance [OrderTop β] : OrderTop (SupHom α β) :=
  OrderTop.lift ((↑) : _ → α → β) (fun _ _ => id) rfl

instance [BoundedOrder β] : BoundedOrder (SupHom α β) :=
  BoundedOrder.lift ((↑) : _ → α → β) (fun _ _ => id) rfl rfl

@[simp]
theorem coe_sup (f g : SupHom α β) : FunLike.coe (f ⊔ g) = f ⊔ g :=
  rfl
#align sup_hom.coe_sup SupHom.coe_sup

@[simp]
theorem coe_bot [Bot β] : ⇑(⊥ : SupHom α β) = ⊥ :=
  rfl
#align sup_hom.coe_bot SupHom.coe_bot

@[simp]
theorem coe_top [Top β] : ⇑(⊤ : SupHom α β) = ⊤ :=
  rfl
#align sup_hom.coe_top SupHom.coe_top

@[simp]
theorem sup_apply (f g : SupHom α β) (a : α) : (f ⊔ g) a = f a ⊔ g a :=
  rfl
#align sup_hom.sup_apply SupHom.sup_apply

@[simp]
theorem bot_apply [Bot β] (a : α) : (⊥ : SupHom α β) a = ⊥ :=
  rfl
#align sup_hom.bot_apply SupHom.bot_apply

@[simp]
theorem top_apply [Top β] (a : α) : (⊤ : SupHom α β) a = ⊤ :=
  rfl
#align sup_hom.top_apply SupHom.top_apply

end SupHom

/-! ### Infimum homomorphisms -/

namespace InfHom

variable [Inf α]

section Inf

variable [Inf β] [Inf γ] [Inf δ]

instance : InfHomClass (InfHom α β) α β where
  coe := InfHom.toFun
  coe_injective' f g h := by cases f; cases g; congr
  map_inf := InfHom.map_inf'

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : FunLike (InfHom α β) α fun _ => β :=
  InfHomClass.toFunLike

@[simp]
theorem toFun_eq_coe {f : InfHom α β} : f.toFun = (f : α → β) :=
  rfl
#align inf_hom.to_fun_eq_coe InfHom.toFun_eq_coe

@[ext]
theorem ext {f g : InfHom α β} (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext f g h
#align inf_hom.ext InfHom.ext

/-- Copy of an `InfHom` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : InfHom α β) (f' : α → β) (h : f' = f) : InfHom α β
    where
  toFun := f'
  map_inf' := h.symm ▸ f.map_inf'
#align inf_hom.copy InfHom.copy

@[simp]
theorem coe_copy (f : InfHom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align inf_hom.coe_copy InfHom.coe_copy

theorem copy_eq (f : InfHom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align inf_hom.copy_eq InfHom.copy_eq

variable (α)

/-- `id` as an `InfHom`. -/
protected def id : InfHom α α :=
  ⟨id, fun _ _ => rfl⟩
#align inf_hom.id InfHom.id

instance : Inhabited (InfHom α α) :=
  ⟨InfHom.id α⟩

@[simp]
theorem coe_id : ⇑(InfHom.id α) = id :=
  rfl
#align inf_hom.coe_id InfHom.coe_id

variable {α}

@[simp]
theorem id_apply (a : α) : InfHom.id α a = a :=
  rfl
#align inf_hom.id_apply InfHom.id_apply

/-- Composition of `InfHom`s as an `InfHom`. -/
def comp (f : InfHom β γ) (g : InfHom α β) : InfHom α γ where
  toFun := f ∘ g
  map_inf' a b := by rw [comp_apply, map_inf, map_inf]; rfl
#align inf_hom.comp InfHom.comp

@[simp]
theorem coe_comp (f : InfHom β γ) (g : InfHom α β) : (f.comp g : α → γ) = f ∘ g :=
  rfl
#align inf_hom.coe_comp InfHom.coe_comp

@[simp]
theorem comp_apply (f : InfHom β γ) (g : InfHom α β) (a : α) : (f.comp g) a = f (g a) :=
  rfl
#align inf_hom.comp_apply InfHom.comp_apply

@[simp]
theorem comp_assoc (f : InfHom γ δ) (g : InfHom β γ) (h : InfHom α β) :
    (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align inf_hom.comp_assoc InfHom.comp_assoc

@[simp] theorem comp_id (f : InfHom α β) : f.comp (InfHom.id α) = f := rfl
#align inf_hom.comp_id InfHom.comp_id

@[simp] theorem id_comp (f : InfHom α β) : (InfHom.id β).comp f = f := rfl
#align inf_hom.id_comp InfHom.id_comp

theorem cancel_right {g₁ g₂ : InfHom β γ} {f : InfHom α β} (hf : Surjective f) :
    g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => InfHom.ext <| hf.forall.2 <| FunLike.ext_iff.1 h, fun h => congr_arg₂ _ h rfl⟩
#align inf_hom.cancel_right InfHom.cancel_right

theorem cancel_left {g : InfHom β γ} {f₁ f₂ : InfHom α β} (hg : Injective g) :
    g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => InfHom.ext fun a => hg <| by rw [← InfHom.comp_apply, h, InfHom.comp_apply],
    congr_arg _⟩
#align inf_hom.cancel_left InfHom.cancel_left

end Inf

variable (α) [SemilatticeInf β]

/-- The constant function as an `InfHom`. -/
def const (b : β) : InfHom α β :=
  ⟨fun _ => b, fun _ _ => inf_idem.symm⟩
#align inf_hom.const InfHom.const

@[simp]
theorem coe_const (b : β) : ⇑(const α b) = Function.const α b :=
  rfl
#align inf_hom.coe_const InfHom.coe_const

@[simp]
theorem const_apply (b : β) (a : α) : const α b a = b :=
  rfl
#align inf_hom.const_apply InfHom.const_apply

variable {α}

instance : Inf (InfHom α β) :=
  ⟨fun f g =>
    ⟨f ⊓ g, fun a b => by
      rw [Pi.inf_apply, map_inf, map_inf]
      exact inf_inf_inf_comm _ _ _ _⟩⟩

instance : SemilatticeInf (InfHom α β) :=
  (FunLike.coe_injective.semilatticeInf _) fun _ _ => rfl

instance [Bot β] : Bot (InfHom α β) :=
  ⟨InfHom.const α ⊥⟩

instance [Top β] : Top (InfHom α β) :=
  ⟨InfHom.const α ⊤⟩

instance [OrderBot β] : OrderBot (InfHom α β) :=
  OrderBot.lift ((↑) : _ → α → β) (fun _ _ => id) rfl

instance [OrderTop β] : OrderTop (InfHom α β) :=
  OrderTop.lift ((↑) : _ → α → β) (fun _ _ => id) rfl

instance [BoundedOrder β] : BoundedOrder (InfHom α β) :=
  BoundedOrder.lift ((↑) : _ → α → β) (fun _ _ => id) rfl rfl

@[simp]
theorem coe_inf (f g : InfHom α β) : FunLike.coe (f ⊓ g) = f ⊓ g :=
  rfl
#align inf_hom.coe_inf InfHom.coe_inf

@[simp]
theorem coe_bot [Bot β] : ⇑(⊥ : InfHom α β) = ⊥ :=
  rfl
#align inf_hom.coe_bot InfHom.coe_bot

@[simp]
theorem coe_top [Top β] : ⇑(⊤ : InfHom α β) = ⊤ :=
  rfl
#align inf_hom.coe_top InfHom.coe_top

@[simp]
theorem inf_apply (f g : InfHom α β) (a : α) : (f ⊓ g) a = f a ⊓ g a :=
  rfl
#align inf_hom.inf_apply InfHom.inf_apply

@[simp]
theorem bot_apply [Bot β] (a : α) : (⊥ : InfHom α β) a = ⊥ :=
  rfl
#align inf_hom.bot_apply InfHom.bot_apply

@[simp]
theorem top_apply [Top β] (a : α) : (⊤ : InfHom α β) a = ⊤ :=
  rfl
#align inf_hom.top_apply InfHom.top_apply

end InfHom

/-! ### Finitary supremum homomorphisms -/

namespace SupBotHom

variable [Sup α] [Bot α]

section Sup

variable [Sup β] [Bot β] [Sup γ] [Bot γ] [Sup δ] [Bot δ]

/-- Reinterpret a `SupBotHom` as a `BotHom`. -/
def toBotHom (f : SupBotHom α β) : BotHom α β :=
  { f with }
#align sup_bot_hom.to_bot_hom SupBotHom.toBotHom

instance : SupBotHomClass (SupBotHom α β) α β
    where
  coe f := f.toFun
  coe_injective' f g h := by
    obtain ⟨⟨_, _⟩, _⟩ := f
    obtain ⟨⟨_, _⟩, _⟩ := g
    congr
  map_sup f := f.map_sup'
  map_bot f := f.map_bot'

-- porting note: replaced `CoeFun` instance with `FunLike` instance
instance : FunLike (SupBotHom α β) α fun _ => β :=
  SupHomClass.toFunLike

-- porting note: this is the `simp`-normal version of `toFun_eq_coe`
@[simp]
theorem coe_toSupHom {f : SupBotHom α β} : (f.toSupHom : α → β) = (f : α → β) :=
  rfl

-- porting note: adding this since we also added `coe_toSupHom`
@[simp]
theorem coe_toBotHom {f : SupBotHom α β} : (f.toBotHom : α → β) = (f : α → β) :=
  rfl

theorem toFun_eq_coe {f : SupBotHom α β} : f.toFun = (f : α → β) :=
  rfl
#align sup_bot_hom.to_fun_eq_coe SupBotHom.toFun_eq_coe

@[ext]
theorem ext {f g : SupBotHom α β} (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext f g h
#align sup_bot_hom.ext SupBotHom.ext

/-- Copy of a `SupBotHom` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : SupBotHom α β) (f' : α → β) (h : f' = f) : SupBotHom α β :=
  { f.toBotHom.copy f' h with toSupHom := f.toSupHom.copy f' h }
#align sup_bot_hom.copy SupBotHom.copy

@[simp]
theorem coe_copy (f : SupBotHom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align sup_bot_hom.coe_copy SupBotHom.coe_copy

theorem copy_eq (f : SupBotHom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align sup_bot_hom.copy_eq SupBotHom.copy_eq

variable (α)

/-- `id` as a `SupBotHom`. -/
@[simps]
protected def id : SupBotHom α α :=
  ⟨SupHom.id α, rfl⟩
#align sup_bot_hom.id SupBotHom.id

instance : Inhabited (SupBotHom α α) :=
  ⟨SupBotHom.id α⟩

@[simp]
theorem coe_id : ⇑(SupBotHom.id α) = id :=
  rfl
#align sup_bot_hom.coe_id SupBotHom.coe_id

variable {α}

@[simp]
theorem id_apply (a : α) : SupBotHom.id α a = a :=
  rfl
#align sup_bot_hom.id_apply SupBotHom.id_apply

/-- Composition of `SupBotHom`s as a `SupBotHom`. -/
def comp (f : SupBotHom β γ) (g : SupBotHom α β) : SupBotHom α γ :=
  { f.toSupHom.comp g.toSupHom, f.toBotHom.comp g.toBotHom with }
#align sup_bot_hom.comp SupBotHom.comp

@[simp]
theorem coe_comp (f : SupBotHom β γ) (g : SupBotHom α β) : (f.comp g : α → γ) = f ∘ g :=
  rfl
#align sup_bot_hom.coe_comp SupBotHom.coe_comp

@[simp]
theorem comp_apply (f : SupBotHom β γ) (g : SupBotHom α β) (a : α) : (f.comp g) a = f (g a) :=
  rfl
#align sup_bot_hom.comp_apply SupBotHom.comp_apply

@[simp]
theorem comp_assoc (f : SupBotHom γ δ) (g : SupBotHom β γ) (h : SupBotHom α β) :
    (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align sup_bot_hom.comp_assoc SupBotHom.comp_assoc

@[simp] theorem comp_id (f : SupBotHom α β) : f.comp (SupBotHom.id α) = f := rfl
#align sup_bot_hom.comp_id SupBotHom.comp_id

@[simp] theorem id_comp (f : SupBotHom α β) : (SupBotHom.id β).comp f = f := rfl
#align sup_bot_hom.id_comp SupBotHom.id_comp

theorem cancel_right {g₁ g₂ : SupBotHom β γ} {f : SupBotHom α β} (hf : Surjective f) :
    g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => ext <| hf.forall.2 <| FunLike.ext_iff.1 h, fun h => congr_arg₂ _ h rfl⟩
#align sup_bot_hom.cancel_right SupBotHom.cancel_right

theorem cancel_left {g : SupBotHom β γ} {f₁ f₂ : SupBotHom α β} (hg : Injective g) :
    g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => SupBotHom.ext fun a => hg <| by rw [← comp_apply, h, comp_apply], congr_arg _⟩
#align sup_bot_hom.cancel_left SupBotHom.cancel_left

end Sup

variable [SemilatticeSup β] [OrderBot β]

instance : Sup (SupBotHom α β) :=
  ⟨fun f g => { f.toBotHom ⊔ g.toBotHom with toSupHom := f.toSupHom ⊔ g.toSupHom }⟩

instance : SemilatticeSup (SupBotHom α β) :=
  (FunLike.coe_injective.semilatticeSup _) fun _ _ => rfl

instance : OrderBot (SupBotHom α β) where
  bot := ⟨⊥, rfl⟩
  bot_le _ _ := bot_le

@[simp]
theorem coe_sup (f g : SupBotHom α β) : FunLike.coe (f ⊔ g) = f ⊔ g :=
  rfl
#align sup_bot_hom.coe_sup SupBotHom.coe_sup

@[simp]
theorem coe_bot : ⇑(⊥ : SupBotHom α β) = ⊥ :=
  rfl
#align sup_bot_hom.coe_bot SupBotHom.coe_bot

@[simp]
theorem sup_apply (f g : SupBotHom α β) (a : α) : (f ⊔ g) a = f a ⊔ g a :=
  rfl
#align sup_bot_hom.sup_apply SupBotHom.sup_apply

@[simp]
theorem bot_apply (a : α) : (⊥ : SupBotHom α β) a = ⊥ :=
  rfl
#align sup_bot_hom.bot_apply SupBotHom.bot_apply

end SupBotHom

/-! ### Finitary infimum homomorphisms -/

namespace InfTopHom

variable [Inf α] [Top α]

section Inf

variable [Inf β] [Top β] [Inf γ] [Top γ] [Inf δ] [Top δ]

/-- Reinterpret an `InfTopHom` as a `TopHom`. -/
def toTopHom (f : InfTopHom α β) : TopHom α β :=
  { f with }
#align inf_top_hom.to_top_hom InfTopHom.toTopHom

instance : InfTopHomClass (InfTopHom α β) α β
    where
  coe f := f.toFun
  coe_injective' f g h := by
    obtain ⟨⟨_, _⟩, _⟩ := f
    obtain ⟨⟨_, _⟩, _⟩ := g
    congr
  map_inf f := f.map_inf'
  map_top f := f.map_top'

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : FunLike (InfTopHom α β) α fun _ => β :=
  InfHomClass.toFunLike

-- porting note: this is the `simp`-normal version of `toFun_eq_coe`
@[simp]
theorem coe_toInfHom {f : InfTopHom α β} : (f.toInfHom : α → β) = (f : α → β) :=
  rfl

-- porting note: adding this since we also added `coe_toInfHom`
@[simp]
theorem coe_toTopHom {f : InfTopHom α β} : (f.toTopHom : α → β) = (f : α → β) :=
  rfl

theorem toFun_eq_coe {f : InfTopHom α β} : f.toFun = (f : α → β) := rfl
#align inf_top_hom.to_fun_eq_coe InfTopHom.toFun_eq_coe

@[ext]
theorem ext {f g : InfTopHom α β} (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext f g h
#align inf_top_hom.ext InfTopHom.ext

/-- Copy of an `InfTopHom` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : InfTopHom α β) (f' : α → β) (h : f' = f) : InfTopHom α β :=
  { f.toTopHom.copy f' h with toInfHom := f.toInfHom.copy f' h }
#align inf_top_hom.copy InfTopHom.copy

@[simp]
theorem coe_copy (f : InfTopHom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align inf_top_hom.coe_copy InfTopHom.coe_copy

theorem copy_eq (f : InfTopHom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align inf_top_hom.copy_eq InfTopHom.copy_eq

variable (α)

/-- `id` as an `InfTopHom`. -/
@[simps]
protected def id : InfTopHom α α :=
  ⟨InfHom.id α, rfl⟩
#align inf_top_hom.id InfTopHom.id

instance : Inhabited (InfTopHom α α) :=
  ⟨InfTopHom.id α⟩

@[simp]
theorem coe_id : ⇑(InfTopHom.id α) = id :=
  rfl
#align inf_top_hom.coe_id InfTopHom.coe_id

variable {α}

@[simp]
theorem id_apply (a : α) : InfTopHom.id α a = a :=
  rfl
#align inf_top_hom.id_apply InfTopHom.id_apply

/-- Composition of `InfTopHom`s as an `InfTopHom`. -/
def comp (f : InfTopHom β γ) (g : InfTopHom α β) : InfTopHom α γ :=
  { f.toInfHom.comp g.toInfHom, f.toTopHom.comp g.toTopHom with }
#align inf_top_hom.comp InfTopHom.comp

@[simp]
theorem coe_comp (f : InfTopHom β γ) (g : InfTopHom α β) : (f.comp g : α → γ) = f ∘ g :=
  rfl
#align inf_top_hom.coe_comp InfTopHom.coe_comp

@[simp]
theorem comp_apply (f : InfTopHom β γ) (g : InfTopHom α β) (a : α) : (f.comp g) a = f (g a) :=
  rfl
#align inf_top_hom.comp_apply InfTopHom.comp_apply

@[simp]
theorem comp_assoc (f : InfTopHom γ δ) (g : InfTopHom β γ) (h : InfTopHom α β) :
    (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align inf_top_hom.comp_assoc InfTopHom.comp_assoc

@[simp] theorem comp_id (f : InfTopHom α β) : f.comp (InfTopHom.id α) = f := rfl
#align inf_top_hom.comp_id InfTopHom.comp_id

@[simp] theorem id_comp (f : InfTopHom α β) : (InfTopHom.id β).comp f = f := rfl
#align inf_top_hom.id_comp InfTopHom.id_comp

theorem cancel_right {g₁ g₂ : InfTopHom β γ} {f : InfTopHom α β} (hf : Surjective f) :
    g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => ext <| hf.forall.2 <| FunLike.ext_iff.1 h, fun h => congr_arg₂ _ h rfl⟩
#align inf_top_hom.cancel_right InfTopHom.cancel_right

theorem cancel_left {g : InfTopHom β γ} {f₁ f₂ : InfTopHom α β} (hg : Injective g) :
    g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => InfTopHom.ext fun a => hg <| by rw [← comp_apply, h, comp_apply], congr_arg _⟩
#align inf_top_hom.cancel_left InfTopHom.cancel_left

end Inf

variable [SemilatticeInf β] [OrderTop β]

instance : Inf (InfTopHom α β) :=
  ⟨fun f g => { f.toTopHom ⊓ g.toTopHom with toInfHom := f.toInfHom ⊓ g.toInfHom }⟩

instance : SemilatticeInf (InfTopHom α β) :=
  (FunLike.coe_injective.semilatticeInf _) fun _ _ => rfl

instance : OrderTop (InfTopHom α β) where
  top := ⟨⊤, rfl⟩
  le_top _ _ := le_top

@[simp]
theorem coe_inf (f g : InfTopHom α β) : FunLike.coe (f ⊓ g) = f ⊓ g :=
  rfl
#align inf_top_hom.coe_inf InfTopHom.coe_inf

@[simp]
theorem coe_top : ⇑(⊤ : InfTopHom α β) = ⊤ :=
  rfl
#align inf_top_hom.coe_top InfTopHom.coe_top

@[simp]
theorem inf_apply (f g : InfTopHom α β) (a : α) : (f ⊓ g) a = f a ⊓ g a :=
  rfl
#align inf_top_hom.inf_apply InfTopHom.inf_apply

@[simp]
theorem top_apply (a : α) : (⊤ : InfTopHom α β) a = ⊤ :=
  rfl
#align inf_top_hom.top_apply InfTopHom.top_apply

end InfTopHom

/-! ### Lattice homomorphisms -/

namespace LatticeHom

variable [Lattice α] [Lattice β] [Lattice γ] [Lattice δ]

/-- Reinterpret a `LatticeHom` as an `InfHom`. -/
def toInfHom (f : LatticeHom α β) : InfHom α β :=
  { f with }
#align lattice_hom.to_inf_hom LatticeHom.toInfHom

instance : LatticeHomClass (LatticeHom α β) α β
    where
  coe f := f.toFun
  coe_injective' f g h := by obtain ⟨⟨_, _⟩, _⟩ := f; obtain ⟨⟨_, _⟩, _⟩ := g; congr
  map_sup f := f.map_sup'
  map_inf f := f.map_inf'

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : FunLike (LatticeHom α β) α fun _ => β :=
  SupHomClass.toFunLike

-- porting note: this is the `simp`-normal version of `toFun_eq_coe`
@[simp]
theorem coe_toSupHom {f : LatticeHom α β} : (f.toSupHom : α → β) = (f : α → β) :=
  rfl

-- porting note: adding this since we also added `coe_toSupHom`
@[simp]
theorem coe_toInfHom {f : LatticeHom α β} : (f.toInfHom : α → β) = (f : α → β) :=
  rfl

theorem toFun_eq_coe {f : LatticeHom α β} : f.toFun = (f : α → β) := rfl
#align lattice_hom.to_fun_eq_coe LatticeHom.toFun_eq_coe

@[ext]
theorem ext {f g : LatticeHom α β} (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext f g h
#align lattice_hom.ext LatticeHom.ext

/-- Copy of a `LatticeHom` with a new `toFun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : LatticeHom α β) (f' : α → β) (h : f' = f) : LatticeHom α β :=
  { f.toSupHom.copy f' h, f.toInfHom.copy f' h with }
#align lattice_hom.copy LatticeHom.copy

@[simp]
theorem coe_copy (f : LatticeHom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align lattice_hom.coe_copy LatticeHom.coe_copy

theorem copy_eq (f : LatticeHom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align lattice_hom.copy_eq LatticeHom.copy_eq

variable (α)

/-- `id` as a `LatticeHom`. -/
protected def id : LatticeHom α α where
  toFun := id
  map_sup' _ _ := rfl
  map_inf' _ _ := rfl
#align lattice_hom.id LatticeHom.id

instance : Inhabited (LatticeHom α α) :=
  ⟨LatticeHom.id α⟩

@[simp]
theorem coe_id : ⇑(LatticeHom.id α) = id :=
  rfl
#align lattice_hom.coe_id LatticeHom.coe_id

variable {α}

@[simp]
theorem id_apply (a : α) : LatticeHom.id α a = a :=
  rfl
#align lattice_hom.id_apply LatticeHom.id_apply

/-- Composition of `LatticeHom`s as a `LatticeHom`. -/
def comp (f : LatticeHom β γ) (g : LatticeHom α β) : LatticeHom α γ :=
  { f.toSupHom.comp g.toSupHom, f.toInfHom.comp g.toInfHom with }
#align lattice_hom.comp LatticeHom.comp

@[simp]
theorem coe_comp (f : LatticeHom β γ) (g : LatticeHom α β) : (f.comp g : α → γ) = f ∘ g :=
  rfl
#align lattice_hom.coe_comp LatticeHom.coe_comp

@[simp]
theorem comp_apply (f : LatticeHom β γ) (g : LatticeHom α β) (a : α) : (f.comp g) a = f (g a) :=
  rfl
#align lattice_hom.comp_apply LatticeHom.comp_apply

@[simp]
-- porting note: `simp`-normal form of `coe_comp_sup_hom`
theorem coe_comp_sup_hom' (f : LatticeHom β γ) (g : LatticeHom α β) :
    ⟨f ∘ g, map_sup (f.comp g)⟩ = (f : SupHom β γ).comp g :=
  rfl

theorem coe_comp_sup_hom (f : LatticeHom β γ) (g : LatticeHom α β) :
    (f.comp g : SupHom α γ) = (f : SupHom β γ).comp g :=
  rfl
#align lattice_hom.coe_comp_sup_hom LatticeHom.coe_comp_sup_hom

@[simp]
-- porting note: `simp`-normal form of `coe_comp_inf_hom`
theorem coe_comp_inf_hom' (f : LatticeHom β γ) (g : LatticeHom α β) :
    ⟨f ∘ g, map_inf (f.comp g)⟩ = (f : InfHom β γ).comp g :=
  rfl

theorem coe_comp_inf_hom (f : LatticeHom β γ) (g : LatticeHom α β) :
    (f.comp g : InfHom α γ) = (f : InfHom β γ).comp g :=
  rfl
#align lattice_hom.coe_comp_inf_hom LatticeHom.coe_comp_inf_hom

@[simp]
theorem comp_assoc (f : LatticeHom γ δ) (g : LatticeHom β γ) (h : LatticeHom α β) :
    (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align lattice_hom.comp_assoc LatticeHom.comp_assoc

@[simp]
theorem comp_id (f : LatticeHom α β) : f.comp (LatticeHom.id α) = f :=
  LatticeHom.ext fun _ => rfl
#align lattice_hom.comp_id LatticeHom.comp_id

@[simp]
theorem id_comp (f : LatticeHom α β) : (LatticeHom.id β).comp f = f :=
  LatticeHom.ext fun _ => rfl
#align lattice_hom.id_comp LatticeHom.id_comp

theorem cancel_right {g₁ g₂ : LatticeHom β γ} {f : LatticeHom α β} (hf : Surjective f) :
    g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => LatticeHom.ext <| hf.forall.2 <| FunLike.ext_iff.1 h, fun h => congr_arg₂ _ h rfl⟩
#align lattice_hom.cancel_right LatticeHom.cancel_right

theorem cancel_left {g : LatticeHom β γ} {f₁ f₂ : LatticeHom α β} (hg : Injective g) :
    g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => LatticeHom.ext fun a => hg <| by rw [← LatticeHom.comp_apply, h, LatticeHom.comp_apply],
    congr_arg _⟩
#align lattice_hom.cancel_left LatticeHom.cancel_left

end LatticeHom

namespace OrderHomClass

variable (α β) [LinearOrder α] [Lattice β] [OrderHomClass F α β]

/-- An order homomorphism from a linear order is a lattice homomorphism. -/
/- The `Lattice` parameter can't be `[]` because `outParam`s would make them metavariables,
and can't be `{}` because they don't appear in the goal or the `OrderIsoClass` parameter.
We choose `{}` since it fails faster. -/
@[nolint dangerousInstance]
-- porting note: made it an `instance` because we're no longer afraid of loops
instance (priority := 100) toLatticeHomClass {_ : LinearOrder α} {_ : Lattice β}
  [OrderHomClass F α β] : LatticeHomClass F α β :=
  { ‹OrderHomClass F α β› with
    map_sup := fun f a b => by
      obtain h | h := le_total a b
      · rw [sup_eq_right.2 h, sup_eq_right.2 (OrderHomClass.mono f h : f a ≤ f b)]
      · rw [sup_eq_left.2 h, sup_eq_left.2 (OrderHomClass.mono f h : f b ≤ f a)]
    map_inf := fun f a b => by
      obtain h | h := le_total a b
      · rw [inf_eq_left.2 h, inf_eq_left.2 (OrderHomClass.mono f h : f a ≤ f b)]
      · rw [inf_eq_right.2 h, inf_eq_right.2 (OrderHomClass.mono f h : f b ≤ f a)] }
#align order_hom_class.to_lattice_hom_class OrderHomClass.toLatticeHomClass

/-- Reinterpret an order homomorphism to a linear order as a `LatticeHom`. -/
def toLatticeHom (f : F) : LatticeHom α β := f
#align order_hom_class.to_lattice_hom OrderHomClass.toLatticeHom

@[simp]
theorem coe_to_lattice_hom (f : F) : ⇑(toLatticeHom α β f) = f :=
  rfl
#align order_hom_class.coe_to_lattice_hom OrderHomClass.coe_to_lattice_hom

@[simp]
theorem to_lattice_hom_apply (f : F) (a : α) : toLatticeHom α β f a = f a :=
  rfl
#align order_hom_class.to_lattice_hom_apply OrderHomClass.to_lattice_hom_apply

end OrderHomClass

/-! ### Bounded lattice homomorphisms -/

namespace BoundedLatticeHom

variable [Lattice α] [Lattice β] [Lattice γ] [Lattice δ] [BoundedOrder α] [BoundedOrder β]
  [BoundedOrder γ] [BoundedOrder δ]

/-- Reinterpret a `BoundedLatticeHom` as a `SupBotHom`. -/
def toSupBotHom (f : BoundedLatticeHom α β) : SupBotHom α β :=
  { f with }
#align bounded_lattice_hom.to_sup_bot_hom BoundedLatticeHom.toSupBotHom

/-- Reinterpret a `BoundedLatticeHom` as an `InfTopHom`. -/
def toInfTopHom (f : BoundedLatticeHom α β) : InfTopHom α β :=
  { f with }
#align bounded_lattice_hom.to_inf_top_hom BoundedLatticeHom.toInfTopHom

/-- Reinterpret a `BoundedLatticeHom` as a `BoundedOrderHom`. -/
def toBoundedOrderHom (f : BoundedLatticeHom α β) : BoundedOrderHom α β :=
  { f, (f.toLatticeHom : α →o β) with }
#align bounded_lattice_hom.to_bounded_order_hom BoundedLatticeHom.toBoundedOrderHom

instance : BoundedLatticeHomClass (BoundedLatticeHom α β) α β
    where
  coe f := f.toFun
  coe_injective' f g h := by obtain ⟨⟨⟨_, _⟩, _⟩, _⟩ := f; obtain ⟨⟨⟨_, _⟩, _⟩, _⟩ := g; congr
  map_sup f := f.map_sup'
  map_inf f := f.map_inf'
  map_top f := f.map_top'
  map_bot f := f.map_bot'

-- porting note: this is the `simp`-normal version of `toFun_eq_coe`
@[simp]
theorem coe_toLatticeHom {f : BoundedLatticeHom α β} : (f.toLatticeHom : α → β) = (f : α → β) :=
  rfl

@[simp]
theorem toFun_eq_coe {f : BoundedLatticeHom α β} : f.toFun = (f : α → β) :=
  rfl
#align bounded_lattice_hom.to_fun_eq_coe BoundedLatticeHom.toFun_eq_coe

@[ext]
theorem ext {f g : BoundedLatticeHom α β} (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext f g h
#align bounded_lattice_hom.ext BoundedLatticeHom.ext

/-- Copy of a `BoundedLatticeHom` with a new `toFun` equal to the old one. Useful to fix
definitional equalities. -/
protected def copy (f : BoundedLatticeHom α β) (f' : α → β) (h : f' = f) : BoundedLatticeHom α β :=
  { f.toLatticeHom.copy f' h, f.toBoundedOrderHom.copy f' h with }
#align bounded_lattice_hom.copy BoundedLatticeHom.copy

@[simp]
theorem coe_copy (f : BoundedLatticeHom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align bounded_lattice_hom.coe_copy BoundedLatticeHom.coe_copy

theorem copy_eq (f : BoundedLatticeHom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align bounded_lattice_hom.copy_eq BoundedLatticeHom.copy_eq

variable (α)

/-- `id` as a `BoundedLatticeHom`. -/
protected def id : BoundedLatticeHom α α :=
  { LatticeHom.id α, BoundedOrderHom.id α with }
#align bounded_lattice_hom.id BoundedLatticeHom.id

instance : Inhabited (BoundedLatticeHom α α) :=
  ⟨BoundedLatticeHom.id α⟩

@[simp]
theorem coe_id : ⇑(BoundedLatticeHom.id α) = id :=
  rfl
#align bounded_lattice_hom.coe_id BoundedLatticeHom.coe_id

variable {α}

@[simp]
theorem id_apply (a : α) : BoundedLatticeHom.id α a = a :=
  rfl
#align bounded_lattice_hom.id_apply BoundedLatticeHom.id_apply

/-- Composition of `BoundedLatticeHom`s as a `BoundedLatticeHom`. -/
def comp (f : BoundedLatticeHom β γ) (g : BoundedLatticeHom α β) : BoundedLatticeHom α γ :=
  { f.toLatticeHom.comp g.toLatticeHom, f.toBoundedOrderHom.comp g.toBoundedOrderHom with }
#align bounded_lattice_hom.comp BoundedLatticeHom.comp

@[simp]
theorem coe_comp (f : BoundedLatticeHom β γ) (g : BoundedLatticeHom α β) :
    (f.comp g : α → γ) = f ∘ g :=
  rfl
#align bounded_lattice_hom.coe_comp BoundedLatticeHom.coe_comp

@[simp]
theorem comp_apply (f : BoundedLatticeHom β γ) (g : BoundedLatticeHom α β) (a : α) :
    (f.comp g) a = f (g a) :=
  rfl
#align bounded_lattice_hom.comp_apply BoundedLatticeHom.comp_apply

@[simp]
-- porting note: `simp`-normal form of `coe_comp_lattice_hom`
theorem coe_comp_lattice_hom' (f : BoundedLatticeHom β γ) (g : BoundedLatticeHom α β) :
    (⟨(f : SupHom β γ).comp g, map_inf (f.comp g)⟩ : LatticeHom α γ) =
      (f : LatticeHom β γ).comp g :=
  rfl

theorem coe_comp_lattice_hom (f : BoundedLatticeHom β γ) (g : BoundedLatticeHom α β) :
    (f.comp g : LatticeHom α γ) = (f : LatticeHom β γ).comp g :=
  rfl
#align bounded_lattice_hom.coe_comp_lattice_hom BoundedLatticeHom.coe_comp_lattice_hom

@[simp]
-- porting note: `simp`-normal form of `coe_comp_sup_hom`
theorem coe_comp_sup_hom' (f : BoundedLatticeHom β γ) (g : BoundedLatticeHom α β) :
    ⟨f ∘ g, map_sup (f.comp g)⟩ = (f : SupHom β γ).comp g :=
  rfl

theorem coe_comp_sup_hom (f : BoundedLatticeHom β γ) (g : BoundedLatticeHom α β) :
    (f.comp g : SupHom α γ) = (f : SupHom β γ).comp g :=
  rfl
#align bounded_lattice_hom.coe_comp_sup_hom BoundedLatticeHom.coe_comp_sup_hom

@[simp]
-- porting note: `simp`-normal form of `coe_comp_inf_hom`
theorem coe_comp_inf_hom' (f : BoundedLatticeHom β γ) (g : BoundedLatticeHom α β) :
    ⟨f ∘ g, map_inf (f.comp g)⟩ = (f : InfHom β γ).comp g :=
  rfl

theorem coe_comp_inf_hom (f : BoundedLatticeHom β γ) (g : BoundedLatticeHom α β) :
    (f.comp g : InfHom α γ) = (f : InfHom β γ).comp g :=
  rfl
#align bounded_lattice_hom.coe_comp_inf_hom BoundedLatticeHom.coe_comp_inf_hom

@[simp]
theorem comp_assoc (f : BoundedLatticeHom γ δ) (g : BoundedLatticeHom β γ)
    (h : BoundedLatticeHom α β) : (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align bounded_lattice_hom.comp_assoc BoundedLatticeHom.comp_assoc

@[simp] theorem comp_id (f : BoundedLatticeHom α β) : f.comp (BoundedLatticeHom.id α) = f := rfl
#align bounded_lattice_hom.comp_id BoundedLatticeHom.comp_id

@[simp] theorem id_comp (f : BoundedLatticeHom α β) : (BoundedLatticeHom.id β).comp f = f := rfl
#align bounded_lattice_hom.id_comp BoundedLatticeHom.id_comp

theorem cancel_right {g₁ g₂ : BoundedLatticeHom β γ} {f : BoundedLatticeHom α β}
    (hf : Surjective f) : g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
  ⟨fun h => BoundedLatticeHom.ext <| hf.forall.2 <| FunLike.ext_iff.1 h,
    fun h => congr_arg₂ _ h rfl⟩
#align bounded_lattice_hom.cancel_right BoundedLatticeHom.cancel_right

theorem cancel_left {g : BoundedLatticeHom β γ} {f₁ f₂ : BoundedLatticeHom α β} (hg : Injective g) :
    g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
  ⟨fun h => ext fun a => hg <| by rw [← comp_apply, h, comp_apply], congr_arg _⟩
#align bounded_lattice_hom.cancel_left BoundedLatticeHom.cancel_left

end BoundedLatticeHom

/-! ### Dual homs -/

namespace SupHom

variable [Sup α] [Sup β] [Sup γ]

/-- Reinterpret a supremum homomorphism as an infimum homomorphism between the dual lattices. -/
@[simps]
protected def dual : SupHom α β ≃ InfHom αᵒᵈ βᵒᵈ where
  toFun f := ⟨f, f.map_sup'⟩
  invFun f := ⟨f, f.map_inf'⟩
  left_inv _ := rfl
  right_inv _ := rfl
#align sup_hom.dual SupHom.dual

@[simp]
theorem dual_id : SupHom.dual (SupHom.id α) = InfHom.id _ :=
  rfl
#align sup_hom.dual_id SupHom.dual_id

@[simp]
theorem dual_comp (g : SupHom β γ) (f : SupHom α β) :
    SupHom.dual (g.comp f) = (SupHom.dual g).comp (SupHom.dual f) :=
  rfl
#align sup_hom.dual_comp SupHom.dual_comp

@[simp]
theorem symm_dual_id : SupHom.dual.symm (InfHom.id _) = SupHom.id α :=
  rfl
#align sup_hom.symm_dual_id SupHom.symm_dual_id

@[simp]
theorem symm_dual_comp (g : InfHom βᵒᵈ γᵒᵈ) (f : InfHom αᵒᵈ βᵒᵈ) :
    SupHom.dual.symm (g.comp f) =
      (SupHom.dual.symm g).comp (SupHom.dual.symm f) :=
  rfl
#align sup_hom.symm_dual_comp SupHom.symm_dual_comp

end SupHom

namespace InfHom

variable [Inf α] [Inf β] [Inf γ]

/-- Reinterpret an infimum homomorphism as a supremum homomorphism between the dual lattices. -/
@[simps]
protected def dual : InfHom α β ≃ SupHom αᵒᵈ βᵒᵈ where
  toFun f := ⟨f, f.map_inf'⟩
  invFun f := ⟨f, f.map_sup'⟩
  left_inv _ := rfl
  right_inv _ := rfl
#align inf_hom.dual InfHom.dual

@[simp]
theorem dual_id : InfHom.dual (InfHom.id α) = SupHom.id _ :=
  rfl
#align inf_hom.dual_id InfHom.dual_id

@[simp]
theorem dual_comp (g : InfHom β γ) (f : InfHom α β) :
    InfHom.dual (g.comp f) = (InfHom.dual g).comp (InfHom.dual f) :=
  rfl
#align inf_hom.dual_comp InfHom.dual_comp

@[simp]
theorem symm_dual_id : InfHom.dual.symm (SupHom.id _) = InfHom.id α :=
  rfl
#align inf_hom.symm_dual_id InfHom.symm_dual_id

@[simp]
theorem symm_dual_comp (g : SupHom βᵒᵈ γᵒᵈ) (f : SupHom αᵒᵈ βᵒᵈ) :
    InfHom.dual.symm (g.comp f) =
      (InfHom.dual.symm g).comp (InfHom.dual.symm f) :=
  rfl
#align inf_hom.symm_dual_comp InfHom.symm_dual_comp

end InfHom

namespace SupBotHom

variable [Sup α] [Bot α] [Sup β] [Bot β] [Sup γ] [Bot γ]

/-- Reinterpret a finitary supremum homomorphism as a finitary infimum homomorphism between the dual
lattices. -/
def dual : SupBotHom α β ≃ InfTopHom αᵒᵈ βᵒᵈ where
  toFun f := ⟨SupHom.dual f.toSupHom, f.map_bot'⟩
  invFun f := ⟨SupHom.dual.symm f.toInfHom, f.map_top'⟩
  left_inv _ := rfl
  right_inv _ := rfl
#align sup_bot_hom.dual SupBotHom.dual

@[simp] theorem dual_id : SupBotHom.dual (SupBotHom.id α) = InfTopHom.id _ := rfl
#align sup_bot_hom.dual_id SupBotHom.dual_id

@[simp]
theorem dual_comp (g : SupBotHom β γ) (f : SupBotHom α β) :
    SupBotHom.dual (g.comp f) = (SupBotHom.dual g).comp (SupBotHom.dual f) :=
  rfl
#align sup_bot_hom.dual_comp SupBotHom.dual_comp

@[simp]
theorem symm_dual_id : SupBotHom.dual.symm (InfTopHom.id _) = SupBotHom.id α :=
  rfl
#align sup_bot_hom.symm_dual_id SupBotHom.symm_dual_id

@[simp]
theorem symm_dual_comp (g : InfTopHom βᵒᵈ γᵒᵈ) (f : InfTopHom αᵒᵈ βᵒᵈ) :
    SupBotHom.dual.symm (g.comp f) =
      (SupBotHom.dual.symm g).comp (SupBotHom.dual.symm f) :=
  rfl
#align sup_bot_hom.symm_dual_comp SupBotHom.symm_dual_comp

end SupBotHom

namespace InfTopHom

variable [Inf α] [Top α] [Inf β] [Top β] [Inf γ] [Top γ]

/-- Reinterpret a finitary infimum homomorphism as a finitary supremum homomorphism between the dual
lattices. -/
@[simps]
protected def dual : InfTopHom α β ≃ SupBotHom αᵒᵈ βᵒᵈ
    where
  toFun f := ⟨InfHom.dual f.toInfHom, f.map_top'⟩
  invFun f := ⟨InfHom.dual.symm f.toSupHom, f.map_bot'⟩
  left_inv _ := rfl
  right_inv _ := rfl
#align inf_top_hom.dual InfTopHom.dual

@[simp]
theorem dual_id : InfTopHom.dual (InfTopHom.id α) = SupBotHom.id _ :=
  rfl
#align inf_top_hom.dual_id InfTopHom.dual_id

@[simp]
theorem dual_comp (g : InfTopHom β γ) (f : InfTopHom α β) :
    InfTopHom.dual (g.comp f) = (InfTopHom.dual g).comp (InfTopHom.dual f) :=
  rfl
#align inf_top_hom.dual_comp InfTopHom.dual_comp

@[simp]
theorem symm_dual_id : InfTopHom.dual.symm (SupBotHom.id _) = InfTopHom.id α :=
  rfl
#align inf_top_hom.symm_dual_id InfTopHom.symm_dual_id

@[simp]
theorem symm_dual_comp (g : SupBotHom βᵒᵈ γᵒᵈ) (f : SupBotHom αᵒᵈ βᵒᵈ) :
    InfTopHom.dual.symm (g.comp f) =
      (InfTopHom.dual.symm g).comp (InfTopHom.dual.symm f) :=
  rfl
#align inf_top_hom.symm_dual_comp InfTopHom.symm_dual_comp

end InfTopHom

namespace LatticeHom

variable [Lattice α] [Lattice β] [Lattice γ]

/-- Reinterpret a lattice homomorphism as a lattice homomorphism between the dual lattices. -/
@[simps]
protected def dual : LatticeHom α β ≃ LatticeHom αᵒᵈ βᵒᵈ where
  toFun f := ⟨InfHom.dual f.toInfHom, f.map_sup'⟩
  invFun f := ⟨SupHom.dual.symm f.toInfHom, f.map_sup'⟩
  left_inv _ := rfl
  right_inv _ := rfl
#align lattice_hom.dual LatticeHom.dual

@[simp] theorem dual_id : LatticeHom.dual (LatticeHom.id α) = LatticeHom.id _ := rfl
#align lattice_hom.dual_id LatticeHom.dual_id

@[simp]
theorem dual_comp (g : LatticeHom β γ) (f : LatticeHom α β) :
    LatticeHom.dual (g.comp f) = (LatticeHom.dual g).comp (LatticeHom.dual f) :=
  rfl
#align lattice_hom.dual_comp LatticeHom.dual_comp

@[simp]
theorem symm_dual_id : LatticeHom.dual.symm (LatticeHom.id _) = LatticeHom.id α :=
  rfl
#align lattice_hom.symm_dual_id LatticeHom.symm_dual_id

@[simp]
theorem symm_dual_comp (g : LatticeHom βᵒᵈ γᵒᵈ) (f : LatticeHom αᵒᵈ βᵒᵈ) :
    LatticeHom.dual.symm (g.comp f) =
      (LatticeHom.dual.symm g).comp (LatticeHom.dual.symm f) :=
  rfl
#align lattice_hom.symm_dual_comp LatticeHom.symm_dual_comp

end LatticeHom

namespace BoundedLatticeHom

variable [Lattice α] [BoundedOrder α] [Lattice β] [BoundedOrder β] [Lattice γ] [BoundedOrder γ]

/-- Reinterpret a bounded lattice homomorphism as a bounded lattice homomorphism between the dual
bounded lattices. -/
@[simps]
protected def dual : BoundedLatticeHom α β ≃ BoundedLatticeHom αᵒᵈ βᵒᵈ where
  toFun f := ⟨LatticeHom.dual f.toLatticeHom, f.map_bot', f.map_top'⟩
  invFun f := ⟨LatticeHom.dual.symm f.toLatticeHom, f.map_bot', f.map_top'⟩
  left_inv _ := rfl
  right_inv _ := rfl
#align bounded_lattice_hom.dual BoundedLatticeHom.dual

@[simp]
theorem dual_id : BoundedLatticeHom.dual (BoundedLatticeHom.id α) = BoundedLatticeHom.id _ :=
  rfl
#align bounded_lattice_hom.dual_id BoundedLatticeHom.dual_id

@[simp]
theorem dual_comp (g : BoundedLatticeHom β γ) (f : BoundedLatticeHom α β) :
    BoundedLatticeHom.dual (g.comp f) =
      (BoundedLatticeHom.dual g).comp (BoundedLatticeHom.dual f) :=
  rfl
#align bounded_lattice_hom.dual_comp BoundedLatticeHom.dual_comp

@[simp]
theorem symm_dual_id :
    BoundedLatticeHom.dual.symm (BoundedLatticeHom.id _) = BoundedLatticeHom.id α :=
  rfl
#align bounded_lattice_hom.symm_dual_id BoundedLatticeHom.symm_dual_id

@[simp]
theorem symm_dual_comp (g : BoundedLatticeHom βᵒᵈ γᵒᵈ) (f : BoundedLatticeHom αᵒᵈ βᵒᵈ) :
    BoundedLatticeHom.dual.symm (g.comp f) =
      (BoundedLatticeHom.dual.symm g).comp (BoundedLatticeHom.dual.symm f) :=
  rfl
#align bounded_lattice_hom.symm_dual_comp BoundedLatticeHom.symm_dual_comp

end BoundedLatticeHom


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis, Yaël Dillies

! This file was ported from Lean 3 source module algebra.order.module
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.SMul

/-!
# Ordered module

In this file we provide lemmas about `OrderedSMul` that hold once a module structure is present.

## References

* https://en.wikipedia.org/wiki/Ordered_module

## Tags

ordered module, ordered scalar, ordered smul, ordered action, ordered vector space
-/

open Pointwise

variable {k M N : Type _}

instance instModuleOrderDual [Semiring k] [OrderedAddCommMonoid M] [Module k M] : Module k Mᵒᵈ
    where
  add_smul _ _ x := OrderDual.rec (add_smul _ _) x
  zero_smul m := OrderDual.rec (zero_smul _) m

section Semiring

variable [OrderedSemiring k] [OrderedAddCommGroup M] [Module k M] [OrderedSMul k M] {a b : M}
  {c : k}

/- can be generalized from `module k M` to `distrib_mul_action_with_zero k M` once it exists.
where `distrib_mul_action_with_zero k M`is the conjunction of `distrib_mul_action k M` and
`smul_with_zero k M`.-/
theorem smul_neg_iff_of_pos (hc : 0 < c) : c • a < 0 ↔ a < 0 := by
  rw [← neg_neg a, smul_neg, neg_neg_iff_pos, neg_neg_iff_pos]
  exact smul_pos_iff_of_pos hc
#align smul_neg_iff_of_pos smul_neg_iff_of_pos

end Semiring

section Ring

variable [OrderedRing k] [OrderedAddCommGroup M] [Module k M] [OrderedSMul k M] {a b : M} {c : k}

theorem smul_lt_smul_of_neg (h : a < b) (hc : c < 0) : c • b < c • a := by
  rw [← neg_neg c, neg_smul, neg_smul (-c), neg_lt_neg_iff]
  exact smul_lt_smul_of_pos h (neg_pos_of_neg hc)
#align smul_lt_smul_of_neg smul_lt_smul_of_neg

theorem smul_le_smul_of_nonpos (h : a ≤ b) (hc : c ≤ 0) : c • b ≤ c • a := by
  rw [← neg_neg c, neg_smul, neg_smul (-c), neg_le_neg_iff]
  exact smul_le_smul_of_nonneg h (neg_nonneg_of_nonpos hc)
#align smul_le_smul_of_nonpos smul_le_smul_of_nonpos

theorem eq_of_smul_eq_smul_of_neg_of_le (hab : c • a = c • b) (hc : c < 0) (h : a ≤ b) : a = b := by
  rw [← neg_neg c, neg_smul, neg_smul (-c), neg_inj] at hab
  exact eq_of_smul_eq_smul_of_pos_of_le hab (neg_pos_of_neg hc) h
#align eq_of_smul_eq_smul_of_neg_of_le eq_of_smul_eq_smul_of_neg_of_le

theorem lt_of_smul_lt_smul_of_nonpos (h : c • a < c • b) (hc : c ≤ 0) : b < a := by
  rw [← neg_neg c, neg_smul, neg_smul (-c), neg_lt_neg_iff] at h
  exact lt_of_smul_lt_smul_of_nonneg h (neg_nonneg_of_nonpos hc)
#align lt_of_smul_lt_smul_of_nonpos lt_of_smul_lt_smul_of_nonpos

theorem smul_lt_smul_iff_of_neg (hc : c < 0) : c • a < c • b ↔ b < a := by
  rw [← neg_neg c, neg_smul, neg_smul (-c), neg_lt_neg_iff]
  exact smul_lt_smul_iff_of_pos (neg_pos_of_neg hc)
#align smul_lt_smul_iff_of_neg smul_lt_smul_iff_of_neg

theorem smul_neg_iff_of_neg (hc : c < 0) : c • a < 0 ↔ 0 < a := by
  rw [← neg_neg c, neg_smul, neg_neg_iff_pos]
  exact smul_pos_iff_of_pos (neg_pos_of_neg hc)
#align smul_neg_iff_of_neg smul_neg_iff_of_neg

theorem smul_pos_iff_of_neg (hc : c < 0) : 0 < c • a ↔ a < 0 := by
  rw [← neg_neg c, neg_smul, neg_pos]
  exact smul_neg_iff_of_pos (neg_pos_of_neg hc)
#align smul_pos_iff_of_neg smul_pos_iff_of_neg

theorem smul_nonpos_of_nonpos_of_nonneg (hc : c ≤ 0) (ha : 0 ≤ a) : c • a ≤ 0 :=
  calc
    c • a ≤ c • (0 : M) := smul_le_smul_of_nonpos ha hc
    _ = 0 := smul_zero c
#align smul_nonpos_of_nonpos_of_nonneg smul_nonpos_of_nonpos_of_nonneg

theorem smul_nonneg_of_nonpos_of_nonpos (hc : c ≤ 0) (ha : a ≤ 0) : 0 ≤ c • a :=
  @smul_nonpos_of_nonpos_of_nonneg k Mᵒᵈ _ _ _ _ _ _ hc ha
#align smul_nonneg_of_nonpos_of_nonpos smul_nonneg_of_nonpos_of_nonpos

alias smul_pos_iff_of_neg ↔ _ smul_pos_of_neg_of_neg
#align smul_pos_of_neg_of_neg smul_pos_of_neg_of_neg

alias smul_neg_iff_of_pos ↔ _ smul_neg_of_pos_of_neg
#align smul_neg_of_pos_of_neg smul_neg_of_pos_of_neg

alias smul_neg_iff_of_neg ↔ _ smul_neg_of_neg_of_pos
#align smul_neg_of_neg_of_pos smul_neg_of_neg_of_pos

theorem antitone_smul_left (hc : c ≤ 0) : Antitone (SMul.smul c : M → M) := fun _ _ h =>
  smul_le_smul_of_nonpos h hc
#align antitone_smul_left antitone_smul_left

theorem strict_anti_smul_left (hc : c < 0) : StrictAnti (SMul.smul c : M → M) := fun _ _ h =>
  smul_lt_smul_of_neg h hc
#align strict_anti_smul_left strict_anti_smul_left

/-- Binary **rearrangement inequality**. -/
theorem smul_add_smul_le_smul_add_smul [ContravariantClass M M (· + ·) (· ≤ ·)] {a b : k} {c d : M}
    (hab : a ≤ b) (hcd : c ≤ d) : a • d + b • c ≤ a • c + b • d := by
  obtain ⟨b, rfl⟩ := exists_add_of_le hab
  obtain ⟨d, rfl⟩ := exists_add_of_le hcd
  rw [smul_add, add_right_comm, smul_add, ← add_assoc, add_smul _ _ d]
  rw [le_add_iff_nonneg_right] at hab hcd
  exact add_le_add_left (le_add_of_nonneg_right <| smul_nonneg hab hcd) _
#align smul_add_smul_le_smul_add_smul smul_add_smul_le_smul_add_smul

/-- Binary **rearrangement inequality**. -/
theorem smul_add_smul_le_smul_add_smul' [ContravariantClass M M (· + ·) (· ≤ ·)] {a b : k} {c d : M}
    (hba : b ≤ a) (hdc : d ≤ c) : a • d + b • c ≤ a • c + b • d := by
  rw [add_comm (a • d), add_comm (a • c)]
  exact smul_add_smul_le_smul_add_smul hba hdc
#align smul_add_smul_le_smul_add_smul' smul_add_smul_le_smul_add_smul'

/-- Binary strict **rearrangement inequality**. -/
theorem smul_add_smul_lt_smul_add_smul [CovariantClass M M (· + ·) (· < ·)]
    [ContravariantClass M M (· + ·) (· < ·)] {a b : k} {c d : M} (hab : a < b) (hcd : c < d) :
    a • d + b • c < a • c + b • d := by
  obtain ⟨b, rfl⟩ := exists_add_of_le hab.le
  obtain ⟨d, rfl⟩ := exists_add_of_le hcd.le
  rw [smul_add, add_right_comm, smul_add, ← add_assoc, add_smul _ _ d]
  rw [lt_add_iff_pos_right] at hab hcd
  exact add_lt_add_left (lt_add_of_pos_right _ <| smul_pos hab hcd) _
#align smul_add_smul_lt_smul_add_smul smul_add_smul_lt_smul_add_smul

/-- Binary strict **rearrangement inequality**. -/
theorem smul_add_smul_lt_smul_add_smul' [CovariantClass M M (· + ·) (· < ·)]
    [ContravariantClass M M (· + ·) (· < ·)] {a b : k} {c d : M} (hba : b < a) (hdc : d < c) :
    a • d + b • c < a • c + b • d := by
  rw [add_comm (a • d), add_comm (a • c)]
  exact smul_add_smul_lt_smul_add_smul hba hdc
#align smul_add_smul_lt_smul_add_smul' smul_add_smul_lt_smul_add_smul'

end Ring

section Field

variable [LinearOrderedField k] [OrderedAddCommGroup M] [Module k M] [OrderedSMul k M] {a b : M}
  {c : k}

theorem smul_le_smul_iff_of_neg (hc : c < 0) : c • a ≤ c • b ↔ b ≤ a := by
  rw [← neg_neg c, neg_smul, neg_smul (-c), neg_le_neg_iff]
  exact smul_le_smul_iff_of_pos (neg_pos_of_neg hc)
#align smul_le_smul_iff_of_neg smul_le_smul_iff_of_neg

theorem inv_smul_le_iff_of_neg (h : c < 0) : c⁻¹ • a ≤ b ↔ c • b ≤ a := by
  rw [← smul_le_smul_iff_of_neg h, smul_inv_smul₀ h.ne]
#align inv_smul_le_iff_of_neg inv_smul_le_iff_of_neg

theorem inv_smul_lt_iff_of_neg (h : c < 0) : c⁻¹ • a < b ↔ c • b < a := by
  rw [← smul_lt_smul_iff_of_neg h, smul_inv_smul₀ h.ne]
#align inv_smul_lt_iff_of_neg inv_smul_lt_iff_of_neg

theorem smul_inv_le_iff_of_neg (h : c < 0) : a ≤ c⁻¹ • b ↔ b ≤ c • a := by
  rw [← smul_le_smul_iff_of_neg h, smul_inv_smul₀ h.ne]
#align smul_inv_le_iff_of_neg smul_inv_le_iff_of_neg

theorem smul_inv_lt_iff_of_neg (h : c < 0) : a < c⁻¹ • b ↔ b < c • a := by
  rw [← smul_lt_smul_iff_of_neg h, smul_inv_smul₀ h.ne]
#align smul_inv_lt_iff_of_neg smul_inv_lt_iff_of_neg

variable (M)

/-- Left scalar multiplication as an order isomorphism. -/
@[simps]
def OrderIso.smulLeftDual {c : k} (hc : c < 0) : M ≃o Mᵒᵈ where
  toFun b := OrderDual.toDual (c • b)
  invFun b := c⁻¹ • OrderDual.ofDual b
  left_inv := inv_smul_smul₀ hc.ne
  right_inv := smul_inv_smul₀ hc.ne
  map_rel_iff' := (@OrderDual.toDual_le_toDual M).trans <| smul_le_smul_iff_of_neg hc
#align order_iso.smul_left_dual OrderIso.smulLeftDual

end Field

/-! ### Upper/lower bounds -/

section OrderedRing

variable [OrderedRing k] [OrderedAddCommGroup M] [Module k M] [OrderedSMul k M] {s : Set M} {c : k}

theorem smul_lowerBounds_subset_upperBounds_smul (hc : c ≤ 0) :
    c • lowerBounds s ⊆ upperBounds (c • s) :=
  (antitone_smul_left hc).image_lowerBounds_subset_upperBounds_image
#align smul_lower_bounds_subset_upper_bounds_smul smul_lowerBounds_subset_upperBounds_smul

theorem smul_upperBounds_subset_lowerBounds_smul (hc : c ≤ 0) :
    c • upperBounds s ⊆ lowerBounds (c • s) :=
  (antitone_smul_left hc).image_upperBounds_subset_lowerBounds_image
#align smul_upper_bounds_subset_lower_bounds_smul smul_upperBounds_subset_lowerBounds_smul

theorem BddBelow.smul_of_nonpos (hc : c ≤ 0) (hs : BddBelow s) : BddAbove (c • s) :=
  (antitone_smul_left hc).map_bddBelow hs
#align bdd_below.smul_of_nonpos BddBelow.smul_of_nonpos

theorem BddAbove.smul_of_nonpos (hc : c ≤ 0) (hs : BddAbove s) : BddBelow (c • s) :=
  (antitone_smul_left hc).map_bddAbove hs
#align bdd_above.smul_of_nonpos BddAbove.smul_of_nonpos

end OrderedRing

section LinearOrderedField

variable [LinearOrderedField k] [OrderedAddCommGroup M] [Module k M] [OrderedSMul k M] {s : Set M}
  {c : k}

@[simp]
theorem lowerBounds_smul_of_neg (hc : c < 0) : lowerBounds (c • s) = c • upperBounds s :=
  (OrderIso.smulLeftDual M hc).upperBounds_image
#align lower_bounds_smul_of_neg lowerBounds_smul_of_neg

@[simp]
theorem upperBounds_smul_of_neg (hc : c < 0) : upperBounds (c • s) = c • lowerBounds s :=
  (OrderIso.smulLeftDual M hc).lowerBounds_image
#align upper_bounds_smul_of_neg upperBounds_smul_of_neg

@[simp]
theorem bddBelow_smul_iff_of_neg (hc : c < 0) : BddBelow (c • s) ↔ BddAbove s :=
  (OrderIso.smulLeftDual M hc).bddAbove_image
#align bdd_below_smul_iff_of_neg bddBelow_smul_iff_of_neg

@[simp]
theorem bddAbove_smul_iff_of_neg (hc : c < 0) : BddAbove (c • s) ↔ BddBelow s :=
  (OrderIso.smulLeftDual M hc).bddBelow_image
#align bdd_above_smul_iff_of_neg bddAbove_smul_iff_of_neg

end LinearOrderedField