1/*  Constraint logic programming over continuous domains
    2
    3    Author:        Edison Mera
    4    E-mail:        efmera@gmail.com
    5    WWW:           https://github.com/edisonm/assertions
    6    Copyright (C): 2020, 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:- export(eepsilon/2).   36:- export(eepsilon/3).   37:- export(eval/3).   38:- export(cast/3).   39:- export(castable/2).   40:- export(compare/4).   41:- export(near_compare/4).   42
   43:- use_module(library(solution_sequences)).   44
   45:- public eval_1/4.   46
   47:- multifile check_dupcode:ignore_dupcode/3.   48
   49% TBD: Move the predicates refered in this clause to a module, instead of an included file
   50check_dupcode:ignore_dupcode(Head, Source, _) :-
   51    '$current_source_module'(Source),
   52    member(F/A, [eepsilon/2, eepsilon/3, eval/3, cast/3, castable/2, compare/4, near_compare/4,
   53                 compare/5, do_eval_cputime/2, do_eval_z/2, reserve_eps/1, near_compare_b/4]),
   54    functor(Head, F, A),
   55    neck.
   56
   57eval_1(Type, Arg, eval(Type, Arg, EA), EA).
   58
   59eval(_, Expr, _) :-
   60    var(Expr),
   61    !,
   62    fail.
   63eval(Type, Expr, C) :-
   64    do_eval(Expr, Type, C),
   65    !.
   66eval(Type, Value, C) :-
   67    cast(Type, Value, C),
   68    !.
   69eval(Type, Value, _) :-
   70    throw(error(type_error(evaluable, Type:Value), _)).
   71
   72cast(Type, Value, C) :-
   73    ( inner_cast(Type, Value, C)
   74    ->true
   75    ; integer(Value)
   76    ->term_string(Value, String),
   77      cast(Type, String, C)
   78    ; rational(Value)
   79    ->X is numerator(Value),
   80      Y is denominator(Value),
   81      do_eval(X/Y, Type, C)
   82    ; ground(Value)
   83    ->do_eval(Value, Type, C)
   84    ).
   85
   86castable(Type, Value) :-
   87    cd_prefix(Type, Pref, _),
   88    atom_concat(is_, Pref, Func),
   89    Body =.. [Func, Value],
   90    necki,
   91    Body.
   92
   93inner_cast(Type, Value, C) :-
   94    cd_prefix(Type, Pref, EAL),
   95    append([Value|EAL], [C], AL),
   96    Body =.. [Pref|AL],
   97    necki,
   98    Body.
   99
  100do_eval_cputime(T, V) :-
  101    X is cputime,
  102    inner_cast(T, X, V).
  103
  104:- table
  105    do_eval_z/2,
  106    eepsilon/2.  107
  108do_eval_z(Type, C) :- cast(Type, 0, C).
  109
  110eepsilon(T, E) :-
  111    reserve_eps(N),
  112    eval(T, N*epsilon, E).
  113
  114eepsilon(T, N, E) :-
  115    eepsilon(T, R),
  116    eval(T, R*N, E).
  117
  118compare(Type, Op, A, B) :-
  119    eval(Type, A, X),
  120    eval(Type, B, Y),
  121    compare_b(Op, Type, X, Y).
  122
  123near_compare(Type, Op, A, B) :-
  124    eval(Type, A, X),
  125    eval(Type, B, Y),
  126    near_compare_b(Type, Op, X, Y).
  127
  128near_compare_b(Type, Op, X, Y) :-
  129    ( compare_b(=, Type, X, Y)
  130    ->compare_eq(Op)
  131    ; eepsilon(Type, max(abs(X), abs(Y)), E),
  132      compare(Op, Type, X, Y, E)
  133    ).
  134
  135compare(=,  T, A, B, E) :- compare(T, =<, abs(A - B), E).
  136compare(=<, T, A, B, E) :- compare(T, =<, A - B, E).
  137compare(>=, T, A, B, E) :- compare(T, =<, B - A, E).
  138compare(<,  T, A, B, E) :- compare(T, >, B - A, E).
  139compare(>,  T, A, B, E) :- compare(T, >, A - B, E).
  140compare(\=, T, A, B, E) :- compare(T, >, abs(A - B), E).
  141
  142compare_b(Op, Type, X, Y) :-
  143    op_pred(Op, Pred),
  144    Body =.. [Pred, Type, X, Y],
  145    necki,
  146    Body.
  147
  148Head :-
  149    op_pred(_, Pred),
  150    Head =.. [Pred, Type, X, Y],
  151    cd_prefix(Type, Pref, _),
  152    atomic_list_concat([Pref, '_', Pred], F),
  153    Body =.. [F, X, Y],
  154    necki,
  155    Body.
  156
  157Head :-
  158    distinct(Pred, expr_pred(_, Pred)),
  159    Pred =.. [Name|AL],
  160    Head =.. [Name, Type, C|AL],
  161    cd_prefix(Type, Pref, EAL),
  162    atomic_list_concat([Pref, '_', Name], BN),
  163    append(EAL, [C|AL], BL),
  164    Body =.. [BN|BL],
  165    necki,
  166    Body