import convex linalg
  analysis.normed_space.hahn_banach.separation

open_locale pointwise
open_locale topological_space

variables {V : Type} [inner_product_space ℝ V]
[finite_dimensional ℝ V]

def relint (A : set V) : set V :=
coe '' interior ((coe : affine_span ℝ A → V) ⁻¹' A)

def relbd (A : set V) : set V :=
(closure A) \ (relint A)

def is_relopen (A : set V) : Prop :=
is_open ((coe : affine_span ℝ A → V) ⁻¹' A)

theorem open_in_subspace (E : affine_subspace ℝ V) (A : set V) (h : is_open A) : is_open ((coe : E → V) ⁻¹' A) :=
begin
  let c := (coe : E → V),
  have : c = (coe : E → V) := rfl,
  let cc : continuous (coe : E → V) := continuous_subtype_coe,
  refine is_open.preimage cc h,
end

lemma relint_subset_self (A : set V) :
relint A ⊆ A :=
begin
  simp only [relint],
  intros x hx,
  simp only [set.mem_image] at hx,
  rcases hx with ⟨y, hy, rfl⟩,
  replace hy := interior_subset hy,
  exact hy,
end

lemma coe_ball_affine {E : affine_subspace ℝ V} (u : E) (ε : ℝ) :
coe '' metric.ball u ε = metric.ball (u : V) ε ∩ E :=
begin
  ext,
  simp only [set.mem_image, metric.mem_ball, set.mem_inter_iff],
  split,
  {
    rintro ⟨e, he, rfl⟩,
    refine ⟨_, e.property⟩,
    simpa only [subtype.dist_eq] using he,
  },
  {
    rintro ⟨h, xE⟩,
    refine ⟨⟨x, xE⟩, _, rfl⟩,
    {
      simpa only [subtype.dist_eq, subtype.coe_mk] using h,
    },
  },
end

lemma mem_relint (A : set V) (u : V) :
u ∈ relint A ↔ u ∈ span_points ℝ A ∧ ∃ ε : ℝ, ε > 0 ∧ metric.ball u ε ∩ span_points ℝ A ⊆ A :=
begin
  split,
  {
    intro hu,
    refine ⟨mem_span_points _ _ _ (relint_subset_self _ hu), _⟩,
    simp only [relint] at hu,
    rcases hu with ⟨pu, hpu, rfl⟩,
    have : is_open (interior (coe ⁻¹' A)) := is_open_interior,
    rw [metric.is_open_iff] at this,
    replace this := this _ hpu,
    rcases this with ⟨ε, hε, εball⟩,
    refine ⟨ε, hε, _⟩,
    replace εball := subset_trans εball interior_subset,
    rintro x ⟨xball, xA⟩,
    rw [←set.image_subset_iff] at εball,
    refine εball _,
    simp only [set.mem_image],
    refine ⟨⟨x, xA⟩, _, rfl⟩,
    {
      --simp only [metric.mem_ball] at xball,
      simp only [metric.mem_ball] at xball ⊢,
      simp only [subtype.dist_eq],
      exact xball,
    },
  },
  {
    intro h,
    rcases h with ⟨usp, ε, εpos, εball⟩,
    simp only [relint, set.mem_image],
    refine ⟨⟨u, usp⟩, _, rfl⟩,
    {
      simp only [mem_interior],
      refine ⟨metric.ball ⟨u, usp⟩ ε, _, _, _⟩,
      {
        simp only [←set.image_subset_iff, coe_ball_affine, subtype.coe_mk, coe_affine_span],
        exact εball,
      },
      {
        exact metric.is_open_ball,
      },
      {
        exact metric.mem_ball_self εpos,
      },
    },
  },
end

lemma mem_relint' (A : set V) (u : V) :
u ∈ relint A ↔ u ∈ span_points ℝ A ∧ ∃ (t : set V), t ∩ span_points ℝ A ⊆ A ∧ is_open t ∧ u ∈ t :=
begin
  rw [mem_relint], split,
  {
    rintro ⟨hu, ε, εpos, εball⟩,
    refine ⟨hu, metric.ball u ε, εball, metric.is_open_ball, metric.mem_ball_self εpos⟩,
  },
  {
    rintro ⟨hu, t, tsub, topen, tmem⟩,
    rw [metric.is_open_iff] at topen,
    rcases topen _ tmem with ⟨ε, εpos, εball⟩,
    refine ⟨hu, ε, εpos, _⟩,
    refine subset_trans _ tsub,
    apply set.inter_subset_inter_left,
    exact εball,
  },
end

lemma relint_mem_between {A : set V} {u x: V}
(uA : u ∈ relint A) (xA : x ∈ span_points ℝ A) (ne : u ≠ x) :
∃ y ∈ open_segment ℝ u x, y ∈ A :=
begin
  let v := x - u,
  let f : ℝ → V := λ δ, δ • v + u,
  have fcont : continuous f := by continuity,
  let uA := uA,
  rw [mem_relint] at uA,
  rcases uA with ⟨usp, ε, εpos, εball⟩,
  let U := f ⁻¹' metric.ball u ε,
  have Uo : is_open U := is_open.preimage fcont metric.is_open_ball,
  rw [metric.is_open_iff] at Uo,
  have Uo0 : (0 : ℝ) ∈ U,
  {
    simp only [set.mem_preimage, f, metric.mem_ball, zero_smul, zero_add, dist_self],
    exact εpos,
  },
  rcases Uo 0 Uo0 with ⟨δ', δpos', hδ'⟩,
  let δ := min δ' 1,
  have δpos : δ > 0,
  {
    simp only [gt_iff_lt, lt_min_iff, zero_lt_one, and_true],
    exact δpos',
  },
  have hδ : metric.ball 0 δ ⊆ U,
  {
    refine subset_trans _ hδ',
    apply metric.ball_subset_ball,
    simp only [min_le_iff, le_refl, true_or],
  },
  have δlt : δ / 2 < 1,
  {
    simp only [δ, div_lt_iff (show 0 < (2 : ℝ), by linarith)],
    simp only [one_mul, min_lt_iff],
    right,
    linarith,
  },
  let x' := (δ / 2) • v + u,
  refine ⟨x', _, _⟩,
  {
    simp only [open_segment, set.mem_set_of],
    refine ⟨1 - δ / 2, δ / 2, _, _, _, _⟩,
    {
      simp only [sub_pos],
      exact δlt,
    },
    {
      exact half_pos δpos,
    },
    {
      ring,
    },
    {
      simp only [x', sub_smul, one_smul, smul_sub],
      abel,
    },
  },
  {
    apply εball,
    split,
    {
      have : δ / 2 ∈ U,
      {
        apply hδ,
        simp only [metric.mem_ball, dist_eq_norm, tsub_zero, real.norm_eq_abs,
          abs_eq_self.mpr (le_of_lt (half_pos δpos))],
        exact half_lt_self δpos,
      },
      exact this,
    },
    {
      simp only [x', v],
      refine vadd_mem_span_points_of_mem_span_points_of_mem_vector_span ℝ _ _,
      {
        exact usp,
      },
      {
        refine submodule.smul_mem _ _ _,
        refine vsub_mem_vector_span_of_mem_span_points_of_mem_span_points ℝ _ _,
        {exact xA},
        {exact usp},
      },
    },
  },
end

lemma affine_span_inter' {A : set V} {E : submodule ℝ V} {u : V}
(uA : u ∈ relint A) (uE : u ∈ E) :
span_points ℝ A ∩ (E : set V) ⊆ span_points ℝ (A ∩ E) :=
begin
  rintro x ⟨hx₁, hx₂⟩,
  let uA := uA,
  rw [mem_relint] at uA,
  rcases uA with ⟨umem, ε, εpos, εball⟩,
  have umem' : u ∈ span_points ℝ A,
  {
    apply mem_span_points,
    exact relint_subset_self _ uA,
  },
  have umem : u ∈ span_points ℝ (A ∩ E),
  {
    apply mem_span_points,
    exact ⟨relint_subset_self _ uA, uE⟩,
  },
  let v := x - u,
  have vmem : v ∈ vector_span ℝ (A ∩ E),
  {
    have vmem' : v ∈ vector_span ℝ A :=
      vsub_mem_vector_span_of_mem_span_points_of_mem_span_points ℝ
      hx₁ umem',
    have : ∀ δ : ℝ, δ • v + u ∈ span_points ℝ A,
    {
      intro δ,
      have : δ • v ∈ vector_span ℝ A := submodule.smul_mem _ δ vmem',
      exact vadd_mem_span_points_of_mem_span_points_of_mem_vector_span ℝ
        umem' this,
    },
    let f : ℝ → V := λ δ, δ • v + u,
    have fcont : continuous f := by continuity,
    let U := f ⁻¹' metric.ball u ε,
    have Uo : is_open U := is_open.preimage fcont metric.is_open_ball,
    rw [metric.is_open_iff] at Uo,
    have Uo0 : (0 : ℝ) ∈ U,
    {
      simp only [set.mem_preimage, f, metric.mem_ball, zero_smul, zero_add, dist_self],
      exact εpos,
    },
    rcases Uo 0 Uo0 with ⟨δ, δpos, hδ⟩,
    let x' := (δ / 2) • v + u,
    have x'A : x' ∈ A ∩ E,
    {
      split, rotate,
      {
        simp only [x', set_like.mem_coe],
        apply E.add_mem (E.smul_mem _
          (E.sub_mem hx₂ uE)) uE,
      },
      apply εball,
      split,
      {
        have : δ / 2 ∈ U,
        {
          apply hδ,
          simp only [metric.mem_ball, dist_eq_norm, tsub_zero, real.norm_eq_abs,
            abs_eq_self.mpr (le_of_lt (half_pos δpos))],
          exact half_lt_self δpos,
        },
        exact this,
      },
      {
        exact this (δ / 2),
      },
    },
    let v' := (δ / 2) • v,
    have v'mem : v' ∈ vector_span ℝ (A ∩ E),
    {
      simpa only [vsub_eq_sub, add_sub_cancel] using vsub_mem_vector_span_of_mem_span_points_of_mem_span_points ℝ
        (mem_span_points ℝ x' (A ∩ ↑E) x'A) umem,
    },
    suffices h : (δ / 2)⁻¹ • (δ / 2) • v ∈ vector_span ℝ (A ∩ E),
    {
      simp only [inv_smul_smul₀ (ne_of_gt (half_pos δpos))] at h,
      exact h,
    },
    exact submodule.smul_mem _ (δ / 2)⁻¹ v'mem,
  },
  suffices h : v + u ∈ span_points ℝ (A ∩ E),
  {
    simpa only [sub_add_cancel] using h,
  },
  exact vadd_mem_span_points_of_mem_span_points_of_mem_vector_span
    ℝ umem vmem,
end

/- lemma affine_span_inter {A : set V} {E : submodule ℝ V} {u : V}
(h : u ∈ (relint A) ∩ E) :
affine_span ℝ (E.subtype ⁻¹' A) = (affine_span ℝ A).comap E.subtype.to_affine_map :=
begin
  apply le_antisymm,
  {
    admit,
  },
  {
    rw [set.mem_inter_iff] at h,
    have := affine_span_inter' h.1 h.2,
    intros x hx,
    simp only [affine_subspace.coe_comap, linear_map.coe_to_affine_map, submodule.coe_subtype, coe_affine_span, set.mem_preimage] at hx,
    have xmem : ↑x ∈ span_points ℝ (A ∩ E),
    {
      apply this,
      split,
      {exact hx},
      {exact x.property},
    },
    simp only [submodule.coe_subtype, coe_affine_span],
    admit,
  }
end -/

lemma line_subset_aspan {A : set V} {x y : V}
(xA : x ∈ span_points ℝ A) (yA : y ∈ span_points ℝ A) {c d : ℝ} (h : c + d = 1) :
c • x + d • y ∈ span_points ℝ A :=
begin
  suffices hs : c • (x - y) + (c + d) • y ∈ span_points ℝ A,
  {
    simp only [smul_sub, add_smul] at hs,
    simp only [←add_assoc, add_sub_right_comm, sub_add_cancel] at hs,
    exact hs,
  },
  {
    apply vadd_mem_span_points_of_mem_span_points_of_mem_vector_span ℝ,
    {
      rw [h, one_smul],
      exact yA,
    },
    {
      refine submodule.smul_mem _ _ _,
      apply vsub_mem_vector_span_of_mem_span_points_of_mem_span_points ℝ,
      all_goals {assumption},
    }
  },
end

-- linalg
lemma aspan_le_span (A : set V) :
affine_span ℝ A ≤ (submodule.span ℝ A).to_affine_subspace :=
begin
  rw [affine_span_le],
  apply submodule.subset_span,
end

lemma span_eq_hom_aspan {A : set V} :
↑(submodule.span ℝ A) =
{ x : V | (∃ (a : ℝ) (y ∈ span_points ℝ A), x = a • y)
∨ x ∈ vector_span ℝ A} :=
begin
  apply subset_antisymm,
  {
    intros x hx,
    refine submodule.span_induction hx _ _ _ _,
    {
      intros y yA,
      left,
      refine ⟨1, y, (mem_span_points _ _ _ yA), (one_smul _ _).symm⟩,
    },
    {
      right,
      exact submodule.zero_mem _,
    },
    {
      simp only [set.mem_set_of],
      intros y z hy hz,
      rcases hy with ⟨cy, y', ysp, rfl⟩,
      {
        rcases hz with ⟨cz, z', zsp, rfl⟩,
        {
          by_cases hc : cy + cz = 0,
          {
            right,
            simp only [add_eq_zero_iff_eq_neg] at hc,
            rw [hc, neg_smul, add_comm, ←sub_eq_add_neg, ←smul_sub],
            refine submodule.smul_mem _ _ _,
            apply vsub_mem_vector_span_of_mem_span_points_of_mem_span_points ℝ,
            all_goals {assumption},
          },
          {
            left,
            let c := cy + cz,
            refine ⟨c, c⁻¹ • (cy • y' + cz • z'), _, _⟩,
            {
              simp only [smul_add, ←mul_smul],
              apply line_subset_aspan,
              any_goals {assumption},
              simp only [c, ←mul_add, inv_mul_eq_one₀ hc],
            },
            {
              simp only [smul_inv_smul₀ hc],
            },
          },
        },
        {
          by_cases hc : cy = 0,
          {
            right,
            simp only [hc, zero_smul, zero_add],
            assumption,
          },
          {
            left,
            refine ⟨cy, y' + cy⁻¹ • z, _, _⟩,
            {
              rw [add_comm],
              apply vadd_mem_span_points_of_mem_span_points_of_mem_vector_span ℝ,
              {assumption},
              {
                refine submodule.smul_mem _ _ _,
                assumption,
              },
            },
            {
              rw [smul_add, smul_inv_smul₀ hc],
            },
          },
        },
      },
      {
        rcases hz with ⟨cz, z', zsp, rfl⟩,
        {
          by_cases hc : cz = 0,
          {
            right,
            simp only [hc, zero_smul, add_zero],
            assumption,
          },
          {
            left,
            refine ⟨cz, cz⁻¹ • y + z', _, _⟩,
            {
              apply vadd_mem_span_points_of_mem_span_points_of_mem_vector_span ℝ,
              {assumption},
              {
                refine submodule.smul_mem _ _ _,
                assumption,
              },
            },
            {
              rw [smul_add, smul_inv_smul₀ hc],
            },
          },
        },
        {
          right,
          refine submodule.add_mem _ _ _,
          all_goals {assumption},
        },
      },
    },
    {
      intros a y hy,
      rcases hy with ⟨cy, y', hy, rfl⟩,
      {
        left,
        simp only [smul_smul],
        tauto,
      },
      {
        right,
        refine submodule.smul_mem _ _ _,
        assumption,
      },
    },
  },
  {
    intros x hx,
    rcases hx with ⟨a, x', hx', rfl⟩,
    {
      -- replace hx' := this hx',
      simp only [set_like.mem_coe],
      apply submodule.smul_mem _ _ _,
      exact aspan_le_span _ hx',
    },
    {
      have : vector_span ℝ A ≤ submodule.span ℝ A,
      {
        simp only [vector_span, submodule.span_le],
        rintro - ⟨a, b, ha, hb, rfl⟩,
        rw [vsub_eq_sub, set_like.mem_coe],
        apply submodule.sub_mem _ _ _,
        all_goals {
          apply submodule.subset_span,
          assumption,
        },
      },
      exact this hx,
    },
  },
end

lemma aspan_inter_eq_aspan_preimage (A : set V) (E : submodule ℝ V) :
span_points ℝ (A ∩ E) = coe '' span_points ℝ (E.subtype ⁻¹' A) :=
begin
  suffices h : affine_span ℝ (A ∩ E) = affine_subspace.map E.subtype.to_affine_map (affine_span ℝ (E.subtype ⁻¹' A)),
  {
    ext, split,
    {
      intro hx,
      change x ∈ affine_span ℝ (A ∩ E) at hx,
      rw [h] at hx,
      exact hx,
    },
    {
      intro hx,
      change x ∈ (affine_span ℝ (E.subtype ⁻¹' A)).map E.subtype.to_affine_map at hx,
      rw [←h] at hx,
      exact hx,
    },
  },
  apply le_antisymm,
  {
    apply affine_span_le.mpr,
    rintro x ⟨xA, xE⟩,
    simp only [submodule.coe_subtype, affine_subspace.coe_map, linear_map.coe_to_affine_map, set.mem_image, coe_affine_span],
    refine ⟨⟨x, xE⟩, _, _⟩,
    {
      apply mem_span_points ℝ,
      simp only [set.mem_preimage, submodule.coe_mk],
      exact xA,
    },
    {
      simp only [submodule.coe_mk],
    },
  },
  {
    rw [affine_subspace.map_span, affine_span_le],
    simp only [linear_map.coe_to_affine_map, submodule.coe_subtype, coe_affine_span, set.image_subset_iff],
    intros x hx,
    simp only [set.mem_preimage] at hx ⊢,
    apply mem_span_points ℝ,
    exact ⟨hx, x.property⟩,
  },
end

lemma vspan_inter {A : set V} {E : submodule ℝ V} {u : V}
(h : u ∈ (relint A) ∩ E) :
vector_span ℝ (E.subtype ⁻¹' A) = (vector_span ℝ A).comap E.subtype :=
begin
  apply le_antisymm,
  {
    simp only [vector_span, submodule.span_le],
    rintro - ⟨a, b, ha, hb, rfl⟩,
    simp only [vsub_eq_sub, submodule.comap_coe, submodule.coe_subtype, set.mem_preimage, add_subgroup_class.coe_sub,
    set_like.mem_coe],
    apply submodule.subset_span _,
    refine ⟨a, b, ha, hb, rfl⟩,
  },
  {
    intros x hx,
    simp only [submodule.mem_comap, submodule.coe_subtype] at hx,
    let y := ↑x + u,
    have usp' : u ∈ span_points ℝ A,
    {
      apply mem_span_points,
      exact relint_subset_self _ h.1,
    },
    have usp : u ∈ span_points ℝ (A ∩ E),
    {
      apply affine_span_inter' h.1 h.2 _,
      exact ⟨usp', h.2⟩,
    },
    have ysp : y ∈ span_points ℝ A,
    {
      apply vadd_mem_span_points_of_mem_span_points_of_mem_vector_span ℝ,
      {
        exact usp',
      },
      {
        exact hx,
      },
    },
    by_cases hc : x = 0,
    {
      rw [hc],
      exact submodule.zero_mem _,
    },
    have huy : u ≠ y,
    {
      simp only [ne.def, self_eq_add_left, submodule.coe_eq_zero],
      exact hc,
    },
    have := relint_mem_between h.1 ysp huy,
    rcases this with ⟨z, hz₁, hz₂⟩,
    simp only [open_segment, set.mem_set_of] at hz₁,
    rcases hz₁ with ⟨a, b, ha, hb, hab, rfl⟩,
    simp only [y] at hz₂,
    rw [smul_add, add_comm, add_assoc, ←add_smul] at hz₂,
    rw [add_comm] at hab,
    rw [hab, one_smul] at hz₂,
    suffices hs : (b • x + ⟨u, h.2⟩) - ⟨u, h.2⟩ ∈ vector_span ℝ (E.subtype ⁻¹' A),
    {
      simp only [add_sub_cancel, submodule.coe_subtype] at hs,
      convert submodule.smul_mem _ b⁻¹ hs,
      rw [inv_smul_smul₀ (ne_of_gt hb)],
    },
    apply vsub_mem_vector_span_of_mem_span_points_of_mem_span_points ℝ,
    {
      apply mem_span_points,
      simp only [set.mem_preimage, submodule.coe_subtype, submodule.coe_add, submodule.coe_smul_of_tower, submodule.coe_mk],
      exact hz₂,
    },
    {
      apply mem_span_points,
      simp only [set.mem_preimage, submodule.coe_subtype, submodule.coe_add, submodule.coe_smul_of_tower, submodule.coe_mk],
      exact relint_subset_self _ h.1,
    },
  }
end

lemma span_inter {A : set V} {E : submodule ℝ V} {u : V}
(h : u ∈ (relint A) ∩ E) :
submodule.span ℝ (E.subtype ⁻¹' A) = (submodule.span ℝ A).comap E.subtype :=
begin
  apply le_antisymm,
  { -- easy direction
    rw [submodule.span_le],
    intros x hx,
    simp only [submodule.mem_comap, submodule.coe_subtype, set_like.mem_coe] at hx ⊢,
    apply submodule.subset_span,
    exact hx,
  },
  {
    intros x hx,
    simp only [submodule.mem_comap, submodule.coe_subtype] at hx,
    rw [←set_like.mem_coe, span_eq_hom_aspan, set.mem_set_of] at hx ⊢,
    rcases hx with ⟨a, y, ha, hxy⟩,
    {
      by_cases hc : a = 0,
      {
        rw [set.mem_inter_iff] at h,
        left,
        refine ⟨0, ⟨u, _⟩, _⟩,
        {
          exact h.2,
        },
        simp only [hc, zero_smul, submodule.coe_eq_zero] at hxy,
        rw [hxy],
        simp only [submodule.coe_subtype, zero_smul, eq_self_iff_true, exists_prop, and_true],
        apply mem_span_points ℝ,
        simp only [set.mem_preimage, submodule.coe_mk],
        exact relint_subset_self _ h.1,
      },
      left,
      refine ⟨a, ⟨y, _⟩, _, _⟩,
      {
        convert E.smul_mem a⁻¹ x.property,
        simp only [hxy, subtype.val_eq_coe, inv_smul_smul₀ hc],
      },
      {
        suffices h : y ∈ coe '' span_points ℝ ((E.subtype) ⁻¹' A),
        {
          rw [set.mem_image] at h,
          rcases h with ⟨z, h₁, rfl⟩,
          have : z = ⟨↑z, z.property⟩ := by simp only [set_like.eta],
          rw [←set_like.eta z z.property] at h₁,
          exact h₁,
        },
        rw [←aspan_inter_eq_aspan_preimage],
        apply affine_span_inter' h.1 h.2,
        refine ⟨ha, _⟩,
        simp only [set_like.mem_coe],
        convert E.smul_mem a⁻¹ x.property,
        rw [subtype.val_eq_coe, hxy, inv_smul_smul₀ hc],
      },
      {
        apply subtype.coe_injective,
        simp only [hxy, submodule.coe_smul_of_tower, submodule.coe_mk],
      },
    },
    {
      right,
      rw [vspan_inter h, submodule.mem_comap],
      exact hx,
    },
  },
end

lemma relint_eq_int {A : set V} (hA : vector_span ℝ A = ⊤) :
relint A = interior A :=
begin
  cases A.eq_empty_or_nonempty with hs hs,
  {
    rw [hs],
    simp only [relint, set.preimage_empty, interior_empty, set.image_empty],
  },
  {
    rw [←affine_subspace.affine_span_eq_top_iff_vector_span_eq_top_of_nonempty] at hA,
    replace hA := congr_arg (coe : affine_subspace ℝ V → set V) hA,
    rw [coe_affine_span, affine_subspace.top_coe] at hA,
    {
      ext,
      rw [mem_relint', mem_interior, hA],
      simp only [set.mem_univ, set.inter_univ, true_and, exists_prop],
    },
    {
      exact hs,
    },
  },
end

lemma aspan_preimage_coe_le' {W : submodule ℝ V} (A : set V) :
span_points ℝ ((coe : W → V) ⁻¹' A) ⊆ coe ⁻¹' span_points ℝ A :=
begin
  have : coe ⁻¹' span_points ℝ A = (affine_subspace.comap W.subtype.to_affine_map (affine_span ℝ A) : set W) := rfl,
  rw [this, ←coe_affine_span, ←affine_subspace.le_def, affine_span_le],
  simp only [affine_subspace.coe_comap, linear_map.coe_to_affine_map, submodule.coe_subtype, coe_affine_span],
  exact set.preimage_mono (by apply subset_affine_span),
end

lemma relint_inter_flat {A : set V} {E : submodule ℝ V}
{x : V} (xA : x ∈ relint A) (xE : x ∈ E) :
(⟨x, xE⟩ : E) ∈ relint ((coe : E → V) ⁻¹' A) :=
begin
  have xA' := relint_subset_self A xA,
  simp only [mem_relint'] at xA ⊢,
  refine ⟨_, _⟩,
  {
    apply subset_affine_span,
    exact xA',
  },
  {
    rcases xA.2 with ⟨t, tsub, topen, tmem⟩,
    refine ⟨coe ⁻¹' t, _, _, _⟩,
    {
      refine subset_trans _ (set.preimage_mono tsub),
      rintro y ⟨hy₁, hy₂⟩,
      simp only [set.mem_inter_eq, set.mem_preimage, ←coe_affine_span] at hy₁ ⊢,
      exact ⟨hy₁, aspan_preimage_coe_le' _ hy₂⟩,
    },
    {
      exact open_in_subspace E.to_affine_subspace _ topen,
    },
    {
      exact tmem,
    },
  },
end

lemma relint_eq_iff_relopen {A : set V} :
relint A = A ↔ is_relopen A :=
begin
  simp only [is_relopen, relint],
  rw [←interior_eq_iff_open],
  split,
  {
    intro h,
    conv {
      to_rhs,
      congr, skip,
      rw [←h],
    },
    rw [set.preimage_image_eq],
    exact subtype.coe_injective,
  },
  {
    intro h,
    rw [h, set.image_preimage_eq_iff, subtype.range_coe],
    exact subset_affine_span ℝ A,
  },
end

lemma relint_relopen {A : set V} (hA : is_relopen A) :
relint A = A := relint_eq_iff_relopen.mpr hA

/- lemma interior_convex {A : set V} (Acv : convex ℝ A) :
convex ℝ (interior A) := sorry -/

/- lemma relint_convex {A : set V} (Acv : convex ℝ A) :
convex ℝ (relint A) := sorry -/

/- lemma cl_relint_eq_cl {A : set V} (Acv : convex ℝ A) :
closure (relint A) = closure A := sorry -/

lemma relint_nonempty {A : set V} (Acv : convex ℝ A)
(Ane : A.nonempty) : (relint A).nonempty := sorry

lemma exists_mem_open_segment_of_mem_relint {A : set V} {x y : V}
(xA : x ∈ relint A) (yA : y ∈ affine_span ℝ A) :
∃ z : V, z ∈ A ∧ x ∈ open_segment ℝ y z :=
begin
  rw [mem_relint'] at xA,
  obtain ⟨xA, U, hU₁, hU₂⟩ := xA,
  let f : ℝ → V := λ c, (1 + c) • x - c • y,
  have fc : continuous f := by continuity,
  have fz : f 0 = x,
  {
    simp only [f],
    rw [add_zero, one_smul, zero_smul, sub_zero],
  },
  haveI : (𝓝[set.Ioo (0 : ℝ) 1] 0).ne_bot := left_nhds_within_Ioo_ne_bot zero_lt_one,
  have mem_cl : (0 : ℝ) ∈ closure (set.Ioo (0 : ℝ) 1),
  {
    rw [closure_Ioo zero_ne_one],
    exact set.left_mem_Icc.mpr zero_le_one,
    all_goals {apply_instance},
  },
  rw [mem_closure_iff_seq_limit] at mem_cl,
  obtain ⟨t, ht₁, ht₂⟩ := mem_cl,
  have ftt : filter.tendsto (f ∘ t) filter.at_top (𝓝 (f 0)) :=
  filter.tendsto.comp fc.continuous_at ht₂,
  rw [fz, tendsto_at_top_nhds] at ftt,
  obtain ⟨n, hn⟩ := ftt U hU₂.2 hU₂.1,
  replace hn := hn n (le_refl n),
  have : (f ∘ t) n ∈ affine_span ℝ A,
  {
    simp only [f, function.comp_app],
    rw [add_smul, one_smul, add_sub_assoc, ←smul_sub, add_comm],
    refine affine_subspace.vadd_mem_of_mem_direction _ xA,
    {
      refine submodule.smul_mem _ _ _,
      refine affine_subspace.vsub_mem_direction xA yA,
    },
  },
  refine ⟨_, hU₁ ⟨hn, this⟩, _⟩,
  simp only [f, function.comp_app, mem_open_segment'],
  have dpos : 0 < (1 + t n) := add_pos zero_lt_one (ht₁ n).1,
  refine ⟨1 - (1 + t n)⁻¹, ⟨_, _⟩, _⟩,
  {
    simp only [sub_pos],
    apply inv_lt_one,
    rw [lt_add_iff_pos_right],
    exact (ht₁ n).1,
  },
  {
    rw [sub_lt_self_iff, inv_pos],
    exact add_pos zero_lt_one (ht₁ n).1,
  },
  {
    -- so tedious...
    simp only [sub_sub_cancel, smul_sub],
    rw [inv_smul_smul₀ (ne_of_gt dpos), sub_smul, smul_smul],
    rw [←sub_smul, add_sub_left_comm, self_eq_add_right, ←sub_smul],
    rw [smul_eq_zero],
    nth_rewrite 0 [←inv_mul_cancel (ne_of_gt dpos)],
    rw [sub_right_comm, ←mul_sub],
    simp only [add_tsub_cancel_right, mul_one, sub_self, eq_self_iff_true, true_or],
  },
end

lemma relopen_iff_exists_open_inter_aspan
{A : set V} :
is_relopen A ↔ ∃ B : set V, is_open B ∧ B ∩ affine_span ℝ A = A :=
begin
  simp only [is_relopen, is_open_induced_iff],
  apply exists_congr,
  simp only [and.congr_right_iff],
  intros B hB,
  simp only [←subtype.coe_injective.image_injective.eq_iff, subtype.image_preimage_coe],
  congr', -- Why does this work while congr doesn't?
  ext, simp only [set.mem_inter_eq, and_iff_left_iff_imp],
  intro xA,
  exact subset_affine_span ℝ A xA,
end

/- def make_relopen_open (A : set V) : set V :=
--{x : V | ∃ a : V, a ∈ A ∧ }
A + (vector_span ℝ A)ᗮ

lemma interior_make_relopen_open (A : set V) :
interior (make_relopen_open A) = make_relopen_open (relint A) :=
begin
  ext,
  simp only [mem_interior, make_relopen_open, set.mem_add, exists_prop, set_like.mem_coe, exists_and_distrib_left, vector_span_def, exists_prop],
  split,
  {
    rintro ⟨t, tss, topen, xt⟩,
    obtain ⟨y, z, yA, hz, rfl⟩ := tss xt,
    refine ⟨y, _, z, _, rfl⟩,
    {
      rw [mem_relint'],
      let t' := t + (vector_span ℝ A)ᗮ, --{x : V | ∃ y : V, y ∈ (vector_span ℝ A)ᗮ ∧ x + y ∈ t},
      refine ⟨subset_affine_span ℝ _ yA, t', _, _, _⟩,
      {
        have tss' : t' ⊆ A + (vector_span ℝ A)ᗮ,
        {
          simp only [t'],
          refine subset_trans (set.add_subset_add_right tss) _,
          rw [add_assoc],
          rintro - ⟨a, -, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩,
          refine ⟨a, b + c, ha, _, rfl⟩,
          rw [set_like.mem_coe],
          exact submodule.add_mem _ hb hc,
        },
        rintro w ⟨w₁, w₂⟩,
        obtain ⟨a, b, ha, hb, rfl⟩ := tss' w₁,
        have : b ∈ vector_span ℝ A,
        {
          rw [←add_sub_cancel' a b],
          apply vsub_mem_vector_span_of_mem_span_points_of_mem_span_points ℝ,
          exact w₂,
          exact subset_affine_span ℝ _ ha,
        },
        rw [set_like.mem_coe] at hb,
        replace hb := hb _ this,
        rw [inner_self_eq_zero] at hb,
        rw [hb, add_zero],
        exact ha,
      },
      {
        rw [metric.is_open_iff] at topen ⊢,
        rintro x ⟨x₁, x₂, hx₁, hx₂, rfl⟩,
        obtain ⟨ε, εpos, εball⟩ := topen x₁ hx₁,
        refine ⟨ε, εpos, _⟩,
        rw [←ball_add_singleton],
        rintro y ⟨y₁, y₂, hy₁, hy₂, rfl⟩,
        rw [set.mem_singleton_iff] at hy₂,
        obtain rfl := hy₂,
        exact ⟨y₁, y₂, εball hy₁, hx₂, rfl⟩,
      },
      {
        refine ⟨y + z, -z, xt, _, _⟩,
        {
          rw [set_like.mem_coe] at hz ⊢,
          exact submodule.neg_mem _ hz,
        },
        {
          simp only [add_neg_cancel_right],
        },
      },
    },
    {
      simp only [mem_orthogonal_span, set_like.mem_coe] at hz ⊢,
      intros u hu,
      apply hz u,
      obtain ⟨u₁, u₂, hu₁, hu₂, rfl⟩ := hu,
      exact ⟨u₁, u₂, relint_subset_self _ hu₁, relint_subset_self _ hu₂, rfl⟩,
    },
  },
  {
    rintro ⟨y, hy, z, hz, rfl⟩,
    rw [mem_relint] at hy,
    obtain ⟨ε, εpos, εball⟩ := hy.2,
    refine ⟨metric.ball (y + z) ε, _, _, _⟩,
    {
      intros w hw,
      let v := orthogonal_projection (vector_span ℝ A) (w - (y + z)),
      have : ∥v∥ < ε,
      {
        refine lt_of_le_of_lt _ (mem_ball_iff_norm.mp hw),
        refine le_trans (continuous_linear_map.le_op_norm (orthogonal_projection (vector_span ℝ A)) (w - (y + z))) _,
        refine le_trans
        (mul_le_mul_of_nonneg_right
        (orthogonal_projection_norm_le _) (norm_nonneg _)) _,
        rw [one_mul],
      },
      have hz': z ∈ (vector_span ℝ A)ᗮ,
      {
        admit,
      },
      have : ((w - (y + z)) - v) + z ∈ (vector_span ℝ A)ᗮ,
      {
        refine submodule.add_mem _ _ hz',
        exact sub_orthogonal_projection_mem_orthogonal _,
      },
      rw [←sub_sub, sub_add_eq_add_sub, sub_add_cancel, sub_sub] at this,
      refine ⟨y + v, w - (y + v), _, _, _⟩,
      {
        admit,
      },
      {
        exact this,
      },
      {
        simp only [add_sub_cancel'_right],
      },
    },
    {
      exact metric.is_open_ball,
    },
    {
      exact metric.mem_ball_self εpos,
    },
  },
end -/

/- lemma relopen_iff_open_preimage
{A : set V} :
is_relopen A ↔ is_open (make_relopen_open A) :=
begin
  rw [←relint_eq_iff_relopen],
  admit,
end -/

lemma cl_subset_aspan (A : set V) :
closure A ⊆ affine_span ℝ A :=
begin
  rw [is_closed.closure_subset_iff], rotate,
  {apply affine_subspace.closed_of_finite_dimensional},
  apply subset_affine_span,
end

lemma mem_open_segment_tendsto_left_of_tendsto_right {x y z : V}
(hy : y ∈ open_segment ℝ x z)
{t : ℕ → V}
(ht : filter.tendsto t filter.at_top (𝓝 z))
{E : affine_subspace ℝ V}
(yE : y ∈ E)
(zE : ∀ n, t n ∈ E) :
∃ u : ℕ → V, filter.tendsto u filter.at_top (𝓝 x) ∧
(∀ n : ℕ, y ∈ open_segment ℝ (u n) (t n)) ∧
(∀ n : ℕ, u n ∈ E) :=
begin
  rw [mem_open_segment'] at hy,
  obtain ⟨c, ⟨hc₁, hc₂⟩, hy⟩ := hy,
  let f : V → V := λ z', c⁻¹ • (y - (1 - c) • z'),
  have fc : continuous f := by continuity,
  have fz : f z = x :=
  by simp only [f, hy, smul_add, sub_smul, ne_of_gt hc₁, inv_smul_smul₀, ne.def, not_false_iff, add_sub_cancel],
  refine ⟨λ n, f (t n), _, _, _⟩,
  {
    rw [←fz],
    exact filter.tendsto.comp fc.continuous_at ht,
  },
  {
    intro n,
    rw [mem_open_segment'],
    refine ⟨c, ⟨hc₁, hc₂⟩, _⟩,
    simp only [ne_of_gt hc₁, smul_inv_smul₀, ne.def, not_false_iff, sub_add_cancel],
  },
  {
    intro n,
    simp only [f, smul_sub, sub_smul, one_smul, inv_smul_smul₀ (ne_of_gt hc₁)],
    rw [←sub_add, ←smul_sub],
    refine  affine_subspace.vadd_mem_of_mem_direction _ (zE n),
    {
      refine submodule.smul_mem _ _ _,
      exact affine_subspace.vsub_mem_direction yE (zE n),
    },
  },
end

lemma open_segment_subset_affine_subspace {x y : V}
{E : affine_subspace ℝ V} (xE : x ∈ E) (yE : y ∈ E) :
open_segment ℝ x y ⊆ E :=
begin
  rintro z hz,
  rw [mem_open_segment'] at hz,
  obtain ⟨c, ⟨hc₁, hc₂⟩, rfl⟩ := hz,
  rw [sub_smul, add_sub_left_comm, ←smul_sub, add_comm, one_smul],
  refine affine_subspace.vadd_mem_of_mem_direction _ yE,
  {
    refine submodule.smul_mem _ _ _,
    exact affine_subspace.vsub_mem_direction xE yE,
  },
end

lemma open_segment_subset_of_mem_relint_of_mem_cl {A : set V}
(Acv : convex ℝ A)
{x y : V} (hx : x ∈ relint A) (hy : y ∈ closure A) :
open_segment ℝ x y ⊆ A :=
begin
  rw [mem_relint'] at hx,
  obtain ⟨U, hU₁, hU₂⟩ := hx.2,
  intros a ha,
  let ha' := ha,
  rw [mem_open_segment'] at ha',
  obtain ⟨c, ⟨hc₁, hc₂⟩, ha'⟩ := ha',
  let hy' := hy,
  rw [mem_closure_iff_seq_limit] at hy,
  obtain ⟨t, ht₁, ht₂⟩ := hy,
  have : a ∈ affine_span ℝ A,
  {
    refine open_segment_subset_affine_subspace hx.1 _ ha,
    apply cl_subset_aspan,
    exact hy,
  },
  have ht₁' := λ n, subset_affine_span ℝ _ (ht₁ n),
  obtain ⟨u, hu₁, hu₂, hu₃⟩ := mem_open_segment_tendsto_left_of_tendsto_right ha ht₂ this ht₁',
  rw [tendsto_at_top_nhds] at hu₁,
  obtain ⟨n, hn⟩ := hu₁ U hU₂.2 hU₂.1,
  replace hn := hn n (le_refl n),
  replace hu₂ := hu₂ n,
  rw [convex_iff_open_segment_subset] at Acv,
  refine Acv (hU₁ ⟨hn, hu₃ n⟩) (ht₁ n) hu₂,
end

lemma closed_iff_segments_closable {A : set V}
(Acv : convex ℝ A):
is_closed A ↔ ∀ x y : V, open_segment ℝ x y ⊆ A → segment ℝ x y ⊆ A :=
begin
  split,
  {
    exact segments_closable_of_closed,
  },
  {
    intro h,
    rw [←closure_eq_iff_is_closed],
    refine subset_antisymm _ subset_closure,
    intros z hz,
    obtain ⟨x, hx⟩ := relint_nonempty Acv (closure_nonempty_iff.mp ⟨z, hz⟩),
    have := h _ _ (open_segment_subset_of_mem_relint_of_mem_cl Acv hx hz),
    exact this (right_mem_segment _ _ _),
  },
end


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.preimage
import data.set.intervals.unordered_interval

/-!
# Locally finite orders

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

This file defines locally finite orders.

A locally finite order is an order for which all bounded intervals are finite. This allows to make
sense of `Icc`/`Ico`/`Ioc`/`Ioo` as lists, multisets, or finsets.
Further, if the order is bounded above (resp. below), then we can also make sense of the
"unbounded" intervals `Ici`/`Ioi` (resp. `Iic`/`Iio`).

Many theorems about these intervals can be found in `data.finset.locally_finite`.

## Examples

Naturally occurring locally finite orders are `ℕ`, `ℤ`, `ℕ+`, `fin n`, `α × β` the product of two
locally finite orders, `α →₀ β` the finitely supported functions to a locally finite order `β`...

## Main declarations

In a `locally_finite_order`,
* `finset.Icc`: Closed-closed interval as a finset.
* `finset.Ico`: Closed-open interval as a finset.
* `finset.Ioc`: Open-closed interval as a finset.
* `finset.Ioo`: Open-open interval as a finset.
* `finset.uIcc`: Unordered closed interval as a finset.
* `multiset.Icc`: Closed-closed interval as a multiset.
* `multiset.Ico`: Closed-open interval as a multiset.
* `multiset.Ioc`: Open-closed interval as a multiset.
* `multiset.Ioo`: Open-open interval as a multiset.

In a `locally_finite_order_top`,
* `finset.Ici`: Closed-infinite interval as a finset.
* `finset.Ioi`: Open-infinite interval as a finset.
* `multiset.Ici`: Closed-infinite interval as a multiset.
* `multiset.Ioi`: Open-infinite interval as a multiset.

In a `locally_finite_order_bot`,
* `finset.Iic`: Infinite-open interval as a finset.
* `finset.Iio`: Infinite-closed interval as a finset.
* `multiset.Iic`: Infinite-open interval as a multiset.
* `multiset.Iio`: Infinite-closed interval as a multiset.

## Instances

A `locally_finite_order` instance can be built
* for a subtype of a locally finite order. See `subtype.locally_finite_order`.
* for the product of two locally finite orders. See `prod.locally_finite_order`.
* for any fintype (but not as an instance). See `fintype.to_locally_finite_order`.
* from a definition of `finset.Icc` alone. See `locally_finite_order.of_Icc`.
* by pulling back `locally_finite_order β` through an order embedding `f : α →o β`. See
  `order_embedding.locally_finite_order`.

Instances for concrete types are proved in their respective files:
* `ℕ` is in `data.nat.interval`
* `ℤ` is in `data.int.interval`
* `ℕ+` is in `data.pnat.interval`
* `fin n` is in `data.fin.interval`
* `finset α` is in `data.finset.interval`
* `Σ i, α i` is in `data.sigma.interval`
Along, you will find lemmas about the cardinality of those finite intervals.

## TODO

Provide the `locally_finite_order` instance for `α ×ₗ β` where `locally_finite_order α` and
`fintype β`.

Provide the `locally_finite_order` instance for `α →₀ β` where `β` is locally finite. Provide the
`locally_finite_order` instance for `Π₀ i, β i` where all the `β i` are locally finite.

From `linear_order α`, `no_max_order α`, `locally_finite_order α`, we can also define an
order isomorphism `α ≃ ℕ` or `α ≃ ℤ`, depending on whether we have `order_bot α` or
`no_min_order α` and `nonempty α`. When `order_bot α`, we can match `a : α` to `(Iio a).card`.

We can provide `succ_order α` from `linear_order α` and `locally_finite_order α` using

```lean
lemma exists_min_greater [linear_order α] [locally_finite_order α] {x ub : α} (hx : x < ub) :
  ∃ lub, x < lub ∧ ∀ y, x < y → lub ≤ y :=
begin -- very non golfed
  have h : (finset.Ioc x ub).nonempty := ⟨ub, finset.mem_Ioc_iff.2 ⟨hx, le_rfl⟩⟩,
  use finset.min' (finset.Ioc x ub) h,
  split,
  { have := finset.min'_mem _ h,
    simp * at * },
  rintro y hxy,
  obtain hy | hy := le_total y ub,
  apply finset.min'_le,
  simp * at *,
  exact (finset.min'_le _ _ (finset.mem_Ioc_iff.2 ⟨hx, le_rfl⟩)).trans hy,
end
```
Note that the converse is not true. Consider `{-2^z | z : ℤ} ∪ {2^z | z : ℤ}`. Any element has a
successor (and actually a predecessor as well), so it is a `succ_order`, but it's not locally finite
as `Icc (-1) 1` is infinite.
-/

open finset function

/-- A locally finite order is an order where bounded intervals are finite. When you don't care too
much about definitional equality, you can use `locally_finite_order.of_Icc` or
`locally_finite_order.of_finite_Icc` to build a locally finite order from just `finset.Icc`. -/
class locally_finite_order (α : Type*) [preorder α] :=
(finset_Icc : α → α → finset α)
(finset_Ico : α → α → finset α)
(finset_Ioc : α → α → finset α)
(finset_Ioo : α → α → finset α)
(finset_mem_Icc : ∀ a b x : α, x ∈ finset_Icc a b ↔ a ≤ x ∧ x ≤ b)
(finset_mem_Ico : ∀ a b x : α, x ∈ finset_Ico a b ↔ a ≤ x ∧ x < b)
(finset_mem_Ioc : ∀ a b x : α, x ∈ finset_Ioc a b ↔ a < x ∧ x ≤ b)
(finset_mem_Ioo : ∀ a b x : α, x ∈ finset_Ioo a b ↔ a < x ∧ x < b)

/-- A locally finite order top is an order where all intervals bounded above are finite. This is
slightly weaker than `locally_finite_order` + `order_top` as it allows empty types. -/
class locally_finite_order_top (α : Type*) [preorder α] :=
(finset_Ioi : α → finset α)
(finset_Ici : α → finset α)
(finset_mem_Ici : ∀ a x : α, x ∈ finset_Ici a ↔ a ≤ x)
(finset_mem_Ioi : ∀ a x : α, x ∈ finset_Ioi a ↔ a < x)

/-- A locally finite order bot is an order where all intervals bounded below are finite. This is
slightly weaker than `locally_finite_order` + `order_bot` as it allows empty types. -/
class locally_finite_order_bot (α : Type*) [preorder α] :=
(finset_Iio : α → finset α)
(finset_Iic : α → finset α)
(finset_mem_Iic : ∀ a x : α, x ∈ finset_Iic a ↔ x ≤ a)
(finset_mem_Iio : ∀ a x : α, x ∈ finset_Iio a ↔ x < a)

/-- A constructor from a definition of `finset.Icc` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order.of_Icc`, this one requires `decidable_rel (≤)` but
only `preorder`. -/
def locally_finite_order.of_Icc' (α : Type*) [preorder α] [decidable_rel ((≤) : α → α → Prop)]
  (finset_Icc : α → α → finset α) (mem_Icc : ∀ a b x, x ∈ finset_Icc a b ↔ a ≤ x ∧ x ≤ b) :
  locally_finite_order α :=
{ finset_Icc := finset_Icc,
  finset_Ico := λ a b, (finset_Icc a b).filter (λ x, ¬b ≤ x),
  finset_Ioc := λ a b, (finset_Icc a b).filter (λ x, ¬x ≤ a),
  finset_Ioo := λ a b, (finset_Icc a b).filter (λ x, ¬x ≤ a ∧ ¬b ≤ x),
  finset_mem_Icc := mem_Icc,
  finset_mem_Ico := λ a b x, by rw [finset.mem_filter, mem_Icc, and_assoc, lt_iff_le_not_le],
  finset_mem_Ioc := λ a b x, by rw [finset.mem_filter, mem_Icc, and.right_comm, lt_iff_le_not_le],
  finset_mem_Ioo := λ a b x, by rw [finset.mem_filter, mem_Icc, and_and_and_comm, lt_iff_le_not_le,
    lt_iff_le_not_le] }

/-- A constructor from a definition of `finset.Icc` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order.of_Icc`, this one requires `partial_order` but only
`decidable_eq`. -/
def locally_finite_order.of_Icc (α : Type*) [partial_order α] [decidable_eq α]
  (finset_Icc : α → α → finset α) (mem_Icc : ∀ a b x, x ∈ finset_Icc a b ↔ a ≤ x ∧ x ≤ b) :
  locally_finite_order α :=
{ finset_Icc := finset_Icc,
  finset_Ico := λ a b, (finset_Icc a b).filter (λ x, x ≠ b),
  finset_Ioc := λ a b, (finset_Icc a b).filter (λ x, a ≠ x),
  finset_Ioo := λ a b, (finset_Icc a b).filter (λ x, a ≠ x ∧ x ≠ b),
  finset_mem_Icc := mem_Icc,
  finset_mem_Ico := λ a b x, by rw [finset.mem_filter, mem_Icc, and_assoc, lt_iff_le_and_ne],
  finset_mem_Ioc := λ a b x, by rw [finset.mem_filter, mem_Icc, and.right_comm, lt_iff_le_and_ne],
  finset_mem_Ioo := λ a b x, by rw [finset.mem_filter, mem_Icc, and_and_and_comm, lt_iff_le_and_ne,
    lt_iff_le_and_ne] }

/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order_top.of_Ici`, this one requires `decidable_rel (≤)` but
only `preorder`. -/
def locally_finite_order_top.of_Ici' (α : Type*) [preorder α] [decidable_rel ((≤) : α → α → Prop)]
  (finset_Ici : α → finset α) (mem_Ici : ∀ a x, x ∈ finset_Ici a ↔ a ≤ x) :
  locally_finite_order_top α :=
{ finset_Ici := finset_Ici,
  finset_Ioi := λ a, (finset_Ici a).filter (λ x, ¬x ≤ a),
  finset_mem_Ici := mem_Ici,
  finset_mem_Ioi := λ a x, by rw [mem_filter, mem_Ici, lt_iff_le_not_le] }

/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order_top.of_Ici'`, this one requires `partial_order` but
only `decidable_eq`. -/
def locally_finite_order_top.of_Ici (α : Type*) [partial_order α] [decidable_eq α]
  (finset_Ici : α → finset α) (mem_Ici : ∀ a x, x ∈ finset_Ici a ↔ a ≤ x) :
  locally_finite_order_top α :=
{ finset_Ici := finset_Ici,
  finset_Ioi := λ a, (finset_Ici a).filter (λ x, a ≠ x),
  finset_mem_Ici := mem_Ici,
  finset_mem_Ioi := λ a x, by rw [mem_filter, mem_Ici, lt_iff_le_and_ne] }

/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order.of_Icc`, this one requires `decidable_rel (≤)` but
only `preorder`. -/
def locally_finite_order_bot.of_Iic' (α : Type*) [preorder α] [decidable_rel ((≤) : α → α → Prop)]
  (finset_Iic : α → finset α) (mem_Iic : ∀ a x, x ∈ finset_Iic a ↔ x ≤ a) :
  locally_finite_order_bot α :=
{ finset_Iic := finset_Iic,
  finset_Iio := λ a, (finset_Iic a).filter (λ x, ¬a ≤ x),
  finset_mem_Iic := mem_Iic,
  finset_mem_Iio := λ a x, by rw [mem_filter, mem_Iic, lt_iff_le_not_le] }

/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
the ends. As opposed to `locally_finite_order_top.of_Ici'`, this one requires `partial_order` but
only `decidable_eq`. -/
def locally_finite_order_top.of_Iic (α : Type*) [partial_order α] [decidable_eq α]
  (finset_Iic : α → finset α) (mem_Iic : ∀ a x, x ∈ finset_Iic a ↔ x ≤ a) :
  locally_finite_order_bot α :=
{ finset_Iic := finset_Iic,
  finset_Iio := λ a, (finset_Iic a).filter (λ x, x ≠ a),
  finset_mem_Iic := mem_Iic,
  finset_mem_Iio := λ a x, by rw [mem_filter, mem_Iic, lt_iff_le_and_ne] }

variables {α β : Type*}

/-- An empty type is locally finite.

This is not an instance as it would not be defeq to more specific instances. -/
@[reducible] -- See note [reducible non-instances]
protected def _root_.is_empty.to_locally_finite_order [preorder α] [is_empty α] :
  locally_finite_order α :=
{ finset_Icc := is_empty_elim,
  finset_Ico := is_empty_elim,
  finset_Ioc := is_empty_elim,
  finset_Ioo := is_empty_elim,
  finset_mem_Icc := is_empty_elim,
  finset_mem_Ico := is_empty_elim,
  finset_mem_Ioc := is_empty_elim,
  finset_mem_Ioo := is_empty_elim }

/-- An empty type is locally finite.

This is not an instance as it would not be defeq to more specific instances. -/
@[reducible] -- See note [reducible non-instances]
protected def _root_.is_empty.to_locally_finite_order_top [preorder α] [is_empty α] :
  locally_finite_order_top α :=
{ finset_Ici := is_empty_elim,
  finset_Ioi := is_empty_elim,
  finset_mem_Ici := is_empty_elim,
  finset_mem_Ioi := is_empty_elim }

/-- An empty type is locally finite.

This is not an instance as it would not be defeq to more specific instances. -/
@[reducible] -- See note [reducible non-instances]
protected def _root_.is_empty.to_locally_finite_order_bot [preorder α] [is_empty α] :
  locally_finite_order_bot α :=
{ finset_Iic := is_empty_elim,
  finset_Iio := is_empty_elim,
  finset_mem_Iic := is_empty_elim,
  finset_mem_Iio := is_empty_elim }

/-! ### Intervals as finsets -/

namespace finset
section preorder
variables [preorder α]

section locally_finite_order
variables [locally_finite_order α] {a b x : α}

/-- The finset of elements `x` such that `a ≤ x` and `x ≤ b`. Basically `set.Icc a b` as a finset.
-/
def Icc (a b : α) : finset α := locally_finite_order.finset_Icc a b

/-- The finset of elements `x` such that `a ≤ x` and `x < b`. Basically `set.Ico a b` as a finset.
-/
def Ico (a b : α) : finset α := locally_finite_order.finset_Ico a b

/-- The finset of elements `x` such that `a < x` and `x ≤ b`. Basically `set.Ioc a b` as a finset.
-/
def Ioc (a b : α) : finset α := locally_finite_order.finset_Ioc a b

/-- The finset of elements `x` such that `a < x` and `x < b`. Basically `set.Ioo a b` as a finset.
-/
def Ioo (a b : α) : finset α := locally_finite_order.finset_Ioo a b

@[simp] lemma mem_Icc : x ∈ Icc a b ↔ a ≤ x ∧ x ≤ b :=
locally_finite_order.finset_mem_Icc a b x

@[simp] lemma mem_Ico : x ∈ Ico a b ↔ a ≤ x ∧ x < b :=
locally_finite_order.finset_mem_Ico a b x

@[simp] lemma mem_Ioc : x ∈ Ioc a b ↔ a < x ∧ x ≤ b :=
locally_finite_order.finset_mem_Ioc a b x

@[simp] lemma mem_Ioo : x ∈ Ioo a b ↔ a < x ∧ x < b :=
locally_finite_order.finset_mem_Ioo a b x

@[simp, norm_cast]
lemma coe_Icc (a b : α) : (Icc a b : set α) = set.Icc a b := set.ext $ λ _, mem_Icc

@[simp, norm_cast]
lemma coe_Ico (a b : α) : (Ico a b : set α) = set.Ico a b := set.ext $ λ _, mem_Ico

@[simp, norm_cast]
lemma coe_Ioc (a b : α) : (Ioc a b : set α) = set.Ioc a b := set.ext $ λ _, mem_Ioc

@[simp, norm_cast]
lemma coe_Ioo (a b : α) : (Ioo a b : set α) = set.Ioo a b := set.ext $ λ _, mem_Ioo

end locally_finite_order

section locally_finite_order_top
variables [locally_finite_order_top α] {a x : α}

/-- The finset of elements `x` such that `a ≤ x`. Basically `set.Ici a` as a finset. -/
def Ici (a : α) : finset α := locally_finite_order_top.finset_Ici a

/-- The finset of elements `x` such that `a < x`. Basically `set.Ioi a` as a finset. -/
def Ioi (a : α) : finset α := locally_finite_order_top.finset_Ioi a

@[simp] lemma mem_Ici : x ∈ Ici a ↔ a ≤ x := locally_finite_order_top.finset_mem_Ici _ _
@[simp] lemma mem_Ioi : x ∈ Ioi a ↔ a < x := locally_finite_order_top.finset_mem_Ioi _ _

@[simp, norm_cast]

end locally_finite_order_top

section locally_finite_order_bot
variables [locally_finite_order_bot α] {a x : α}

/-- The finset of elements `x` such that `a ≤ x`. Basically `set.Iic a` as a finset. -/
def Iic (a : α) : finset α := locally_finite_order_bot.finset_Iic a

/-- The finset of elements `x` such that `a < x`. Basically `set.Iio a` as a finset. -/
def Iio (a : α) : finset α := locally_finite_order_bot.finset_Iio a

@[simp] lemma mem_Iic : x ∈ Iic a ↔ x ≤ a := locally_finite_order_bot.finset_mem_Iic _ _
@[simp] lemma mem_Iio : x ∈ Iio a ↔ x < a := locally_finite_order_bot.finset_mem_Iio _ _

@[simp, norm_cast] lemma coe_Iic (a : α) : (Iic a : set α) = set.Iic a := set.ext $ λ _, mem_Iic
@[simp, norm_cast] lemma coe_Iio (a : α) : (Iio a : set α) = set.Iio a := set.ext $ λ _, mem_Iio

end locally_finite_order_bot

section order_top
variables [locally_finite_order α] [order_top α] {a x : α}

@[priority 100] -- See note [lower priority instance]
instance _root_.locally_finite_order.to_locally_finite_order_top : locally_finite_order_top α :=
{ finset_Ici := λ b, Icc b ⊤,
  finset_Ioi := λ b, Ioc b ⊤,
  finset_mem_Ici := λ a x, by rw [mem_Icc, and_iff_left le_top],
  finset_mem_Ioi := λ a x, by rw [mem_Ioc, and_iff_left le_top] }

lemma Ici_eq_Icc (a : α) : Ici a = Icc a ⊤ := rfl
lemma Ioi_eq_Ioc (a : α) : Ioi a = Ioc a ⊤ := rfl

end order_top

section order_bot
variables [order_bot α] [locally_finite_order α] {b x : α}

@[priority 100] -- See note [lower priority instance]
instance locally_finite_order.to_locally_finite_order_bot : locally_finite_order_bot α :=
{ finset_Iic := Icc ⊥,
  finset_Iio := Ico ⊥,
  finset_mem_Iic := λ a x, by rw [mem_Icc, and_iff_right bot_le],
  finset_mem_Iio := λ a x, by rw [mem_Ico, and_iff_right bot_le] }

lemma Iic_eq_Icc : Iic = Icc (⊥ : α) := rfl
lemma Iio_eq_Ico : Iio = Ico (⊥ : α) := rfl

end order_bot
end preorder

section lattice
variables [lattice α] [locally_finite_order α] {a b x : α}

/-- `finset.uIcc a b` is the set of elements lying between `a` and `b`, with `a` and `b` included.
Note that we define it more generally in a lattice as `finset.Icc (a ⊓ b) (a ⊔ b)`. In a
product type, `finset.uIcc` corresponds to the bounding box of the two elements. -/
def uIcc (a b : α) : finset α := Icc (a ⊓ b) (a ⊔ b)

localized "notation (name := finset.uIcc) `[`a `, ` b `]` := finset.uIcc a b"
  in finset_interval

@[simp] lemma mem_uIcc : x ∈ uIcc a b ↔ a ⊓ b ≤ x ∧ x ≤ a ⊔ b := mem_Icc

@[simp, norm_cast] lemma coe_uIcc (a b : α) : ([a, b] : set α) = set.uIcc a b := coe_Icc _ _

end lattice
end finset

/-! ### Intervals as multisets -/

namespace multiset
variables [preorder α]

section locally_finite_order
variables [locally_finite_order α]

/-- The multiset of elements `x` such that `a ≤ x` and `x ≤ b`. Basically `set.Icc a b` as a
multiset. -/
def Icc (a b : α) : multiset α := (finset.Icc a b).val

/-- The multiset of elements `x` such that `a ≤ x` and `x < b`. Basically `set.Ico a b` as a
multiset. -/
def Ico (a b : α) : multiset α := (finset.Ico a b).val

/-- The multiset of elements `x` such that `a < x` and `x ≤ b`. Basically `set.Ioc a b` as a
multiset. -/
def Ioc (a b : α) : multiset α := (finset.Ioc a b).val

/-- The multiset of elements `x` such that `a < x` and `x < b`. Basically `set.Ioo a b` as a
multiset. -/
def Ioo (a b : α) : multiset α := (finset.Ioo a b).val

@[simp] lemma mem_Icc {a b x : α} : x ∈ Icc a b ↔ a ≤ x ∧ x ≤ b :=
by rw [Icc, ←finset.mem_def, finset.mem_Icc]

@[simp] lemma mem_Ico {a b x : α} : x ∈ Ico a b ↔ a ≤ x ∧ x < b :=
by rw [Ico, ←finset.mem_def, finset.mem_Ico]

@[simp] lemma mem_Ioc {a b x : α} : x ∈ Ioc a b ↔ a < x ∧ x ≤ b :=
by rw [Ioc, ←finset.mem_def, finset.mem_Ioc]

@[simp] lemma mem_Ioo {a b x : α} : x ∈ Ioo a b ↔ a < x ∧ x < b :=
by rw [Ioo, ←finset.mem_def, finset.mem_Ioo]

end locally_finite_order

section locally_finite_order_top
variables [locally_finite_order_top α]

/-- The multiset of elements `x` such that `a ≤ x`. Basically `set.Ici a` as a multiset. -/
def Ici (a : α) : multiset α := (finset.Ici a).val

/-- The multiset of elements `x` such that `a < x`. Basically `set.Ioi a` as a multiset. -/
def Ioi (a : α) : multiset α := (finset.Ioi a).val

@[simp] lemma mem_Ici {a x : α} : x ∈ Ici a ↔ a ≤ x := by rw [Ici, ←finset.mem_def, finset.mem_Ici]
@[simp] lemma mem_Ioi {a x : α} : x ∈ Ioi a ↔ a < x := by rw [Ioi, ←finset.mem_def, finset.mem_Ioi]

end locally_finite_order_top

section locally_finite_order_bot
variables [locally_finite_order_bot α]

/-- The multiset of elements `x` such that `x ≤ b`. Basically `set.Iic b` as a multiset. -/
def Iic (b : α) : multiset α := (finset.Iic b).val

/-- The multiset of elements `x` such that `x < b`. Basically `set.Iio b` as a multiset. -/
def Iio (b : α) : multiset α := (finset.Iio b).val

@[simp] lemma mem_Iic {b x : α} : x ∈ Iic b ↔ x ≤ b := by rw [Iic, ←finset.mem_def, finset.mem_Iic]
@[simp] lemma mem_Iio {b x : α} : x ∈ Iio b ↔ x < b := by rw [Iio, ←finset.mem_def, finset.mem_Iio]

end locally_finite_order_bot
end multiset

/-! ### Finiteness of `set` intervals -/

namespace set
section preorder
variables [preorder α] [locally_finite_order α] (a b : α)

instance fintype_Icc : fintype (Icc a b) :=
fintype.of_finset (finset.Icc a b) (λ x, by rw [finset.mem_Icc, mem_Icc])

instance fintype_Ico : fintype (Ico a b) :=
fintype.of_finset (finset.Ico a b) (λ x, by rw [finset.mem_Ico, mem_Ico])

instance fintype_Ioc : fintype (Ioc a b) :=
fintype.of_finset (finset.Ioc a b) (λ x, by rw [finset.mem_Ioc, mem_Ioc])

instance fintype_Ioo : fintype (Ioo a b) :=
fintype.of_finset (finset.Ioo a b) (λ x, by rw [finset.mem_Ioo, mem_Ioo])

lemma finite_Icc : (Icc a b).finite := (Icc a b).to_finite
lemma finite_Ico : (Ico a b).finite := (Ico a b).to_finite
lemma finite_Ioc : (Ioc a b).finite := (Ioc a b).to_finite
lemma finite_Ioo : (Ioo a b).finite := (Ioo a b).to_finite

end preorder

section order_top
variables [preorder α] [locally_finite_order_top α] (a : α)

instance fintype_Ici : fintype (Ici a) :=
fintype.of_finset (finset.Ici a) (λ x, by rw [finset.mem_Ici, mem_Ici])

instance fintype_Ioi : fintype (Ioi a) :=
fintype.of_finset (finset.Ioi a) (λ x, by rw [finset.mem_Ioi, mem_Ioi])

lemma finite_Ici : (Ici a).finite := (Ici a).to_finite
lemma finite_Ioi : (Ioi a).finite := (Ioi a).to_finite

end order_top

section order_bot
variables [preorder α] [locally_finite_order_bot α] (b : α)

instance fintype_Iic : fintype (Iic b) :=
fintype.of_finset (finset.Iic b) (λ x, by rw [finset.mem_Iic, mem_Iic])

instance fintype_Iio : fintype (Iio b) :=
fintype.of_finset (finset.Iio b) (λ x, by rw [finset.mem_Iio, mem_Iio])

lemma finite_Iic : (Iic b).finite := (Iic b).to_finite
lemma finite_Iio : (Iio b).finite := (Iio b).to_finite

end order_bot

end set

/-! ### Instances -/

open finset

section preorder
variables [preorder α] [preorder β]

/-- A noncomputable constructor from the finiteness of all closed intervals. -/
noncomputable def locally_finite_order.of_finite_Icc (h : ∀ a b : α, (set.Icc a b).finite) :
  locally_finite_order α :=
@locally_finite_order.of_Icc' α _ (classical.dec_rel _)
  (λ a b, (h a b).to_finset)
  (λ a b x, by rw [set.finite.mem_to_finset, set.mem_Icc])

/-- A fintype is a locally finite order.

This is not an instance as it would not be defeq to better instances such as
`fin.locally_finite_order`.
-/
@[reducible]
def fintype.to_locally_finite_order [fintype α] [@decidable_rel α (<)] [@decidable_rel α (≤)] :
  locally_finite_order α :=
{ finset_Icc := λ a b, (set.Icc a b).to_finset,
  finset_Ico := λ a b, (set.Ico a b).to_finset,
  finset_Ioc := λ a b, (set.Ioc a b).to_finset,
  finset_Ioo := λ a b, (set.Ioo a b).to_finset,
  finset_mem_Icc := λ a b x, by simp only [set.mem_to_finset, set.mem_Icc],
  finset_mem_Ico := λ a b x, by simp only [set.mem_to_finset, set.mem_Ico],
  finset_mem_Ioc := λ a b x, by simp only [set.mem_to_finset, set.mem_Ioc],
  finset_mem_Ioo := λ a b x, by simp only [set.mem_to_finset, set.mem_Ioo] }

instance : subsingleton (locally_finite_order α) :=
subsingleton.intro (λ h₀ h₁, begin
  cases h₀,
  cases h₁,
  have hIcc : h₀_finset_Icc = h₁_finset_Icc,
  { ext a b x, rw [h₀_finset_mem_Icc, h₁_finset_mem_Icc] },
  have hIco : h₀_finset_Ico = h₁_finset_Ico,
  { ext a b x, rw [h₀_finset_mem_Ico, h₁_finset_mem_Ico] },
  have hIoc : h₀_finset_Ioc = h₁_finset_Ioc,
  { ext a b x, rw [h₀_finset_mem_Ioc, h₁_finset_mem_Ioc] },
  have hIoo : h₀_finset_Ioo = h₁_finset_Ioo,
  { ext a b x, rw [h₀_finset_mem_Ioo, h₁_finset_mem_Ioo] },
  simp_rw [hIcc, hIco, hIoc, hIoo],
end)

instance : subsingleton (locally_finite_order_top α) :=
subsingleton.intro $ λ h₀ h₁, begin
  cases h₀,
  cases h₁,
  have hIci : h₀_finset_Ici = h₁_finset_Ici,
  { ext a b x, rw [h₀_finset_mem_Ici, h₁_finset_mem_Ici] },
  have hIoi : h₀_finset_Ioi = h₁_finset_Ioi,
  { ext a b x, rw [h₀_finset_mem_Ioi, h₁_finset_mem_Ioi] },
  simp_rw [hIci, hIoi],
end

instance : subsingleton (locally_finite_order_bot α) :=
subsingleton.intro $ λ h₀ h₁, begin
  cases h₀,
  cases h₁,
  have hIic : h₀_finset_Iic = h₁_finset_Iic,
  { ext a b x, rw [h₀_finset_mem_Iic, h₁_finset_mem_Iic] },
  have hIio : h₀_finset_Iio = h₁_finset_Iio,
  { ext a b x, rw [h₀_finset_mem_Iio, h₁_finset_mem_Iio] },
  simp_rw [hIic, hIio],
end

-- Should this be called `locally_finite_order.lift`?
/-- Given an order embedding `α ↪o β`, pulls back the `locally_finite_order` on `β` to `α`. -/
protected noncomputable def order_embedding.locally_finite_order [locally_finite_order β]
  (f : α ↪o β) : locally_finite_order α :=
{ finset_Icc := λ a b, (Icc (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_Ico := λ a b, (Ico (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_Ioc := λ a b, (Ioc (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_Ioo := λ a b, (Ioo (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
  finset_mem_Icc := λ a b x, by rw [mem_preimage, mem_Icc, f.le_iff_le, f.le_iff_le],
  finset_mem_Ico := λ a b x, by rw [mem_preimage, mem_Ico, f.le_iff_le, f.lt_iff_lt],
  finset_mem_Ioc := λ a b x, by rw [mem_preimage, mem_Ioc, f.lt_iff_lt, f.le_iff_le],
  finset_mem_Ioo := λ a b x, by rw [mem_preimage, mem_Ioo, f.lt_iff_lt, f.lt_iff_lt] }

open order_dual

section locally_finite_order
variables [locally_finite_order α] (a b : α)

/-- Note we define `Icc (to_dual a) (to_dual b)` as `Icc α _ _ b a` (which has type `finset α` not
`finset αᵒᵈ`!) instead of `(Icc b a).map to_dual.to_embedding` as this means the
following is defeq:
```
lemma this : (Icc (to_dual (to_dual a)) (to_dual (to_dual b)) : _) = (Icc a b : _) := rfl
```
-/
instance : locally_finite_order αᵒᵈ :=
{ finset_Icc := λ a b, @Icc α _ _ (of_dual b) (of_dual a),
  finset_Ico := λ a b, @Ioc α _ _ (of_dual b) (of_dual a),
  finset_Ioc := λ a b, @Ico α _ _ (of_dual b) (of_dual a),
  finset_Ioo := λ a b, @Ioo α _ _ (of_dual b) (of_dual a),
  finset_mem_Icc := λ a b x, mem_Icc.trans (and_comm _ _),
  finset_mem_Ico := λ a b x, mem_Ioc.trans (and_comm _ _),
  finset_mem_Ioc := λ a b x, mem_Ico.trans (and_comm _ _),
  finset_mem_Ioo := λ a b x, mem_Ioo.trans (and_comm _ _) }

lemma Icc_to_dual : Icc (to_dual a) (to_dual b) = (Icc b a).map to_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Icc, mem_Icc], exact and_comm _ _ }

lemma Ico_to_dual : Ico (to_dual a) (to_dual b) = (Ioc b a).map to_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ico, mem_Ioc], exact and_comm _ _ }

lemma Ioc_to_dual : Ioc (to_dual a) (to_dual b) = (Ico b a).map to_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioc, mem_Ico], exact and_comm _ _ }

lemma Ioo_to_dual : Ioo (to_dual a) (to_dual b) = (Ioo b a).map to_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioo, mem_Ioo], exact and_comm _ _ }

lemma Icc_of_dual (a b : αᵒᵈ) : Icc (of_dual a) (of_dual b) = (Icc b a).map of_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Icc, mem_Icc], exact and_comm _ _ }

lemma Ico_of_dual (a b : αᵒᵈ) : Ico (of_dual a) (of_dual b) = (Ioc b a).map of_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ico, mem_Ioc], exact and_comm _ _ }

lemma Ioc_of_dual (a b : αᵒᵈ) : Ioc (of_dual a) (of_dual b) = (Ico b a).map of_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioc, mem_Ico], exact and_comm _ _ }

lemma Ioo_of_dual (a b : αᵒᵈ) : Ioo (of_dual a) (of_dual b) = (Ioo b a).map of_dual.to_embedding :=
by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioo, mem_Ioo], exact and_comm _ _ }

end locally_finite_order

section locally_finite_order_top
variables [locally_finite_order_top α]

/-- Note we define `Iic (to_dual a)` as `Ici a` (which has type `finset α` not `finset αᵒᵈ`!)
instead of `(Ici a).map to_dual.to_embedding` as this means the following is defeq:
```
lemma this : (Iic (to_dual (to_dual a)) : _) = (Iic a : _) := rfl
```
-/
instance : locally_finite_order_bot αᵒᵈ :=
{ finset_Iic := λ a, @Ici α _ _ (of_dual a),
  finset_Iio := λ a, @Ioi α _ _ (of_dual a),
  finset_mem_Iic := λ a x, mem_Ici,
  finset_mem_Iio := λ a x, mem_Ioi }

lemma Iic_to_dual (a : α) : Iic (to_dual a) = (Ici a).map to_dual.to_embedding := map_refl.symm
lemma Iio_to_dual (a : α) : Iio (to_dual a) = (Ioi a).map to_dual.to_embedding := map_refl.symm
lemma Ici_of_dual (a : αᵒᵈ) : Ici (of_dual a) = (Iic a).map of_dual.to_embedding := map_refl.symm
lemma Ioi_of_dual (a : αᵒᵈ) : Ioi (of_dual a) = (Iio a).map of_dual.to_embedding := map_refl.symm

end locally_finite_order_top

section locally_finite_order_top
variables [locally_finite_order_bot α]

/-- Note we define `Ici (to_dual a)` as `Iic a` (which has type `finset α` not `finset αᵒᵈ`!)
instead of `(Iic a).map to_dual.to_embedding` as this means the following is defeq:
```
lemma this : (Ici (to_dual (to_dual a)) : _) = (Ici a : _) := rfl
```
-/
instance : locally_finite_order_top αᵒᵈ :=
{ finset_Ici := λ a, @Iic α _ _ (of_dual a),
  finset_Ioi := λ a, @Iio α _ _ (of_dual a),
  finset_mem_Ici := λ a x, mem_Iic,
  finset_mem_Ioi := λ a x, mem_Iio }

lemma Ici_to_dual (a : α) : Ici (to_dual a) = (Iic a).map to_dual.to_embedding := map_refl.symm
lemma Ioi_to_dual (a : α) : Ioi (to_dual a) = (Iio a).map to_dual.to_embedding := map_refl.symm
lemma Iic_of_dual (a : αᵒᵈ) : Iic (of_dual a) = (Ici a).map of_dual.to_embedding := map_refl.symm
lemma Iio_of_dual (a : αᵒᵈ) : Iio (of_dual a) = (Ioi a).map of_dual.to_embedding := map_refl.symm

end locally_finite_order_top

namespace prod

instance [locally_finite_order α] [locally_finite_order β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] :
  locally_finite_order (α × β) :=
locally_finite_order.of_Icc' (α × β)
  (λ a b, Icc a.fst b.fst ×ˢ Icc a.snd b.snd)
  (λ a b x, by { rw [mem_product, mem_Icc, mem_Icc, and_and_and_comm], refl })

instance [locally_finite_order_top α] [locally_finite_order_top β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] :
  locally_finite_order_top (α × β) :=
locally_finite_order_top.of_Ici' (α × β)
  (λ a, Ici a.fst ×ˢ Ici a.snd) (λ a x, by { rw [mem_product, mem_Ici, mem_Ici], refl })

instance [locally_finite_order_bot α] [locally_finite_order_bot β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] :
  locally_finite_order_bot (α × β) :=
locally_finite_order_bot.of_Iic' (α × β)
  (λ a, Iic a.fst ×ˢ Iic a.snd) (λ a x, by { rw [mem_product, mem_Iic, mem_Iic], refl })

lemma Icc_eq [locally_finite_order α] [locally_finite_order β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] (p q : α × β) :
  finset.Icc p q = finset.Icc p.1 q.1 ×ˢ finset.Icc p.2 q.2 := rfl

@[simp] lemma Icc_mk_mk [locally_finite_order α] [locally_finite_order β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] (a₁ a₂ : α) (b₁ b₂ : β) :
  finset.Icc (a₁, b₁) (a₂, b₂) = finset.Icc a₁ a₂ ×ˢ finset.Icc b₁ b₂ := rfl

lemma card_Icc [locally_finite_order α] [locally_finite_order β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] (p q : α × β) :
  (finset.Icc p q).card = (finset.Icc p.1 q.1).card * (finset.Icc p.2 q.2).card :=
finset.card_product _ _

end prod

end preorder

namespace prod
variables [lattice α] [lattice β]

lemma uIcc_eq [locally_finite_order α] [locally_finite_order β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] (p q : α × β) :
  finset.uIcc p q = finset.uIcc p.1 q.1 ×ˢ finset.uIcc p.2 q.2 := rfl

@[simp] lemma uIcc_mk_mk [locally_finite_order α] [locally_finite_order β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] (a₁ a₂ : α) (b₁ b₂ : β) :
  finset.uIcc (a₁, b₁) (a₂, b₂) = finset.uIcc a₁ a₂ ×ˢ finset.uIcc b₁ b₂ := rfl

lemma card_uIcc [locally_finite_order α] [locally_finite_order β]
  [decidable_rel ((≤) : α × β → α × β → Prop)] (p q : α × β) :
  (finset.uIcc p q).card = (finset.uIcc p.1 q.1).card * (finset.uIcc p.2 q.2).card :=
prod.card_Icc _ _

end prod

/-!
#### `with_top`, `with_bot`

Adding a `⊤` to a locally finite `order_top` keeps it locally finite.
Adding a `⊥` to a locally finite `order_bot` keeps it locally finite.
-/

namespace with_top
variables (α) [partial_order α] [order_top α] [locally_finite_order α]

local attribute [pattern] coe
local attribute [simp] option.mem_iff

instance : locally_finite_order (with_top α) :=
{ finset_Icc := λ a b, match a, b with
    |       ⊤,       ⊤ := {⊤}
    |       ⊤, (b : α) := ∅
    | (a : α),       ⊤ := insert_none (Ici a)
    | (a : α), (b : α) := (Icc a b).map embedding.coe_option
    end,
  finset_Ico := λ a b, match a, b with
    |      ⊤,      _ := ∅
    | (a : α),      ⊤ := (Ici a).map embedding.coe_option
    | (a : α), (b : α) := (Ico a b).map embedding.coe_option
    end,
  finset_Ioc := λ a b, match a, b with
    |      ⊤,      _ := ∅
    | (a : α),      ⊤ := insert_none (Ioi a)
    | (a : α), (b : α) := (Ioc a b).map embedding.coe_option
    end,
  finset_Ioo := λ a b, match a, b with
    |      ⊤,      _ := ∅
    | (a : α),      ⊤ := (Ioi a).map embedding.coe_option
    | (a : α), (b : α) := (Ioo a b).map embedding.coe_option
    end,
  finset_mem_Icc := λ a b x, match a, b, x with
    |       ⊤,       ⊤,       x := mem_singleton.trans (le_antisymm_iff.trans $ and_comm _ _)
    |       ⊤, (b : α),       x := iff_of_false (not_mem_empty _)
                                     (λ h, (h.1.trans h.2).not_lt $ coe_lt_top _)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_1]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_1, coe_eq_coe]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_1]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_1, coe_eq_coe]
    end,
  finset_mem_Ico := λ a b x, match a, b, x with
    |       ⊤,       b,       x := iff_of_false (not_mem_empty _)
                                     (λ h, not_top_lt $ h.1.trans_lt h.2)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_2]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_2, coe_eq_coe,
                                        coe_lt_top]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_2]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_2, coe_eq_coe,
                                        coe_lt_coe]
    end,
  finset_mem_Ioc := λ a b x, match a, b, x with
    |       ⊤,       b,       x := iff_of_false (not_mem_empty _)
                                     (λ h, not_top_lt $ h.1.trans_le h.2)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_3, coe_lt_top]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_3, coe_eq_coe,
                                        coe_lt_coe]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_3]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_3, coe_eq_coe,
                                        coe_lt_coe]
    end,
  finset_mem_Ioo := λ a b x, match a, b, x with
    |       ⊤,       b,       x := iff_of_false (not_mem_empty _)
                                     (λ h, not_top_lt $ h.1.trans h.2)
    | (a : α),       ⊤,       ⊤ := by simp [with_top.locally_finite_order._match_4, coe_lt_top]
    | (a : α),       ⊤, (x : α) := by simp [with_top.locally_finite_order._match_4, coe_eq_coe,
                                        coe_lt_coe, coe_lt_top]
    | (a : α), (b : α),       ⊤ := by simp [with_top.locally_finite_order._match_4]
    | (a : α), (b : α), (x : α) := by simp [with_top.locally_finite_order._match_4, coe_eq_coe,
                                        coe_lt_coe]
    end }

variables (a b : α)

lemma Icc_coe_top : Icc (a : with_top α) ⊤ = insert_none (Ici a) := rfl
lemma Icc_coe_coe : Icc (a : with_top α) b = (Icc a b).map embedding.coe_option := rfl
lemma Ico_coe_top : Ico (a : with_top α) ⊤ = (Ici a).map embedding.coe_option := rfl
lemma Ico_coe_coe : Ico (a : with_top α) b = (Ico a b).map embedding.coe_option := rfl
lemma Ioc_coe_top : Ioc (a : with_top α) ⊤ = insert_none (Ioi a) := rfl
lemma Ioc_coe_coe : Ioc (a : with_top α) b = (Ioc a b).map embedding.coe_option := rfl
lemma Ioo_coe_top : Ioo (a : with_top α) ⊤ = (Ioi a).map embedding.coe_option := rfl
lemma Ioo_coe_coe : Ioo (a : with_top α) b = (Ioo a b).map embedding.coe_option := rfl

end with_top

namespace with_bot
variables (α) [partial_order α] [order_bot α] [locally_finite_order α]

instance : locally_finite_order (with_bot α) :=
@order_dual.locally_finite_order (with_top αᵒᵈ) _ _

variables (a b : α)

lemma Icc_bot_coe : Icc (⊥ : with_bot α) b = insert_none (Iic b) := rfl
lemma Icc_coe_coe : Icc (a : with_bot α) b = (Icc a b).map embedding.coe_option := rfl
lemma Ico_bot_coe : Ico (⊥ : with_bot α) b = insert_none (Iio b) := rfl
lemma Ico_coe_coe : Ico (a : with_bot α) b = (Ico a b).map embedding.coe_option := rfl
lemma Ioc_bot_coe : Ioc (⊥ : with_bot α) b = (Iic b).map embedding.coe_option := rfl
lemma Ioc_coe_coe : Ioc (a : with_bot α) b = (Ioc a b).map embedding.coe_option := rfl
lemma Ioo_bot_coe : Ioo (⊥ : with_bot α) b = (Iio b).map embedding.coe_option := rfl
lemma Ioo_coe_coe : Ioo (a : with_bot α) b = (Ioo a b).map embedding.coe_option := rfl

end with_bot

namespace order_iso
variables [preorder α] [preorder β]

/-! #### Transfer locally finite orders across order isomorphisms -/

/-- Transfer `locally_finite_order` across an `order_iso`. -/
@[reducible] -- See note [reducible non-instances]
def locally_finite_order [locally_finite_order β] (f : α ≃o β) : locally_finite_order α :=
{ finset_Icc := λ a b, (Icc (f a) (f b)).map f.symm.to_equiv.to_embedding,
  finset_Ico := λ a b, (Ico (f a) (f b)).map f.symm.to_equiv.to_embedding,
  finset_Ioc := λ a b, (Ioc (f a) (f b)).map f.symm.to_equiv.to_embedding,
  finset_Ioo := λ a b, (Ioo (f a) (f b)).map f.symm.to_equiv.to_embedding,
  finset_mem_Icc := by simp,
  finset_mem_Ico := by simp,
  finset_mem_Ioc := by simp,
  finset_mem_Ioo := by simp }

/-- Transfer `locally_finite_order_top` across an `order_iso`. -/
@[reducible] -- See note [reducible non-instances]
def locally_finite_order_top [locally_finite_order_top β]
  (f : α ≃o β) : locally_finite_order_top α :=
{ finset_Ici := λ a, (Ici (f a)).map f.symm.to_equiv.to_embedding,
  finset_Ioi := λ a, (Ioi (f a)).map f.symm.to_equiv.to_embedding,
  finset_mem_Ici := by simp,
  finset_mem_Ioi := by simp }

/-- Transfer `locally_finite_order_bot` across an `order_iso`. -/
@[reducible] -- See note [reducible non-instances]
def locally_finite_order_bot [locally_finite_order_bot β]
  (f : α ≃o β) : locally_finite_order_bot α :=
{ finset_Iic := λ a, (Iic (f a)).map f.symm.to_equiv.to_embedding,
  finset_Iio := λ a, (Iio (f a)).map f.symm.to_equiv.to_embedding,
  finset_mem_Iic := by simp,
  finset_mem_Iio := by simp }

end order_iso

/-! #### Subtype of a locally finite order -/

variables [preorder α] (p : α → Prop) [decidable_pred p]

instance [locally_finite_order α] : locally_finite_order (subtype p) :=
{ finset_Icc := λ a b, (Icc (a : α) b).subtype p,
  finset_Ico := λ a b, (Ico (a : α) b).subtype p,
  finset_Ioc := λ a b, (Ioc (a : α) b).subtype p,
  finset_Ioo := λ a b, (Ioo (a : α) b).subtype p,
  finset_mem_Icc := λ a b x, by simp_rw [finset.mem_subtype, mem_Icc, subtype.coe_le_coe],
  finset_mem_Ico := λ a b x, by simp_rw [finset.mem_subtype, mem_Ico, subtype.coe_le_coe,
    subtype.coe_lt_coe],
  finset_mem_Ioc := λ a b x, by simp_rw [finset.mem_subtype, mem_Ioc, subtype.coe_le_coe,
    subtype.coe_lt_coe],
  finset_mem_Ioo := λ a b x, by simp_rw [finset.mem_subtype, mem_Ioo, subtype.coe_lt_coe] }

instance [locally_finite_order_top α] : locally_finite_order_top (subtype p) :=
{ finset_Ici := λ a, (Ici (a : α)).subtype p,
  finset_Ioi := λ a, (Ioi (a : α)).subtype p,
  finset_mem_Ici := λ a x, by simp_rw [finset.mem_subtype, mem_Ici, subtype.coe_le_coe],
  finset_mem_Ioi := λ a x, by simp_rw [finset.mem_subtype, mem_Ioi, subtype.coe_lt_coe] }

instance [locally_finite_order_bot α] : locally_finite_order_bot (subtype p) :=
{ finset_Iic := λ a, (Iic (a : α)).subtype p,
  finset_Iio := λ a, (Iio (a : α)).subtype p,
  finset_mem_Iic := λ a x, by simp_rw [finset.mem_subtype, mem_Iic, subtype.coe_le_coe],
  finset_mem_Iio := λ a x, by simp_rw [finset.mem_subtype, mem_Iio, subtype.coe_lt_coe] }

namespace finset
section locally_finite_order
variables [locally_finite_order α] (a b : subtype p)

lemma subtype_Icc_eq : Icc a b = (Icc (a : α) b).subtype p := rfl
lemma subtype_Ico_eq : Ico a b = (Ico (a : α) b).subtype p := rfl
lemma subtype_Ioc_eq : Ioc a b = (Ioc (a : α) b).subtype p := rfl
lemma subtype_Ioo_eq : Ioo a b = (Ioo (a : α) b).subtype p := rfl

variables (hp : ∀ ⦃a b x⦄, a ≤ x → x ≤ b → p a → p b → p x)
include hp

lemma map_subtype_embedding_Icc : (Icc a b).map (embedding.subtype p) = Icc a b :=
begin
  rw subtype_Icc_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Icc at hx,
  exact hp hx.1 hx.2 a.prop b.prop,
end

lemma map_subtype_embedding_Ico : (Ico a b).map (embedding.subtype p) = Ico a b :=
begin
  rw subtype_Ico_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Ico at hx,
  exact hp hx.1 hx.2.le a.prop b.prop,
end

lemma map_subtype_embedding_Ioc : (Ioc a b).map (embedding.subtype p) = Ioc a b :=
begin
  rw subtype_Ioc_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Ioc at hx,
  exact hp hx.1.le hx.2 a.prop b.prop,
end

lemma map_subtype_embedding_Ioo : (Ioo a b).map (embedding.subtype p) = Ioo a b :=
begin
  rw subtype_Ioo_eq,
  refine finset.subtype_map_of_mem (λ x hx, _),
  rw mem_Ioo at hx,
  exact hp hx.1.le hx.2.le a.prop b.prop,
end

end locally_finite_order

section locally_finite_order_top
variables [locally_finite_order_top α] (a : subtype p)

lemma subtype_Ici_eq : Ici a = (Ici (a : α)).subtype p := rfl
lemma subtype_Ioi_eq : Ioi a = (Ioi (a : α)).subtype p := rfl

variables (hp : ∀ ⦃a x⦄, a ≤ x → p a → p x)
include hp

lemma map_subtype_embedding_Ici : (Ici a).map (embedding.subtype p) = Ici a :=
by { rw subtype_Ici_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Ici.1 hx) a.prop) }

lemma map_subtype_embedding_Ioi : (Ioi a).map (embedding.subtype p) = Ioi a :=
by { rw subtype_Ioi_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Ioi.1 hx).le a.prop) }

end locally_finite_order_top

section locally_finite_order_bot
variables [locally_finite_order_bot α] (a : subtype p)

lemma subtype_Iic_eq : Iic a = (Iic (a : α)).subtype p := rfl
lemma subtype_Iio_eq : Iio a = (Iio (a : α)).subtype p := rfl

variables (hp : ∀ ⦃a x⦄, x ≤ a → p a → p x)
include hp

lemma map_subtype_embedding_Iic : (Iic a).map (embedding.subtype p) = Iic a :=
by { rw subtype_Iic_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Iic.1 hx) a.prop) }

lemma map_subtype_embedding_Iio : (Iio a).map (embedding.subtype p) = Iio a :=
by { rw subtype_Iio_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Iio.1 hx).le a.prop) }

end locally_finite_order_bot
end finset


/-
Copyright (c) 2021 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky
-/
import algebra.group_power.order
import algebra.smul_with_zero

/-!

# Tropical algebraic structures

This file defines algebraic structures of the (min-)tropical numbers, up to the tropical semiring.
Some basic lemmas about conversion from the base type `R` to `tropical R` are provided, as
well as the expected implementations of tropical addition and tropical multiplication.

## Main declarations

* `tropical R`: The type synonym of the tropical interpretation of `R`.
    If `[linear_order R]`, then addition on `R` is via `min`.
* `semiring (tropical R)`: A `linear_ordered_add_comm_monoid_with_top R`
    induces a `semiring (tropical R)`. If one solely has `[linear_ordered_add_comm_monoid R]`,
    then the "tropicalization of `R`" would be `tropical (with_top R)`.

## Implementation notes

The tropical structure relies on `has_top` and `min`. For the max-tropical numbers, use
`order_dual R`.

Inspiration was drawn from the implementation of `additive`/`multiplicative`/`opposite`,
where a type synonym is created with some barebones API, and quickly made irreducible.

Algebraic structures are provided with as few typeclass assumptions as possible, even though
most references rely on `semiring (tropical R)` for building up the whole theory.

## References followed

* https://arxiv.org/pdf/math/0408099.pdf
* https://www.mathenjeans.fr/sites/default/files/sujets/tropical_geometry_-_casagrande.pdf

-/

universes u v
variables (R : Type u)

/-- The tropicalization of a type `R`. -/
def tropical : Type u := R

variables {R}

namespace tropical

/-- Reinterpret `x : R` as an element of `tropical R`.
See `tropical.trop_equiv` for the equivalence.
-/
@[pp_nodot]
def trop : R → tropical R := id
/-- Reinterpret `x : tropical R` as an element of `R`.
See `tropical.trop_equiv` for the equivalence. -/
@[pp_nodot]
def untrop : tropical R → R := id

lemma trop_injective : function.injective (trop : R → tropical R) := λ _ _, id
lemma untrop_injective : function.injective (untrop : tropical R → R) := λ _ _, id

@[simp] lemma trop_inj_iff (x y : R) : trop x = trop y ↔ x = y := iff.rfl
@[simp] lemma untrop_inj_iff (x y : tropical R) : untrop x = untrop y ↔ x = y := iff.rfl

@[simp] lemma trop_untrop (x : tropical R) : trop (untrop x) = x := rfl
@[simp] lemma untrop_trop (x : R) : untrop (trop x) = x := rfl

lemma left_inverse_trop : function.left_inverse (trop : R → tropical R) untrop := trop_untrop
lemma right_inverse_trop : function.right_inverse (trop : R → tropical R) untrop := trop_untrop

attribute [irreducible] tropical

/-- Reinterpret `x : R` as an element of `tropical R`.
See `tropical.trop_order_iso` for the order-preserving equivalence. -/
def trop_equiv : R ≃ tropical R :=
{ to_fun := trop,
  inv_fun := untrop,
  left_inv := untrop_trop,
  right_inv := trop_untrop }

@[simp]
lemma trop_equiv_coe_fn : (trop_equiv : R → tropical R) = trop := rfl
@[simp]
lemma trop_equiv_symm_coe_fn : (trop_equiv.symm : tropical R → R) = untrop := rfl

lemma trop_eq_iff_eq_untrop {x : R} {y} : trop x = y ↔ x = untrop y :=
trop_equiv.apply_eq_iff_eq_symm_apply

lemma untrop_eq_iff_eq_trop {x} {y : R} : untrop x = y ↔ x = trop y :=
trop_equiv.symm.apply_eq_iff_eq_symm_apply

lemma injective_trop : function.injective (trop : R → tropical R) := trop_equiv.injective

instance [inhabited R] : inhabited (tropical R) := ⟨trop (default _)⟩

/-- Recursing on a `x' : tropical R` is the same as recursing on an `x : R` reinterpreted
as a term of `tropical R` via `trop x`. -/
@[simp]
def trop_rec {F : Π (X : tropical R), Sort v} (h : Π X, F (trop X)) : Π X, F X :=
λ X, h (untrop X)

section order

instance [has_le R] : has_le (tropical R) :=
{ le := λ x y, untrop x ≤ untrop y }

@[simp] lemma untrop_le_iff [has_le R] {x y : tropical R} :
  untrop x ≤ untrop y ↔ x ≤ y := iff.rfl

instance [has_lt R] : has_lt (tropical R) :=
{ lt := λ x y, untrop x < untrop y }

@[simp] lemma untrop_lt_iff [has_lt R] {x y : tropical R} :
  untrop x < untrop y ↔ x < y := iff.rfl

instance [preorder R] : preorder (tropical R) :=
{ le_refl := λ _, le_refl _,
  le_trans := λ _ _ _ h h', le_trans h h',
  lt_iff_le_not_le := λ _ _, lt_iff_le_not_le,
  ..tropical.has_le,
  ..tropical.has_lt }

/-- Reinterpret `x : R` as an element of `tropical R`, preserving the order. -/
def trop_order_iso [preorder R] : R ≃o tropical R :=
{ map_rel_iff' := λ _ _, untrop_le_iff,
  ..trop_equiv }

@[simp]
lemma trop_order_iso_coe_fn [preorder R] : (trop_order_iso : R → tropical R) = trop := rfl
@[simp]
lemma trop_order_iso_symm_coe_fn [preorder R] : (trop_order_iso.symm : tropical R → R) = untrop :=
rfl

lemma trop_monotone [preorder R] : monotone (trop : R → tropical R) := λ _ _, id
lemma untrop_monotone [preorder R] : monotone (untrop : tropical R → R) := λ _ _, id

instance [partial_order R] : partial_order (tropical R) :=
{ le_antisymm := λ _ _ h h', untrop_injective (le_antisymm h h'),
  ..tropical.preorder }

instance [has_top R] : has_zero (tropical R) := ⟨trop ⊤⟩
instance [has_top R] : has_top (tropical R) := ⟨0⟩

@[simp] lemma untrop_zero [has_top R] : untrop (0 : tropical R) = ⊤ := rfl
@[simp] lemma trop_top [has_top R] : trop (⊤ : R) = 0 := rfl

@[simp] lemma trop_coe_ne_zero (x : R) : trop (x : with_top R) ≠ 0 .
@[simp] lemma zero_ne_trop_coe (x : R) : (0 : tropical (with_top R)) ≠ trop x .

@[simp] lemma le_zero [has_le R] [order_top R] (x : tropical R) : x ≤ 0 := le_top

instance [has_le R] [order_top R] : order_top (tropical R) :=
{ le_top := λ _, le_top,
  ..tropical.has_top }

variable [linear_order R]

/-- Tropical addition is the minimum of two underlying elements of `R`. -/
protected def add (x y : tropical R) : tropical R :=
trop (min (untrop x) (untrop y))

instance : add_comm_semigroup (tropical R) :=
{ add := tropical.add,
  add_assoc := λ _ _ _, untrop_injective (min_assoc _ _ _),
  add_comm := λ _ _, untrop_injective (min_comm _ _) }

instance : linear_order (tropical R) :=
{ le_total := λ a b, le_total (untrop a) (untrop b),
  decidable_le := λ x y, if h : (untrop x) ≤ (untrop y) then is_true h else is_false h,
  ..tropical.partial_order }

@[simp] lemma untrop_add (x y : tropical R) : untrop (x + y) = min (untrop x) (untrop y) := rfl
@[simp] lemma trop_min (x y : R) : trop (min x y) = trop x + trop y := rfl
@[simp] lemma trop_inf (x y : R) : trop (x ⊓ y) = trop x + trop y := rfl

lemma trop_add_def (x y : tropical R) : x + y = trop (min (untrop x) (untrop y)) := rfl

@[simp] lemma add_eq_left ⦃x y : tropical R⦄ (h : x ≤ y) :
  x + y = x := untrop_injective (by simpa using h)

@[simp] lemma add_eq_right ⦃x y : tropical R⦄ (h : y ≤ x) :
  x + y = y := untrop_injective (by simpa using h)

lemma add_eq_left_iff {x y : tropical R} : x + y = x ↔ x ≤ y :=
by rw [trop_add_def, trop_eq_iff_eq_untrop, ←untrop_le_iff, min_eq_left_iff]

lemma add_eq_right_iff {x y : tropical R} : x + y = y ↔ y ≤ x :=
by rw [trop_add_def, trop_eq_iff_eq_untrop, ←untrop_le_iff, min_eq_right_iff]

@[simp] lemma add_self (x : tropical R) : x + x = x := untrop_injective (min_eq_right le_rfl)

@[simp] lemma bit0 (x : tropical R) : bit0 x = x := add_self x

lemma add_eq_iff {x y z : tropical R} :
  x + y = z ↔ x = z ∧ x ≤ y ∨ y = z ∧ y ≤ x :=
by { rw [trop_add_def, trop_eq_iff_eq_untrop], simp [min_eq_iff] }

@[simp] lemma add_eq_zero_iff {a b : tropical (with_top R)} :
  a + b = 0 ↔ a = 0 ∧ b = 0 :=
begin
  rw add_eq_iff,
  split,
  { rintro (⟨rfl, h⟩|⟨rfl, h⟩),
    { exact ⟨rfl, le_antisymm (le_zero _) h⟩ },
    { exact ⟨le_antisymm (le_zero _) h, rfl⟩ } },
  { rintro ⟨rfl, rfl⟩,
    simp }
end

instance [order_top R] : add_comm_monoid (tropical R) :=
{ zero_add := λ _, untrop_injective (min_top_left _),
  add_zero := λ _, untrop_injective (min_top_right _),
  ..tropical.has_zero,
  ..tropical.add_comm_semigroup }

end order

section monoid

/-- Tropical multiplication is the addition in the underlying `R`. -/
protected def mul [has_add R] (x y : tropical R) : tropical R := trop (untrop x + untrop y)

instance [has_add R] : has_mul (tropical R) := ⟨tropical.mul⟩

@[simp] lemma trop_add [has_add R] (x y : R) :
  trop (x + y) = trop x * trop y := rfl
@[simp] lemma untrop_mul [has_add R] (x y : tropical R) :
  untrop (x * y) = untrop x + untrop y := rfl

lemma trop_mul_def [has_add R] (x y : tropical R) :
  x * y = trop (untrop x + untrop y) := rfl

instance [has_zero R] : has_one (tropical R) := ⟨trop 0⟩

@[simp] lemma trop_zero [has_zero R] : trop (0 : R) = 1 := rfl
@[simp] lemma untrop_one [has_zero R] : untrop (1 : tropical R) = 0 := rfl

instance [has_zero R] : nontrivial (tropical (with_top R)) :=
⟨⟨0, 1, trop_injective.ne with_top.top_ne_coe⟩⟩

instance [has_neg R] : has_inv (tropical R) := ⟨λ x, trop (- untrop x)⟩

@[simp] lemma untrop_inv [has_neg R] (x : tropical R) : untrop x⁻¹ = - untrop x := rfl

instance [has_sub R] : has_div (tropical R) := ⟨λ x y, trop (untrop x - untrop y)⟩

@[simp] lemma untrop_div [has_sub R] (x y : tropical R) :
  untrop (x / y) = untrop x - untrop y := rfl

instance [add_semigroup R] : semigroup (tropical R) :=
{ mul := tropical.mul,
  mul_assoc := λ _ _ _, untrop_injective (add_assoc _ _ _) }

instance [add_comm_semigroup R] : comm_semigroup (tropical R) :=
{ mul_comm := λ _ _, untrop_injective (add_comm _ _),
  ..tropical.semigroup }

instance [add_monoid R] : monoid (tropical R) :=
{ one := trop 0,
  one_mul := λ _, untrop_injective (zero_add _),
  mul_one := λ _, untrop_injective (add_zero _),
  npow := λ n x, trop (n • untrop x),
  npow_zero' := trop_rec (λ _, by simp only [trop_zero, zero_smul]),
  npow_succ' := λ _, trop_rec (λ _, by simp only [succ_nsmul, untrop_trop, trop_add]),
  ..tropical.semigroup }

@[simp] lemma untrop_pow [add_monoid R] (x : tropical R) (n : ℕ) :
  untrop (x ^ n) = n • untrop x := rfl

@[simp] lemma trop_nsmul [add_monoid R] (x : R) (n : ℕ) :
  trop (n • x) = trop x ^ n := rfl

instance [add_comm_monoid R] : comm_monoid (tropical R) :=
{ ..tropical.monoid, ..tropical.comm_semigroup }

instance [add_group R] : group (tropical R) :=
{ inv := λ x, trop (- untrop x),
  mul_left_inv := λ _, untrop_injective (add_left_neg _),
  zpow := λ n x, trop (n • untrop x),
  zpow_zero' := trop_rec (λ _, by simp only [zero_zsmul, trop_zero]),
  zpow_succ' := λ _, trop_rec (λ _, untrop_injective
    (by simp only [succ_nsmul, of_nat_zsmul, untrop_trop, trop_add])),
  zpow_neg' := λ _, trop_rec (λ _, untrop_injective
    (by simp only [zsmul_neg_succ_of_nat, untrop_trop, untrop_pow, coe_nat_zsmul])),
  ..tropical.monoid }

instance [add_comm_group R] : comm_group (tropical R) :=
{ mul_comm := λ _ _, untrop_injective (add_comm _ _),
  ..tropical.group }

@[simp] lemma untrop_zpow [add_group R] (x : tropical R) (n : ℤ) :
  untrop (x ^ n) = n • untrop x := rfl

@[simp] lemma trop_zsmul [add_group R] (x : R) (n : ℤ) :
  trop (n • x) = trop x ^ n := rfl

end monoid

section distrib

instance covariant_mul [has_le R] [has_add R] [covariant_class R R (+) (≤)] :
  covariant_class (tropical R) (tropical R) (*) (≤) :=
⟨λ x y z h, add_le_add_left h _⟩

instance covariant_swap_mul [has_le R] [has_add R] [covariant_class R R (function.swap (+)) (≤)] :
  covariant_class (tropical R) (tropical R) (function.swap (*)) (≤) :=
⟨λ x y z h, add_le_add_right h _⟩

instance covariant_add [linear_order R] : covariant_class (tropical R) (tropical R) (+) (≤) :=
⟨λ x y z h, begin
  cases le_total x y with hx hy,
  { rw [add_eq_left hx, add_eq_left (hx.trans h)] },
  { rw [add_eq_right hy],
    cases le_total x z with hx hx,
    { rwa [add_eq_left hx] },
    { rwa [add_eq_right hx] } }
end⟩

instance covariant_swap_add [linear_order R] :
  covariant_class (tropical R) (tropical R) (function.swap (+)) (≤) :=
⟨λ x y z h, by { convert add_le_add_left h x using 1; rw [add_comm] }⟩

instance covariant_mul_lt [has_lt R] [has_add R] [covariant_class R R (+) (<)] :
  covariant_class (tropical R) (tropical R) (*) (<) :=
⟨λ x y z h, add_lt_add_left h _⟩

instance covariant_swap_mul_lt [preorder R] [has_add R]
  [covariant_class R R (function.swap (+)) (<)] :
  covariant_class (tropical R) (tropical R) (function.swap (*)) (<) :=
⟨λ x y z h, add_lt_add_right h _⟩

instance covariant_add_lt [linear_order R] : covariant_class (tropical R) (tropical R) (+) (≤) :=
⟨λ x y z h, begin
  cases le_total x y with hx hy,
  { rw [add_eq_left hx, add_eq_left (hx.trans h)] },
  { rw [add_eq_right hy],
    cases le_total x z with hx hx,
    { rwa [add_eq_left hx] },
    { rwa [add_eq_right hx] } }
end⟩

instance covariant_swap_add_lt [linear_order R] :
  covariant_class (tropical R) (tropical R) (function.swap (+)) (≤) :=
⟨λ x y z h, by { convert add_le_add_left h x using 1; rw [add_comm] }⟩

instance [linear_order R] [has_add R]
  [covariant_class R R (+) (≤)] [covariant_class R R (function.swap (+)) (≤)] :
  distrib (tropical R) :=
{ mul := tropical.mul,
  add := tropical.add,
  left_distrib := λ _ _ _, untrop_injective (min_add_add_left _ _ _).symm,
  right_distrib := λ _ _ _, untrop_injective (min_add_add_right _ _ _).symm }

@[simp] lemma add_pow [linear_order R] [add_monoid R]
  [covariant_class R R (+) (≤)] [covariant_class R R (function.swap (+)) (≤)]
  (x y : tropical R) (n : ℕ) :
  (x + y) ^ n = x ^ n + y ^ n :=
begin
  cases le_total x y with h h,
  { rw [add_eq_left h, add_eq_left (pow_le_pow_of_le_left' h _)] },
  { rw [add_eq_right h, add_eq_right (pow_le_pow_of_le_left' h _)] }
end

end distrib

section semiring

variable [linear_ordered_add_comm_monoid_with_top R]

instance : comm_semiring (tropical R) :=
{ zero_mul := λ _, untrop_injective (top_add _),
  mul_zero := λ _, untrop_injective (add_top _),
  ..tropical.has_zero,
  ..tropical.distrib,
  ..tropical.add_comm_monoid,
  ..tropical.comm_monoid  }

@[simp] lemma succ_nsmul {R} [linear_order R] [order_top R] (x : tropical R) (n : ℕ) :
  (n + 1) • x = x :=
begin
  induction n with n IH,
  { simp },
  { rw [add_nsmul, IH, one_nsmul, add_self] }
end

-- TODO: find/create the right classes to make this hold (for enat, ennreal, etc)
-- Requires `zero_eq_bot` to be true
-- lemma add_eq_zero_iff {a b : tropical R} :
--   a + b = 1 ↔ a = 1 ∨ b = 1 := sorry

@[simp] lemma mul_eq_zero_iff {R : Type*} [linear_ordered_add_comm_monoid R]
  {a b : tropical (with_top R)} :
  a * b = 0 ↔ a = 0 ∨ b = 0 :=
by simp [←untrop_inj_iff, with_top.add_eq_top]

instance {R : Type*} [linear_ordered_add_comm_monoid R] :
  no_zero_divisors (tropical (with_top R)) :=
⟨λ _ _, mul_eq_zero_iff.mp⟩

end semiring

end tropical