new version of viterbi implementation
fix all:atvars reporting bad info fix bad S info in x86_64 git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1968 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
b6b281684d
commit
9e9c260f7e
@ -10,8 +10,11 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2007-10-17 09:18:26 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2007-10-28 00:54:09 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.225 2007/10/17 09:18:26 vsc
|
||||
* growtrail assumed SREG meant ASP?
|
||||
*
|
||||
* Revision 1.224 2007/09/24 09:02:31 vsc
|
||||
* minor bug fixes
|
||||
*
|
||||
@ -7355,6 +7358,9 @@ Yap_absmi(int inp)
|
||||
saveregs();
|
||||
d0 = (f)();
|
||||
setregs();
|
||||
#if SHADOW_S
|
||||
SREG = Yap_REGS.S_;
|
||||
#endif
|
||||
if (!d0) {
|
||||
FAIL();
|
||||
}
|
||||
|
||||
11
C/attvar.c
11
C/attvar.c
@ -418,10 +418,16 @@ AllAttVars(attvar_record *attv) {
|
||||
return 0L;
|
||||
}
|
||||
if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) {
|
||||
if (IsVarTerm(attv->Atts) && VarOfTerm(attv->Atts) < (CELL *)attv) {
|
||||
if (IsVarTerm(attv->Atts)) {
|
||||
if (VarOfTerm(attv->Atts) < (CELL *)attv) {
|
||||
/* skip call residue(s) */
|
||||
attv = (attvar_record *)(attv->Atts);
|
||||
} else {
|
||||
continue;
|
||||
} else if (IsUnboundVar(&attv->Atts)) {
|
||||
/* ignore arena */
|
||||
continue;
|
||||
}
|
||||
}
|
||||
if (H != h0) {
|
||||
H[-1] = AbsPair(H);
|
||||
}
|
||||
@ -429,7 +435,6 @@ AllAttVars(attvar_record *attv) {
|
||||
H += 2;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (H != h0) {
|
||||
H[-1] = TermNil;
|
||||
return AbsPair(h0);
|
||||
|
||||
@ -10,8 +10,11 @@
|
||||
* File: c_interface.c *
|
||||
* comments: c_interface primitives definition *
|
||||
* *
|
||||
* Last rev: $Date: 2007-10-16 18:57:17 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2007-10-28 00:54:09 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.99 2007/10/16 18:57:17 vsc
|
||||
* get rid of debug statement.
|
||||
*
|
||||
* Revision 1.98 2007/10/15 23:48:46 vsc
|
||||
* unset var
|
||||
*
|
||||
@ -412,6 +415,38 @@ static int do_yap_putc(int streamno,wchar_t ch) {
|
||||
return(ch);
|
||||
}
|
||||
|
||||
static int
|
||||
dogc(void)
|
||||
{
|
||||
UInt arity;
|
||||
|
||||
if (P && PREVOP(P,sla)->opc == Yap_opcode(_call_usercpred)) {
|
||||
arity = PREVOP(P,sla)->u.sla.sla_u.p->ArityOfPE;
|
||||
} else {
|
||||
arity = 0;
|
||||
}
|
||||
if (!Yap_gc(arity, ENV, CP)) {
|
||||
return FALSE;
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static int
|
||||
doexpand(UInt sz)
|
||||
{
|
||||
UInt arity;
|
||||
|
||||
if (P && PREVOP(P,sla)->opc == Yap_opcode(_call_usercpred)) {
|
||||
arity = PREVOP(P,sla)->u.sla.sla_u.p->ArityOfPE;
|
||||
} else {
|
||||
arity = 0;
|
||||
}
|
||||
if (!Yap_gcl(sz, arity, ENV, CP)) {
|
||||
return FALSE;
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
X_API Term
|
||||
YAP_A(int i)
|
||||
{
|
||||
@ -539,8 +574,10 @@ YAP_MkBlobTerm(unsigned int sz)
|
||||
BACKUP_H();
|
||||
|
||||
I = AbsAppl(H);
|
||||
if (H+(sz+sizeof(MP_INT)/sizeof(CELL)+2) > ASP-1024)
|
||||
while (H+(sz+sizeof(MP_INT)/sizeof(CELL)+2) > ASP-1024) {
|
||||
if (!doexpand((sz+sizeof(MP_INT)/sizeof(CELL)+2)*sizeof(CELL)))
|
||||
return TermNil;
|
||||
}
|
||||
H[0] = (CELL)FunctorBigInt;
|
||||
dst = (MP_INT *)(H+1);
|
||||
dst->_mp_size = 0L;
|
||||
@ -1103,22 +1140,6 @@ YAP_BufferToString(char *s)
|
||||
return t;
|
||||
}
|
||||
|
||||
static int
|
||||
dogc(void)
|
||||
{
|
||||
UInt arity;
|
||||
|
||||
if (P && PREVOP(P,sla)->opc == Yap_opcode(_call_usercpred)) {
|
||||
arity = PREVOP(P,sla)->u.sla.sla_u.p->ArityOfPE;
|
||||
} else {
|
||||
arity = 0;
|
||||
}
|
||||
if (!Yap_gc(arity, ENV, CP)) {
|
||||
return FALSE;
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
/* copy a string to a buffer */
|
||||
X_API Term
|
||||
YAP_ReadBuffer(char *s, Term *tp)
|
||||
|
||||
156
C/globals.c
156
C/globals.c
@ -912,6 +912,64 @@ CopyTermToArena(Term t, Term arena, int share, UInt arity, Term *newarena, Term
|
||||
goto restart;
|
||||
}
|
||||
|
||||
static Term
|
||||
CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Term *newarena, Term init)
|
||||
{
|
||||
UInt old_size = ArenaSz(arena);
|
||||
CELL *oldH = H;
|
||||
CELL *oldHB = HB;
|
||||
CELL *oldASP = ASP;
|
||||
Term tf;
|
||||
CELL *HB0;
|
||||
Functor f = Yap_MkFunctor(Na, Nar);
|
||||
UInt i;
|
||||
|
||||
restart:
|
||||
H = HB = ArenaPt(arena);
|
||||
ASP = ArenaLimit(arena);
|
||||
HB0 = H;
|
||||
tf = AbsAppl(H);
|
||||
H[0] = (CELL)f;
|
||||
H += 1+ArityOfFunctor(f);
|
||||
if (H > ASP-128) {
|
||||
/* overflow */
|
||||
H = HB;
|
||||
CloseArena(oldH, oldHB, oldASP, newarena, old_size);
|
||||
XREGS[arity+1] = arena;
|
||||
XREGS[arity+2] = (CELL)newarena;
|
||||
{
|
||||
CELL *old_top = ArenaLimit(*newarena);
|
||||
ASP = oldASP;
|
||||
H = oldH;
|
||||
HB = oldHB;
|
||||
if (arena == GlobalArena)
|
||||
GlobalArenaOverflows++;
|
||||
if (!GrowArena(arena, old_top, old_size, Nar*sizeof(CELL), arity+2)) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, "while creating large global term");
|
||||
return 0L;
|
||||
}
|
||||
}
|
||||
oldH = H;
|
||||
oldHB = HB;
|
||||
oldASP = ASP;
|
||||
newarena = (CELL *)XREGS[arity+2];
|
||||
arena = Deref(XREGS[arity+1]);
|
||||
old_size = ArenaSz(arena);
|
||||
goto restart;
|
||||
}
|
||||
if (init == 0L) {
|
||||
for (i=1; i<=Nar; i++) {
|
||||
RESET_VARIABLE(HB0+i);
|
||||
}
|
||||
} else {
|
||||
for (i=1; i<=Nar; i++) {
|
||||
HB0[i] = init;
|
||||
}
|
||||
}
|
||||
CloseArena(oldH, oldHB, oldASP, newarena, old_size);
|
||||
return tf;
|
||||
}
|
||||
|
||||
inline static GlobalEntry *
|
||||
FindGlobalEntry(Atom at)
|
||||
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||
@ -1108,10 +1166,10 @@ p_nb_linkval(void)
|
||||
Term t = Deref(ARG1), to;
|
||||
GlobalEntry *ge;
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,t,"nb_setval");
|
||||
Yap_Error(INSTANTIATION_ERROR,t,"nb_linkval");
|
||||
return (TermNil);
|
||||
} else if (!IsAtomTerm(t)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM,t,"nb_setval");
|
||||
Yap_Error(TYPE_ERROR_ATOM,t,"nb_linkval");
|
||||
return (FALSE);
|
||||
}
|
||||
ge = GetGlobalEntry(AtomOfTerm(t));
|
||||
@ -1264,6 +1322,98 @@ p_nb_delete(void)
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_nb_create(void)
|
||||
{
|
||||
Term t = Deref(ARG1);
|
||||
Term tname = Deref(ARG2);
|
||||
Term tarity = Deref(ARG3);
|
||||
Term to;
|
||||
GlobalEntry *ge;
|
||||
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,t,"nb_create");
|
||||
return FALSE;
|
||||
} else if (!IsAtomTerm(t)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM,t,"nb_create");
|
||||
return FALSE;
|
||||
}
|
||||
ge = GetGlobalEntry(AtomOfTerm(t));
|
||||
if (!ge)
|
||||
return FALSE;
|
||||
if (IsVarTerm(tarity)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,tarity,"nb_create");
|
||||
return FALSE;
|
||||
} else if (!IsIntegerTerm(tarity)) {
|
||||
Yap_Error(TYPE_ERROR_INTEGER,tarity,"nb_create");
|
||||
return FALSE;
|
||||
}
|
||||
if (IsVarTerm(tname)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,tname,"nb_create");
|
||||
return FALSE;
|
||||
} else if (!IsAtomTerm(tname)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM,tname,"nb_create");
|
||||
return FALSE;
|
||||
}
|
||||
to = CreateTermInArena(GlobalArena, AtomOfTerm(tname), IntegerOfTerm(tarity), 3, &GlobalArena, 0L);
|
||||
if (!to)
|
||||
return FALSE;
|
||||
WRITE_LOCK(ge->GRWLock);
|
||||
ge->global=to;
|
||||
WRITE_UNLOCK(ge->GRWLock);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_nb_create2(void)
|
||||
{
|
||||
Term t = Deref(ARG1);
|
||||
Term tname = Deref(ARG2);
|
||||
Term tarity = Deref(ARG3);
|
||||
Term tinit = Deref(ARG4);
|
||||
Term to;
|
||||
GlobalEntry *ge;
|
||||
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,t,"nb_create");
|
||||
return FALSE;
|
||||
} else if (!IsAtomTerm(t)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM,t,"nb_create");
|
||||
return FALSE;
|
||||
}
|
||||
ge = GetGlobalEntry(AtomOfTerm(t));
|
||||
if (!ge)
|
||||
return FALSE;
|
||||
if (IsVarTerm(tarity)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,tarity,"nb_create");
|
||||
return FALSE;
|
||||
} else if (!IsIntegerTerm(tarity)) {
|
||||
Yap_Error(TYPE_ERROR_INTEGER,tarity,"nb_create");
|
||||
return FALSE;
|
||||
}
|
||||
if (IsVarTerm(tname)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,tname,"nb_create");
|
||||
return FALSE;
|
||||
} else if (!IsAtomTerm(tname)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM,tname,"nb_create");
|
||||
return FALSE;
|
||||
}
|
||||
if (IsVarTerm(tinit)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,tname,"nb_create");
|
||||
return FALSE;
|
||||
} else if (!IsAtomTerm(tinit)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM,tname,"nb_create");
|
||||
return FALSE;
|
||||
}
|
||||
to = CreateTermInArena(GlobalArena, AtomOfTerm(tname), IntegerOfTerm(tarity), 4, &GlobalArena, tinit);
|
||||
if (!to)
|
||||
return FALSE;
|
||||
WRITE_LOCK(ge->GRWLock);
|
||||
ge->global=to;
|
||||
WRITE_UNLOCK(ge->GRWLock);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
/* a non-backtrackable queue is a term of the form $array(Arena,Start,End,Size) plus an Arena. */
|
||||
|
||||
static Int
|
||||
@ -2403,6 +2553,8 @@ void Yap_InitGlobals(void)
|
||||
Yap_InitCPred("nb_set_shared_arg", 3, p_nb_set_shared_arg, 0L);
|
||||
Yap_InitCPred("nb_linkarg", 3, p_nb_linkarg, 0L);
|
||||
Yap_InitCPred("nb_delete", 1, p_nb_delete, 0L);
|
||||
Yap_InitCPred("nb_create", 3, p_nb_create, 0L);
|
||||
Yap_InitCPred("nb_create", 4, p_nb_create2, 0L);
|
||||
Yap_InitCPredBack("$nb_current", 1, 1, init_current_nb, cont_current_nb, SafePredFlag);
|
||||
CurrentModule = GLOBALS_MODULE;
|
||||
Yap_InitCPred("nb_queue", 1, p_nb_queue, 0L);
|
||||
|
||||
@ -58,7 +58,7 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
|
||||
if (i > 0) fprintf(Yap_stderr, ",");
|
||||
#if DEBUG
|
||||
#if COROUTINING
|
||||
/* Yap_Portray_delays = TRUE; */
|
||||
Yap_Portray_delays = TRUE;
|
||||
#endif
|
||||
#endif
|
||||
omax_depth = max_depth;
|
||||
|
||||
@ -7,6 +7,7 @@ professor_popularity(p5,l) :- {}.
|
||||
professor_popularity(p45,h) :- {}.
|
||||
professor_popularity(p15,m) :- {}.
|
||||
|
||||
:- start_low_level_trace.
|
||||
course_rating(c0, h) :- {}.
|
||||
course_rating(c1, m) :- {}.
|
||||
course_rating(c2, l) :- {}.
|
||||
|
||||
@ -2,13 +2,21 @@
|
||||
|
||||
:- module(hmm, [init_hmm/0,
|
||||
hmm_state/1,
|
||||
emission/4]).
|
||||
emission/1]).
|
||||
|
||||
:- ensure_loaded(library(clpbn)).
|
||||
|
||||
:- use_module(library(lists),
|
||||
[nth/3]).
|
||||
|
||||
:- use_module(library(nbhash),
|
||||
[nb_hash_new/2,
|
||||
nb_hash_lookup/3,
|
||||
nb_hash_insert/3
|
||||
]).
|
||||
|
||||
:- ensure_loaded(library(tries)).
|
||||
|
||||
:- meta_predicate hmm_state(:).
|
||||
|
||||
:- dynamic hmm_tabled/1.
|
||||
@ -18,7 +26,10 @@
|
||||
:- ensure_loaded(library('clpbn/viterbi')).
|
||||
|
||||
init_hmm :-
|
||||
retractall(hmm_tabled(_)).
|
||||
% retractall(hmm_tabled(_)).
|
||||
% eraseall(hmm_tabled).
|
||||
% nb_hash_new(hmm_table, 1000000).
|
||||
trie_open(Trie), nb_setval(trie,Trie).
|
||||
|
||||
hmm_state(Mod:A) :- !, hmm_state(A,Mod).
|
||||
hmm_state(A) :- prolog_flag(typein_module,Mod), hmm_state(A,Mod).
|
||||
@ -31,40 +42,35 @@ hmm_state((A,B),Mod) :- !,
|
||||
hmm_state(N/A,Mod) :-
|
||||
atom_codes(N,[TC|_]),
|
||||
atom_codes(T,[TC]),
|
||||
build_args(A,LArgs,KArgs,Last),
|
||||
build_args(A,LArgs,KArgs,First,Last),
|
||||
Key =.. [T|KArgs],
|
||||
Head =.. [N|LArgs],
|
||||
asserta_static( Mod:(Head :-
|
||||
(
|
||||
hmm:hmm_tabled(Key)
|
||||
asserta_static( (Mod:Head :-
|
||||
( First > 2 ->
|
||||
Last = Key, !
|
||||
;
|
||||
% hmm:hmm_tabled(Key)
|
||||
% nb_hash:nb_hash_lookup(hmm_table, Key, [])
|
||||
nb_getval(trie, Trie), trie_check_entry(Trie, Key, _)
|
||||
->
|
||||
% leave work for solver!
|
||||
%
|
||||
%format(' ~w~n',[Key]),
|
||||
Last = Key, !
|
||||
% clpbn:put_atts(Last,[key(Key)]), !
|
||||
;
|
||||
% first time we saw this entry
|
||||
%format('+~w~n',[Key]),
|
||||
%write(Key),nl,
|
||||
%(Key = d(30,46) -> start_low_level_trace ; stop_low_level_trace),
|
||||
assert(hmm:hmm_tabled(Key)), fail
|
||||
% assert(hmm:hmm_tabled(Key)),
|
||||
% nb_hash:nb_hash_insert(hmm_table,Key,[]),
|
||||
nb_getval(trie, Trie), trie_put_entry(Trie, Key, _),
|
||||
fail
|
||||
)
|
||||
)
|
||||
).
|
||||
|
||||
build_args(3,[A,B,C],[A,B],C).
|
||||
build_args(2,[A,B],[A],B).
|
||||
build_args(4,[A,B,C,D],[A,B,C],A,D).
|
||||
build_args(3, [A,B,C], [A,B],A,C).
|
||||
build_args(2, [A,B], [A],A,B).
|
||||
|
||||
find_var(Key,Last) :-
|
||||
array_element(hmm_tree,1,Tree),
|
||||
lookup(Key, Tree, Last).
|
||||
|
||||
|
||||
emission(Vals,CPT,Ev,V) :-
|
||||
cvt_vals(Vals,LVals),
|
||||
once(nth(Nth, LVals, Ev)),
|
||||
find_probs(CPT,Nth,Prob),
|
||||
emission(V) :-
|
||||
put_atts(V,[emission(Prob)]).
|
||||
|
||||
cvt_vals(aminoacids,[a, c, d, e, f, g, h, i, k, l, m, n, p, q, r, s, t, v, w, y]).
|
||||
|
||||
@ -1,149 +1,235 @@
|
||||
|
||||
%:- style_check(all).
|
||||
|
||||
:- module(viterbi, [viterbi/5]).
|
||||
:- module(viterbi, [viterbi/4]).
|
||||
|
||||
:- use_module(library(lists),
|
||||
[nth/3]).
|
||||
[nth/3,
|
||||
member/2]).
|
||||
|
||||
:- use_module(library(assoc)).
|
||||
|
||||
:- use_module(library(dgraphs)).
|
||||
|
||||
:- use_module(library(matrix)).
|
||||
|
||||
:- use_module(library(clpbn), []).
|
||||
|
||||
:- ensure_loaded(library('clpbn/hmm')).
|
||||
|
||||
:- use_module(library('clpbn/dists'), [
|
||||
get_dist_params/2]).
|
||||
|
||||
:- attribute prob/1, emission/1, backp/1, ancestors/1.
|
||||
:- meta_predicate viterbi(:,:,+,-).
|
||||
|
||||
|
||||
viterbi(Start,End,Trace,Ticks,Slices) :-
|
||||
viterbi(Start,End,String,Trace) :-
|
||||
init_hmm,
|
||||
Start,
|
||||
mk_graph(NOfNodes, Map, ViterbiCode),
|
||||
compile_trace(String, Emissions),
|
||||
get_id(Start, Map, SI),
|
||||
get_id(End, Map, EI),
|
||||
% add a random symbol in front (for the c/1 state).
|
||||
compiled_viterbi(NOfNodes, SI, ViterbiCode, Emissions, Dump, L),
|
||||
backtrace(Dump, EI, Map, L, Trace).
|
||||
|
||||
state_from_goal(_:Start,S) :-
|
||||
state_from_goal(Start,S).
|
||||
state_from_goal(Start,S) :-
|
||||
functor(Start, N, Ar),
|
||||
% get rid of position and random var
|
||||
NAr is Ar-2,
|
||||
functor(S, N, NAr).
|
||||
|
||||
|
||||
mk_graph(NOfNodes, Map, ViterbiCode) :-
|
||||
attributes:all_attvars(Vars0),
|
||||
group_vars_by_key_and_parents(Vars0,Ticks,Slices),
|
||||
init_viterbi(Start),
|
||||
viterbi_alg([Start|R],R),
|
||||
backtrace(Start,End,[],Trace).
|
||||
empty_assoc(KeyMap0),
|
||||
get_graph(Vars0, Nodes, Edges, KeyMap0, KeyMap),
|
||||
dgraph_new(G0),
|
||||
dgraph_add_vertices(Nodes, G0, G1),
|
||||
dgraph_add_edges(Edges, G1, G2),
|
||||
dgraph_top_sort(G2, SortedNodes),
|
||||
compile_viterbi(SortedNodes, KeyMap, NOfNodes, Map, ViterbiCode).
|
||||
|
||||
group_vars_by_key_and_parents(AVars, NTicks, Slices) :-
|
||||
NTicks1 is NTicks+2,
|
||||
functor(Hashes,slots,NTicks1),
|
||||
NSlices is Slices+2,
|
||||
build_slices(0,NTicks1,NSlices,Hashes),
|
||||
get_keys(AVars, Hashes),
|
||||
get_parents(AVars, Hashes).
|
||||
get_graph([V|Vs], [NKey|Keys], EdgesF, KeyMap0, KeyMap) :-
|
||||
clpbn:get_atts(V,[key(Key), dist(Id,Parents)]),
|
||||
( Key =.. [N,2|More] ; Key = s(0), N=s, More=[] ), !,
|
||||
NKey =.. [N|More],
|
||||
fetch_edges(Parents, NKey, EdgesF, Edges0, PKeys),
|
||||
get_emission(V, Key, EmissionProb),
|
||||
put_assoc(NKey,KeyMap0,nodeinfo(_,Id,EmissionProb,PKeys),KeyMapI),
|
||||
get_graph(Vs, Keys, Edges0, KeyMapI, KeyMap).
|
||||
get_graph([_|Vs], Keys, Edges, KeyMap0, KeyMap) :-
|
||||
get_graph(Vs, Keys, Edges, KeyMap0, KeyMap).
|
||||
get_graph([], [], [], KeyMap, KeyMap).
|
||||
|
||||
build_slices(NTicks,NTicks,_,_) :- !.
|
||||
build_slices(I0,NTicks,NSlices,Hashes) :-
|
||||
functor(Slice,slices,NSlices),
|
||||
I is I0+1,
|
||||
arg(I,Hashes,Slice),
|
||||
build_slices(I,NTicks,NSlices,Hashes).
|
||||
get_emission(V, Key, EmissionProbs) :-
|
||||
hmm:get_atts(V,[emission(_)]), !,
|
||||
user:emission_cpt(Key, EmissionProbs).
|
||||
get_emission(_, _, []).
|
||||
|
||||
get_keys([], _).
|
||||
get_keys([V|AVars], Trees) :-
|
||||
clpbn:get_atts(V, [key(K)]), !,
|
||||
arg(1,K,Time0),
|
||||
Time is Time0+1,
|
||||
arg(Time, Trees, Tree),
|
||||
make_key(K, TKey),
|
||||
arg(TKey, Tree, List),
|
||||
lookup(List, K, V),
|
||||
get_keys(AVars, Trees).
|
||||
get_keys([_|AVars], Trees) :- % may be non-CLPBN vars.
|
||||
get_keys(AVars, Trees).
|
||||
|
||||
get_parents([], _).
|
||||
get_parents([V|AVars], Trees) :-
|
||||
clpbn:get_atts(V, [dist(Id,Parents)]), !,
|
||||
%clpbn:get_atts(V, [key(K)]), format('~w (~w): ~w~n',[V,K,Parents]),
|
||||
add_parents(Parents,V,Id,Trees),
|
||||
get_parents(AVars, Trees).
|
||||
get_parents([_|AVars], Trees) :- % may be non-CLPBN vars.
|
||||
get_parents(AVars, Trees).
|
||||
|
||||
add_parents(Parents,V,Id,Trees) :-
|
||||
transform_parents(Parents,NParents,Copy,Trees),
|
||||
( var(Copy) -> true ; clpbn:put_atts(V, [dist(Id,NParents)]) ).
|
||||
|
||||
transform_parents([],[],_,_).
|
||||
transform_parents([P|Parents0],[P|NParents],Copy,Trees) :-
|
||||
var(P), !,
|
||||
inc_ancestors(P),
|
||||
transform_parents(Parents0,NParents,Copy,Trees).
|
||||
transform_parents([P|Parents0],[V|NParents],copy,Trees) :-
|
||||
arg(1,P,Time0),
|
||||
Time is Time0+1,
|
||||
arg(Time, Trees, Tree),
|
||||
make_key(P, TKey),
|
||||
arg(TKey, Tree, List),
|
||||
lookup(List, P, V),
|
||||
inc_ancestors(V),
|
||||
transform_parents(Parents0,NParents,copy,Trees).
|
||||
|
||||
inc_ancestors(P) :-
|
||||
get_atts(P,[ancestors(N)]), !,
|
||||
N1 is N+1,
|
||||
%format(' ~w->~d:~n',[P,N1]),
|
||||
put_atts(P,[ancestors(N1)]).
|
||||
inc_ancestors(P) :-
|
||||
%format(' ~w->1:~n',[P]),
|
||||
put_atts(P,[ancestors(1)]).
|
||||
|
||||
make_key(T,K) :-
|
||||
arg(2,T,I), !,
|
||||
K is I+2.
|
||||
make_key(_,1).
|
||||
|
||||
lookup(Tree, K, V) :- var(Tree), !,
|
||||
Tree = [[K|V]|_].
|
||||
lookup([[K1|V]|_],K2,V) :- K1 == K2, !.
|
||||
lookup([_|List],K,V) :-
|
||||
lookup(List,K,V).
|
||||
|
||||
|
||||
init_viterbi(V) :-
|
||||
put_atts(V,[prob(0)]).
|
||||
|
||||
viterbi_alg(L0, Lf) :- L0 == Lf, !.
|
||||
viterbi_alg([V|Vs], Rs) :-
|
||||
% format('<< ~w~n',[V]),
|
||||
% get the current status
|
||||
get_atts(V,[prob(P0)]), !,
|
||||
clpbn:get_atts(V,[dist(Id,States)]),
|
||||
get_dist_params(Id,Probs),
|
||||
% adjust to consider emission probabilities
|
||||
adjust_for_emission(V, P0, Pf),
|
||||
propagate(Probs,States,Pf,V,Rs,NRs),
|
||||
viterbi_alg(Vs,NRs).
|
||||
|
||||
adjust_for_emission(V, P0, Pf) :-
|
||||
hmm:get_atts(V,[emission(P)]), !,
|
||||
Pf is P+P0,
|
||||
put_atts(V,[prob(Pf)]).
|
||||
adjust_for_emission(_, P, P).
|
||||
|
||||
propagate([],[],_,_,Rs,Rs).
|
||||
propagate([Prob|Probs],[State|States],Pf,V,Rs,Rs0) :-
|
||||
%format(' ~w~n',[State]),
|
||||
get_atts(State,[prob(P0),ancestors(N)]), !,
|
||||
mprob(Pf,Prob,P),
|
||||
N1 is N-1,
|
||||
(P > P0 ->
|
||||
put_atts(State,[prob(P),backp(V),ancestors(N1)])
|
||||
fetch_edges([V|Parents], Key0, EdgesF, Edges0, [Slice-AKey|PKeys]) :-
|
||||
var(V), !,
|
||||
clpbn:get_atts(V,[key(Key)]),
|
||||
abstract_key(Key, AKey, Slice),
|
||||
(
|
||||
Slice < 3
|
||||
->
|
||||
EdgesF = [Key0-AKey|EdgesI]
|
||||
;
|
||||
put_atts(State,[ancestors(N1)])
|
||||
EdgesF = EdgesI
|
||||
),
|
||||
(N1 == 0 -> Rs = [State|NRs] ; Rs = NRs),
|
||||
propagate(Probs,States,Pf,V,NRs,Rs0).
|
||||
propagate([Prob|Probs],[State|States],Pf,V,Rs,Rs0) :-
|
||||
get_atts(State,[ancestors(N)]), !,
|
||||
N1 is N-1,
|
||||
mprob(Pf,Prob,P),
|
||||
put_atts(State,[prob(P),backp(V),ancestors(N1)]),
|
||||
(N1 == 0 -> Rs = [State|NRs] ; Rs = NRs),
|
||||
propagate(Probs,States,Pf,V,NRs,Rs0).
|
||||
fetch_edges(Parents, Key0, EdgesI, Edges0, PKeys).
|
||||
fetch_edges([Key|Parents], Key0, EdgesF, Edges0, [Slice-AKey|PKeys]) :-
|
||||
abstract_key(Key, AKey, Slice),
|
||||
(
|
||||
Slice < 3
|
||||
->
|
||||
EdgesF = [Key0-AKey|EdgesI]
|
||||
;
|
||||
EdgesF = EdgesI
|
||||
),
|
||||
fetch_edges(Parents, Key0, EdgesI, Edges0, PKeys).
|
||||
fetch_edges([], _, Edges, Edges, []).
|
||||
|
||||
abstract_key(Key, NKey, Slice) :-
|
||||
Key =.. [N,Slice|More],
|
||||
NKey =.. [N|More].
|
||||
|
||||
|
||||
compile_viterbi(Keys, KeyMap, Nodes, Map, ViterbiCode) :-
|
||||
enum_keys(Keys, KeyMap, 0, Nodes, Map),
|
||||
compile_keys(Keys, KeyMap, ViterbiCode).
|
||||
|
||||
% just enumerate keys
|
||||
enum_keys([], _, I, I, []).
|
||||
enum_keys([Key|Keys], KeyMap, I0, Nodes, [I0-Key|Map]) :-
|
||||
get_assoc(Key,KeyMap,nodeinfo(I0,_,_,_)),
|
||||
I is I0+1,
|
||||
enum_keys(Keys, KeyMap, I, Nodes, Map).
|
||||
|
||||
compile_keys([Key|Keys], KeyMap, ViterbiCodeF) :-
|
||||
get_assoc(Key,KeyMap,nodeinfo(IKey,Id,Emission,PKeys)),
|
||||
compile_emission(Emission,IKey,ViterbiCodeF,ViterbiCodeI),
|
||||
get_dist_params(Id,Probs),
|
||||
compile_propagation(PKeys,Probs,IKey,KeyMap,ViterbiCodeI,ViterbiCode0),
|
||||
compile_keys(Keys, KeyMap, ViterbiCode0).
|
||||
compile_keys([], _, []).
|
||||
|
||||
|
||||
% add a random symbol to the end.
|
||||
compile_emission([],_) --> !, [].
|
||||
compile_emission(EmissionTerm,IKey) --> [emit(IKey,EmissionTerm)].
|
||||
|
||||
compile_propagation([],[],_,_) --> [].
|
||||
compile_propagation([0-PKey|Ps], [Prob|Probs], IKey, KeyMap) -->
|
||||
[prop_same(IKey,Parent,Prob)],
|
||||
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
|
||||
compile_propagation(Ps, Probs, IKey, KeyMap).
|
||||
compile_propagation([2-PKey|Ps], [Prob|Probs], IKey, KeyMap) -->
|
||||
[prop_same(IKey,Parent,Prob)],
|
||||
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
|
||||
compile_propagation(Ps, Probs, IKey, KeyMap).
|
||||
compile_propagation([3-PKey|Ps], [Prob|Probs], IKey, KeyMap) -->
|
||||
[prop_next(IKey,Parent,Prob)],
|
||||
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
|
||||
compile_propagation(Ps, Probs, IKey, KeyMap).
|
||||
|
||||
get_id(_:S, Map, SI) :- !,
|
||||
get_id(S, Map, SI).
|
||||
get_id(S, Map, SI) :-
|
||||
functor(S,N,A),
|
||||
A2 is A-2,
|
||||
functor(S2,N,A2),
|
||||
once(member(SI-S2,Map)).
|
||||
|
||||
compile_trace(Trace, Emissions) :-
|
||||
user:hmm_domain(Domain),
|
||||
(atom(Domain) ->
|
||||
hmm:cvt_vals(Domain, Vals)
|
||||
;
|
||||
Vals = Domain
|
||||
),
|
||||
compile_trace(Trace, Vals, Emissions).
|
||||
|
||||
compile_trace([], _, []).
|
||||
compile_trace([El|Trace], Vals, [N|Emissions]) :-
|
||||
once(nth(N, Vals, El)),
|
||||
compile_trace(Trace, Vals, Emissions).
|
||||
|
||||
compiled_viterbi(Nodes, S, Commands, Input, Trace, L) :-
|
||||
length(Input,L),
|
||||
prolog_flag(min_tagged_integer, Min),
|
||||
matrix_new_set(ints,[Nodes], Min, Current),
|
||||
matrix_new_set(ints,[Nodes], Min, Next),
|
||||
L1 is L+1,
|
||||
matrix_new(ints,[L1,Nodes], Trace),
|
||||
matrix_set(Current, [S], 0),
|
||||
run_commands(Input, Commands, 0, Current, Next, Trace, Min).
|
||||
|
||||
|
||||
run_commands([], _, _, _, _, _, _).
|
||||
run_commands([E|Input], Commands, I, Current, Next, Trace, Min) :-
|
||||
run_code(Commands, E, I, Current, Next, Trace),
|
||||
matrix_get(Current, [32], M10),
|
||||
matrix_get(Current, [34], C),
|
||||
matrix_set_all(Current,Min),
|
||||
I1 is I+1,
|
||||
run_commands(Input, Commands, I1, Next, Current, Trace, Min).
|
||||
|
||||
run_code([], _, _, _, _, Trace).
|
||||
run_code([Inst|Input], E, I, Current, Next, Trace) :-
|
||||
run_inst(Inst, E, I, Current, Next, Trace) ,
|
||||
run_code(Input, E, I, Current, Next, Trace).
|
||||
|
||||
run_inst(emit(Id,T), E, _SP, Current, _, Trace) :-
|
||||
arg(E,T,P),
|
||||
matrix_add(Current, [Id], P).
|
||||
run_inst(prop_same(I,P,Prob), _, SP, Current, _, Trace) :-
|
||||
matrix_get(Current, [I], PI),
|
||||
NP is PI+Prob,
|
||||
matrix_get(Current, [P], P0),
|
||||
(NP > P0 ->
|
||||
matrix_set(Current, [P], NP),
|
||||
matrix_set(Trace, [SP,P], I)
|
||||
;
|
||||
true
|
||||
).
|
||||
run_inst(prop_next(I,P,Prob), _, SP, Current, Next, Trace) :-
|
||||
matrix_get(Current, [I], PI),
|
||||
NP is PI+Prob,
|
||||
matrix_get(Next, [P], P0),
|
||||
(NP > P0 ->
|
||||
matrix_set(Next, [P], NP),
|
||||
SP1 is SP+1,
|
||||
IN is -I,
|
||||
matrix_set(Trace, [SP1,P], IN)
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
backtrace(Dump, EI, Map, L, Trace) :-
|
||||
L1 is L-1,
|
||||
Pos = [L1,EI],
|
||||
matrix_get(Dump,Pos,Next),
|
||||
trace(L1,Next,Dump,Map,[],Trace).
|
||||
|
||||
trace(0,0,_,_,Trace,Trace) :- !.
|
||||
trace(L1,Next,Dump,Map,Trace0,Trace) :-
|
||||
(Next < 0 ->
|
||||
NL is L1-1,
|
||||
P is -Next
|
||||
;
|
||||
NL = L1,
|
||||
P = Next
|
||||
),
|
||||
once(member(P-AKey,Map)),
|
||||
AKey=..[N|Args],
|
||||
Key=..[N,NL|Args],
|
||||
matrix_get(Dump,[NL,P],New),
|
||||
trace(NL,New,Dump,Map,[Key|Trace0],Trace).
|
||||
|
||||
|
||||
backtrace(Start,Var,Trace,Trace) :- Start == Var, !.
|
||||
backtrace(Start,Var,Trace0,Trace) :-
|
||||
get_atts(Var,[backp(V)]),
|
||||
clpbn:get_atts(Var, [key(K)]),
|
||||
backtrace(Start,V,[K|Trace0],Trace).
|
||||
|
||||
mprob(P0,P1,Pf) :- Pf is P0+P1.
|
||||
|
||||
@ -87,6 +87,7 @@ register struct yami* P1REG asm ("bp"); /* can't use yamop before Yap.h */
|
||||
#define SHADOW_P 1
|
||||
#define SHADOW_REGS 1
|
||||
#define SHADOW_S 1
|
||||
#define S_IN_MEM 1
|
||||
#define Y_IN_MEM 1
|
||||
#define TR_IN_MEM 1
|
||||
#endif /* __x86_64__ */
|
||||
|
||||
@ -8041,8 +8041,8 @@ True when @var{Numbers} is a list of numbers, and @var{Min} is the minimum.
|
||||
@end table
|
||||
|
||||
@node matrix, MATLAB, Lists, Library
|
||||
@section MATLAB Package Interface
|
||||
@cindex Matlab Interface
|
||||
@section Matrix Library
|
||||
@cindex Matrix Library
|
||||
|
||||
This package provides a fast implementation of multi-dimensional
|
||||
matrices of integers and floats. In contrast to dynamic arrays, these
|
||||
|
||||
@ -74,10 +74,10 @@ typedef enum {
|
||||
|
||||
matrix_new(ints,Dims,Matrix) :-
|
||||
length(Dims,NDims),
|
||||
new_ints_matrix(NDims, Dims, [], Matrix).
|
||||
new_ints_matrix_set(NDims, Dims, 0, Matrix).
|
||||
matrix_new(floats,Dims,Matrix) :-
|
||||
length(Dims,NDims),
|
||||
new_float_matrix(NDims, Dims, [], Matrix).
|
||||
new_float_matrix_set(NDims, Dims, 0.0, Matrix).
|
||||
|
||||
|
||||
matrix_new(ints,Dims,Data,Matrix) :-
|
||||
|
||||
Reference in New Issue
Block a user