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

! This file was ported from Lean 3 source module order.countable_dense_linear_order
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Ideal
import Mathbin.Data.Finset.Lattice

/-!
# The back and forth method and countable dense linear orders

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

## Results

Suppose `α β` are linear orders, with `α` countable and `β` dense, nontrivial. Then there is an
order embedding `α ↪ β`. If in addition `α` is dense, nonempty, without endpoints and `β` is
countable, without endpoints, then we can upgrade this to an order isomorphism `α ≃ β`.

The idea for both results is to consider "partial isomorphisms", which identify a finite subset of
`α` with a finite subset of `β`, and prove that for any such partial isomorphism `f` and `a : α`, we
can extend `f` to include `a` in its domain.

## References

https://en.wikipedia.org/wiki/Back-and-forth_method

## Tags

back and forth, dense, countable, order
-/

noncomputable section

open Classical

namespace Order

#print Order.exists_between_finsets /-
/-- Suppose `α` is a nonempty dense linear order without endpoints, and
    suppose `lo`, `hi`, are finite subssets with all of `lo` strictly
    before `hi`. Then there is an element of `α` strictly between `lo`
    and `hi`. -/
theorem exists_between_finsets {α : Type _} [LinearOrder α] [DenselyOrdered α] [NoMinOrder α]
    [NoMaxOrder α] [nonem : Nonempty α] (lo hi : Finset α) (lo_lt_hi : ∀ x ∈ lo, ∀ y ∈ hi, x < y) :
    ∃ m : α, (∀ x ∈ lo, x < m) ∧ ∀ y ∈ hi, m < y :=
  if nlo : lo.Nonempty then
    if nhi : hi.Nonempty then
      -- both sets are nonempty, use densely_ordered
        Exists.elim
        (exists_between (lo_lt_hi _ (Finset.max'_mem _ nlo) _ (Finset.min'_mem _ nhi))) fun m hm =>
        ⟨m, fun x hx => lt_of_le_of_lt (Finset.le_max' lo x hx) hm.1, fun y hy =>
          lt_of_lt_of_le hm.2 (Finset.min'_le hi y hy)⟩
    else-- upper set is empty, use `no_max_order`
        Exists.elim
        (exists_gt (Finset.max' lo nlo)) fun m hm =>
        ⟨m, fun x hx => lt_of_le_of_lt (Finset.le_max' lo x hx) hm, fun y hy => (nhi ⟨y, hy⟩).elim⟩
  else
    if nhi : hi.Nonempty then
      -- lower set is empty, use `no_min_order`
        Exists.elim
        (exists_lt (Finset.min' hi nhi)) fun m hm =>
        ⟨m, fun x hx => (nlo ⟨x, hx⟩).elim, fun y hy => lt_of_lt_of_le hm (Finset.min'_le hi y hy)⟩
    else-- both sets are empty, use nonempty
          nonem.elim
        fun m => ⟨m, fun x hx => (nlo ⟨x, hx⟩).elim, fun y hy => (nhi ⟨y, hy⟩).elim⟩
#align order.exists_between_finsets Order.exists_between_finsets
-/

variable (α β : Type _) [LinearOrder α] [LinearOrder β]

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (p q «expr ∈ » f) -/
#print Order.PartialIso /-
/-- The type of partial order isomorphisms between `α` and `β` defined on finite subsets.
    A partial order isomorphism is encoded as a finite subset of `α × β`, consisting
    of pairs which should be identified. -/
def PartialIso : Type _ :=
  { f : Finset (α × β) //
    ∀ (p) (_ : p ∈ f) (q) (_ : q ∈ f),
      cmp (Prod.fst p) (Prod.fst q) = cmp (Prod.snd p) (Prod.snd q) }
#align order.partial_iso Order.PartialIso
-/

namespace PartialIso

instance : Inhabited (PartialIso α β) :=
  ⟨⟨∅, fun p h q => h.elim⟩⟩

instance : Preorder (PartialIso α β) :=
  Subtype.preorder _

variable {α β}

#print Order.PartialIso.exists_across /-
/-- For each `a`, we can find a `b` in the codomain, such that `a`'s relation to
the domain of `f` is `b`'s relation to the image of `f`.

Thus, if `a` is not already in `f`, then we can extend `f` by sending `a` to `b`.
-/
theorem exists_across [DenselyOrdered β] [NoMinOrder β] [NoMaxOrder β] [Nonempty β]
    (f : PartialIso α β) (a : α) : ∃ b : β, ∀ p ∈ f.val, cmp (Prod.fst p) a = cmp (Prod.snd p) b :=
  by
  by_cases h : ∃ b, (a, b) ∈ f.val
  · cases' h with b hb
    exact ⟨b, fun p hp => f.prop _ hp _ hb⟩
  have :
    ∀ x ∈ (f.val.filter fun p : α × β => p.fst < a).image Prod.snd,
      ∀ y ∈ (f.val.filter fun p : α × β => a < p.fst).image Prod.snd, x < y :=
    by
    intro x hx y hy
    rw [Finset.mem_image] at hx hy
    rcases hx with ⟨p, hp1, rfl⟩
    rcases hy with ⟨q, hq1, rfl⟩
    rw [Finset.mem_filter] at hp1 hq1
    rw [← lt_iff_lt_of_cmp_eq_cmp (f.prop _ hp1.1 _ hq1.1)]
    exact lt_trans hp1.right hq1.right
  cases' exists_between_finsets _ _ this with b hb
  use b
  rintro ⟨p1, p2⟩ hp
  have : p1 ≠ a := fun he => h ⟨p2, he ▸ hp⟩
  cases' lt_or_gt_of_ne this with hl hr
  · have : p1 < a ∧ p2 < b :=
      ⟨hl, hb.1 _ (finset.mem_image.mpr ⟨(p1, p2), finset.mem_filter.mpr ⟨hp, hl⟩, rfl⟩)⟩
    rw [← cmp_eq_lt_iff, ← cmp_eq_lt_iff] at this
    cc
  · have : a < p1 ∧ b < p2 :=
      ⟨hr, hb.2 _ (finset.mem_image.mpr ⟨(p1, p2), finset.mem_filter.mpr ⟨hp, hr⟩, rfl⟩)⟩
    rw [← cmp_eq_gt_iff, ← cmp_eq_gt_iff] at this
    cc
#align order.partial_iso.exists_across Order.PartialIso.exists_across
-/

#print Order.PartialIso.comm /-
/-- A partial isomorphism between `α` and `β` is also a partial isomorphism between `β` and `α`. -/
protected def comm : PartialIso α β → PartialIso β α :=
  Subtype.map (Finset.image (Equiv.prodComm _ _)) fun f hf p hp q hq =>
    Eq.symm <|
      hf ((Equiv.prodComm α β).symm p)
        (by
          rw [← Finset.mem_coe, Finset.coe_image, Equiv.image_eq_preimage] at hp
          rwa [← Finset.mem_coe])
        ((Equiv.prodComm α β).symm q)
        (by
          rw [← Finset.mem_coe, Finset.coe_image, Equiv.image_eq_preimage] at hq
          rwa [← Finset.mem_coe])
#align order.partial_iso.comm Order.PartialIso.comm
-/

variable (β)

/- warning: order.partial_iso.defined_at_left -> Order.PartialIso.definedAtLeft is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (β : Type.{u2}) [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] [_inst_3 : DenselyOrdered.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))))] [_inst_4 : NoMinOrder.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))))] [_inst_5 : NoMaxOrder.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))))] [_inst_6 : Nonempty.{succ u2} β], α -> (Order.Cofinal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))
but is expected to have type
  forall {α : Type.{u1}} (β : Type.{u2}) [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] [_inst_3 : DenselyOrdered.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_2))))))] [_inst_4 : NoMinOrder.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_2))))))] [_inst_5 : NoMaxOrder.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_2))))))] [_inst_6 : Nonempty.{succ u2} β], α -> (Order.Cofinal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))
