(*---------------------------------------------------------------------------*
 * "minsort" - a naive sort, but a good test for formal development.         *
 * Minsort is not a sorting algorithm, since it eliminates duplicates in     *
 * the input.                                                                *
 *---------------------------------------------------------------------------*)

(*---------------------------------------------------------------------------*
 * Bring in and open up required context.                                    *
 *---------------------------------------------------------------------------*)
app load ["bossLib", "Q", "permTheory", "sortingTheory"];

open bossLib sortingTheory permTheory listTheory 
     relationTheory arithmeticTheory;
infix 8 by;


(*---------------------------------------------------------------------------*
 * Algorithms.                                                               *
 *---------------------------------------------------------------------------*)

val expunge_def = 
 Define
    `(expunge x []     = [])
 /\  (expunge x (h::t) = if x=h then expunge x t else h::expunge x t)`;


val min_def = 
 Define
    `(min [] m = m) 
 /\  (min (h::t) m = if m <= h then min t m else min t h)`;


val minsort_def = 
 Hol_defn "minsort"
    `(minsort [] = []) 
 /\  (minsort (h::t) =
       let m = min t h
       in 
         m::minsort (expunge m (h::t)))`;


(*---------------------------------------------------------------------------*
 * Lemmas about min.                                                         *
 *---------------------------------------------------------------------------*)

val MEM_min = Q.prove(`!h t. MEM (min t h) (h::t)`,
Induct_on `t` 
  THEN RW_TAC list_ss [min_def]
  THEN PROVE_TAC [MEM, DECIDE `~(x<=y) ==> ~(x=y)`]);


val min_leq_start = Q.prove(`!h t. min t h <= h`,
Induct_on `t` 
  THEN RW_TAC list_ss [min_def]
  THEN Q.PAT_ASSUM `$! M` (MP_TAC o SPEC_ALL)
  THEN DECIDE_TAC);


val min_leq_cong = Q.prove(`!x y t. x<=y ==> min t x <= min t y`,
Induct_on `t` 
  THEN RW_TAC list_ss [min_def]);


val min_leq = Q.prove(`!h t x. MEM x (h::t) ==> min t h <= x`,
Induct_on `t` 
 THENL
  [RW_TAC list_ss [min_def,MEM],
   ONCE_REWRITE_TAC [MEM]
     THEN RW_TAC list_ss [min_def] 
      THENL
        [PROVE_TAC[MEM],
         PROVE_TAC [min_leq_cong, LESS_EQ_TRANS],
         PROVE_TAC [min_leq_start,DECIDE `!x y. x<=y /\ ~(z<=y) ==> x<=z`],
         PROVE_TAC[]]]);


(*---------------------------------------------------------------------------*
 * Lemmas about expunge.                                                     *
 *---------------------------------------------------------------------------*)

val not_MEM_expunge = Q.prove(`!x l. ~MEM x (expunge x l)`,
Induct_on `l` 
  THEN RW_TAC list_ss [expunge_def,MEM]);

val MEM_expunge = Q.prove
(`!x y l. ~(y=x) ==> MEM x l ==> MEM x (expunge y l)`,
Induct_on `l` 
 THEN RW_TAC list_ss [expunge_def,MEM]
 THEN PROVE_TAC []);

val MEM_expunge_MEM = Q.prove
(`!x y l. MEM x (expunge y l) ==> MEM x l`,
 Induct_on `l` 
    THEN RW_TAC list_ss [expunge_def]
    THEN PROVE_TAC [MEM]);


(*---------------------------------------------------------------------------*
 * Argument boundedness of expunge.                                          *
 *---------------------------------------------------------------------------*)

val expunge_argb = Q.prove
(`!x l. LENGTH (expunge x l) <= LENGTH l`,
 Induct_on `l` 
   THEN RW_TAC list_ss [expunge_def] 
   THEN PROVE_TAC [DECIDE`x<=y  ==> x <= SUC y`]);


(*---------------------------------------------------------------------------*
 * Strictness of expunge.                                                    *
 *---------------------------------------------------------------------------*)

val expunge_strict = Q.prove
(`!x l. MEM x l ==> LENGTH (expunge x l) < LENGTH l`,
 Induct_on `l` 
    THEN RW_TAC list_ss [MEM,expunge_def]
    THEN PROVE_TAC [expunge_argb, DECIDE`x <= y ==> x < SUC y`]);


(*---------------------------------------------------------------------------*
 * Termination of minsort.                                                   *
 * First, instantiate the definition of `minsort' with the termination       *
 * relation.                                                                 *
 *---------------------------------------------------------------------------*)

val (minsort_eqns, minsort_ind) = 
Defn.tprove
 (minsort_def,
  WF_REL_TAC minsort_def `measure LENGTH`
   THEN PROVE_TAC [expunge_strict,MEM_min]);



(*---------------------------------------------------------------------------*
 * Correctness:                                                              *
 *                                                                           *
 *    o !x l. MEM x l = MEM x (minsort l)                                    *
 *    o !l. sorted $<= (minsort l)                                           *
 *                                                                           *
 *---------------------------------------------------------------------------*)
           
val MEM_minsort = Q.store_thm("MEM_minsort",
 `!l x. MEM x (minsort l) = MEM x l`,
recInduct minsort_ind
 THEN RW_TAC std_ss [minsort_eqns,MEM]
 THEN PROVE_TAC [MEM_expunge, MEM_min, MEM, MEM_expunge_MEM]);


val sorted_minsort = Q.store_thm("sorted_minsort",
`!l. SORTED $<= (minsort l)`,
recInduct minsort_ind
 THEN RW_TAC std_ss [minsort_eqns]
 THENL [RW_TAC std_ss [SORTED_def],
        `transitive $<=` by (ONCE_REWRITE_TAC[transitive_def] THEN DECIDE_TAC)
          THEN PROVE_TAC [SORTED_eq,MEM_minsort, MEM_expunge_MEM, min_leq]]);

