1:- module(miser, [miserly/2]).    2
    3% TODO script that calls miser_sort/2 from multiple predicates
    4
    5:- use_module(library(random)).    6
    7% each clause is an observation of runtime cost for a miserly predicate
    8:- dynamic observation/3.    9
   10% implementations(Predicate, Implementations)
   11%
   12% True if Predicate has a list of Implementations
   13:- dynamic implementations/2.   14
   15
   16% miserly(PredicateIndicator, Implementations)
   17%
   18% Creates a predicate (name and arity determined by
   19% PredicateIndicator) which self-optimizes by choosing the fastest
   20% implementation from among Implementations.
   21:- meta_predicate miserly(0,+).   22miserly(Predicate, Implementations) :-
   23    Module:Name/Arity = Predicate,
   24    functor(Term0, Name, Arity),
   25    format(atom(Base), 'miserly_~w_', [Name/Arity]),
   26    assertz((
   27        user:goal_expansion(Term0, Module:Term) :-
   28            gensym(Base, Sym),
   29            rename_term(Term0, Sym, Term),
   30            generate_optimizing_predicate(Module:Sym/Arity, Implementations)
   31    )).
   32
   33rename_term(Term0, NewName, Term) :-
   34    Term0 =.. [_|Args],
   35    Term  =.. [NewName|Args].
   36
   37:- meta_predicate generate_optimizing_predicate(0,+).   38generate_optimizing_predicate(Predicate, Implementations) :-
   39    Module:Functor/Arity = Predicate,
   40    (dynamic Predicate),
   41    maplist(qualify(Module), Implementations, Qualified),
   42    assertz(miser:implementations(Predicate, Qualified)),
   43    length(Args, Arity),
   44    Head =.. [Functor|Args],
   45    Body = ( miser:measure_one(Predicate, Args),
   46             miser:trim_implementations(Predicate)
   47           ),
   48    Module:assertz(Head :- Body).
   49
   50qualify(Module, Predicate, Module:Predicate).
   51
   52
   53% measure a single, working implementation and record results
   54% in the database. removes failing implementations if any are encountered
   55measure_one(Predicate, Arguments) :-
   56    random_implementation(Predicate, Chosen), % infinite choice points
   57        print_message(informational, miser(chose, Chosen)),
   58        (   measure_cost(Chosen, Arguments, Cost)
   59        ->  true
   60        ;   remove_implementation(Predicate, Chosen, _),
   61            fail
   62        ),
   63    !,
   64    observe(Predicate, Chosen, Cost),
   65    print_message(informational, miser(cost, Cost)).
   66
   67% randomly choose an implementation for Predicate, providing
   68% infinite choice points choosing randomly again on each backtrack
   69random_implementation(Predicate, Chosen) :-
   70    repeat,
   71    implementations(Predicate, Choices),
   72    ( Choices=[] -> throw('No implementations to choose from') ; true),
   73    random_member(Chosen, Choices).
   74
   75% record results of measuring an implementation's performance
   76observe(Predicate, Implementation, Cost) :-
   77    assertz(observation(Predicate, Implementation, Cost)).
   78
   79% remove cost measurement results (opposite of observe/3)
   80forget(Predicate, Implementation) :-
   81    retractall(observation(Predicate, Implementation,_)).
   82
   83% macro creates this to count observations that have happened so far
   84observation_count(Predicate, Count) :-
   85    findall(Name, observation(Predicate, Name, _), Names),
   86    length(Names, Count).
   87
   88% macro creates this to discard losing implementations
   89trim_implementations(Predicate) :-
   90    observation_count(Predicate, ObservationCount),
   91    ObservationCount > 5,
   92    !,
   93
   94    % find the most costly implementation we've seen
   95    most_costly_implementation(Predicate, MostCostly),
   96
   97    % ... remove it from available choices
   98    remove_implementation(Predicate, MostCostly, Keepers),
   99
  100    (   Keepers=[]       ->  found_winner(Predicate, MostCostly)
  101    ;   Keepers=[Winner] ->  found_winner(Predicate, Winner)
  102    ;   print_message(informational, miser(discard, MostCostly)),
  103        forget(Predicate, MostCostly)
  104    ).
  105trim_implementations(_).
  106
  107% true if MostCostly is the implementation with highest measured
  108% cost in our observations so far
  109most_costly_implementation(Predicate, MostCostly) :-
  110    findall(Cost-Name, implementation_cost(Predicate, Name, Cost), Costs),
  111    keysort(Costs, AscendingCost),
  112    reverse(AscendingCost, [_-MostCostly|_]).
  113
  114% remove a single implementation from the list of choices
  115remove_implementation(Predicate, Needle, Leftover) :-
  116    once(implementations(Predicate, Choices)),
  117    once(select(Needle, Choices, Leftover)),
  118    retractall(implementations(Predicate,_)),
  119    assertz(implementations(Predicate, Leftover)).
  120
  121
  122% true if Predicate has an implementation Name whose average observed
  123% cost is AvgCost
  124implementation_cost(Pred, Name, AvgCost) :-
  125    aggregate(count, Pred^Cost^observation(Pred, Name, Cost), Count),
  126    aggregate(sum(Cost), Pred^observation(Pred, Name, Cost), TotalCost),
  127    AvgCost is TotalCost / Count.
  128
  129% macro creates this for making the winner permanent
  130found_winner(Predicate, Winner) :-
  131    print_message(informational, miser(winner, Winner)),
  132
  133    % prepare to erase the old definition
  134    Module:Functor/Arity = Predicate,
  135    functor(Term, Functor, Arity),
  136    clause(Module:Term, _, OldClause),  % should be exactly one OldClause
  137
  138    % make Functor an alias for Winner (same arity)
  139    length(Args, Arity),
  140    quniv(Head, Functor, Args),
  141    quniv(Body, Winner, Args),
  142    Module:assertz(Head :- Body),
  143
  144    % erase the old definition and clean up
  145    erase(OldClause),
  146    compile_predicates([Predicate]),
  147    retractall(implementations(Predicate, _)),
  148    retractall(observation(Predicate,_,_)).
  149
  150% like =../2 (aka "univ") but allows module-qualified functors
  151quniv(Module:Term, Module:Functor, Args) :-
  152    Term =.. [Functor|Args],
  153    !.
  154quniv(Term, Functor, Args) :-
  155    Term =.. [Functor|Args].
  156
  157
  158% measures the cost of calling a goal (by some reasonable metric)
  159measure_cost(Implementation, Arguments, Cost) :-
  160    quniv(Goal, Implementation, Arguments),
  161    statistics(inferences, Before),
  162    call(Goal),
  163    statistics(inferences, After),
  164    Cost is After - Before.
  165
  166
  167% define how to show this library's messages
  168:- multifile prolog:message//1.  169prolog:message(miser(chose, Chosen)) --> ['chose ~p'-[Chosen]].
  170prolog:message(miser(cost, Cost)) --> ['cost ~p'-[Cost]].
  171prolog:message(miser(discard, Loser)) --> ['discarding ~p'-[Loser]].
  172prolog:message(miser(winner, Winner)) --> ['found a winner ~p'-[Winner]]