1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1999-2011, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(table_util,
   36          [ sort_table/2,               % +Handle, +OutputFile
   37            verify_table_order/1        % +Handle
   38          ]).   39:- use_module(library(table)).   40
   41/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   42Utility library for the table package.  Predicates:
   43
   44        verify_table_order(+Table)
   45                If `table' is a handle to a defined table and the table
   46                contains a key-fields, check that the fields in the table
   47                are really sorted according to the order defined in the
   48                table.  Errors are reported.
   49
   50        sort_table(+Table, +FileName)
   51                Read the records from the given table, sort them according
   52                to the ordering information on the key field and write the
   53                result to the given filename.  Note this may require a lot
   54                of memory.
   55- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
   56
   57
   58%       sort_table(+Table, +File)
   59%
   60%       Read the given table, sort it using the associated ordering and
   61%       write the result back to File.
   62
   63sort_table(Table, File) :-
   64    open(File, write, OutFd),       % fail early :-)
   65    get_table_attribute(Table, key_field, Key),
   66    !,
   67    get_table_attribute(Table, field(Key), Term),
   68    get_table_attribute(Table, file, InFile),
   69    functor(Term, KeyName, _),
   70    arg(2, Term, Attributes),
   71    format('Sorting table "~w" ', [InFile]),
   72    (   memberchk(sorted(Order), Attributes)
   73    ->  true
   74    ;   memberchk(sorted, Attributes),
   75        Order = exact
   76    ),
   77    format('sorted(~w) on field "~w" ... ', [Order, KeyName]),
   78    flush,
   79    read_table(Table, KeyName, Fields),
   80    sort_fields(Order, Fields, SortedFields),
   81    write_table(SortedFields, Table, OutFd),
   82    close(OutFd),
   83    format('done.~n', []).
   84
   85read_table(Table, KeyName, Fields) :-
   86    format('(reading) ... ', []), flush,
   87    read_table(Table, KeyName, 0, Fields).
   88
   89read_table(Table, KeyName, From, [KeyValue-From|T]) :-
   90    read_field(Table, From, To, KeyName, KeyValue),
   91    !,
   92    read_table(Table, KeyName, To, T).
   93read_table(_, _, _, []).
   94
   95sort_fields(Order, Fields, Sorted) :-
   96    length(Fields, N),
   97    format('(sorting ~D records) ... ', [N]), flush,
   98    sort_keyed_strings(Order, Fields, Sorted).
   99
  100write_table(Records, Table, OutFd) :-
  101    format('(writing) ... ', []), flush,
  102    get_table_attribute(Table, record_separator, Sep),
  103    write_records(Records, Table, Sep, OutFd).
  104
  105write_records([], _, _, _).
  106write_records([_-From|T], Table, Sep, OutFd) :-
  107    read_table_record_data(Table, From, _To, RecordData),
  108    format(OutFd, '~s~c', [RecordData, Sep]),
  109    write_records(T, Table, Sep, OutFd).
  110
  111
  112%       sort_keyed_strings(+Table, +List, -Sorted)
  113%
  114%       Sort a list of KeyName-Index pairs on their KeyName using the
  115%       given ordering table.
  116
  117sort_keyed_strings(Table, List, Sorted) :-
  118    length(List, Length),
  119    do_sort(Length, Table, List, _, Result),
  120    Sorted = Result.
  121
  122do_sort(2, Table, [X1, X2|L], L, R) :-
  123    !,
  124    X1 = K1-_,
  125    X2 = K2-_,
  126    compare_strings(Table, K1, K2, Cmp),
  127    merge2(Cmp, X1, X2, R).
  128do_sort(1, _, [X|L], L, [X]) :- !.
  129do_sort(0, _, L, L, []) :- !.
  130do_sort(N, Table, L1, L3, R) :-
  131    N1 is N // 2,
  132    N2 is N - N1,
  133    do_sort(N1, Table, L1, L2, R1),
  134    do_sort(N2, Table, L2, L3, R2),
  135    do_merge(R1, R2, Table, R).
  136
  137do_merge([], R, _, R) :- !.
  138do_merge(R, [], _, R) :- !.
  139do_merge(R1, R2, Table, [X|R]) :-
  140    R1 = [X1|R1a],
  141    R2 = [X2|R2a],
  142    X1 = K1-_,
  143    X2 = K2-_,
  144    (   compare_strings(Table, K1, K2, >)
  145    ->  X = X2, do_merge(R1, R2a, Table, R)
  146    ;   X = X1, do_merge(R1a, R2, Table, R)
  147    ).
  148
  149merge2(>, A, B, [B, A]) :- !.
  150merge2(_, A, B, [A, B]).
  151
  152
  153                 /*******************************
  154                 *             VERIFY           *
  155                 *******************************/
  156
  157%       verify_table_order)(+Table)
  158%
  159%       Verify a sorted table is really sorted according to its documentation.
  160
  161verify_table_order(Table) :-
  162    get_table_attribute(Table, key_field, Key),
  163    !,
  164    get_table_attribute(Table, field(Key), Term),
  165    get_table_attribute(Table, file, File),
  166    functor(Term, KeyName, _),
  167    arg(2, Term, Attributes),
  168    format('Checking "~w" ', [File]),
  169    (   memberchk(sorted(Order), Attributes)
  170    ->  true
  171    ;   memberchk(sorted, Attributes),
  172        Order = exact
  173    ),
  174    (   memberchk(unique, Attributes)
  175    ->  Cmp = >,
  176        format('uniquely ', [])
  177    ;   Cmp = [>, =]
  178    ),
  179    format('sorted(~w) on field "~w" ... ', [Order, KeyName]),
  180    flush,
  181    read_field(Table, 0, To, KeyName, KeyValue),
  182    verify_table(Table, To, KeyName, KeyValue, Order, Cmp),
  183    format('done.~n', []).
  184
  185verify_table(Table, From, KeyName, PrevValue, Order, Cmp) :-
  186    read_field(Table, From, To, KeyName, KeyValue),
  187    !,
  188    (   compare_strings(Order, KeyValue, PrevValue, Rval),
  189        ok_cmp(Rval, Cmp)
  190    ->  verify_table(Table, To, KeyName, KeyValue, Order, Cmp)
  191    ;   format('~N!! Order conflict: ~w < ~w~n', [KeyValue, PrevValue]),
  192        verify_table(Table, To, KeyName, KeyValue, Order, Cmp)
  193    ).
  194verify_table(_, _, _, _, _, _).
  195
  196ok_cmp(Cmp, Cmp) :- !.
  197ok_cmp(Cmp, List) :-
  198    memberchk(Cmp, List).
  199
  200read_field(Table, From, To, Field, Value) :-
  201    functor(Term, Field, 1),
  202    read_table_fields(Table, From, To,  [Term]),
  203    arg(1, Term, Value)