:- ensure_loaded( library(lists) ).
:- ensure_loaded( construct_scall ). % spec_constructs_scall/5,
% pred_type_constructs_scall/5.
% :- pl( swi(_), lib(jump_swi/0), lib(jump/0) ).
:- lib(jump/9).
:- lib(bp/0). % assorted preds
:- lib(on_random/6).
:- lib(nst_length/3).
:- lib(rev_append/3).
:- lib(n_distinct_randoms_in/4).
:- lib(report/2).
% :- ensure_loaded( chains_metrics_dbg ). % testing only
:- multifile( last_skips/2 ).
:- dynamic( last_skips/2 ).
:- multifile( mcmc_recovery/2 ).
:- dynamic( mcmc_recovery/2 ).
kernel( SGl, HotClss, I, Bid, P, ResO ) :-
% SGl = Prd/Args,
% copy_term( Args, FrArgs ),
% ( bb_get(given_initial_model,MODiPrv)-> true; true ),
SGl =.. [Prd|Args],
append( Args, [MODiPrv], PlArgs ),
length( PlArgs, Arity ),
% Arity is PlLgth,
spec_constructs_scall( Prd/Arity, Type, Path, PlArgs, Slp ),
once( initial_bp_str(Bid,P,Str) ),
( bims_bb_delete(initial_model_given,MODiPrv) -> true ; true ),
bims_bb_get( msd, Msd ),
( current_predicate(global_priors_ratio/3) ->
bims_bb_put( gpr, true )
;
( bims_bb_delete( gpr, _ ) -> true ; true )
),
bims_bb_put( s_random_prod, [] ),
bims_bb_put( s_random_avail, [] ),
bims_bb_put( s_random_cons, [] ),
initial_slp( Msd, Slp ),
initial_hot_chain_models( HotClss, Bid, Prd/Arity, Type, Args, Msd, HotChns ),
( current_predicate(bims_lkl:to_model/3) ->
bims_lkl:to_model( MODiPrv, MODi, MODiKp )
;
MODi = MODiPrv, MODiKp = MODi
),
path_to_btrack_pos( Bid, Path, Sop ),
% fixme: above leaves backtrack point, is it appropriate here?
report( b_pos, b_pos(1,Sop) ),
( is_list(Sop) -> nst_length( Sop, 0, Ni ) ; Ni = nal ),
% ( length( Sop, Ni ) -> true ; Ni = nal ), % nal = not_a_list
% % reverse( Pos, Sop ),
% (VorO == op -> BpStr = P ; BpStr = 1-1/2-P),
% portray_clause( ResO, m(1,MODiKp) ),
bims_lkl:model_llhood( MODi, LLi ),
report( lkl_l, lkl_l(1,LLi,Ni) ),
length( HotChns, LgthHotChns ),
HCLim is LgthHotChns + 2,
!,
transition( false, Path, Prd/Args/Type, Sop, MODi/MODiKp, 1, Ni, LLi, Bid/Str, HotChns/HCLim, 2, ResO, [iter(I)] ).
initial_slp( rm, Slp ) :-
call( slp:Slp ),
!.
initial_slp( fm, Slp ) :-
repeat,
call( slp:Slp ),
!.
initial_hot_chain_models( [], _Bid, _Spec, _Type, _Args, _Msd, [] ).
initial_hot_chain_models( [H|T], Bid, Spec, Type, Args, Msd, HotMods ) :-
append( Args, [HModPrv], PlArgs ),
spec_constructs_scall( Spec, Type, Path, PlArgs, Slp ),
initial_slp( Msd, Slp ),
path_to_btrack_pos( Bid, Path, Sop ),
( is_list(Sop) -> nst_length( Sop, 0, LgS) ; LgS = nal ),
( current_predicate(bims_lkl:to_model/3) ->
bims_lkl:to_model( HModPrv, HMod, HModKp )
;
HMod = HModPrv, HModKp = HModPrv
),
model_llhood( HMod, LLh ),
HotMods = [hc(HMod/HModKp,LLh,Path,Sop,LgS,H)|TMods],
initial_hot_chain_models( T, Bid, Spec, Type, Args, Msd, TMods ).
transition( true, _InP, _SGl, _Sop, _MODi/MODiKp, Tms, _Ni, _LLi, _Str, _HotChns, _Iter, ResO, _Termin ) :- !,
portray_clause( ResO, m(Tms,MODiKp) ).
transition( false, InPath, SGl, Sop, MODi/MODiKp, Tms, Ni, LLi, Bid/Str, HotChns/HCLm, I, ResO, Termin ) :-
% debug( bims, 'Iteration: ~d', I ),
once( bp_str_to_bp(Bid,Str,Bp) ),
once( backtrack_on_nxt( Bid, Bp, InPath, MODi/MODiKp, SGl, Sop, I, Ni, NwPath, PrvOSop, PrvNxNi, MODst/MODstKp, Nth, BCntr ) ),
% write( user_error, model_star( I, MODst, MODstKp ) ), nl( user_error ),
% since, now, all proposals are non-excluding, we can do away with next if
( MODst == '__failure' ->
bims_bb_get( bk_failures, FsSoFar ),
bims_bb_put( bk_failures, [I|FsSoFar] ),
Fin = false, OutPath = InPath,
OSop = Sop, NxMODi = MODi, NxMODiKp = MODiKp,
NxNi = Ni, NxLL = LLi, NxTms = Tms,
NxStr = Str, NxI = I
;
once( update_bp_str(Bid,Str,NxStr) ),
NxI is I + 1,
jump( Bid, MODi, MODst, BCntr, I, LLi, LLst, RecA, Jump ),
bims_report_progress( I ),
report( m_star, m_star(I,MODstKp) ),
report( l_star, l_star(I,LLst,Nth,RecA) ),
( Jump==jump ->
% backtrack_on_nxt/n might have instantiate them.
% this is the case for Bid=uc, since the length is needed
% for computing BCntr
( MODiKp == MODstKp -> NxTms is Tms + 1 % fixme: we assume this is desirable, ie when jumping back and accepting
% the same or isomorphic model
; portray_clause( ResO, m(Tms,MODiKp) ),
NxTms is 1
),
( var(PrvOSop) ->
path_to_btrack_pos( Bid, NwPath, CldOSop ),
% % reverse( NwPos, OSop ),
( is_list(CldOSop) ->
% only do that for Bids that need it.
% nst_length( OSop, 0, NxNi ) % length( OSop, NxNi )
length( CldOSop, CldNxNi )
;
CldNxNi = nal
)
;
CldOSop = PrvOSop,
CldNxNi = PrvNxNi
),
CldOutPath = NwPath, CldNxLL = LLst, CldNxMODi = MODst,
CldNxMODiKp = MODstKp
;
NxTms is Tms + 1,
CldOutPath = InPath, CldNxNi = Ni, CldNxLL = LLi,
CldNxMODi = MODi, CldNxMODiKp = MODiKp, CldOSop = Sop
),
report( b_pos, b_pos(I,Sop) ),
( termination( Termin, Jump, I ) ->
% Model = Jump-OutPath
bims_bb_put( last_model, c(NxMODi) ),
Fin = true
;
Fin = false
)
),
( HotChns == [] ->
NxHotChns = [],
OutPath = CldOutPath, NxNi = CldNxNi, NxLL = CldNxLL,
NxMODi = CldNxMODi, NxMODiKp = CldNxMODiKp, OSop = CldOSop
;
Nil = hc(CldNxMODi/CldNxMODiKp,CldNxLL,CldOutPath,CldOSop,CldNxNi,1),
power_backtrack( HotChns, Bid, Bp, SGl, PrvNxHotChns ),
n_distinct_randoms_in( 2, 1, HCLm, [Rnd1,Rnd2] ),
power_chain_swap( Rnd1, Rnd2, [Nil|PrvNxHotChns], HotJmp, [Fst|NxHotChns] ),
( (Rnd1 =:= 1, HotJmp == jump) ->
Fst = hc(NxMODi/NxMODiKp,NxLL,OutPath,OSop,NxNi,_)
;
OutPath = CldOutPath, NxNi = CldNxNi, NxLL = CldNxLL,
NxMODi = CldNxMODi , OSop = CldOSop,
% Temporarily only:
NxMODiKp = CldNxMODiKp
)
),
!,
% % chains_metrics_dbg( NxMODi, NxHotChains ), % testing only
% portray_clause( ResO, m(NxI,NxMODiKp) ),
report( lkl_l, lkl_l(NxI,NxLL,NxNi) ),
transition( Fin, OutPath, SGl, OSop, NxMODi/NxMODiKp, NxTms, NxNi, NxLL, Bid/NxStr, NxHotChns/HCLm, NxI, ResO, Termin ).
backtrack_on_nxt( sc, _Bp, _InPath, MODi/MODiKp, SGl, _Sop, _I, _LgS, [], _NwSop, _NwLgS, MODst/MODstKp, _Nth, _BLCntr ) :-
!,
findall( VId, scm_gen_each_vid(MODi,VId), VIds ),
scm_iterate( VIds, SGl, MODi, MODiKp, MODst, MODstKp ).
backtrack_on_nxt( uc, Bp, InPath, _MODi, SGl, Sop, It, LgS, NwPath, NwSop, NwLgS, MODstWK, Nth, BLCntr ) :-
!,
backtrack_on_nxt_1( uc, Bp, InPath, _, SGl, Sop, It, LgS, NwPath, MODstWK, Nth, _Sel, _BCntr ),
% % % split_on_nth( NwPath, Nth, _Within, _FNth, uc/NwCntr, _Left ),
path_to_btrack_pos( uc, NwPath, NwSop ),
nst_length( NwSop, 0, NwLgSPrv ),
NwLgS is max( NwLgSPrv, 1 ),
BLCntr is LgS / NwLgS.
backtrack_on_nxt( Bid, Bp, InPath, _MODi, SGl, Sop, It, LgS, NwPath, _NwSop, _NwLgS, MODstWK, Nth, BLCntr ) :-
backtrack_on_nxt_1( Bid, Bp, InPath, _MODiDsh, SGl, Sop, It, LgS, NwPath, MODstWK, Nth, _Sel, BLCntr ).
% % % backtrack_on_nxt_1( Bid, Bp, InPath, _MODi, SGl, Sop, LgS, NwPath, MODstWK, Nth, _Sel, BLCntr ).
% backtrack_on_nxt_1( Bid, Bp, InPath, _MODi, Prd/Args/Type, Sop, LgS, NewPath, MODst, Nth, BLCntr ) :-
% Nolabels contributions so, BCntr
% backtrack_on_nxt_1( Bid, Bp, InPath, MODi/MODiKp, Prd/Args/Type, Sop, LgS, NewPath, MODst/MODstKp, Nth, Sel, BCntr ) :-
backtrack_on_nxt_1( Bid, Bp, InPath, MODi/MODiKp, Prd/Args/Type, Sop, It, LgS, NewPath, MODst/MODstKp, Nth, Sel, BCntr ) :-
( select_btrack_point( Bid, Sop, LgS, Bp, Nth, Sel, BCntr ) ->
report( path, path(It,InPath) ),
( Sel == +inf ->
NewPath = InPath,
MODst = MODi, MODstKp = MODiKp,
Nth = +inf, % i think this is only used for printing
BCntr is 1
;
( Nth =:= 0 ->
true % let Left be an uninstantiated variable
;
split_on_nth( InPath, Nth, _Within, _FNth, Bid/BCntr, Left )
),
% copy_term( Args, FrArgs ),
% write( user_error, inpath(InPath) ), nl( user_error ),
append( Args, [MODstPrv], PlArgs ),
pred_type_constructs_scall( Type, Prd, Left/[], PlArgs, Slp ),
( call(slp:Slp) ->
( current_predicate(bims_lkl:to_model/3) ->
bims_lkl:to_model( MODstPrv, MODst, MODstKp )
;
MODst = MODstPrv, MODstKp = MODstPrv
),
NewPath = Left
;
( bims_bb_get(msd,fm) ->
% (\+ bb_get(exclude_lbd,false);bb_get(msd,fm)) ->
MODst = '__failure'
;
bims_bb_get(msd,Msd),
werr( [['Unable to generate model under model structure definition: \'',Msd,'\''],[slp_call(Slp)]] ),
abort
)
)
)
;
werr( [['Unable to backtrack. '],[sop(Sop),bid(Bid/Bp)]] ),
abort
).
path_to_btrack_pos( bu, Path, Pos ) :-
!,
rec_cps( Path, 1, 0, 0, [], 0, 0, [], _N, Pos ).
path_to_btrack_pos( cd, Path, Pos ) :-
!,
% HERE a
path_to_nst_btrack_points( Path, 1, 0, _LstN, Pos ).
path_to_btrack_pos( Bid, Path, Pos ) :-
path_to_btrack_points( Path, 1, 0, _Cont, PrvPos/[] ),
% path_to_btrack_points( Path, 1, 0, ClnPath, _Cont, PrvPos/[] ),
% HERE
% path_to_btrack_points( Path, 1, PrvPos ),
once( bid_points_to_pos(Bid,PrvPos,Pos) ).
/* need to uncomment its call too
% path_to_btrack_points( [], _Ind, [] ).
path_to_btrack_points( [H|T], Ind, Pos ) :-
( H=_Id/Prb ->
Pos = [Ind-Prb|TPos]
;
Pos = TPos
),
NxInd is Ind + 1,
path_to_btrack_points( T, NxInd, TPos ).
*/
path_to_nst_btrack_points( [], N, _Last, N, [] ).
path_to_nst_btrack_points( [H|T], N, Last, LstN, Pos ) :-
( is_list(H) ->
Pos = [HPos|TPos],
path_to_nst_btrack_points( H, N, 0, NxN, HPos ),
NxLst = 0
;
NxN is N + 1,
( H=Id/Prb ->
NxLst = Id,
( last_skips( Last, Id ) ->
TPos = Pos
;
Pos = [N-Prb|TPos]
)
;
Pos = TPos,
NxLst = 0
)
),
path_to_nst_btrack_points( T, NxN, NxLst, LstN, TPos ).
path_to_btrack_points( [], Cont, _Last, Cont, T/T ).
% path_to_btrack_points( [H|T], Ind, Last, ClnPath, Cont, Pos/TPos ) :-
path_to_btrack_points( [H|T], Ind, Last, Cont, Pos/TPos ) :-
( is_list(H) ->
path_to_btrack_points( H , Ind, 0, NxInd, Pos/MdPos ),
% ClnPath = [ClnH|ClnT],
Id = 0
;
( H=Id/Prb ->
%( ((Last==8;),(Id==8;Id==7)) ->
( last_skips( Last, Id ) ->
Pos = MdPos
;
Pos = [Ind-Prb|MdPos]
),
% ClnPath = [H|ClnT],
NxInd is Ind + 1
;
Pos = MdPos,
( H = bp(_), % HERE, this is not valid any longer
NxInd is Ind,
% ClnPath = ClnT,
Id = Last
;
NxInd is Ind + 1,
% ClnPath = [H|ClnT],
Id = 0
)
)
),
path_to_btrack_points( T, NxInd, Id, Cont, MdPos/TPos ).
% % last_skips( 2, Id ) :-
% !,
% (Id =:= 1; Id =:= 2 ).
/*
last_skips( 8, Id ) :-
!,
(Id =:= 7; Id =:= 8 ).
last_skips( 6, Id ) :-
( Id =:= 5; Id =:= 6 ).
*/
rec_cps( [], N, _Lt, CntThese, InThese, CntAlts, CntAltPts, InAlts, N, Poss ) :-
reverse( InThese, These ),
reverse( InAlts, Alts ),
Poss = cps( CntThese, These, CntAlts, CntAltPts, Alts ).
rec_cps( [H|T], N, Lt, CntTh, AccThese, CntA, CntAPs, AccAlts, FinN, Poss ) :-
( is_list(H) ->
rec_cps( H, N, 0, 0, [], 0, 0, [], NxN, HCPs ),
HCPs = cps(CntH,_,CntAltH,_,_),
( (CntH=:=0,CntAltH=:=0) ->
% zap it out
NxCntTh is CntTh, NxAccThese = AccThese,
NxCntA is CntA, NxCntAPs is CntAPs, NxAccAlts = AccAlts
;
NxCntTh is CntTh, NxAccThese = AccThese,
NxCntA is CntA + 1, NxCntAPs is CntAPs + CntH + CntAltH,
NxAccAlts = [HCPs|AccAlts]
),
NxLt = 0
;
NxN is N + 1,
( H = Hid/HPrb -> % a backtrack point
NxLt = Hid,
( last_skips(Lt,Hid) ->
NxCntTh is CntTh, NxAccThese = AccThese,
NxCntA is CntA, NxCntAPs is CntAPs, NxAccAlts = AccAlts
;
NxCntTh is CntTh + 1, NxAccThese = [N-HPrb|AccThese],
NxCntA is CntA, NxCntAPs is CntAPs, NxAccAlts = AccAlts
)
;
NxCntTh is CntTh, NxAccThese = AccThese,
NxCntA is CntA, NxCntAPs is CntAPs, NxAccAlts = AccAlts,
NxLt = H
)
),
rec_cps( T, NxN, NxLt, NxCntTh, NxAccThese, NxCntA, NxCntAPs, NxAccAlts, FinN, Poss ).
select_btrack_point( bu, Points, _NoBPoints, K, Nth, _Sel, Cntr ) :-
!,
Cntr is 1,
bu_select_bp( Points, K, Nth-_Prb ).
select_btrack_point( cd, Points, NoBPoints, P, Nth, _Sel, Cntr ) :-
!,
select_ind_btrack_point( P, Points, NoBPoints, Nth ),
Cntr = 1. % everything cancels out in evaluating jump-alpha
select_btrack_point( uc, Points, NoBPoints, _P, NthPoint, Nth, _Cntr ) :-
% Nth = Sel(ected)
!,
Lim is NoBPoints + 1,
random( 1, Lim, Nth ),
nth( Nth, Points, NthPoint-_NPrb ).
% 2005/01/21: we instantiate this later.
% Cntr = 1. % everything cancels out in evaluating jump-alpha
select_btrack_point( Bid, Points, _Lg, P, NthPoint, _Nth, Cntr ) :-
select_dep_btrack_point( Points, Bid, P, 1, NthPoint, Cntr ).
% select_ind_btrack_point( _Curr, _NoBPoints, Nth ) :-
% Nth = 7.
select_ind_btrack_point( Curr, Points, NoBPoints, NthPoint ) :-
( NoBPoints < Curr -> Nth = NoBPoints ; Nth = Curr ),
( Nth =:= 0 -> NthPoint = 0
;
% HERE b
breadth_first_nth( Points, Curr, [], [], NthPoint )
% nth( Nth, Points, NthPoint-_NPprb)
).
select_dep_btrack_point( [H-HPrb|T], Bid, P, Acc, Nth, Cntr ) :-
( T == [] ->
% dbg( 30, controlled_sample_from_last(H) ),
Nth = H, Cntr = Acc % check that this is correct for all BPids
;
( continue_backtracking(Bid,P,HPrb,HCntr) ->
NxAcc is Acc * HCntr,
select_dep_btrack_point( T, Bid, P, NxAcc, Nth, Cntr )
;
((Nth = H, Cntr = Acc) ;
select_dep_btrack_point( T, Bid, P, Acc, Nth, Cntr ) )
% by using Acc we probably say that this was not a real choice point
% which seems a reasonable enough statement
)
).
breadth_first_nth( [], N, AccFlat, AccRec, NthK ) :-
( N == [] -> % get out of recursion
true
;
( AccFlat == [] ->
( AccRec == [] ->
NthK = +inf
;
reverse( AccRec, Rec ),
breadth_first_nth( Rec, N, [], [], NthK )
)
;
reverse( AccFlat, Flat ),
reverse( AccRec, Rec ),
append( Flat, Rec, FlatNRec ),
breadth_first_nth( FlatNRec, N, [], [], NthK )
)
).
breadth_first_nth( [H|T], N, AccFlat, AccRec, NthK ) :-
( is_list(H) ->
flatten_one_level( H, HFlat, HRec ),
rev_append( HFlat, AccFlat, NxFlat ),
rev_append( HRec, AccRec, NxRec ),
NxN is N, NxT = T
;
% we assume any non-list element is a pair structure
( N =:= 1 ->
H = NthK-_Prb,
NxN = [],
NxT = []
;
NxT = T,
NxN is N - 1
),
NxFlat = AccFlat,
NxRec = AccRec
),
breadth_first_nth( NxT, NxN, NxFlat, NxRec, NthK ).
flatten_one_level( [], [], [] ).
flatten_one_level( [H|T], Flat, Nst ) :-
( is_list(H) ->
TFlat = Flat,
Nst = [H|TNst]
;
Flat = [H|TFlat],
TNst = Nst
),
flatten_one_level( T, TFlat, TNst ).
% nth_replace_column( Nth, InPath, LblCst, NewPath ) :-
nth_replace_column( Nth, [H|T], LblCst, NewPath ) :-
( Nth =< 1 ->
( H = Sid:LblCst ->
NewPath = [Sid|T]
;
H = _Sid/_LblCst,
NewPath = [H|T]
)
;
% Sid=a, % just trick SWI's erroneous
% singleton variable in branch warning
NxN is Nth - 1,
NewPath = [H|NewT],
nth_replace_column( NxN, T, LblCst, NewT )
).
split_on_nth( [], Nth, false, Nth, _BStr, [] ) :- !.
split_on_nth( [H|T], Nth, OutWithin, FNth, BStr, Left ) :-
Nth > 1,
!,
( is_list(H) ->
split_on_nth( H, Nth, NestWithin, NxNth, BStr, HLeft ),
( NestWithin == true ->
Rem = [],
Left = [HLeft|T],
OutWithin = true
;
Rem = T,
Left = [H|TLeft],
RemWithin = OutWithin
)
;
Rem = T,
Left = [H|TLeft],
NxNth is Nth - 1,
RemWithin = OutWithin
),
split_on_nth( Rem, NxNth, RemWithin, FNth, BStr, TLeft ).
split_on_nth( [H|T], Nth, true, Nth, BStr, Left ) :-
Nth =:= 1,
( is_list(H) ->
split_on_nth( H, 1, true, _, BStr, RecLeft ),
Left = [RecLeft|T]
;
( BStr = uc/BCntr ->
% nst_length( T, 0, BCntr )
% path_to_btrack_pos( uc, T, TrailCPs ),
( H=Lst/_Lprb -> true % this should always be the case
; Lst = 0 ), % remove if after testing.
path_to_btrack_points( T, 1, Lst, _Cont, TrailCPs/[] ),
length( TrailCPs, BCntr )
;
true
)
).
% Let Left uninstantiated.
/* bp/1 version
split_on_nth( [_H|_Right], Nth, true, Nth, Left ) :-
( H = [F|_RcT] ->
Left = [[bp(F)|_]|Right]
;
Left = [bp(F)|_]
).
*/
split_is_or_not_in_list( [], Nth, Nth, false, [] ).
split_is_or_not_in_list( [H|T], Nth, OutNth, Within, Pfx ) :-
Nth > 1,
!,
NxNth is Nth - 1,
Pfx = [H|TPfx],
split_is_or_not_in_list( T, NxNth, OutNth, Within, TPfx ).
split_is_or_not_in_list( [H|_T], Nth, Nth, true, [H|_] ).
% Value of OutNth doesnt matter here anyway.
% The unanymous variable in last argument is in line with one path
% proposed trailing. It should work for the current two path trailing.
/* 2005/01/14, this is fine for non nested paths.
split_on_nth( Nth, [H|T], [H|Left], Right ) :-
Nth > 1,
!,
NxNth is Nth - 1,
split_on_nth( NxNth, T, Left, Right ).
split_on_nth( _Nth, [H|Right], [H], Right ).
*/
bu_select_bp( done, _K, _Sel ) :- !.
bu_select_bp( cps(CntTh,These,CntAlts,CntAltPts,Alts), K, Sel ) :-
random( Rnd ),
(CntTh =:= 0 ->
Nth0Alt is integer( CntAlts * Rnd ),
% random( 0, CntAlts, Nth0Alt ),
nth0( Nth0Alt, Alts, RecCps )
;
Here is CntTh / (CntTh + (CntAltPts * K)),
( Rnd < Here ->
% Nth0 is integer( Rnd * Here * CntTh ),
random( 0, CntTh, Nth0 ),
nth0( Nth0, These, Sel ),
RecCps = done
;
% Nth0 is integer( (1 - Here) * CntAlts * Rnd ),
random( 0, CntAlts, Nth0 ),
nth0( Nth0, Alts, RecCps )
)
),
bu_select_bp( RecCps, K, Sel ).
/*
split_on_nth_or_earlier( Nth, [H|T], [H|Left], Right ) :-
Nth >= 1,
NxNth is Nth - 1,
split_on_nth_or_earlier( NxNth, T, Left, Right ).
split_on_nth_or_earlier( _Nth, Right, [], Right ).
*/
termination( Termin, _Jump, I ) :-
( memberchk( iter(IterLim), Termin ) ->
I >= IterLim
;
report( iter, iter(I) ),
fail
).
%
% scm_iterate( +Ids, +SGl, +MODr, +MODrKp, -MODst, -MODstKp ) :-
% for model modifier ids Ids, goal structure SGl recursively changed
% model MODr/MODrKp final recursion's MODr/MODrKp are MODst/MODstKp.
% Each modifier pinpoints a part of input MODr which will be modified.
% Modified model is stochastically compared to input model, resulting
% to one of the two being the next iteration's (input) model.
%
scm_iterate( [], _, MODst, MODstKp, MODst, MODstKp ).
scm_iterate( [Hstr|T], Prd/Args/Type, MODr, MODrKp, MODst, MODstKp ) :-
( Hstr = H-_LstA -> true; H = Hstr ),
scm_gen_vstructure( MODr, H, Vstr, ExV, RepV ),
% this is superfluous in our experiments to-date
copy_term( Args, PrvFrArgs ),
( Hstr = _Hag-LastArg ->
% last( FrArgs, LastArg )
replace_last( PrvFrArgs, LastArg, FrArgs )
;
PrvFrArgs = FrArgs
),
append( FrArgs, [Vstr], PlArgs ),
pred_type_constructs_scall( Type, Prd, _Left/_Sin, PlArgs, Slp ),
call( slp:Slp ),
( current_predicate(bims_lkl:to_model/3) ->
bims_lkl:to_model( Vstr, NxMODrPrp, NxMODrKpPrp )
;
NxMODrPrp = Vstr, NxMODrKpPrp = Vstr
),
scm_rel_likelihood( RepV, ExV, RelL ),
Alpha is min(1,RelL),
on_random( Alpha, t, t, _Rnd, Whc, _ChV ),
% bef 2007/01/03, was: on_random( Alpha, RepV, ExV, _Rnd, Whc, _ChV ),
( Whc == first -> NxMODr = NxMODrPrp, NxMODrKp = NxMODrKpPrp
; NxMODr = MODr, NxMODrKp = MODrKp ),
scm_iterate( T, Prd/Args/Type, NxMODr, NxMODrKp, MODst, MODstKp ).
replace_last( [_], Last, [Last] ) :- !.
replace_last( [H|T], Last, [H|R] ) :-
replace_last( T, Last, R ).
bims_report_progress( I ) :-
( bims_bb_get(progress,pts(Grs,F,Oth)) ->
( F =< I ->
write( user_error, Grs ),
( Oth == [] ->
nl( user_error ), bims_bb_delete(progress,_)
; Oth = [NxPrg|TlPrg],
bims_bb_put(progress,pts(Grs,NxPrg,TlPrg))
),
flush_output( user_error )
; true
)
; true
).