1:- module(search, [common_expr/6, iterative_deepening/2]).    2
    3:- use_module(utils).    4:- use_module(quantity, [quantity_dimensions/2]).    5:- use_module(unit_defs, [all_unit_kind/2]).    6:- use_module('../units.pl').    7
    8:- meta_predicate common_expr(2, +, -, +, -, -).
 common_expr(:ChildParentGoal, +Expr1, -Factor1, +Expr2, -Factor2, -CommonExpr) is nondet
Finds a common base expression CommonExpr for two input expressions Expr1 and Expr2 (typically units or quantities), along with their respective scaling factors Factor1 and Factor2.

The relationship established is that `Expr1*Factor1 = Expr2*Factor2 = CommonExpr`.

This predicate is tabled to memoize its results. It employs an iterative deepening approach to search for the closest common ancestor of Expr1 and Expr2. The search expands definitions (guided by the ChildParentGoal predicate, e.g., for unit parents or quantity parents) to establish this commonality.

Arguments:
ChildParentGoal- A meta-argument (predicate name) that defines how to expand or find parents of elements within the expressions (e.g., unit_parent for units, alias_or_child_quantity_parent for quantities).
Expr1- The first input expression (e.g., si:metre, isq:speed).
Factor1- The numerical scaling factor associated with Expr1 in the context of the common relationship.
Expr2- The second input expression.
Factor2- The numerical scaling factor associated with Expr2 in the context of the common relationship.
CommonExpr- The common base expression derived from Expr1 and Expr2.
   33common_expr(ChildParentGoal, Unit1, NewFactor1, Unit2, NewFactor2, NewUnit) :-
   34   common_expr_(ChildParentGoal, Unit1, NewFactor1, Unit2, NewFactor2, NewUnit).
   35
   36:- table common_expr_/6.   37
   38common_expr_(ChildParentGoal, Unit1, NewFactor1, Unit2, NewFactor2, NewUnit) :-
   39   parse_normalize_factors(Unit1, F1),
   40   parse_normalize_factors(Unit2, F2),
   41   once(iterative_deepening(1,
   42      {F1, NewF1, ChildParentGoal, NewUnits, F2, NewF2}/[N]>>partition_factors(
   43         F1, NewF1, ChildParentGoal, NewUnits, N, F2, NewF2))),
   44   normalize_factors(NewUnits, SortedNewUnits),
   45   maplist(generate_expression, [NewF1, NewF2, SortedNewUnits],
   46           [NewFactor1, NewFactor2, NewUnit]).
   47
   48:- meta_predicate iterative_deepening(+, 1).
 iterative_deepening(+InitialLimit, :Goal) is nondet
Executes Goal using an iterative deepening search strategy.

Goal is expected to take an additional argument, DepthLimit-Flag where DepthLimit is the maximum search depth and Flag is a term n(Status). Goal should set (with nb_set/2) Status to depth_limit_exceeded if it fails due to reaching DepthLimit. In this case, Goal is called again with DepthLimit + 1. If Goal, this predicate fails.

Note: We don't use call_with_depth_limit/2 because the use of exception to signal that the depth limit is reached will cut existing choice points which should be explored. Moreover, Goal is free to count depth level freely.