Case conversion may be inaccurate. Consider using '#align order.partial_iso.defined_at_left Order.PartialIso.definedAtLeftₓ'. -/
/-- The set of partial isomorphisms defined at `a : α`, together with a proof that any
    partial isomorphism can be extended to one defined at `a`. -/
def definedAtLeft [DenselyOrdered β] [NoMinOrder β] [NoMaxOrder β] [Nonempty β] (a : α) :
    Cofinal (PartialIso α β)
    where
  carrier f := ∃ b : β, (a, b) ∈ f.val
  mem_gt f := by
    cases' exists_across f a with b a_b
    refine'
      ⟨⟨insert (a, b) f.val, fun p hp q hq => _⟩, ⟨b, Finset.mem_insert_self _ _⟩,
        Finset.subset_insert _ _⟩
    rw [Finset.mem_insert] at hp hq
    rcases hp with (rfl | pf) <;> rcases hq with (rfl | qf)
    · simp only [cmp_self_eq_eq]
    · rw [cmp_eq_cmp_symm]
      exact a_b _ qf
    · exact a_b _ pf
    · exact f.prop _ pf _ qf
#align order.partial_iso.defined_at_left Order.PartialIso.definedAtLeft

variable (α) {β}

/- warning: order.partial_iso.defined_at_right -> Order.PartialIso.definedAtRight is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] [_inst_3 : DenselyOrdered.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))] [_inst_4 : NoMinOrder.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))] [_inst_5 : NoMaxOrder.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))] [_inst_6 : Nonempty.{succ u1} α], β -> (Order.Cofinal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))
but is expected to have type
  forall (α : Type.{u1}) {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] [_inst_3 : DenselyOrdered.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))))] [_inst_4 : NoMinOrder.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))))] [_inst_5 : NoMaxOrder.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))))] [_inst_6 : Nonempty.{succ u1} α], β -> (Order.Cofinal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))
Case conversion may be inaccurate. Consider using '#align order.partial_iso.defined_at_right Order.PartialIso.definedAtRightₓ'. -/
/-- The set of partial isomorphisms defined at `b : β`, together with a proof that any
    partial isomorphism can be extended to include `b`. We prove this by symmetry. -/
def definedAtRight [DenselyOrdered α] [NoMinOrder α] [NoMaxOrder α] [Nonempty α] (b : β) :
    Cofinal (PartialIso α β) where
  carrier f := ∃ a, (a, b) ∈ f.val
  mem_gt f := by
    rcases(defined_at_left α b).mem_gt f.comm with ⟨f', ⟨a, ha⟩, hl⟩
    refine' ⟨f'.comm, ⟨a, _⟩, _⟩
    · change (a, b) ∈ f'.val.image _
      rwa [← Finset.mem_coe, Finset.coe_image, Equiv.image_eq_preimage]
    · change _ ⊆ f'.val.image _
      rw [← Finset.coe_subset, Finset.coe_image, ← Equiv.subset_image]
      change f.val.image _ ⊆ _ at hl
      rwa [← Finset.coe_subset, Finset.coe_image] at hl
#align order.partial_iso.defined_at_right Order.PartialIso.definedAtRight

variable {α}

/- warning: order.partial_iso.fun_of_ideal -> Order.PartialIso.funOfIdeal is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] [_inst_3 : DenselyOrdered.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))))] [_inst_4 : NoMinOrder.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))))] [_inst_5 : NoMaxOrder.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))))] [_inst_6 : Nonempty.{succ u2} β] (a : α) (I : Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))), (Exists.{succ (max u1 u2)} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (fun (f : Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) => And (Membership.Mem.{max u1 u2, max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Cofinal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2)) (Order.Cofinal.hasMem.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2)) f (Order.PartialIso.definedAtLeft.{u1, u2} α β _inst_1 _inst_2 _inst_3 _inst_4 _inst_5 _inst_6 a)) (Membership.Mem.{max u1 u2, max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (SetLike.hasMem.{max u1 u2, max u1 u2} (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.setLike.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2)))) f I))) -> (Subtype.{succ u2} β (fun (b : β) => Exists.{succ (max u1 u2)} (Subtype.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u1 u2} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q)))))) (fun (f : Subtype.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u1 u2} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q)))))) => Exists.{0} (Membership.Mem.{max u1 u2, max u1 u2} (Subtype.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u1 u2} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q)))))) (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (SetLike.hasMem.{max u1 u2, max u1 u2} (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.setLike.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2)))) f I) (fun (H : Membership.Mem.{max u1 u2, max u1 u2} (Subtype.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u1 u2} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q)))))) (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (SetLike.hasMem.{max u1 u2, max u1 u2} (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.setLike.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2)))) f I) => Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) (Prod.mk.{u1, u2} α β a b) (Subtype.val.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u1 u2} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q))))) f)))))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] [_inst_3 : DenselyOrdered.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_2))))))] [_inst_4 : NoMinOrder.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_2))))))] [_inst_5 : NoMaxOrder.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_2))))))] [_inst_6 : Nonempty.{succ u2} β] (a : α) (I : Order.Ideal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))), (Exists.{succ (max u1 u2)} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (fun (f : Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) => And (Membership.mem.{max u1 u2, max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Cofinal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2)) (Order.Cofinal.instMembershipCofinal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2)) f (Order.PartialIso.definedAtLeft.{u1, u2} α β _inst_1 _inst_2 _inst_3 _inst_4 _inst_5 _inst_6 a)) (Membership.mem.{max u1 u2, max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))) (SetLike.instMembership.{max u1 u2, max u1 u2} (Order.Ideal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))) (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.instSetLikeIdeal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2)))) f I))) -> (Subtype.{succ u2} β (fun (b : β) => Exists.{succ (max u1 u2)} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (fun (f : Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) => And (Membership.mem.{max u1 u2, max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))) (SetLike.instMembership.{max u1 u2, max u1 u2} (Order.Ideal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))) (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.instSetLikeIdeal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2)))) f I) (Membership.mem.{max u2 u1, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u2 u1} (Prod.{u1, u2} α β)) (Finset.instMembershipFinset.{max u1 u2} (Prod.{u1, u2} α β)) (Prod.mk.{u1, u2} α β a b) (Subtype.val.{succ (max u1 u2)} (Finset.{max u2 u1} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u2 u1} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u2 u1} (Prod.{u1, u2} α β)) (Finset.instMembershipFinset.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u2 u1} (Prod.{u1, u2} α β)) (Finset.instMembershipFinset.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1)))))) (fun (a : α) (b : α) => instDecidableLtToLTToPreorderToPartialOrder.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_2)))))) (fun (a : β) (b : β) => instDecidableLtToLTToPreorderToPartialOrder.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q))))) f)))))
Case conversion may be inaccurate. Consider using '#align order.partial_iso.fun_of_ideal Order.PartialIso.funOfIdealₓ'. -/
/-- Given an ideal which intersects `defined_at_left β a`, pick `b : β` such that
    some partial function in the ideal maps `a` to `b`. -/
