-- FILE: /home/diacon/LANG/Cafe/prog/sorting.mod
-- CONTENTS: generic sorting algorithm for strings featuring
--             algorithm execution modulo axioms
--             reasoning about the algorithm 
--             module parameterization mechanism
-- AUTHOR: Razvan Diaconescu
-- DIFFICULTY: ****

-- ---------------------------- --
-- SPECIFICATION PART --
-- ---------------------------- --

-- the natural numbers with the usual zero and succesor
-- operations constitute the initial algebra of PNAT=
-- moreover we have a specification of the equality of numbers

mod! PNAT= {
  [ PNat ]
  op 0 :  -> PNat 
  op s_ : PNat -> PNat
  op _=_ : PNat PNat -> Bool {comm}
  vars M N : PNat 
  eq ((s M) = 0) = false .
  eq (0 = 0) = true .
  eq [succ=] : (s M = s N) = (M = N) .  
}

-- This adds a specification of the `strictly less than' relation
-- on the naturals numbers

mod! PNAT< {
  protecting(PNAT=)
  op _<_ : PNat PNat -> Bool 
  vars M N : PNat 
  eq [succ<] : (s M) < (s N) = M < N .
  eq 0 < (s M) = true .
  eq M < 0 = false .
}

-- The strings of natural numbers with concatenation and
-- empty string constitute the initial algebra of STRG-PNAT

mod! STRG-PNAT {
  protecting(PNAT=)
  [ PNat < Strg ]
  op nil :  -> Strg 
  op _;_ : Strg Strg -> Strg {assoc id: nil} 
}

-- Specification of bubble sorting algorithm for strings of naturals.
-- Bubble sorting algorithm appears as an instance of rewriting modulo
-- associativity (of concatenation).
-- The initial model is the *preordered algebra* that has strings
-- of naturals as elements and the transitions given by the sorting
-- algorithm as the preorder relation.

mod! SORTING-STRG-PNAT {
  protecting(STRG-PNAT + PNAT<)
  ctrans E:PNat ; E':PNat => E' ; E  if (E' < E) .
}

-- We may use this specification as an actual sorting
-- (very high level) program by executing it by rewriting
-- modulo associativity

exec s s s 0 ; s 0 ; 0 ; s s 0 .

-- However, if we look more carefully into the specification
-- of bubble sorting, we note that it essentially requires only
-- a binary relation <, no commitement to any property of the
-- naturals, not even to the naturals as elements of the strings.
-- This means bubble sorting is very general, has a *generic* nature.
-- Such kind of sorting over binary relations is sometimes known as
-- *topological* sorting.

-- The following parameterized module specifies strings over
-- *any* set (Elt) of elements.

-- generic strings
mod! STRG (X :: TRIV) {
  [ Elt < Strg ]
  op nil :  -> Strg 
  op _;_ : Strg Strg -> Strg {assoc id: nil} 
}

-- The following specifies a generic binary relation < on
-- the elements, to be used for the sorting.
-- We also loose negation of <, namely not<, mainly for
-- operational reasons.
-- Note that the sentence specifying not< is *not* a conditional
-- equation (although CafeOBJ notation refers to it as
-- conditional equation); however this is OK since this is
-- loose semantics specification, which does not require existence
-- of initial algebras.

mod* PSEUDO-ORDER {
  [ Elt ]
  op _<_ : Elt Elt -> Bool
  op _not<_ : Elt Elt -> Bool 
  vars E1 E2 E3 : Elt
  cq (E1 not< E2) = true if E2 < E1 or not(E1 < E2) .
}

-- The following instantiate the above specified pseudo-orders
-- to the standard ordering of the natural numbers.
-- It uses default mapping mechanism, hence only the mapping
-- of not< needs to be specified explicitly.
-- The view specification requires a proof that the initial
-- algebra of PNAT< satisfies the axiom of PSEUDO-ORDER
-- through the translation given by the view.
-- This means an inductive proof, that can be done by
-- proof score programming based upon the structural induction method;
-- we skip this here.
-- Note that in this case we have that proof score programming is
-- involved at the stage of specification writing. 

view PNAT<asPO from PSEUDO-ORDER to PNAT<
     {op (E:Elt not< E':Elt) -> ((E:PNat = E':PNat) or (E' < E))} .
     
-- generic sorting algorithm
     
mod! SORTING-STRG(Y :: PSEUDO-ORDER) {
  protecting(STRG(Y))
  ctrans E:Elt ; E':Elt => E' ; E  if (E' < E) .
}

-- SORTING-STRG-PNAT can be obtained as an instance of
-- SORTING-STRG by the above defined view PNAT<asPO

select SORTING-STRG(PNAT<asPO) .
exec (s s s s 0 ; s s s 0 ; s s s s s 0 ; s s s 0 ; s 0) .

-- ------------------------------------------------------------------------------- --
-- PROOF of termination of topological (generic) bubble sorting --
-- ------------------------------------------------------------------------------- --
-- For this we go back to the specification level and define a function
-- disorder : Strg -> PNat such that 
-- (forall S,S')  S => S' implies disorder(S') < disorder(S)
-- (note this is a Horn clause in the POA, the logical system of
-- preordered algebra)
-- Then the mathematical argument of well-foundness of the natural numbers
-- leads to the informal mathematical proof of termination.

-- --------------------------------------------- --
-- Specification of auxiliary functions --
-- --------------------------------------------- --
-- The definition of function `disorder' requires specification of several other
-- auxiliary functions.