Arguments:
InitialLimit- The starting depth limit for the search.
Goal- The goal to execute. It must be a predicate accepting a Limit-Flag pair as an argument. Flag is n(Status) used to signal if the depth limit was hit.
   70iterative_deepening(Limit, Goal) :-
   71   N = n(no),
   72   (  call(Goal, Limit-N)
   73   -> true
   74   ;  (  N = n(depth_limit_exceeded)
   75      -> Limit1 is Limit + 1,
   76         iterative_deepening(Limit1, Goal)
   77      ;  fail
   78      )
   79   ).
   80
   81not_factor(X-_) :-
   82   \+ number(X),
   83   \+ X == pi.
   84
   85select_(E, L, R) :-
   86   (  select(E, L, R)
   87   ;  L = R
   88   ).
   89
   90get_dimension(Type, U-E, Dim-(U-E)) :-
   91    (   var(U)
   92    -> Dim = var
   93    ;   not_factor(U-E)
   94    -> (   Type = _:unit_parent
   95        ->  all_unit_kind(U**E, K)
   96        ;   K = U**E
   97        ),
   98        quantity_dimensions(K, Dim)
   99    ;   Dim = 1
  100    ).
  101get_dimensions(Type, L, D) :-
  102    maplist(get_dimension(Type), L, D).
  103
  104partition_factors(L1, R1, ChildParentGoal, L, N, L2, R2) :-
  105    get_dimensions(ChildParentGoal, L1, G1),
  106    get_dimensions(ChildParentGoal, L2, G2),
  107    partition_factors_(G1, R1, ChildParentGoal, L, N, G2, R2).
  108
  109partition_factors_(L1, R1, ChildParentGoal, L, N, L2, R2) :-
  110    select(Dim-F1, L1, L11),
  111    selectchk(Dim-F2, L2, L22),
  112    common_factors([F1], R11, ChildParentGoal, LL, N, [F2], R22),
  113    !,
  114    append(R11, R111, R1),
  115    append(R22, R222, R2),
  116    append(LL, LLL, L),
  117    partition_factors_(L11, R111, ChildParentGoal, LLL, N, L22, R222).
  118partition_factors_(L1, R1, ChildParentGoal, L, N, L2, R2) :-
  119    pairs_values(L1, V1),
  120    pairs_values(L2, V2),
  121    common_factors(V1, R1, ChildParentGoal, L, N, V2, R2).
  122
  123common_factors(L1, R1, ChildParentGoal, L, N, L2, R2) :-
  124   exclude(ground, L1, Vars1),
  125   foldl(select_, Vars1, L2, _),
  126   exclude(ground, L2, Vars2),
  127   foldl(select_, Vars2, L1, _),
  128   partition(not_factor, L1, Unit1, Factor1),
  129   normalize_factors(Unit1, NUnit1),
  130   partition(not_factor, L2, Unit2, Factor2),
  131   normalize_factors(Unit2, NUnit2),
  132   ord_intersection(NUnit1, NUnit2, CommonUnits, Unit2Only),
  133   ord_subtract(NUnit1, NUnit2, Unit1Only),
  134   append(CommonUnits, R, L),
  135   append(Factor1, R11, R1),
  136   append(Factor2, R22, R2),
  137   expand_either_factors(Unit1Only, R11, ChildParentGoal, R, N, Unit2Only, R22).
  138expand_either_factors([], [], _, [], _-N, [], []) :-
  139   nb_setarg(1, N, no).
  140expand_either_factors(L1, R1, ChildParentGoal, L, Limit-N, L2, R2) :-
  141   (  Limit > 0
  142   -> Limit1 is Limit - 1
  143   ;  nb_setarg(1, N, depth_limit_exceeded),
  144      fail
  145   ),
  146   (  phrase(select_factor(L1, R1, ChildParentGoal, L, Limit1-N), L2, R2)
  147   ;  phrase(select_factor(L2, R2, ChildParentGoal, L, Limit1-N), L1, R1)
  148   ).
  149select_factor(L1, R1, ChildParentGoal, L, N) -->
  150   select(A),
  151   {ground(A)},
  152   expand_factors(ChildParentGoal, A),
  153   partition_factors(L1, R1, ChildParentGoal, L, N).
  154
  155expand_factors(ChildParentGoal, A), Factors -->
  156   { expand_factor(ChildParentGoal, A, Factors) }.
  157expand_factor(ChildParentGoal, Child-N, Factors) :-
  158   call(ChildParentGoal, Child, Parent),
  159   parse_normalize_factors(Parent**N, Factors).
  160
  161:- begin_tests(search, [timeout(1), setup(abolish_all_tables)]).  162
  163test(partition_factors) :-
  164    common_expr(units:unit_parent, si:metre, F1, usc:inch, F2, C),
  165    F1 == 1,
  166    F2 == 9144/(10000*3*12),
  167    C == si:metre.
  168
  169test(partition_factors2) :-
  170    common_expr(units:alias_or_child_quantity_parent,
  171                isq:length/isq:time**2, 1, isq:acceleration, 1, C),
  172    C == isq:length/isq:time**2.
  173
  174test(common_expr_var) :-
  175    common_expr(units:unit_parent, si:metre/T, F1, usc:inch/si:hour, F2, C),
  176    T = si:hour,
  177    F1 == 1,
  178    F2 == 9144/(10000*3*12),
  179    C == si:metre/si:hour.
  180
  181test(common_expr_hard) :-
  182    common_expr(units:unit_parent,
  183                usc:foot*usc:pound_force/si:second, F1,
  184                si:watt, F2, C),
  185    F1 == 9144*45359237*980665/(10000*3*100000000*100000),
  186    F2 == 1,
  187    C == si:kilogram*si:metre**2/si:second**3.
  188
  189:- end_tests(search).