Martin Escardo, 20-21 December 2012.

If X and Y come with orders, both denoted by ≤, then the lexicographic
order on X × Y is defined by

  (x , y) ≤ (x' , y') ↔ x ≤ x' ∧ (x = x' → y ≤ y').

More generally, we can consider the lexicographic product of two
binary relations R on X and S on Y, which is a relation on X × Y, or
even on (Σ x ꞉ X , Y x) if Y and S depend on X.

\begin{code}

{-# OPTIONS --safe --without-K #-}

module Ordinals.LexicographicOrder where

open import MLTT.Spartan

lex-order :  {𝓣} {X : 𝓤 ̇ } {Y : X  𝓥 ̇ }
            (X  X  𝓦 ̇ )
           ({x : X}  Y x  Y x  𝓣 ̇ )
           (Σ Y  Σ Y  𝓤  𝓦  𝓣 ̇ )
lex-order _≤_ _≼_ (x , y) (x' , y') = (x  x')
                                    × ((r : x  x')  transport _ r y  y')

\end{code}

Added 14th June 2018, from 2013 in another development.

However, for a strict order, it makes sense to define

  (x , y) < (x' , y') ↔ x < x' ∨ (x = x' ∧ y < y').

\begin{code}

slex-order : {X : 𝓤 ̇ } {Y : X  𝓥 ̇ }
             (X  X  𝓦 ̇ )
            ({x : X}  Y x  Y x  𝓣 ̇ )
            (Σ Y  Σ Y  𝓤  𝓦  𝓣 ̇ )
slex-order _<_ _≺_ (x , y) (x' , y') = (x < x')
                                     + (Σ r  x  x' , transport _ r y  y')

\end{code}

Usually in such a context, a ≤ b is defined to be ¬ (b < a).

The negation of the strict lexicographic product is, then,

 ¬ (x < x') ∧ ¬ (x = x' ∧ y < y') by constructive de Morgan,
↔ x ≤ x' ∧ ¬ (x = x' ∧ y < y')    by definition of ≤,
↔ x' ≤ x ∧ ((x = x' → ¬ (y < y')) by (un)currying,
↔ x' ≤ x ∧ ((x = x' → y' ≤ y)     by definition of ≤.

What this means is that the non-strict lexigraphic product of the
induced non-strict order is induced by the strict lexicographic
product of the strict orders. This works a little more generally as
follows.

\begin{code}

module lexicographic-commutation
         {X : 𝓤 ̇ }
         {Y : X  𝓥 ̇ }
         (_<_ : X  X  𝓦 ̇ )
         (_≺_ : {x : X}  Y x  Y x  𝓣 ̇ )
         (R : 𝓣 ̇ )
 where
  not :  {𝓤}  𝓤 ̇  𝓣  𝓤 ̇
  not A = A  R

  _⊏_ : Σ Y  Σ Y  𝓣  𝓤  𝓦 ̇
  _⊏_ = slex-order _<_ _≺_

  _≤_ : X  X  𝓦  𝓣 ̇
  x  x' = not (x' < x)

  _≼_ : {x : X}  Y x  Y x  𝓣 ̇
  y  y' = not (y'  y)

  _⊑_ : Σ Y  Σ Y  𝓣  𝓤  𝓦 ̇
  _⊑_ = lex-order _≤_ _≼_

  forth : (x x' : X) (y : Y x) (y' : Y x')
         not ((x , y)  (x' , y'))
         (x' , y')  (x , y)
  forth x x' y y' f = g , h
   where
    g : not (x < x')
    g l = f (inl l)

    h : (r : x'  x)  not (y  transport Y r y')
    h refl l = f (inr (refl , l))

  back : (x x' : X) (y : Y x) (y' : Y x')
        (x' , y')  (x , y)
        not ((x , y)  (x' , y'))
  back x x' y y' (g , h) (inl l) = g l
  back x _  y y' (g , h) (inr (refl , l)) = h refl l

\end{code}