def funOfIdeal [DenselyOrdered β] [NoMinOrder β] [NoMaxOrder β] [Nonempty β] (a : α)
    (I : Ideal (PartialIso α β)) :
    (∃ f, f ∈ definedAtLeft β a ∧ f ∈ I) → { b // ∃ f ∈ I, (a, b) ∈ Subtype.val f } :=
  Classical.indefiniteDescription _ ∘ fun ⟨f, ⟨b, hb⟩, hf⟩ => ⟨b, f, hf, hb⟩
#align order.partial_iso.fun_of_ideal Order.PartialIso.funOfIdeal

/- warning: order.partial_iso.inv_of_ideal -> Order.PartialIso.invOfIdeal is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] [_inst_3 : DenselyOrdered.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))] [_inst_4 : NoMinOrder.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))] [_inst_5 : NoMaxOrder.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))] [_inst_6 : Nonempty.{succ u1} α] (b : β) (I : Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))), (Exists.{succ (max u1 u2)} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (fun (f : Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) => And (Membership.Mem.{max u1 u2, max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Cofinal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2)) (Order.Cofinal.hasMem.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2)) f (Order.PartialIso.definedAtRight.{u1, u2} α β _inst_1 _inst_2 _inst_3 _inst_4 _inst_5 _inst_6 b)) (Membership.Mem.{max u1 u2, max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (SetLike.hasMem.{max u1 u2, max u1 u2} (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.setLike.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2)))) f I))) -> (Subtype.{succ u1} α (fun (a : α) => Exists.{succ (max u1 u2)} (Subtype.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u1 u2} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q)))))) (fun (f : Subtype.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u1 u2} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q)))))) => Exists.{0} (Membership.Mem.{max u1 u2, max u1 u2} (Subtype.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u1 u2} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q)))))) (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (SetLike.hasMem.{max u1 u2, max u1 u2} (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.setLike.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2)))) f I) (fun (H : Membership.Mem.{max u1 u2, max u1 u2} (Subtype.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u1 u2} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q)))))) (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (SetLike.hasMem.{max u1 u2, max u1 u2} (Order.Ideal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2))) (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.setLike.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.preorder.{u1, u2} α β _inst_1 _inst_2)))) f I) => Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) (Prod.mk.{u1, u2} α β a b) (Subtype.val.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u1 u2} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.Mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (fun (a : α) (b : α) => LT.lt.decidable.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))) (fun (a : β) (b : β) => LT.lt.decidable.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q))))) f)))))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] [_inst_3 : DenselyOrdered.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))))] [_inst_4 : NoMinOrder.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))))] [_inst_5 : NoMaxOrder.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))))] [_inst_6 : Nonempty.{succ u1} α] (b : β) (I : Order.Ideal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))), (Exists.{succ (max u1 u2)} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (fun (f : Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) => And (Membership.mem.{max u1 u2, max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Cofinal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2)) (Order.Cofinal.instMembershipCofinal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2)) f (Order.PartialIso.definedAtRight.{u1, u2} α β _inst_1 _inst_2 _inst_3 _inst_4 _inst_5 _inst_6 b)) (Membership.mem.{max u1 u2, max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))) (SetLike.instMembership.{max u1 u2, max u1 u2} (Order.Ideal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))) (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.instSetLikeIdeal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2)))) f I))) -> (Subtype.{succ u1} α (fun (a : α) => Exists.{succ (max u1 u2)} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (fun (f : Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) => And (Membership.mem.{max u1 u2, max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))) (SetLike.instMembership.{max u1 u2, max u1 u2} (Order.Ideal.{max u2 u1} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2))) (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.Ideal.instSetLikeIdeal.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Preorder.toLE.{max u1 u2} (Order.PartialIso.{u1, u2} α β _inst_1 _inst_2) (Order.PartialIso.instPreorderPartialIso.{u1, u2} α β _inst_1 _inst_2)))) f I) (Membership.mem.{max u2 u1, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u2 u1} (Prod.{u1, u2} α β)) (Finset.instMembershipFinset.{max u2 u1} (Prod.{u1, u2} α β)) (Prod.mk.{u1, u2} α β a b) (Subtype.val.{succ (max u1 u2)} (Finset.{max u2 u1} (Prod.{u1, u2} α β)) (fun (f : Finset.{max u2 u1} (Prod.{u1, u2} α β)) => forall (p : Prod.{u1, u2} α β), (Membership.mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u2 u1} (Prod.{u1, u2} α β)) (Finset.instMembershipFinset.{max u1 u2} (Prod.{u1, u2} α β)) p f) -> (forall (q : Prod.{u1, u2} α β), (Membership.mem.{max u1 u2, max u1 u2} (Prod.{u1, u2} α β) (Finset.{max u2 u1} (Prod.{u1, u2} α β)) (Finset.instMembershipFinset.{max u1 u2} (Prod.{u1, u2} α β)) q f) -> (Eq.{1} Ordering (cmp.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1)))))) (fun (a : α) (b : α) => instDecidableLtToLTToPreorderToPartialOrder.{u1} α _inst_1 a b) (Prod.fst.{u1, u2} α β p) (Prod.fst.{u1, u2} α β q)) (cmp.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (DistribLattice.toLattice.{u2} β (instDistribLattice.{u2} β _inst_2)))))) (fun (a : β) (b : β) => instDecidableLtToLTToPreorderToPartialOrder.{u2} β _inst_2 a b) (Prod.snd.{u1, u2} α β p) (Prod.snd.{u1, u2} α β q))))) f)))))
Case conversion may be inaccurate. Consider using '#align order.partial_iso.inv_of_ideal Order.PartialIso.invOfIdealₓ'. -/
/-- Given an ideal which intersects `defined_at_right α b`, pick `a : α` such that
    some partial function in the ideal maps `a` to `b`. -/
def invOfIdeal [DenselyOrdered α] [NoMinOrder α] [NoMaxOrder α] [Nonempty α] (b : β)
    (I : Ideal (PartialIso α β)) :
    (∃ f, f ∈ definedAtRight α b ∧ f ∈ I) → { a // ∃ f ∈ I, (a, b) ∈ Subtype.val f } :=
  Classical.indefiniteDescription _ ∘ fun ⟨f, ⟨a, ha⟩, hf⟩ => ⟨a, f, hf, ha⟩
#align order.partial_iso.inv_of_ideal Order.PartialIso.invOfIdeal

end PartialIso

open PartialIso

variable (α β)

/- warning: order.embedding_from_countable_to_dense -> Order.embedding_from_countable_to_dense is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) (β : Type.{u2}) [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] [_inst_3 : Encodable.{u1} α] [_inst_4 : DenselyOrdered.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))))] [_inst_5 : Nontrivial.{u2} β], Nonempty.{max (succ u1) (succ u2)} (OrderEmbedding.{u1, u2} α β (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (Preorder.toLE.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))))
but is expected to have type
  forall (α : Type.{u2}) (β : Type.{u1}) [_inst_1 : LinearOrder.{u2} α] [_inst_2 : LinearOrder.{u1} β] [_inst_3 : Encodable.{u2} α] [_inst_4 : DenselyOrdered.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_2))))))] [_inst_5 : Nontrivial.{u1} β], Nonempty.{max (succ u1) (succ u2)} (OrderEmbedding.{u2, u1} α β (Preorder.toLE.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1)))))) (Preorder.toLE.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_2)))))))
