PreviousUpNext

15.4.951  src/lib/src/list-mergesort.pkg

## list-mergesort.pkg
#
# List sorting routines using a smooth applicative merge sort
# Taken from, ML for the Working Programmer, LCPaulson. pg 99-100

# Compiled by:
#     src/lib/std/src/standard-core.sublib

###            "The middle way cannot be achieved
###             by dividing two extremes in half."
###
###                         -- Eric Maisel



package   list_mergesort
: (weak)  List_Sort                                             # List_Sort     is from   src/lib/src/list-sort.api
{

    fun sort_list ((>) : (X, X) -> Bool) ls
        =
        case ls
            [] => [];
            _  => samsorting (ls, [], 0);
        esac
        where
            fun merge ([], ys) => ys;
                merge (xs, []) => xs;

                merge (x ! xs, y ! ys)
                    =>
                    if  (x > y)   y ! merge (x ! xs, ys);
                    else          x ! merge (xs, y ! ys);
                    fi;
            end;

            fun merge_pairs (ls as [l], k)
                    =>
                    ls;

                merge_pairs (l1 ! l2 ! ls, k)
                    =>
                    if (k % 2 == 1)   l1 ! l2 ! ls;
                    else              merge_pairs (merge (l1, l2) ! ls, k / 2);
                    fi;

                merge_pairs _
                    =>
                    raise exception DIE "ListSort::sort";
            end;

            fun next_run (run,[])      =>  (reverse run,[]);
                next_run (run, x ! xs) =>  if (x > head run)  next_run (x ! run, xs);
                                           else               (reverse run, x ! xs);
                                           fi;
            end;

            fun samsorting ([], ls, k)
                    =>
                    head (merge_pairs (ls, 0));

                samsorting (x ! xs, ls, k)
                    =>
                    {   (next_run([x], xs))
                            ->
                            (run, tail);

                        samsorting (tail, merge_pairs (run ! ls, k+1), k+1);
                    };
            end;
        end;


    fun sort_list_and_drop_duplicates  cmpfn  ls
        =
        case ls 
            [] => [];
            _  => samsorting (ls, [], 0);
        esac
        where

            fun merge ([], ys) => ys;
                merge (xs,[]) => xs;

                merge (x ! xs, y ! ys)
                    =>
                    case (cmpfn (x, y))
                        #
                        GREATER =>  y ! merge (x ! xs, ys);
                        EQUAL   =>      merge (x ! xs, ys);
                        _       =>  x ! merge (xs, y ! ys);
                    esac;
            end;

            fun merge_pairs (ls as [l], k)
                    =>
                    ls;

                merge_pairs (l1 ! l2 ! ls, k)
                    =>
                    if (k % 2 == 1)  l1 ! l2 ! ls;
                    else             merge_pairs (merge (l1, l2) ! ls, k / 2);
                    fi;

                merge_pairs _
                    =>
                    raise exception DIE "ListSort::uniqueSort";
            end;

            fun next_run (run, [])
                    =>
                    (reverse run,[]);

                next_run (run, x ! xs)
                    => 
                    case (cmpfn (x, head run))
                        #
                        GREATER =>  next_run (x ! run, xs);
                        EQUAL   =>  next_run (run, xs);
                        _       =>  (reverse run, x ! xs);
                    esac;
            end;

            fun samsorting ([], ls, k)
                    =>
                    head (merge_pairs (ls, 0));

                samsorting (x ! xs, ls, k)
                    =>
                    {   (next_run([x], xs))
                            ->
                            (run, tail);

                        samsorting (tail, merge_pairs (run ! ls, k+1), k+1);
                    };
            end;
        end;


    fun sort_list_and_find_duplicates  compare  list
        =
        {   sorted =  sort_list  (\\ (a,b) = (compare(a,b)==LESS))  list;
            #
            find_dups (sorted, [])
            where
                fun eat_dups (a, b ! rest)                                      # Drop all leading 'a's from second arg.
                        =>
                        if (compare (a, b) == EQUAL)   eat_dups (a, rest);      # Found an 'a' -- drop it and continue.
                        else                           rest;
                        fi;

                    eat_dups (a, rest)
                        =>
                        rest;
                end; 

                fun find_dups (a ! (rest as (b ! _)), dups_found)
                        =>
                        if (compare (a,b) == EQUAL)  find_dups (eat_dups (a, rest), a ! dups_found);
                        else                         find_dups (             rest,      dups_found);
                        fi;

                    find_dups (_, results)
                        =>
                        results;        # 'results' will be in ascending order.
                end;
            end;
        };

    fun list_is_sorted (>)
        =
        s
        where
            fun s (x ! (rest as (y ! _)))
                    =>
                    not (x>y) and s rest;

                s l =>  TRUE;
            end;
        end;

};                      # list_mergesort 


## COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext