1
2
3:- module(hmm, [init_hmm/0,
4		  hmm_state/1,
5		  emission/1]).
6
7:- ensure_loaded(library(clpbn)).
8
9:- use_module(library(lists),
10	      [nth/3]).
11
12:- use_module(library(nbhash),
13	      [nb_hash_new/2,
14	       nb_hash_lookup/3,
15	       nb_hash_insert/3
16	      ]).
17
18:- ensure_loaded(library(tries)).
19
20:- meta_predicate hmm_state(:).
21
22:- dynamic hmm_tabled/1.
23
24:- attribute emission/1.
25
26:- ensure_loaded(library('clpbn/viterbi')).
27
28init_hmm :-
29%	retractall(hmm_tabled(_)).
30%	eraseall(hmm_tabled).
31%	nb_hash_new(hmm_table, 1000000).
32	trie_open(Trie), nb_setval(trie,Trie).
33
34hmm_state(Mod:A) :- !, hmm_state(A,Mod).
35hmm_state(A) :- prolog_flag(typein_module,Mod), hmm_state(A,Mod).
36
37hmm_state(Mod:N/A,_) :- !,
38	hmm_state(N/A,Mod).
39hmm_state((A,B),Mod) :- !,
40	hmm_state(A,Mod),
41	hmm_state(B,Mod).
42hmm_state(N/A,Mod) :-
43	atom_codes(N,[TC|_]),
44	atom_codes(T,[TC]),
45	build_args(A,LArgs,KArgs,First,Last),
46	Key =.. [T|KArgs],
47	Head =.. [N|LArgs],
48	asserta_static( (Mod:Head :-
49	        ( First > 2 ->
50		  Last = Key, !
51		;
52		  nb_getval(trie, Trie), trie_check_entry(Trie, Key, _)
53		->
54		  % leave work for solver!
55		  %
56		  Last = Key, !
57		;
58		  % first time we saw this entry
59		  nb_getval(trie, Trie), trie_put_entry(Trie, Key, _),
60		  fail
61		)
62	      )
63	      ).
64
65build_args(4,[A,B,C,D],[A,B,C],A,D).
66build_args(3,  [A,B,C],  [A,B],A,C).
67build_args(2,    [A,B],    [A],A,B).
68
69emission(V) :-
70	put_atts(V,[emission(Prob)]).
71
72cvt_vals(aminoacids,[a,  c,  d,  e,  f,  g,  h,  i,  k,  l,  m,  n,  p,  q,  r,  s,  t,  v,  w,  y]).
73cvt_vals(bool,[t,f]).
74cvt_vals(dna,[a,c,g,t]).
75cvt_vals(rna,[a,c,g,u]).
76cvt_vals([A|B],[A|B]).
77
78% first, try standard representation
79find_probs(Logs,Nth,Log) :-
80	arg(Nth,Logs,Log).
81
82
83
84