Case conversion may be inaccurate. Consider using '#align order.embedding_from_countable_to_dense Order.embedding_from_countable_to_denseₓ'. -/
/-- Any countable linear order embeds in any nontrivial dense linear order. -/
theorem embedding_from_countable_to_dense [Encodable α] [DenselyOrdered β] [Nontrivial β] :
    Nonempty (α ↪o β) := by
  rcases exists_pair_lt β with ⟨x, y, hxy⟩
  cases' exists_between hxy with a ha
  haveI : Nonempty (Set.Ioo x y) := ⟨⟨a, ha⟩⟩
  let our_ideal : Ideal (partial_iso α _) :=
    ideal_of_cofinals default (defined_at_left (Set.Ioo x y))
  let F a := fun_of_ideal a our_ideal (cofinal_meets_ideal_of_cofinals _ _ a)
  refine'
    ⟨RelEmbedding.trans (OrderEmbedding.ofStrictMono (fun a => (F a).val) fun a₁ a₂ => _)
        (OrderEmbedding.subtype _)⟩
  rcases(F a₁).Prop with ⟨f, hf, ha₁⟩
  rcases(F a₂).Prop with ⟨g, hg, ha₂⟩
  rcases our_ideal.directed _ hf _ hg with ⟨m, hm, fm, gm⟩
  exact (lt_iff_lt_of_cmp_eq_cmp <| m.prop (a₁, _) (fm ha₁) (a₂, _) (gm ha₂)).mp
#align order.embedding_from_countable_to_dense Order.embedding_from_countable_to_dense

/- warning: order.iso_of_countable_dense -> Order.iso_of_countable_dense is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) (β : Type.{u2}) [_inst_1 : LinearOrder.{u1} α] [_inst_2 : LinearOrder.{u2} β] [_inst_3 : Encodable.{u1} α] [_inst_4 : DenselyOrdered.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))] [_inst_5 : NoMinOrder.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))] [_inst_6 : NoMaxOrder.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))))] [_inst_7 : Nonempty.{succ u1} α] [_inst_8 : Encodable.{u2} β] [_inst_9 : DenselyOrdered.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))))] [_inst_10 : NoMinOrder.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))))] [_inst_11 : NoMaxOrder.{u2} β (Preorder.toLT.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2)))))] [_inst_12 : Nonempty.{succ u2} β], Nonempty.{max (succ u1) (succ u2)} (OrderIso.{u1, u2} α β (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (Preorder.toLE.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (LinearOrder.toLattice.{u2} β _inst_2))))))
but is expected to have type
  forall (α : Type.{u2}) (β : Type.{u1}) [_inst_1 : LinearOrder.{u2} α] [_inst_2 : LinearOrder.{u1} β] [_inst_3 : Encodable.{u2} α] [_inst_4 : DenselyOrdered.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))))] [_inst_5 : NoMinOrder.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))))] [_inst_6 : NoMaxOrder.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))))] [_inst_7 : Nonempty.{succ u2} α] [_inst_8 : Encodable.{u1} β] [_inst_9 : DenselyOrdered.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_2))))))] [_inst_10 : NoMinOrder.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_2))))))] [_inst_11 : NoMaxOrder.{u1} β (Preorder.toLT.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_2))))))] [_inst_12 : Nonempty.{succ u1} β], Nonempty.{max (succ u1) (succ u2)} (OrderIso.{u2, u1} α β (Preorder.toLE.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1)))))) (Preorder.toLE.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (DistribLattice.toLattice.{u1} β (instDistribLattice.{u1} β _inst_2)))))))
Case conversion may be inaccurate. Consider using '#align order.iso_of_countable_dense Order.iso_of_countable_denseₓ'. -/
/-- Any two countable dense, nonempty linear orders without endpoints are order isomorphic. -/
theorem iso_of_countable_dense [Encodable α] [DenselyOrdered α] [NoMinOrder α] [NoMaxOrder α]
    [Nonempty α] [Encodable β] [DenselyOrdered β] [NoMinOrder β] [NoMaxOrder β] [Nonempty β] :
    Nonempty (α ≃o β) :=
  let to_cofinal : Sum α β → Cofinal (PartialIso α β) := fun p =>
    Sum.recOn p (definedAtLeft β) (definedAtRight α)
  let our_ideal : Ideal (PartialIso α β) := idealOfCofinals default to_cofinal
  let F a := funOfIdeal a our_ideal (cofinal_meets_idealOfCofinals _ to_cofinal (Sum.inl a))
  let G b := invOfIdeal b our_ideal (cofinal_meets_idealOfCofinals _ to_cofinal (Sum.inr b))
  ⟨OrderIso.ofCmpEqCmp (fun a => (F a).val) (fun b => (G b).val) fun a b =>
      by
      rcases(F a).Prop with ⟨f, hf, ha⟩
      rcases(G b).Prop with ⟨g, hg, hb⟩
      rcases our_ideal.directed _ hf _ hg with ⟨m, hm, fm, gm⟩
      exact m.prop (a, _) (fm ha) (_, b) (gm hb)⟩
#align order.iso_of_countable_dense Order.iso_of_countable_dense

end Order


def partial_fun (α β) := α → option β

universes u v
variables {α : Type u} {β : Type v}

def emptyf : partial_fun α β
| _ := none

instance : has_emptyc (partial_fun α β) :=
⟨emptyf⟩

inductive dom (f : partial_fun α β) : set α
| intro (a) (b) : f a = some b → dom a

variable [decidable_eq α]

-- Destructive addition to a context
@[irreducible]
def extend (f : partial_fun α β) (x : α) (y : β) : partial_fun α β
| x' := if x' = x then y else f x'

instance : has_insert (α × β) (partial_fun α β) :=
⟨λ ⟨a, b⟩ f, extend f a b⟩

variable (f : partial_fun α β)

lemma extend_same (x : α) (y : β) : extend f x y x = y :=
by unfold extend; simp

