1/*  Part of Extended Libraries for SWI-Prolog
    2
    3    Author:        Edison Mera
    4    E-mail:        efmera@gmail.com
    5    WWW:           https://github.com/edisonm/xlibrary
    6    Copyright (C): 2024, Process Design Center, Breda, The Netherlands.
    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(shrink,
   36          [ shrink/2,
   37            expand/2
   38          ]).   39
   40:- use_module(library(apply)).   41:- use_module(library(lists)).   42:- use_module(library(neck)).   43:- init_expansors.   44
   45:- meta_predicate
   46        shrink(1, -),
   47        expand(1, -).   48
   49esc_max_size(16).
   50
   51% escaped_atom/1 will be inlined to improve performance
   52
   53escaped_atom(B) :-
   54    esc_max_size(N),
   55    between(1, N, X),
   56    length(L, X),
   57    maplist(=(&), L),
   58    atomic_list_concat(L, B).
   59
   60shrink(GenTerm, Shrink) :- shrink_expand(shrink, GenTerm, Shrink).
   61
   62expand(GenTerm, Expand) :- shrink_expand(expand, GenTerm, Expand).
   63
   64shrink_expand_args(shrink, S2, S, S2, S).
   65shrink_expand_args(shrnkt, S2, S, S2, S).
   66shrink_expand_args(expand, S2, S, S, S2).
   67shrink_expand_args(expndt, S2, S, S, S2).
   68
   69shrink_expand(Cmd, GenTerm, S) :-
   70    SL = s(''),
   71    call(GenTerm, S2),
   72    SL = s(S1),
   73    shrink_expand_args(Cmd, S2, S, S3, S4),
   74    once(diff_term(Cmd, S1, S3, S4)),
   75    nb_setarg(1, SL, S3).

 skip_comp(Term)

Skip compression in some values, that could actually result in a bigger result

   82skip_comp(T) :- var(T).
   83skip_comp(B) :-
   84    escaped_atom(B),
   85    necki,
   86    !,
   87    fail.
   88skip_comp([]).
   89skip_comp('[|]').
   90skip_comp(Atom) :-
   91    atom(Atom),
   92    current_op(_, _, Atom),
   93    atom_length(Atom, L),
   94    L =< 3.
   95skip_comp(Atom) :-
   96    atomic(Atom),
   97    write_length(Atom, L,
   98                 [ quoted(true),
   99                   backquoted_string(true)
  100                 ]),
  101    L =< 2.
  102
  103:- meta_predicate
  104    diff_term(+, ?, ?, ?).  105
  106diff_term(Cmd, A, B, D) :-
  107    diff_term(Cmd, =@=, A, B, D).
  108
  109cmd_into(shrink, shrnkt).
  110cmd_into(shrnkt, shrnkt).
  111cmd_into(expand, expndt).
  112cmd_into(expndt, expndt).
  113
  114diff_term(_,      _, _, T, T) :- skip_comp(T), !.
  115diff_term(shrink, O, A, B, C) :- diff_term_into(shrink, O, A, B, C), !.
  116diff_term(expand, O, A, B, C) :- diff_term_into(expand, O, A, B, C), !.
  117diff_term(shrnkt, O, A, B, C) :- diff_term_shrnkt(O, A, B, [], C), !.
  118diff_term(expndt, _, A, B, C) :- diff_term_expndt(   A, B,     C), !.
  119diff_term(Cmd,    O, A, B, D) :- diff_term_args(Cmd, O, A, B, D), !.
  120diff_term(_, _, _, T, T).
  121
  122diff_term_args(Cmd, _, A, X, Y) :-
  123    compound(A),
  124    A =.. L1,
  125    length(L1, N1),
  126    cmd_into(Cmd, Into),
  127    shrink_expand_args(Into, X, Y, B, D),
  128    compound(B),
  129    B =.. L2,
  130    length(L2, N2),
  131    N is min(N1, N2),
  132    length(C1, N),
  133    length(C2, N),
  134    append(C1, _,  L1),
  135    append(C2, R2, L2),
  136    shrink_expand_args(Into, C2, C3, D2, D3),
  137    % don't try to find a way to use =@= in inner terms, it will make this
  138    % module difficult to extend/maintain due to recursivity and free variables
  139    maplist(diff_term(Into, ==), C1, D2, D3),
  140    append(C3, R2, L3),
  141    D =.. L3,
  142    !.
  143
  144escape_atom(B, C) :-
  145    escaped_atom(B),
  146    atom_concat(&, B, C),
  147    neck.
  148
  149diff_term_shrnkt(_,   _, B, _, C) :- escape_atom(B, C), !.
  150diff_term_shrnkt(=@=, A, B, L, &) :- A-L =@= B-L.
  151diff_term_shrnkt(==,  A, B, L, &) :- A-L ==  B-L.
  152
  153simplify_term(M:A, M:B, A, B).
  154simplify_term(  A,   B, A, B).
  155
  156diff_term_expndt(A, A, B) :-
  157    B == (&).
  158diff_term_expndt(_, C, B) :-
  159    escape_atom(C, B).
  160
  161diff_term_into(Cmd, O, P, Q, R) :-
  162    once(( var(R)
  163         ; R \= (_:_)
  164         )),
  165    once(simplify_term(P, Q, A, B)),
  166    cmd_into(Cmd, Into),
  167    diff_term(Into, O, A, B, R)