1:-module(bot_factoids,
2 [
3 test_factoids/0,
4 test_factoids/1,
5 test_factoids/2,
6 test_factoids_parse1/0,
7 test_factoids_parse2/0,
8 foc_factoids_stream/2,
9 text_to_factoids_pos/2,
10 text_to_factoids_sents/2,
11 text_to_factoids_segs/2,
12 factoids_parse/2]). 13
14:- set_module(class(library)). 15:- set_module(base(system)). 16:- use_module(library(logicmoo_utils)). 17:- use_module(library(logicmoo_nlu/parser_penn_trees)). 18:- use_module(library(logicmoo_nlu/parser_tokenize)). 19
20:- dynamic(lmconfig:bot_py_dir/1). 21:- ignore(( \+ lmconfig:bot_py_dir(Dir), prolog_load_context(directory,Dir), assert(lmconfig:bot_py_dir(Dir)))). 22
23read_factoids_lines(In, Result):- factoids_to_w2(In, Result),!.
24
25text_to_factoids_tree(Text,LExpr):-
26 factoids_parse(Text, String),
27 nop(dmsg(factoids_parse=String)),
28 factoids_to_w2(String,LExpr),
29 nop(print_tree_nl(factoids=LExpr)),!.
30
32factoids_to_w2(Str,StrO):- var(Str),current_factoids_stream(In),!,factoids_to_w2(In,StrO).
33factoids_to_w2(Str,StrO):- string(Str),StrO=Str.
34factoids_to_w2(In, Result):- is_stream(In),!,factoids_stream_to_w2(In,_, Term),factoids_to_w2(Term, Result).
35factoids_to_w2(List,ListO):- is_list(List),!,include(compound,List,ListO).
36factoids_to_w2(factoids(_In,Text),Out):- !, factoids_to_w2(Text,Out).
37factoids_to_w2(Text,ListO):- \+ compound(Text), on_x_fail(atom_to_term(Text,Term,_)),!,factoids_to_w2(Term,ListO).
38factoids_to_w2(Text,_ListO):- \+ compound(Text), nl,writeq(Text),nl,!,fail.
39
40factoids_lexical_segs(I,O):-
41 old_into_lexical_segs(I,M),!,
42 factoids_parse_or_skip(I,S),!,
43 merge_factoids(S,M,O),!.
44
46factoids_parse_or_skip(_,[]).
47
48merge_factoids([],O,O):-!.
49merge_factoids([H|T],I,O):- !, merge_factoids(H,I,M), merge_factoids(T,M,O).
50merge_factoids(w(W,L),O,O):- member(w(W,OL),O), \+ member(factoids,OL),!,
51 ignore((member(spos(Pos),L), downcase_atom(Pos,DPos), set_pos(2,DPos,OL))),
52 nb_set_add(OL,[factoids|L]), !.
53merge_factoids(span(List),I,O):- member(span(_),List),!,
54 merge_factoids(List,I,O),!.
55merge_factoids(span(List),O,O):-
56 member(seg(S,E),List), member(span(Other),O), member(seg(S,E),Other),!,
57 nb_set_add(Other,[factoids|List]).
58merge_factoids(dep_tree(Type,R,Arg),O,O):-
59 member(w(_,Other),O),member(node(R),Other),
60 nb_set_add(Other,dep_tree(Type,R,Arg)).
61merge_factoids(_,I,I):-!.
62merge_factoids(S,I,O):- append(I,[S],O).
63
64factoids_stream_to_w2(In,_, Result):- peek_string(In,10,S),atom_contains(S,"factoids("),!,read_term(In,Term,[]),factoids_to_w2(Term, Result).
65factoids_stream_to_w2(In,S, Result):- atomic(S),atom_contains(S,"factoids("),!,read_term_from_atom_rest(In,S,Term),factoids_to_w2(Term, Result).
66factoids_stream_to_w2(In,S, Result):- atomic(S),at_end_of_stream(In),!,factoids_to_w2(S, Result).
67factoids_stream_to_w2(In,_, Result):- repeat, read_pending_codes(In,Codes,[]),
68 (Codes==[]->(sleep(0.1),fail);true),sformat(S,'~s',[Codes]),
69 factoids_stream_to_w2(In,S, Result).
70
71
72:- dynamic(tmp:existing_factoids_stream/4). 73:- volatile(tmp:existing_factoids_stream/4). 74foc_factoids_stream(Out,In):- thread_self(Self),tmp:existing_factoids_stream(Self,_,Out,In),!,clear_factoids_pending(In).
81foc_factoids_stream(Out,In):-
82 user:network_service_info(factoids,port,P4083),
83 thread_self(Self),
84 tcp_socket(Socket),
85 catch((tcp_connect(Socket, 'logicmoo.org':P4083),
86 tcp_open_socket(Socket, StreamPair)),_,fail),!,
87 StreamPair = In, StreamPair = Out,
88 set_stream(In,close_on_exec(false)),
89 set_stream(In,close_on_abort(false)),
90 set_stream(In,eof_action(eof_code)),
91 assert(tmp:existing_factoids_stream(Self,_,Out,In)),!.
92
93foc_factoids_stream(Out,In):- current_prolog_flag(python_local,true),
94 lmconfig:bot_py_dir(Dir),
95 thread_self(Self),
96 sformat(S,'python bot_factoids.py -nc -cmdloop ',[]),
97 nop(writeln(S)),
98 process_create(path(bash), ['-c', S], [ cwd(Dir), stdin(pipe(Out)),stdout(pipe(In)), stderr(null), process(FFid)]),!,
99 set_stream(In,close_on_exec(false)),
100 set_stream(Out,close_on_exec(false)),
101 set_stream(In,close_on_abort(false)),
102 set_stream(Out,close_on_abort(false)),
103 set_stream(In,eof_action(eof_code)),
104 set_stream(Out,eof_action(eof_code)),
105 sleep(1.0),
106 read_until_factoids_notice(In,"cmdloop_Ready."),!,
107 assert(tmp:existing_factoids_stream(Self,FFid,Out,In)).
108
109read_until_factoids_notice(In,Txt):- repeat,read_line_to_string(In,Str),(Str==end_of_file;atom_contains(Str,Txt)),!.
110
111current_factoids_stream(In):- thread_self(Self),tmp:existing_factoids_stream(Self,_FFid,_Out,In).
112
113clear_factoids_pending:- current_factoids_stream(In), clear_factoids_pending0(In),!.
114clear_factoids_pending(In):- nop(clear_factoids_pending0(In)).
115
116clear_factoids_pending0(In):- at_end_of_stream(In),!,dmsg(clear_factoids_pending=at_end_of_stream).
117clear_factoids_pending0(In):- read_pending_codes(In,Codes,[]),dmsg(clear_factoids_pending=Codes).
118
119tokenize_factoids_string(Text,StrO):- any_to_string(Text,Str), replace_in_string('\n',' ',Str,StrO).
124
125
126factoids_parse(Text, Lines) :-
127 tokenize_factoids_string(Text,String),
128 factoids_parse2(String, Lines).
129
130factoids_parse2(String, Lines) :-
131 once(factoids_parse3(String, Lines)
132 ;factoids_parse4(String, Lines)).
133
134try_factoids_stream(Out,Write):- once(catch((format(Out,'~w',[Write])),_,
135 (retract(tmp:existing_factoids_stream(_,_,Out,_)),fail))).
136
138factoids_parse3(_String, _Lines) :- fail,
139 foc_factoids_stream(Out,_In),
140 try_factoids_stream(Out,''),fail.
142factoids_parse3(String, Lines) :-
143 foc_factoids_stream(Out,In),
144 try_factoids_stream(Out,String),
145 try_factoids_stream(Out,'\n'),
146 flush_output(Out),
147 read_factoids_lines(In, Lines).
148
150factoids_parse4(String, Lines) :- current_prolog_flag(python_local,true),
151 lmconfig:bot_py_dir(Dir),
152 sformat(S,'python bot_factoids.py -nc ~q ',[String]),
153 nop(writeln(S)),
154 process_create(path(bash), ['-c', S], [ cwd(Dir), stdout(pipe(In))]),!,
155 read_until_factoids_notice(In,"cmdloop_Ready."),!,
156 read_factoids_lines(In, Lines).
157
158test_factoids_parse1 :-
159 String = "Can the can do the Can Can?",
160 factoids_parse3(String, Lines),
161 pprint_ecp_cmt(yellow,test_factoids_parse1=Lines).
162
163test_factoids_parse2 :-
164 Text = "Can the can do the Can Can?",
165 factoids_parse4(Text,Lines),
166 pprint_ecp_cmt(yellow,test_factoids_parse2=Lines).
167
168test_factoids_parse3 :-
169 Text = "Can the can do the Can Can?",
170 factoids_parse2(Text,Lines),
171 pprint_ecp_cmt(yellow,test_factoids_parse3=Lines).
172
173
174factoids_pos_info(Text,PosW2s,Info,LExpr):-
175 text_to_factoids_sents(Text,LExpr),
176 tree_to_lexical_segs(LExpr,SegsF),
177 segs_retain_w2(SegsF,Info,PosW2s),!.
178
179text_to_factoids_pos(Text,PosW2s):- factoids_parse(Text,PosW2s),!.
180text_to_factoids_pos(Text,PosW2s):- factoids_pos_info(Text,PosW2s0,_Info,_LExpr),guess_pretty(PosW2s0),!,PosW2s=PosW2s0.
181
182text_to_factoids_segs(Text,Segs):-
183 text_to_factoids_tree(Text,LExpr),
184 tree_to_lexical_segs(LExpr,Segs).
185
186text_to_factoids_sents(Text,Sent):-
187 text_to_factoids_segs(Text,Segs),!,
188 factoids_segs_to_sentences(Segs,Sent),!.
189
190factoids_segs_to_sentences(Segs,sentence(0,W2,Info)):-
191 segs_retain_w2(Segs,Info,W2).
192
193
194:- if( \+ getenv('keep_going','-k')). 195:- use_module(library(editline)). 196:- add_history((call(make),call(test_factoids1))). 197:- endif. 198
199baseKB:regression_test:- test_factoids(1,X),!,test_factoids(X).
200baseKB:sanity_test:- make, forall(test_factoids(1,X),test_factoids(X)).
201baseKB:feature_test:- test_factoids.
202
203test_factoids0:-
204 Txt = "PERSON1 asks : Hey , what 's going on XVAR. < p >. PERSON2 said : Not a whole lot . . < p >. PERSON2 said : I 'm looking forward to the weekend , though . . < p >. PERSON1 asks : Do you have any big plans XVAR. < p >. PERSON2 said : Yes . . < p >. PERSON2 said : I 'm going to Wrigley Field on Saturday . . < p >. PERSON1 asks : Aren 't the Cubs out of town XVAR. < p >. PERSON2 said : Yes , but there 's a big concert at Wrigley this weekend . . < p >. PERSON1 said : Oh nice . . < p >. PERSON1 asks : Who 's playing XVAR. < p >. PERSON2 said : Pearl Jam is headlining the Saturday night show . . < p >. PERSON1 said : Wow , Pearl Jam . . < p >. PERSON1 said : I remeber when I got their first CD , Ten , at the record store at Harlem and Irving Plaza . . < p >. PERSON2 said : Oh right . . < p >. PERSON2 said : I remember that record store . . < p >. PERSON1 said : It was called Rolling Stone , and they went out of business many years ago . . < p >. PERSON2 said : Oh that 's too bad . . < p >. PERSON2 said : I really loved taking the bus to Harlem and Irving and visiting that store . . < p >. PERSON1 said : Me too . . < p >. PERSON1 said : We did n't have the internet back then and had to discover new music the hard way . . < p >. PERSON2 said : Haha yes . . < p >. PERSON2 said : I remember discovering ' ' Nirvana before they got famous . . < p >. PERSON1 said : Those were the good old days . . < p >. PERSON2 said : Yes they were . . < p >. PERSON2 said : I need to dig up my old Sony disc player and pop in an old CD . . < p >. PERSON1 asks : Where did the time go XVAR. < p >. PERSON1 said : Pearl Jam is 25 years old already . . < p >. PERSON2 said : It seems like only yesterday that the grunge music movement took over . . < p >. PERSON1 said : Right . . < p >. PERSON1 said : I bet everyone at the concert will be in their forty 's . . < p >. PERSON2 said : No doubt . . < p >. PERSON2 said : Well , I hope you have a great time at the concert . . < p > .",
205 test_factoids(Txt),
206 ttyflush,writeln(('\n test_factoids0.')),!.
207
208test_factoids1:-
209 210 Txt = "The Norwegian dude lives happily in the first house.",
211 test_factoids(Txt),
212 ttyflush,writeln(('\n test_factoids1.')),!.
213test_factoids2:-
214 Txt = "Rydell used his straw to stir the foam and ice remaining at the bottom of his tall plastic cup, as though he were hoping to find a secret prize.",
215 216 test_factoids(Txt),
217 ttyflush,writeln(('\n test_factoids2.')),!.
218
219test_factoids:-
220 Txt = "Rydell was a big quiet Tennessean with a sad shy grin, cheap sunglasses, and a walkie-talkie screwed permanently into one ear.",
221 test_factoids(Txt),
222 ttyflush,writeln(('\n test_factoids.')),
223 fail.
224test_factoids:- forall(test_factoids(X),test_factoids(X)).
225
226test_1factoids(Text):-
227 format('~N?- ~p.~n',[test_factoids(Text)]),
228 text_to_factoids_tree(Text,W),
229 print_tree_nl(W),
230 !.
231test_1factoids(Text):- wdmsg(failed(test_1factoids(Text))).
232
233test_factoids(N):- number(N),!, forall(test_factoids(N,X),test_1factoids(X)).
234test_factoids(X):- test_factoids(_,X),nop(lex_info(X)).
235
236test_factoids(In,Out):- nonvar(In),var(Out),!,text_to_factoids_tree(In,Out).
237test_factoids(_,X):- nonvar(X), !, once(test_1factoids(X)).
238
239test_factoids(1,".\nThe Norwegian lives in the first house.\n.").
240test_factoids(1,"").
241test_factoids(1,".").
242test_factoids(1,"\n").
243
244test_factoids(1,"Rydell used his straw to stir the foam and ice remaining at the bottom of his tall plastic cup, as though he were hoping to find a secret prize.").
245
246test_factoids(2,Each):- test_factoids(3,Atom),atomic_list_concat(List,'\n',Atom), member(Each,List).
247
248test_factoids(3,
249'There are 5 houses with five different owners.
250 These five owners drink a certain type of beverage, smoke a certain brand of cigar and keep a certain pet.
251 No owners have the same pet, smoke the same brand of cigar or drink the same beverage.
252 The man who smokes Blends has a neighbor who drinks water.
253 A red cat fastly jumped onto the table which is in the kitchen of the house.
254 After Slitscan, Laney heard about another job from Rydell, the night security man at the Chateau.
255 Rydell was a big quiet Tennessean with a sad shy grin, cheap sunglasses, and a walkie-talkie screwed permanently into one ear.
256 Concrete beams overhead had been hand-painted to vaguely resemble blond oak.
257 The chairs, like the rest of the furniture in the Chateau\'s lobby, were oversized to the extent that whoever sat in them seemed built to a smaller scale.
258 Rydell used his straw to stir the foam and ice remaining at the bottom of his tall plastic cup, as though he were hoping to find a secret prize.
259 A book called, "A little tribute to Gibson".
260 "You look like the cat that swallowed the canary, " he said, giving her a puzzled look.').
261
262
263test_factoids(4,".
264The Brit lives in the red house.
265The Swede keeps dogs as pets.
266The Dane drinks tea.
267The green house is on the immediate left of the white house.
268The green house's owner drinks coffee.
269The owner who smokes Pall Mall rears birds.
270The owner of the yellow house smokes Dunhill.
271The owner living in the center house drinks milk.
272The Norwegian lives in the first house.
273The owner who smokes Blends lives next to the one who keeps cats.
274The owner who keeps the horse lives next to the one who smokes Dunhills.
275The owner who smokes Bluemasters drinks beer.
276The German smokes Prince.
277The Norwegian lives next to the blue house.
278The owner who smokes Blends lives next to the one who drinks water.").
279
280:- add_history(test_factoids). 281:- fixup_exports.