lemma extend_diff {x x' : α} (y : β) :
  x' ≠ x → extend f x y x' = f x' :=
by intro h; unfold extend; simp [h]

lemma extend_comm {x₁ x₂ : α} (y₁ y₂ : β) : x₁ ≠ x₂ →
  extend (extend f x₁ y₁) x₂ y₂ = extend (extend f x₂ y₂) x₁ y₁ :=
begin
  intro h,
  apply funext,
  intro x,

  by_cases x = x₁ with h',
  simp [h', extend_same,
        extend_diff _ _ h],

  rw extend_diff _ _ h',
  by_cases x = x₂ with h'',

  simp [h'', extend_same],

  simp [extend_diff _ _ h',
        extend_diff _ _ h'']
end


import pq_induction_principles

universe u

section pq_group_eq_list

variables {Q : Type u} [power_quandle Q]

inductive pq_group_list_rel : list Q → list Q → Prop
| refl (x : list Q) : pq_group_list_rel x x
| symm (x y : list Q) (hxy : pq_group_list_rel x y) : pq_group_list_rel y x
| trans (x y z : list Q) (hxy : pq_group_list_rel x y) (hyz : pq_group_list_rel y z) : pq_group_list_rel x z
| congr_append (x x' y y' : list Q) (hx : pq_group_list_rel x x') (hy : pq_group_list_rel y y') : pq_group_list_rel (y ++ x) (y' ++ x')
| congr_reverse_inv (x y : list Q) (hxy : pq_group_list_rel x y) : pq_group_list_rel ((x.reverse.map (λ g, g ^ (-1 : ℤ)))) ((y.reverse.map (λ g, g ^ (-1 : ℤ))))
| pow_nat (a : Q) (n : ℕ) : pq_group_list_rel ([a ^ (↑n : ℤ)]) (list.repeat a n)
| inv_append (a : Q) : pq_group_list_rel ([a ^ (-1 : ℤ), a]) ([])
| rhd_append (a b : Q) : pq_group_list_rel ([a, b, a ^ (-1 : ℤ)]) ([a ▷ b])

lemma pq_group_list_rel_congr_reverse_inv_alt (x y : list Q) (hxy : pq_group_list_rel ((x.reverse.map (λ g, g ^ (-1 : ℤ)))) ((y.reverse.map (λ g, g ^ (-1 : ℤ))))) : pq_group_list_rel x y :=
begin
  suffices : ∀ a : list Q, (list.map (λ (g : Q), g ^ (-1 : ℤ)) ((list.map (λ (g : Q), g ^ (-1 : ℤ)) a.reverse)).reverse) = a,
  {
    rw ←this x,
    rw ←this y,
    apply pq_group_list_rel.congr_reverse_inv,
    exact hxy,
  },
  clear hxy x y,
  intros a,
  simp only [list.map_reverse, list.reverse_reverse, list.map_map],
  convert list.map_id a,
  funext,
  simp only [id.def, function.comp_app],
  rw power_quandle.pow_comp,
  norm_num,
  rw power_quandle.pow_one,
end

lemma pq_group_list_rel_inv_append_alt (a : Q) : pq_group_list_rel [a, a^(-1 : ℤ)] [] :=
begin
  have := pq_group_list_rel.inv_append (a ^ (-1 : ℤ)),
  rw power_quandle.pow_comp at this,
  norm_num at this,
  rw power_quandle.pow_one at this,
  exact this,
end

lemma pq_group_list_rel_pred_mul_nat (a : Q) (n : ℕ) : pq_group_list_rel [a ^ (↑n : ℤ)] ([a] ++ [a ^ ((↑n : ℤ) - 1)]) :=
begin
  apply pq_group_list_rel.trans,
  apply pq_group_list_rel.pow_nat,
  cases n,
  {
    simp only [list.repeat, zero_sub, int.coe_nat_zero, int.of_nat_eq_coe, list.singleton_append],
    refine pq_group_list_rel.symm [a, a ^ -1] list.nil _,
    apply pq_group_list_rel_inv_append_alt,
  },
  {
    have : list.repeat a n.succ = [a] ++ list.repeat a n,
    {
      refl,
    },
    rw this,
    apply pq_group_list_rel.congr_append,
    {
      simp only [int.coe_nat_succ, int.of_nat_eq_coe, add_sub_cancel],
      apply pq_group_list_rel.symm,
      apply pq_group_list_rel.pow_nat,
    },
    {
      exact pq_group_list_rel.refl [a],
    },
  },
end

lemma pq_group_list_rel_succ_mul_nat (a : Q) (n : ℕ) : pq_group_list_rel [a ^ (↑n : ℤ)] ([a ^ ((↑n : ℤ) + 1)] ++ [a ^ (-1 : ℤ)]) :=
begin
  apply pq_group_list_rel.trans,
  apply pq_group_list_rel.pow_nat,
  suffices : pq_group_list_rel (list.repeat a n) ([a ^ (↑n : ℤ)] ++ [a] ++ [a ^ (-1 : ℤ)]),
  {
    apply pq_group_list_rel.trans _ _ _ this _,
    clear this,
    apply pq_group_list_rel.congr_append,
    apply pq_group_list_rel.refl,
    apply pq_group_list_rel.symm,
    have := pq_group_list_rel.pow_nat a (n + 1),
    apply pq_group_list_rel.trans _ _ _ this _,
    clear this,
    rw list.repeat_add,
    simp only [list.repeat],
    apply pq_group_list_rel.congr_append,
    apply pq_group_list_rel.refl,
    apply pq_group_list_rel.symm,
    apply pq_group_list_rel.pow_nat,
  },
  have : list.repeat a n = list.repeat a n ++ list.nil,
  {
    simp only [list.append_nil],
  },
  rw this,
  clear this,
  rw list.append_assoc,
  apply pq_group_list_rel.congr_append,
  {
    simp only [list.singleton_append],
    apply pq_group_list_rel.symm,
    apply pq_group_list_rel_inv_append_alt,
  },
  {
    apply pq_group_list_rel.symm,
    exact pq_group_list_rel.pow_nat a n,
  },
end

theorem pq_group_list_rel_iff_pq_group_eq (a b : pre_pq_group Q) : ⟦a⟧ = ⟦b⟧ ↔ pq_group_list_rel (create_list_from_pq a) (create_list_from_pq b) :=
begin
  split,
  {
    intros hab,
    have hab1 := quotient.exact hab,
    clear hab,
    rename hab1 hab,
    induction hab,
    induction hab_r,
    {
      exact pq_group_list_rel.refl (create_list_from_pq hab_r),
    },
    {
      exact pq_group_list_rel.symm (create_list_from_pq hab_r_a) (create_list_from_pq hab_r_b) hab_r_ih,
    },
    {
      exact pq_group_list_rel.trans (create_list_from_pq hab_r_a) (create_list_from_pq hab_r_b) (create_list_from_pq hab_r_c) hab_r_ih_hab hab_r_ih_hbc,
    },
    {
      unfold create_list_from_pq,
      exact pq_group_list_rel.congr_append (create_list_from_pq hab_r_b) (create_list_from_pq hab_r_b')
      (create_list_from_pq hab_r_a)
      (create_list_from_pq hab_r_a')
      hab_r_ih_hb
      hab_r_ih_ha,
    },
    {
      unfold create_list_from_pq,
      exact pq_group_list_rel.congr_reverse_inv (create_list_from_pq hab_r_a) (create_list_from_pq hab_r_a') hab_r_ih,
    },
    {
      unfold create_list_from_pq,
      simp only [list.append_assoc],
      exact pq_group_list_rel.refl (create_list_from_pq hab_r_a ++ (create_list_from_pq hab_r_b ++ create_list_from_pq hab_r_c)),
    },
    {
      unfold create_list_from_pq,
      simp only [list.nil_append],
      exact pq_group_list_rel.refl (create_list_from_pq hab_r),
    },
    {
      unfold create_list_from_pq,
      simp only [list.append_nil],
      exact pq_group_list_rel.refl (create_list_from_pq hab_r),
    },
    {
      unfold create_list_from_pq,
      generalize : create_list_from_pq hab_r = x,
      induction x,
      {
        simp only [list.append_nil, list.map, list.reverse_nil],
        exact pq_group_list_rel.refl list.nil,
      },
      {
        simp only [list.reverse_cons, list.map_reverse, list.map_append, list.append_assoc, list.singleton_append, list.map],
        have : (list.map (λ (q : Q), q ^ (-(1 : ℤ))) x_tl).reverse ++ x_hd ^ (-(1 : ℤ)) :: x_hd :: x_tl = (list.map (λ (q : Q), q ^ (-(1 : ℤ))) x_tl).reverse ++ ([x_hd ^ (-1 : ℤ), x_hd]) ++ x_tl,
        {
          simp only [list.cons_append, eq_self_iff_true, list.append_assoc, list.singleton_append, list.map],
        },
        rw this,
        clear this,
        fapply pq_group_list_rel.trans _ (list.map (λ (q : Q), q ^ (-1 : ℤ)) x_tl.reverse ++ x_tl) _,
        swap, assumption,
        clear x_ih,
        rw list.append_assoc,
        apply pq_group_list_rel.congr_append,
        swap,
        simp only [list.map_reverse],
        apply pq_group_list_rel.refl,
        have : x_tl = list.nil ++ x_tl := rfl,
        rw this,
        apply pq_group_list_rel.congr_append,
        simp only [list.nil_append],
        apply pq_group_list_rel.refl,
        exact pq_group_list_rel.inv_append x_hd,
      },
    },
    {
      unfold create_list_from_pq,
      simp only [list.cons_append, list.map_nil, list.reverse_singleton, list.singleton_append, list.map],
      exact pq_group_list_rel.rhd_append hab_r_a hab_r_b,
    },
    {
      unfold create_list_from_pq,
      induction hab_r_n,
      {
        apply pq_group_list_rel_pred_mul_nat,
      },
      {
        apply pq_group_list_rel_congr_reverse_inv_alt,
        simp only [list.reverse_cons, list.map_nil, list.reverse_singleton, list.singleton_append, list.map],
        simp only [power_quandle.pow_comp],
        simp only [mul_one, mul_neg_eq_neg_mul_symm, neg_sub],
        have := pq_group_list_rel_succ_mul_nat hab_r_a (hab_r_n + 1),
        simp only [list.singleton_append] at this,
        convert this,
        simp only [int.coe_nat_succ],
        ring,
      },
    },
    {
      unfold create_list_from_pq,
      simp only [list.reverse_singleton, list.map],
      induction hab_r_n,
      {
        apply pq_group_list_rel_succ_mul_nat hab_r_a hab_r_n,
      },
      {
        apply pq_group_list_rel_congr_reverse_inv_alt,
        simp only [list.reverse_cons, list.map_nil, list.reverse_singleton, list.singleton_append, list.map],
        simp only [power_quandle.pow_comp],
        simp only [mul_one, mul_neg_eq_neg_mul_symm, neg_add_rev, neg_neg],
        rw power_quandle.pow_one,
        have := pq_group_list_rel_pred_mul_nat hab_r_a (hab_r_n + 1),
        simp only [list.singleton_append] at this,
        convert this,
      },
    },
    {
      unfold create_list_from_pq,
      apply pq_group_list_rel.pow_nat hab_r 0,
    },
  },
  {
    intros hab,
    rw ←create_list_from_pq_eq_id,
    rw ←create_list_from_pq_eq_id,
    generalize hx : create_list_from_pq a = x,
    generalize hy : create_list_from_pq b = y,
    rw hx at hab,
    rw hy at hab,
    clear hx hy a b,
    induction hab,
    {
      refl,
    },
    {
      symmetry,
      assumption,
    },
    {
      transitivity,
      assumption,
      assumption,
    },
    {
      simp only [list.map_append, list.prod_append],
      congr,
      assumption,
      assumption,
    },
    {
      -- Factor out to lemma
      have proc_is_inv : ∀ a : list Q, (list.map of (list.map (λ (g : Q), g ^ (-1 : ℤ)) (list.reverse a))).prod = ((list.map of a).prod)⁻¹,
      {
        intros a,
        simp only [list.map_map, list.map_reverse],
        induction a,
        {
          simp only [one_inv, list.prod_nil, list.map, list.reverse_nil],
        },
        {
          simp only [list.reverse_cons, mul_inv_rev, mul_one, list.prod_append, function.comp_app, list.prod_cons, list.prod_nil, list.map],
          rw a_ih,
          simp only [mul_right_inj],
          rw of_inv,
        },
      },
      rw proc_is_inv,
      rw proc_is_inv,
      congr,
      assumption,
    },
    {
      simp only [list.prod_repeat, mul_one, list.map_repeat, list.prod_cons, list.prod_nil, list.map],
      rw of_pow_eq_pow_of,
      refl,
    },
    {
      simp only [mul_one, list.prod_cons, list.prod_nil, list.map],
      rw ←of_inv,
      simp only [mul_left_inv],
    },
    {
      simp only [mul_one, list.prod_cons, list.prod_nil, list.map],
      rw ←rhd_of_eq_of_rhd,
      rw ←mul_assoc,
      rw ←of_inv,
      refl,
    },
  },
end

end pq_group_eq_list


/-
Copyright (c) 2020 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Adam Topaz
-/
import algebra.algebra.subalgebra
import algebra.monoid_algebra
import linear_algebra
import data.equiv.transfer_instance

/-!
# Free Algebras

Given a commutative semiring `R`, and a type `X`, we construct the free `R`-algebra on `X`.

## Notation

1. `free_algebra R X` is the free algebra itself. It is endowed with an `R`-algebra structure.
2. `free_algebra.ι R` is the function `X → free_algebra R X`.
3. Given a function `f : X → A` to an R-algebra `A`, `lift R f` is the lift of `f` to an
  `R`-algebra morphism `free_algebra R X → A`.

## Theorems

1. `ι_comp_lift` states that the composition `(lift R f) ∘ (ι R)` is identical to `f`.
2. `lift_unique` states that whenever an R-algebra morphism `g : free_algebra R X → A` is
  given whose composition with `ι R` is `f`, then one has `g = lift R f`.
3. `hom_ext` is a variant of `lift_unique` in the form of an extensionality theorem.
4. `lift_comp_ι` is a combination of `ι_comp_lift` and `lift_unique`. It states that the lift
  of the composition of an algebra morphism with `ι` is the algebra morphism itself.
5. `equiv_monoid_algebra_free_monoid : free_algebra R X ≃ₐ[R] monoid_algebra R (free_monoid X)`
6. An inductive principle `induction`.

## Implementation details

We construct the free algebra on `X` as a quotient of an inductive type `free_algebra.pre` by an
inductively defined relation `free_algebra.rel`. Explicitly, the construction involves three steps:
1. We construct an inductive type `free_algebra.pre R X`, the terms of which should be thought
  of as representatives for the elements of `free_algebra R X`.
  It is the free type with maps from `R` and `X`, and with two binary operations `add` and `mul`.
2. We construct an inductive relation `free_algebra.rel R X` on `free_algebra.pre R X`.
  This is the smallest relation for which the quotient is an `R`-algebra where addition resp.
  multiplication are induced by `add` resp. `mul` from 1., and for which the map from `R` is the
  structure map for the algebra.
3. The free algebra `free_algebra R X` is the quotient of `free_algebra.pre R X` by
  the relation `free_algebra.rel R X`.
-/

variables (R : Type*) [comm_semiring R]
variables (X : Type*)

namespace free_algebra

/--
This inductive type is used to express representatives of the free algebra.
-/
inductive pre
| of : X → pre
| of_scalar : R → pre
| add : pre → pre → pre
| mul : pre → pre → pre

namespace pre

instance : inhabited (pre R X) := ⟨of_scalar 0⟩

-- Note: These instances are only used to simplify the notation.
/-- Coercion from `X` to `pre R X`. Note: Used for notation only. -/
def has_coe_generator : has_coe X (pre R X) := ⟨of⟩
/-- Coercion from `R` to `pre R X`. Note: Used for notation only. -/
def has_coe_semiring : has_coe R (pre R X) := ⟨of_scalar⟩
/-- Multiplication in `pre R X` defined as `pre.mul`. Note: Used for notation only. -/
def has_mul : has_mul (pre R X) := ⟨mul⟩
/-- Addition in `pre R X` defined as `pre.add`. Note: Used for notation only. -/
def has_add : has_add (pre R X) := ⟨add⟩
/-- Zero in `pre R X` defined as the image of `0` from `R`. Note: Used for notation only. -/
def has_zero : has_zero (pre R X) := ⟨of_scalar 0⟩
/-- One in `pre R X` defined as the image of `1` from `R`. Note: Used for notation only. -/
def has_one : has_one (pre R X) := ⟨of_scalar 1⟩
/--
Scalar multiplication defined as multiplication by the image of elements from `R`.
Note: Used for notation only.
-/
def has_scalar : has_scalar R (pre R X) := ⟨λ r m, mul (of_scalar r) m⟩

end pre

local attribute [instance]
  pre.has_coe_generator pre.has_coe_semiring pre.has_mul pre.has_add pre.has_zero
  pre.has_one pre.has_scalar

/--
Given a function from `X` to an `R`-algebra `A`, `lift_fun` provides a lift of `f` to a function
from `pre R X` to `A`. This is mainly used in the construction of `free_algebra.lift`.
-/
def lift_fun {A : Type*} [semiring A] [algebra R A] (f : X → A) : pre R X → A :=
  λ t, pre.rec_on t f (algebra_map _ _) (λ _ _, (+)) (λ _ _, (*))

/--
An inductively defined relation on `pre R X` used to force the initial algebra structure on
the associated quotient.
-/
inductive rel : (pre R X) → (pre R X) → Prop
-- force `of_scalar` to be a central semiring morphism
| add_scalar {r s : R} : rel ↑(r + s) (↑r + ↑s)
| mul_scalar {r s : R} : rel ↑(r * s) (↑r * ↑s)
| central_scalar {r : R} {a : pre R X} : rel (r * a) (a * r)
-- commutative additive semigroup
| add_assoc {a b c : pre R X} : rel (a + b + c) (a + (b + c))
| add_comm {a b : pre R X} : rel (a + b) (b + a)
| zero_add {a : pre R X} : rel (0 + a) a
-- multiplicative monoid
| mul_assoc {a b c : pre R X} : rel (a * b * c) (a * (b * c))
| one_mul {a : pre R X} : rel (1 * a) a
| mul_one {a : pre R X} : rel (a * 1) a
-- distributivity
| left_distrib {a b c : pre R X} : rel (a * (b + c)) (a * b + a * c)
| right_distrib {a b c : pre R X} : rel ((a + b) * c) (a * c + b * c)
-- other relations needed for semiring
| zero_mul {a : pre R X} : rel (0 * a) 0
| mul_zero {a : pre R X} : rel (a * 0) 0
-- compatibility
| add_compat_left {a b c : pre R X} : rel a b → rel (a + c) (b + c)
| add_compat_right {a b c : pre R X} : rel a b → rel (c + a) (c + b)
| mul_compat_left {a b c : pre R X} : rel a b → rel (a * c) (b * c)
| mul_compat_right {a b c : pre R X} : rel a b → rel (c * a) (c * b)

end free_algebra

/--
The free algebra for the type `X` over the commutative semiring `R`.
-/
def free_algebra := quot (free_algebra.rel R X)

namespace free_algebra

local attribute [instance]
  pre.has_coe_generator pre.has_coe_semiring pre.has_mul pre.has_add pre.has_zero
  pre.has_one pre.has_scalar

instance : semiring (free_algebra R X) :=
{ add := quot.map₂ (+) (λ _ _ _, rel.add_compat_right) (λ _ _ _, rel.add_compat_left),
  add_assoc := by { rintros ⟨⟩ ⟨⟩ ⟨⟩, exact quot.sound rel.add_assoc },
  zero := quot.mk _ 0,
  zero_add := by { rintro ⟨⟩, exact quot.sound rel.zero_add },
  add_zero := begin
    rintros ⟨⟩,
    change quot.mk _ _ = _,
    rw [quot.sound rel.add_comm, quot.sound rel.zero_add],
  end,
  add_comm := by { rintros ⟨⟩ ⟨⟩, exact quot.sound rel.add_comm },
  mul := quot.map₂ (*) (λ _ _ _, rel.mul_compat_right) (λ _ _ _, rel.mul_compat_left),
  mul_assoc := by { rintros ⟨⟩ ⟨⟩ ⟨⟩, exact quot.sound rel.mul_assoc },
  one := quot.mk _ 1,
  one_mul := by { rintros ⟨⟩, exact quot.sound rel.one_mul },
  mul_one := by { rintros ⟨⟩, exact quot.sound rel.mul_one },
  left_distrib := by { rintros ⟨⟩ ⟨⟩ ⟨⟩, exact quot.sound rel.left_distrib },
  right_distrib := by { rintros ⟨⟩ ⟨⟩ ⟨⟩, exact quot.sound rel.right_distrib },
  zero_mul := by { rintros ⟨⟩, exact quot.sound rel.zero_mul },
  mul_zero := by { rintros ⟨⟩, exact quot.sound rel.mul_zero } }

instance : inhabited (free_algebra R X) := ⟨0⟩

instance : has_scalar R (free_algebra R X) :=
{ smul := λ r a, quot.lift_on a (λ x, quot.mk _ $ ↑r * x) $
  λ a b h, quot.sound (rel.mul_compat_right h) }

instance : algebra R (free_algebra R X) :=
{ to_fun := λ r, quot.mk _ r,
  map_one' := rfl,
  map_mul' := λ _ _, quot.sound rel.mul_scalar,
  map_zero' := rfl,
  map_add' := λ _ _, quot.sound rel.add_scalar,
  commutes' := λ _, by { rintros ⟨⟩, exact quot.sound rel.central_scalar },
  smul_def' := λ _ _, rfl }

instance {S : Type*} [comm_ring S] : ring (free_algebra S X) := algebra.semiring_to_ring S

variables {X}

/--
The canonical function `X → free_algebra R X`.
-/
def ι : X → free_algebra R X := λ m, quot.mk _ m

@[simp] lemma quot_mk_eq_ι (m : X) : quot.mk (free_algebra.rel R X) m = ι R m := rfl

variables {A : Type*} [semiring A] [algebra R A]

/-- Internal definition used to define `lift` -/
private def lift_aux (f : X → A) : (free_algebra R X →ₐ[R] A) :=
{ to_fun := λ a, quot.lift_on a (lift_fun _ _ f) $ λ a b h,
  begin
    induction h,
    { exact (algebra_map R A).map_add h_r h_s, },
    { exact (algebra_map R A).map_mul h_r h_s },
    { apply algebra.commutes },
    { change _ + _ + _ = _ + (_ + _),
      rw add_assoc },
    { change _ + _ = _ + _,
      rw add_comm, },
    { change (algebra_map _ _ _) + lift_fun R X f _ = lift_fun R X f _,
      simp, },
    { change _ * _ * _ = _ * (_ * _),
      rw mul_assoc },
    { change (algebra_map _ _ _) * lift_fun R X f _ = lift_fun R X f _,
      simp, },
    { change lift_fun R X f _ * (algebra_map _ _ _) = lift_fun R X f _,
      simp, },
    { change _ * (_ + _) = _ * _ + _ * _,
      rw left_distrib, },
    { change (_ + _) * _ = _ * _ + _ * _,
      rw right_distrib, },
    { change (algebra_map _ _ _) * _ = algebra_map _ _ _,
      simp },
    { change _ * (algebra_map _ _ _) = algebra_map _ _ _,
      simp },
    repeat { change lift_fun R X f _ + lift_fun R X f _ = _,
      rw h_ih,
      refl, },
    repeat { change lift_fun R X f _ * lift_fun R X f _ = _,
      rw h_ih,
      refl, },
  end,
  map_one' := by { change algebra_map _ _ _ = _, simp },
  map_mul' := by { rintros ⟨⟩ ⟨⟩, refl },
  map_zero' := by { change algebra_map _ _ _ = _, simp },
  map_add' := by { rintros ⟨⟩ ⟨⟩, refl },
  commutes' := by tauto }

/--
Given a function `f : X → A` where `A` is an `R`-algebra, `lift R f` is the unique lift
of `f` to a morphism of `R`-algebras `free_algebra R X → A`.
-/
def lift : (X → A) ≃ (free_algebra R X →ₐ[R] A) :=
{ to_fun := lift_aux R,
  inv_fun := λ F, F ∘ (ι R),
  left_inv := λ f, by {ext, refl},
  right_inv := λ F, by {
    ext x,
    rcases x,
    induction x,
    case pre.of : {
      change ((F : free_algebra R X → A) ∘ (ι R)) _ = _,
      refl },
    case pre.of_scalar : {
      change algebra_map _ _ x = F (algebra_map _ _ x),
      rw alg_hom.commutes F x, },
    case pre.add : a b ha hb {
      change lift_aux R (F ∘ ι R) (quot.mk _ _ + quot.mk _ _) = F (quot.mk _ _ + quot.mk _ _),
      rw [alg_hom.map_add, alg_hom.map_add, ha, hb], },
    case pre.mul : a b ha hb {
      change lift_aux R (F ∘ ι R) (quot.mk _ _ * quot.mk _ _) = F (quot.mk _ _ * quot.mk _ _),
      rw [alg_hom.map_mul, alg_hom.map_mul, ha, hb], }, }, }

@[simp] lemma lift_aux_eq (f : X → A) : lift_aux R f = lift R f := rfl

@[simp]
lemma lift_symm_apply (F : free_algebra R X →ₐ[R] A) : (lift R).symm F = F ∘ (ι R) := rfl

variables {R X}

@[simp]
theorem ι_comp_lift (f : X → A) :
  (lift R f : free_algebra R X → A) ∘ (ι R) = f := by {ext, refl}

@[simp]
theorem lift_ι_apply (f : X → A) (x) :
  lift R f (ι R x) = f x := rfl

@[simp]
theorem lift_unique (f : X → A) (g : free_algebra R X →ₐ[R] A) :
  (g : free_algebra R X → A) ∘ (ι R) = f ↔ g = lift R f :=
(lift R).symm_apply_eq

/-!
At this stage we set the basic definitions as `@[irreducible]`, so from this point onwards one
should only use the universal properties of the free algebra, and consider the actual implementation
as a quotient of an inductive type as completely hidden.

Of course, one still has the option to locally make these definitions `semireducible` if so desired,
and Lean is still willing in some circumstances to do unification based on the underlying
definition.
-/
attribute [irreducible] ι lift
-- Marking `free_algebra` irreducible makes `ring` instances inaccessible on quotients.
-- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/algebra.2Esemiring_to_ring.20breaks.20semimodule.20typeclass.20lookup/near/212580241
-- For now, we avoid this by not marking it irreducible.

@[simp]
theorem lift_comp_ι (g : free_algebra R X →ₐ[R] A) :
  lift R ((g : free_algebra R X → A) ∘ (ι R)) = g :=
by { rw ←lift_symm_apply, exact (lift R).apply_symm_apply g }

/-- See note [partially-applied ext lemmas]. -/
@[ext]
theorem hom_ext {f g : free_algebra R X →ₐ[R] A}
  (w : ((f : free_algebra R X → A) ∘ (ι R)) = ((g : free_algebra R X → A) ∘ (ι R))) : f = g :=
begin
  rw [←lift_symm_apply, ←lift_symm_apply] at w,
  exact (lift R).symm.injective w,
end

/--
The free algebra on `X` is "just" the monoid algebra on the free monoid on `X`.

This would be useful when constructing linear maps out of a free algebra,
for example.
-/
noncomputable
def equiv_monoid_algebra_free_monoid : free_algebra R X ≃ₐ[R] monoid_algebra R (free_monoid X) :=
alg_equiv.of_alg_hom
  (lift R (λ x, (monoid_algebra.of R (free_monoid X)) (free_monoid.of x)))
  ((monoid_algebra.lift R (free_monoid X) (free_algebra R X)) (free_monoid.lift (ι R)))
begin
  apply monoid_algebra.alg_hom_ext, intro x,
  apply free_monoid.rec_on x,
  { simp, refl, },
  { intros x y ih, simp at ih, simp [ih], }
end
(by { ext, simp, })

instance [nontrivial R] : nontrivial (free_algebra R X) :=
equiv_monoid_algebra_free_monoid.to_equiv.nontrivial

section
open_locale classical

/-- The left-inverse of `algebra_map`. -/
def algebra_map_inv : free_algebra R X →ₐ[R] R :=
lift R (0 : X → R)

lemma algebra_map_left_inverse :
  function.left_inverse algebra_map_inv (algebra_map R $ free_algebra R X) :=
λ x, by simp [algebra_map_inv]

-- this proof is copied from the approach in `free_abelian_group.of_injective`
lemma ι_injective [nontrivial R] : function.injective (ι R : X → free_algebra R X) :=
λ x y hoxy, classical.by_contradiction $ assume hxy : x ≠ y,
  let f : free_algebra R X →ₐ[R] R := lift R (λ z, if x = z then (1 : R) else 0) in
  have hfx1 : f (ι R x) = 1, from (lift_ι_apply _ _).trans $ if_pos rfl,
  have hfy1 : f (ι R y) = 1, from hoxy ▸ hfx1,
  have hfy0 : f (ι R y) = 0, from (lift_ι_apply _ _).trans $ if_neg hxy,
  one_ne_zero $ hfy1.symm.trans hfy0

end

end free_algebra

/- There is something weird in the above namespace that breaks the typeclass resolution of
`has_coe_to_sort` below. Closing it and reopening it fixes it... -/
namespace free_algebra

/-- An induction principle for the free algebra.

If `C` holds for the `algebra_map` of `r : R` into `free_algebra R X`, the `ι` of `x : X`, and is
preserved under addition and muliplication, then it holds for all of `free_algebra R X`.
-/
@[elab_as_eliminator]
lemma induction {C : free_algebra R X → Prop}
  (h_grade0 : ∀ r, C (algebra_map R (free_algebra R X) r))
  (h_grade1 : ∀ x, C (ι R x))
  (h_mul : ∀ a b, C a → C b → C (a * b))
  (h_add : ∀ a b, C a → C b → C (a + b))
  (a : free_algebra R X) :
  C a :=
begin
  -- the arguments are enough to construct a subalgebra, and a mapping into it from X
  let s : subalgebra R (free_algebra R X) := {
    carrier := C,
    mul_mem' := h_mul,
    add_mem' := h_add,
    algebra_map_mem' := h_grade0, },
  let of : X → s := subtype.coind (ι R) h_grade1,
  -- the mapping through the subalgebra is the identity
  have of_id : alg_hom.id R (free_algebra R X) = s.val.comp (lift R of),
  { ext,
    simp [of, subtype.coind], },
  -- finding a proof is finding an element of the subalgebra
  convert subtype.prop (lift R of a),
  simp [alg_hom.ext_iff] at of_id,
  exact of_id a,
end

/-- The star ring formed by reversing the elements of products -/
instance : star_ring (free_algebra R X) :=
{ star := opposite.unop ∘ lift R (opposite.op ∘ ι R),
  star_involutive := λ x, by {
    unfold has_star.star,
    simp only [function.comp_apply],
    refine free_algebra.induction R X _ _ _ _ x; intros; simp [*] },
  star_mul := λ a b, by simp,
  star_add := λ a b, by simp }

@[simp]
lemma star_ι (x : X) : star (ι R x) = (ι R x) :=
by simp [star, has_star.star]

@[simp]
lemma star_algebra_map (r : R) : star (algebra_map R (free_algebra R X) r) = (algebra_map R _ r) :=
by simp [star, has_star.star]

/-- `star` as an `alg_equiv` -/
def star_hom : free_algebra R X ≃ₐ[R] (free_algebra R X)ᵒᵖ :=
{ commutes' := λ r, by simp [star_algebra_map],
  ..star_ring_equiv }

end free_algebra