-- Addition of naturals.

mod! PNAT+ {
  protecting(PNAT=)
  op _+_ : PNat PNat -> PNat 
  vars M N : PNat 
  eq [succ+] : M + (s N) = s(M + N) .
  eq M + 0 = M .
}

-- E >> S computes how many elements of S are less than E
-- disorder(S) computes how many steps of the sorting algorithm 
-- are needed for the sorting of S.

mod! SORTING-DISORDER (Y :: PSEUDO-ORDER) {
  protecting(SORTING-STRG(Y) + PNAT+)
  op _>>_ : Elt Strg -> PNat
  op disorder : Strg -> PNat
  vars E E' : Elt 
  vars S S' : Strg
  eq E >> nil = 0 .
  cq E >> E' =  s 0 if (E' < E) .
  cq E >> E' =  0   if (E' not< E) .
  eq E >> (S ; S') = (E >> S) + (E >> S') .
  eq disorder(E) = 0 .
  eq disorder(E ; S) = disorder(S) + (E >> S) .
}

select SORTING-DISORDER(PNAT<asPO) .
red disorder(s s s 0 ; s 0 ; s s 0) . 

-- The following specifies an equivalence relation on strings defined by 
-- ----------------------------------------------------------------
-- S <> S' if and only if (forall E) E >> S = E >> S' .
-- ----------------------------------------------------------------
-- Although this is not required by the specification of `disorder', 
-- it is used in the formal proofs below.
-- As this is beyond CafeOBJ logic, at this level we under-specify it,
-- however we will use its complete definition in the proof scores.
 
mod* SORTING<> (Y :: PSEUDO-ORDER) {
  protecting(SORTING-DISORDER(Y))
  op _<>_ : Strg Strg -> Bool
}

-- The PROOF MANAGEMENT of this problem means the following:
-- 1. By an mathematical argument we have reduced the task of 
--     proving termination to proving a Horn clause sentence as inductive
--     property in POA.
-- 2. Extension of the original specification with new functions.
-- 3. Mathematical proof of the fact that 
--    (forall S,S',E1,E2) disorder(S ; E1 ; E2 ; S') < disorder(S ; E2 ; E1 ; S') if E1 < E2
--    implies
--    (forall S,S')  S => S' implies disorder(S') < disorder(S).
--    (This mathematical argument is related to the theory of rewriting 
--    modulo axioms.)
-- 4. Formal proof (by proof score programming and running) of
--     (forall S,S',E1,E2) disorder(S ; E1 ; E2 ; S') < disorder(S ; E2 ; E1 ; S') if E1 < E2
--     This requires several lemmas and tranformation of the proof tasks by 
--     meta-rules such as Universal Quantification or Modus-Ponens.
-- 5. Mathematical proofs for sub-signatures of constructors. 

-- -----------------------------------------------------
-- FORMAL PROOF of 
-- (forall S,S':Strg, E1,E2:Elt) disorder(S ; E1 ; E2 ; S') <
--                               disorder(S ; E2 ; E1 ; S') if E1 < E2
-- --------------------------------------------------------------------------------------------------------------------

open SORTING<> + PNAT< .
  vars E E' : Elt 
  vars S S1 S2 : Strg
  vars M N P : PNat
-- we use a couple of lemmas:
  cq [Lemma-1] : disorder(S ; S1) < disorder(S ; S2) = true   
     if S1 <> S2 and disorder(S1) < disorder(S2) .
  eq [Lemma-2] : (E ; E' ; S) <> (E' ; E ; S) = true .
-- by Universal Quantification we transform the theorem into a
-- quantifier-free sentence
  ops e1 e2 :  -> Elt .
  ops s s' :  -> Strg .
-- by virtue of Modus Ponens we introduce the condition of the theorem
  eq e1 < e2 = true .
-- we use another couple of lemmas for naturals
-- [Lemma-3] :
  op _+_ : PNat PNat -> PNat {assoc comm}
  eq [Lemma-4] : M < s M = true .
-- the theorem is now proved by equational deduction (rewriting)
red disorder(s ; e1 ; e2 ; s') < disorder(s ; e2 ; e1 ; s') .
close

-- -----------------------------------------------------------------------
-- FORMAL PROOF of Lemma-1 :                                          
-- (forall S,S1,S2) disorder(S ; S1) < disorder(S ; S2) = true    
--     if S1 <> S2 and disorder(S1) < disorder(S2) .                
-- -----------------------------------------------------------------------
-- By direct application of the Structural Induction Theorem where
--     X = \{ S \}
--     \rho is (forall S1,S2) disorder(S ; S1) < disorder(S ; S2) = true    
--                            if  S1 <> S2 and disorder(S1) < disorder(S2) .
-- -----------------------------------------------------------------------
-- The sub-signature of constructors consists of nil, all e:Elt, and _;_, 
-- this being established by mathematical proof 

-- The case Q_S = nil :
open SORTING<> + PNAT< .
-- by Universal Quantification we transform the theorem into a
-- quantifier-free sentence
   ops s1 s2 :  -> Strg .
-- by virtue of Modus Ponens we introduce the condition of the theorem
  eq disorder(s1) < disorder(s2) = true .
  eq E:Elt >> s1 = E:Elt >> s2 .
-- the proof of the conclusion
red disorder(nil ; s1) < disorder(nil ; s2) .
close

-- The case Q_S = e:Elt :
open SORTING<> + PNAT< .
-- by Universal Quantification we transform the theorem into a
-- quantifier-free sentence
  ops s1 s2 :  -> Strg .
  op e :  -> Elt .
  var E : Elt 
  vars M N P : PNat
-- by virtue of Modus Ponens we introduce the condition of the theorem
  eq disorder(s1) < disorder(s2) = true .
  eq E >> s1 = E >> s2 .
-- and use another lemma for the naturals:
  cq [Lemma-5] : M + N < P + N = true if M < P .
-- the proof of the conclusion
red disorder(e ; s1) < disorder(e ; s2) .
close

-- The case Q_S = _;_ :
-- We have that Z = \{ x,y \}
open SORTING<> + PNAT< .
  ops x y :  -> Strg .
  vars S S1 S2 : Strg 
-- we introduce the hypotheses for the condition of the
-- Structural Induction Theorem :
  cq disorder(x ; S1) < disorder(x ; S2) = true
        if disorder(S1) < disorder(S2) and S1 <> S2 .
  cq disorder(y ; S1) < disorder(y ; S2) = true
        if disorder(S1) < disorder(S2) and S1 <> S2 .
-- by Universal Quantification we transform the theorem into a
-- quantifier-free sentence
  ops s1 s2 : -> Strg .
-- by virtue of Modus Ponens we introduce the condition of the theorem
  eq s1 <> s2 = true .
  eq disorder(s1) < disorder(s2) = true .
-- we use a new lemma
  cq [Lemma-6] : S ; S1 <> S ; S2 = true if S1 <> S2 .
-- the proof of the conclusion
red disorder(x ; y ; s1) < disorder(x ; y ; s2) .
close

-- ------------------------------------------------------------------- --
-- FORMAL PROOF of Lemma-2 :
-- (forall E,E',S) (E ; E' ; S) <> (E' ; E ; S) = true .
-- which means 
-- (forall E1,E,E',S) E1 >> E ; E' ; S = E1 >> E' ; E ; S
-- -------------------------------------------------------------------- --
open SORTING<> + PNAT< .
-- by Universal Quantification we transform the theorem into a quantifier-free sentence
  ops e1 e e' :  -> Elt .
  op s :  -> Strg .
-- we use again [Lemma-3] :
  op _+_ : PNat PNat -> PNat {assoc comm}
-- and use a new lemma on naturals
  eq [Lemma-7] : (M:PNat = M) = true .
-- the proof of the conclusion
red e1 >> e ; e' ; s = e1 >> e' ; e ; s .
close

-- ---------------------------------------------------------------------- --
-- FORMAL PROOF of Lemma-6 :
-- (forall S,S1,S2)  S ; S1 <> S ; S2 = true if S1 <> S2 .
-- ----------------------------------------------------------------------- --
open SORTING<> + PNAT< .
-- by Universal Quantification we transform the theorem into a
-- quantifier-free sentence
  ops s s1 s2 :  -> Strg .
  op e :  -> Elt .
-- we introduce the condition of the theorem
  var E : Elt 
  eq E >> s1 = E >> s2 .
-- we use a new lemma on naturals 
  eq [Lemma-7] : (M:PNat = M) = true .
-- the proof of the conclusion
red e >> s ; s1 = e >> s ; s2 .
close

-- ------------------------- --
-- MIND SEMANTICS! --
-- ------------------------- --
-- The relation a < b and b < a on \{ a,b \} determines a model
-- of PSEUDO-ORDER, however the bubble sorting algorithm for
-- this instance is not terminating a ; b => b ; a => a ; b => ...
-- In spite of the fact that the proof is correctly built.
-- Is there a gap somewhere?
-- --------------------------------------------
-- We have both that a < b and a not< b, which implies
-- 0 = s 0, hence the naturals are collapsed, and (by PNAT=) 
-- the Booleans also, which means the specification is inconsistent
-- (it lacks models). 
-- ---------------------------------------------
-- This situation is repaired by adding one more equation 
-- with only semantic role, not used in the proofs. 
-- ---------------------------------------------

mod* PSEUDO-ORDER {
  [ Elt ]
  op _<_ : Elt Elt -> Bool
  op _not<_ : Elt Elt -> Bool 
  vars E1 E2 E3 : Elt
  cq (E1 not< E2) = true if E2 < E1 or not(E1 < E2) .
  eq (E1 < E2) and (E1 not< E2) = false .
}

-- CONCLUSION: semantics of specifications comes first,
-- correctness of proof scores depends on the semantic correctness of
-- the specifications .
-- For this it may be necessary to write axioms with absolutely no
-- operational meaning, with only semantic meaning.  
-- --------------------------------- --
-- END of termination proof --
-- --------------------------------- --