1:- module(rmemo,
    2          [ gdpmem//3
    3          , gdp//3
    4          , gdp2//3
    5          , memo//2
    6          , lazy//2
    7          , memo_lookup//3
    8          , gdp_info/3
    9          , gdp_info//3
   10          , gdpmem_info//4
   11          ]).

Memoisation and stochastic memoisation of random predicates built on strand

This module provides memoisation services for predicates that run in the strand store + random state DCG. Memoisation of sampling predicates can be used to do lazy sampling and implement random world semantics. Stochastic memoisation is used to implement Dirichlet Processes and Pitman Yor processes. */

   21:- use_module(library(dcg_pair)).   22:- use_module(library(dcg_macros)).   23:- use_module(library(callutils),  [(*)//4]).   24:- use_module(library(data/store), [store_add//2, store_get//2, store_apply//2, store_set//2]).   25:- use_module(library(prob/crp),   [empty_classes/1, crp_sample//3, add_class//2, inc_class//1]).   26:- use_module(library(prob/crp_tagged), []).
 memo(+F:dcg(A,B,strand), -G:dcg(A,B,strand))// is det
Runs in strand DCG. Produces G, a callable which is a memoised version of F, both of which are binary DCG goals.
   33:- meta_predicate memo(4,-,+,-).   34memo(F,rmemo:memf(TabRef,F)) -->
   35   {empty_assoc(Tab)},
   36   \< store_add(Tab,TabRef).
   37
   38memf(TabRef,F,X,Y) -->
   39   \< store_get(TabRef,T1),
   40   (  {get_assoc(X,T1,Y)} -> []
   41   ;  call(F,X,Y),
   42      \< store_apply(TabRef,assoc_put(X,Y))
   43   ).
   44
   45assoc_put(K,V,T1,T2) :- put_assoc(K,T1,V,T2).
   46
   47:- meta_predicate lazy(3,-,+,-).   48lazy(F,rmemo:lazyf(Ref,F)) -->
   49   \< store_add(nothing,Ref).
   50
   51lazyf(Ref,F,Y) -->
   52   \< store_get(Ref,T),
   53   (  {T=just(Y)} -> []
   54   ;  call(F,Y),
   55      \< store_set(Ref,just(Y))
   56   ).
   57
   58%% memo_lookup(+G:dcg(A,B,strand), -X:A, -Y:B)// is nondet.
   59%
   60%  Looks up previously memoised computations of G.
   61memo_lookup(rmemo:memf(TabRef,_), X, Y) -->
   62   \< store_get(TabRef,T),   {gen_assoc(X,T,Y)}.
 gdp(+GEM:gem_param, +Base:dcg(-A,strand), -CRP:dcg(-A,strand))// is det
Generalised Dirichlet process: builds a CRP (so-called Chinese Restaurant Process) representing the distribution obtained by sampling from a Dirichlet or Pitman-Yor process with given parameter and base distribution.
   70:- meta_predicate gdp(+,3,-,+,-).   71gdp(GEM,H,rmemo:crp(Ref,GEM,H)) -->
   72   {empty_classes(Classes)},
   73   \< store_add(Classes,Ref).
   74
   75:- meta_predicate gdp2(+,3,-,+,-).   76gdp2(GEM,H,rmemo:crp2(Ref,GEM,H)) -->
   77   {empty_classes(Classes)},
   78   \< store_add(Classes,Ref).
   79
   80crp(Ref,GEM,H,X) -->
   81   \< store_get(Ref,Classes),
   82   \> crp_sample(GEM,Classes,Action),
   83   crp_action(Action,Ref,H,X).
   84
   85crp2(Ref,GEM,H,X) -->
   86   \< store_get(Ref,Classes),
   87   \> crp_tagged:crp_sample(GEM,Classes,Action),
   88   crp_action(Action,Ref,H,X).
   89
   90crp_action(new,Ref,H,X) -->
   91   call(H,X),
   92   \< store_apply(Ref,add_class(X,_)).
   93
   94crp_action(old(X,Idx),Ref,_,X) -->
   95   \< store_apply(Ref,inc_class(Idx)).
   96
   97gdp_info(rmemo:crp(_,GEM,Base), GEM, Base).
   98
   99gdp_info(rmemo:crp(Ref,GEM,_), GEM, Classes) -->
  100   \< store_get(Ref,Classes).
 gdpmem(+GEM:gem_param, +Base:dcg(+B,-A,strand), -CRP:dcg(+B,-A,strand))// is det
Stochastic memosation based on generalised Dirichlet processes: Base is binary DCG goal in strand such that call(Base,X,Y) samples Y from some distribtion depending on X. gdpmem//3 produces a stochastically memoised version of Base that defines a GDP for each distinct value of X, created on demand the first time that X is supplied. See gdp//3 for more info.
  109:- meta_predicate gdpmem(+,4,-,+,-).  110gdpmem(GEM,F,rmemo:(call*G)) --> memo(new_gdp(GEM,F),G).
  111new_gdp(GEM,F,X,GX) --> gdp(GEM,call(F,X),GX).
  112
  113gdpmem_info(rmemo:(_*G), X, GEM, Classes) -->
  114   memo_lookup(G, X, CRP),
  115   gdp_info(CRP, GEM, Classes)