1/*  $Id$
2
3    Part of SWI-Prolog
4
5    Author:        Jan Wielemaker
6    E-mail:        wielemak@science.uva.nl
7    WWW:           http://www.swi-prolog.org
8    Copyright (C): 1985-2006, University of Amsterdam
9
10    This program is free software; you can redistribute it and/or
11    modify it under the terms of the GNU General Public License
12    as published by the Free Software Foundation; either version 2
13    of the License, or (at your option) any later version.
14
15    This program is distributed in the hope that it will be useful,
16    but WITHOUT ANY WARRANTY; without even the implied warranty of
17    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18    GNU General Public License for more details.
19
20    You should have received a copy of the GNU General Public
21    License along with this library; if not, write to the Free Software
22    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
23
24    As a special exception, if you link this library with other files,
25    compiled with a Free Software compiler, to produce an executable, this
26    library does not by itself cause the resulting executable to be covered
27    by the GNU General Public License. This exception does not however
28    invalidate any other reasons why the executable file might be covered by
29    the GNU General Public License.
30*/
31
32:- module(rdf_random_test,
33	  [ concur/2,			% +Threads, +Actions
34	    go/0,
35	    go/1,			% +Actions
36	    record/1,			% +Actions
37	    replay/1			% +Actions
38	  ]).
39:- asserta(user:file_search_path(foreign, '.')).
40:- use_module(rdf_db).
41:- use_module(library(thread)).
42:- use_module(library(debug)).
43
44replay_file('rnd.reply').
45
46%%	concur(+Threads:int, +Actions:int) is det.
47%
48%	Create _N_ Threads, each performing Actions using go/1.
49
50concur(1, Actions) :- !,
51	go(Actions).
52concur(Threads, Actions) :-
53	create_threads(Threads, go(Actions), Ids),
54	wait(Ids).
55
56create_threads(0, _, []) :- !.
57create_threads(N, G, [Id|T]) :-
58	thread_create(G, Id, []),
59	N2 is N - 1,
60	create_threads(N2, G, T).
61
62wait([]).
63wait([H|T]) :-
64	thread_join(H, Result),
65	(   Result == true
66	->  true
67	;   format('ERROR from ~w: ~w~n', [H, Result])
68	),
69	wait(T).
70
71%%	go is det.
72%%	go(+N) is det.
73%
74%	Perform N random operations on the database.
75
76go :-
77	go(20000).
78go(N) :-
79	nb_setval(rnd_file, none),
80	do_random(N),
81	rdf_statistics(triples(T)),
82	rdf_predicate_property(rdfs:subPropertyOf, triples(SP)),
83	format('~D triples; property hierarchy complexity: ~D~n', [T, SP]).
84
85%%	record(+N)
86%
87%	As go/1, but  record  generated  random   numbers  in  the  file
88%	specified with replay_file/1.
89
90record(N) :-
91	replay_file(File),
92	open(File, write, Out),
93	nb_setval(rnd_file, out(Out)),
94	do_random(N).
95
96%%	replay(+N)
97%
98%	Replay first N actions recorded using   record/1.  N is normally
99%	the same as used for record/1.
100
101replay(N) :-
102	replay_file(File),
103	open(File, read, In),
104	nb_setval(rnd_file, in(In)),
105	do_random(N).
106
107%%	next(-N, +Max)
108%
109%	Produce a random number 1 =< N <= Max. During record/1, write
110%	to file. Using replay/1, read from file.
111
112next(N, Max) :-
113	nb_getval(rnd_file, X),
114	(   X == none
115	->  N is random(Max)+1
116	;   X = in(Fd)
117	->  read(Fd, N)
118	;   X = out(Fd),
119	    N is random(Max)+1,
120	    format(Fd, '~q.~n', [N]),
121	    flush_output(Fd)
122	).
123
124
125%%	do_random(N) is det.
126%
127%	Take a random action on the database.
128
129do_random(N) :-
130	nb_setval(line, 1),
131	random_actions(N).
132
133random_actions(N) :-
134	MM is N mod 100,
135	(   MM = 0
136	->  rdf_statistics(triples(Triples)),
137	    debug(count, 'Count ~w, Triples ~w', [N, Triples])
138	;   true
139	),
140	next(Op, 10),
141	rans(Subject),
142	ranp(Predicate),
143	rano(Object),
144	rang(Graph),
145	do(Op, Subject, Predicate, Object, Graph),
146	N1 is N - 1,
147	(   N > 1
148	->  random_actions(N1)
149	;   true
150	).
151
152%%	do(+Operation, +Subject, +Predicate, +Object, +Graph) is det.
153%
154%	Execute an operation on Graph.
155%
156%	@tbd	Test update
157
158do(1, S, P, O, G) :-
159	debug(bug(S,P,O), 'ASSERT(~q,~q,~q,~q)', [S,P,O,G]),
160	rdf_assert(S,P,O,G).
161do(2, S, P, O, G) :-
162	debug(bug(S,P,O), 'RETRACTALL(~q,~q,~q,~q)', [S,P,O,G]),
163	rdf_retractall(S,P,O,G).
164do(3, S, _P, _O, _G) :- rdf_s(S).	% allow profiling
165do(4, S, P, _O, _G)  :- rdf_sp(S, P).
166do(5, S, _P, _O, _G) :- has_s(S).
167do(6, S, P, _O, _G)  :- has_sp(S, P).
168do(7, S, P, _O, _G)  :- reach_sp(S, P).
169do(8, _S, P, O, _G)  :- reach_po(P, O).
170do(9, _, P, _, G) :-			% add a random subproperty below me
171	repeat,
172	    ranp(P2),
173	P2 \== P, !,
174	rdf_assert(P2, rdfs:subPropertyOf, P, G),
175	debug(subPropertyOf, 'Added ~p rdfs:subPropertyOf ~p~n', [P2, P]).
176do(10, _, P, _, G) :-			% randomly delete a subproperty
177	(   rdf(_, rdfs:subPropertyOf, P)
178	->  repeat,
179	       ranp(P2),
180	    P2 \== P,
181	    rdf(P2, rdfs:subPropertyOf, P), !,
182	    debug(subPropertyOf, 'Delete ~p rdfs:subPropertyOf ~p~n', [P2, P]),
183	    rdf_retractall(P2, rdfs:subPropertyOf, P, G)
184	;   true
185	).
186
187rdf_s(S) :-
188	forall(rdf(S, _, _), true).
189rdf_sp(S, P) :-
190	forall(rdf(S, P, _), true).
191has_s(S) :-
192	forall(rdf_has(S, _, _), true).
193has_sp(S, P) :-
194	forall(rdf_has(S, P, _), true).
195reach_sp(S, P) :-
196	forall(rdf_reachable(S, P, _), true).
197reach_po(P, O) :-
198	(   atom(O)
199	->  forall(rdf_reachable(_, P, O), true)
200	;   true
201	).
202
203
204%%	rans(-Subject) is det.
205%
206%	Generate a random subject.
207
208rans(X) :-
209	next(I, 4),
210	rs(I, X).
211
212rs(1, a).
213rs(2, b).
214rs(3, c).
215rs(4, d).
216
217%%	ranp(-Predicate) is det.
218%
219%	Generate a random predicate.
220
221ranp(X) :-
222	next(I, 4),
223	rp(I, X).
224rp(1, a).
225rp(2, p1).
226rp(3, p2).
227rp(4, p3).
228
229%%	rano(-Object) is det.
230%
231%	Generate a random object.
232
233rano(X) :-
234	next(I, 13),
235	ro(I, X).
236ro(1, a).
237ro(2, b).
238ro(3, c).
239ro(4, p1).
240ro(5, literal(1)).
241ro(6, literal(hello_world)).
242ro(7, literal(bye)).
243ro(8, literal(lang(en, bye))).
244ro(9, literal(lang(nl, bye))).
245ro(10, d).
246ro(11, R) :-
247	next(I, 1000),
248	atom_concat(r, I, R).
249ro(12, literal(L)) :-
250	next(I, 1000),
251	atom_concat(l, I, L).
252ro(13, literal(lang(Lang, L))) :-
253	next(I, 1000),
254	atom_concat(l, I, L),
255	ranl(Lang).
256
257ranl(Lang) :-
258	next(I, 2),
259	rl(I, Lang).
260
261rl(1, en).
262rl(2, nl).
263
264
265%%	rang(-Graph) is det.
266%
267%	Generate a random graph.
268
269graph_count(200).
270
271rang(X:Line) :-
272	graph_count(Count),
273	next(I, Count),
274	rg(I, X),
275	Line = 1.
276%	line(Line).
277
278term_expansion(rg(x,x), Clauses) :-
279	graph_count(Count),
280	findall(rg(I,N), (between(1, Count, I), atom_concat(g,I,N)), Clauses).
281
282rg(x,x).
283
284line(Line) :-
285	nb_getval(line, Line),
286	NL is Line+1,
287	nb_setval(line, NL).
288
289