1% to keep together shrinks for the same type
    2:- discontiguous shrink/3.    3
    4% get_length(N,NA): NA is the number of atoms composing N
    5% or the length of a list.
    6% Does not consider the minus sign at the beginning of a number.
    7% Examples:
    8% get_length(1,NA), NA = 1.
    9% get_length(-1,NA), NA = 1.
   10% get_length(33,NA), NA = 2.
   11% get_length([33],NA), NA = 1.
   12% get_length([33,1],NA), NA = 2.
   13% get_length([[33,1]],NA), NA = 2.
   14get_length(N,NA):-
   15    atomic(N), 
   16    N \= [], !, % the empty list is atomic
   17    ( atom_chars(N,[-|A]) -> true ; atom_chars(N,A)), % do not consider the - sign
   18    length(A,NA).
   19get_length(L,S):-
   20    is_list(L),
   21    ( L = [LIn], is_list(LIn) ->  
   22    	get_length(LIn,S) ;
   23    	length(L,S)
   24    ).
   25
   26% my_compare/3: compares the length of two lists.
   27% in the > case there is >= to keep duplicates.
   28% Leaves choice points open, due to the = case.
   29my_compare(<,N0,N1):-
   30	get_length(N0,NA0),
   31    get_length(N1,NA1),
   32    NA0 < NA1.
   33my_compare(>,N0,N1):-
   34	get_length(N0,NA0),
   35    get_length(N1,NA1),
   36    NA0 >= NA1. % to keep duplicates
   37my_compare(=,_N0,_N1).
   38
   39% generate_shrinking_alternatives/3: generates possible shrinks
   40% for the term of type specified in the first argument starting
   41% from the value specified in the second argument (Value) and
   42% returns them in the list ShrankList.
   43generate_shrinking_alternatives(Type,Value,ShrankList):-
   44    findall(S,shrink(Type,Value,S),LS),
   45    predsort(my_compare,LS,ShrankList), !.
   46
   47%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   48% shrink(Type,Value,Shrank): Shrank is an attempt to shrink the value Value of type Type
   49% shrink for numbers (int, float, or numbers)
   50% number: try 0
   51shrink(Type,_,0):-
   52    member(Type,[int,float,number]).
   53% number: try changing sign
   54shrink(Type,Value,ChangedSign):-
   55    member(Type,[int,float,number]),
   56    ChangedSign is -Value.
   57% number: bisect
   58shrink(Type,Value,Shrank):-
   59    member(Type,[int,float,number]),
   60    setting(depth,MaxAttempts),
   61    ( Value > 0 ->
   62        LB is -Value, UB = Value ;
   63        LB is Value, UB is -Value
   64    ),
   65    LStartingPoints = [left,right],
   66    member(StartingPoint,LStartingPoints),
   67    shrink_bisect_number(Type,MaxAttempts,StartingPoint,LB,UB,Shrank).
   68shrink_bisect_number(MaxAttempts,_,LB,UB,Shrank):-
   69    MaxAttempts > 0,
   70    LB < UB,
   71    ( LB < 0 ->
   72        Shrank is UB + LB ;
   73        Shrank is UB - LB
   74    ).
   75shrink_bisect_number(MaxAttempts,left,LB,UB,Shrank):-
   76    member(Type,[int,float,number]),
   77    MaxAttempts > 0,
   78    LB < UB,
   79    ( Type = int -> 
   80        LB1 is floor(LB/2) ;
   81        LB1 is LB/2
   82    ),
   83    LB1 \= LB, % to avoid 1
   84    M1 is MaxAttempts - 1,
   85    shrink_bisect_number(M1,right,LB1,UB,Shrank).
   86shrink_bisect_number(Type,MaxAttempts,right,LB,UB,Shrank):-
   87    MaxAttempts > 0,
   88    LB < UB,
   89    ( Type = int -> 
   90        UB1 is floor(UB/2) ;
   91        UB1 is UB/2
   92    ),
   93    UB1 \= UB, % to avoid 1
   94    M1 is MaxAttempts - 1,
   95    shrink_bisect_number(M1,left,LB,UB1,Shrank).
   96%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   97
   98%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   99sublist(List,Start,End,Sublist) :-
  100    findall(El,(between(Start,End,Idx),nth1(Idx,List,El)),Sublist).
  101% lists: try empty
  102shrink(Type,_,[]):-
  103    ( Type = list ; Type = list(*,_) ).
  104% lists of any length: bisect it
  105shrink(Type,List,Shrank):-
  106    % list of arbitrary length: bisect
  107    ( Type = list ; Type = list(*,_) ),
  108    setting(depth,MaxAttempts),
  109    LStartingPoints = [left,right],
  110    member(StartingPoint,LStartingPoints),
  111    length(List,LenList),
  112    shrink_bisect_list(MaxAttempts,List,StartingPoint,1,LenList,Shrank).
  113shrink_bisect_list(MaxAttempts,List,_,Start,End,Shrank):-
  114    MaxAttempts > 0,
  115    Start < End,
  116    sublist(List,Start,End,Shrank).
  117% increase the position of the first element
  118shrink_bisect_list(MaxAttempts,List,left,Start,End,Shrank):-
  119    MaxAttempts > 0,
  120    Start < End,
  121    S1 is floor((End + Start)/2),
  122    M1 is MaxAttempts - 1,
  123    shrink_bisect_list(M1,List,right,S1,End,Shrank).
  124% increase the position of the last element
  125shrink_bisect_list(MaxAttempts,List,right,Start,End,Shrank):-
  126    MaxAttempts > 0,
  127    Start < End,
  128    E1 is ceil((End + Start)/2),
  129    M1 is MaxAttempts - 1,
  130    shrink_bisect_list(M1,List,left,Start,E1,Shrank).
  131
  132%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  133get_type(A,int):- integer(A).
  134get_type(A,float):- float(A).
  135shrink(list(N,_Types),List,Shrank):-
  136    % list of length N of types only Types
  137    integer(N),
  138    maplist(get_type,List,TypeIndex), % TODO: these must be in types
  139    maplist(shrink,TypeIndex,List,Shrank).
  140shrink(list(Types),List,Shrank):-
  141    % list of length len(Types) where each element is of type Types_i in Types
  142    maplist(shrink,Types,List,Shrank).
  143%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%