1/*  Part of SWI-Prolog
   2
   3    Author:        Jan Wielemaker
   4    E-mail:        J.Wielemaker@vu.nl
   5    WWW:           http://www.swi-prolog.org
   6    Copyright (c)  2006-2015, University of Amsterdam
   7                              VU University Amsterdam
   8    All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module(rdf_litindex,
  37          [ rdf_set_literal_index_option/1,     % +Options
  38            rdf_tokenize_literal/2,             % +Literal, -Tokens
  39            rdf_find_literal/2,                 % +Spec, -Literal
  40            rdf_find_literals/2,                % +Spec, -ListOfLiterals
  41            rdf_token_expansions/2,             % +Spec, -Expansions
  42            rdf_stopgap_token/1,                % -Token
  43
  44            rdf_literal_index/2,                % +Type, -Index
  45            rdf_delete_literal_index/1          % +Type
  46          ]).
  47:- use_module(rdf_db).
  48:- use_module(library(debug)).
  49:- use_module(library(lists)).
  50:- use_module(library(error)).
  51:- use_module(library(apply)).
  52:- if(exists_source(library(snowball))).
  53:- use_module(library(snowball)).
  54:- else.
  55:- use_module(library(porter_stem)).
  56:- endif.
  57:- use_module(library(double_metaphone)).
  58
  59/** <module> Search literals
  60
  61This module finds literals of the RDF  database based on words, stemming
  62and _sounds like_ (metaphone).  The normal user-level predicate is
  63
  64  - rdf_find_literals/2
  65*/
  66
  67:- dynamic
  68    literal_map/2,                  % Type, -Map
  69    map_building/2,                 % Type, -Queue
  70    new_token/2,                    % Hook
  71    setting/1,
  72    stopgap/1.
  73:- volatile
  74    literal_map/2.
  75:- multifile
  76    tokenization/2,                 % +Literal, -Tokens
  77    exclude_from_index/2.           % +Which, +Token
  78
  79
  80setting(verbose(false)).                % print progress messages
  81setting(index_threads(1)).              % # threads for creating the index
  82setting(index(thread(1))).              % Use a thread for incremental updates
  83setting(stopgap_threshold(50000)).      % consider token a stopgap over N
  84
  85%!  rdf_set_literal_index_option(+Options:list)
  86%
  87%   Set options for the literal package.  Currently defined options
  88%
  89%           * verbose(Bool)
  90%           If =true=, print progress messages while building the
  91%           index tables.
  92%
  93%           * index_threads(+Count)
  94%           Number of threads to use for initial indexing of
  95%           literals
  96%
  97%           * index(+How)
  98%           How to deal with indexing new literals.  How is one of
  99%           =self= (execute in the same thread), thread(N) (execute
 100%           in N concurrent threads) or =default= (depends on number
 101%           of cores).
 102%
 103%           * stopgap_threshold(+Count)
 104%           Add a token to the dynamic stopgap set if it appears in
 105%           more than Count literals.  The default is 50,000.
 106
 107rdf_set_literal_index_option([]) :- !.
 108rdf_set_literal_index_option([H|T]) :-
 109    !,
 110    set_option(H),
 111    rdf_set_literal_index_option(T).
 112rdf_set_literal_index_option(Option) :-
 113    set_option(Option).
 114
 115set_option(Term) :-
 116    check_option(Term),
 117    functor(Term, Name, Arity),
 118    functor(General, Name, Arity),
 119    retractall(setting(General)),
 120    assert(setting(Term)).
 121
 122check_option(X) :-
 123    var(X),
 124    !,
 125    instantiation_error(X).
 126check_option(verbose(X)) :-
 127    !,
 128    must_be(boolean, X).
 129check_option(index_threads(Count)) :-
 130    !,
 131    must_be(nonneg, Count).
 132check_option(stopgap_threshold(Count)) :-
 133    !,
 134    must_be(nonneg, Count).
 135check_option(index(How)) :-
 136    !,
 137    must_be(oneof([default,thread(_),self]), How).
 138check_option(Option) :-
 139    domain_error(literal_option, Option).
 140
 141
 142                 /*******************************
 143                 *            QUERY             *
 144                 *******************************/
 145
 146%!  rdf_find_literal(+Spec, -Literal) is nondet.
 147%!  rdf_find_literals(+Spec, -Literals) is det.
 148%
 149%   Find literals in the RDF database matching Spec.  Spec is defined
 150%   as:
 151%
 152%   ==
 153%   Spec ::= and(Spec,Spec)
 154%   Spec ::= or(Spec,Spec)
 155%   Spec ::= not(Spec)
 156%   Spec ::= sounds(Like)
 157%   Spec ::= stem(Like)             % same as stem(Like, en)
 158%   Spec ::= stem(Like, Lang)
 159%   Spec ::= prefix(Prefix)
 160%   Spec ::= between(Low, High)     % Numerical between
 161%   Spec ::= ge(High)               % Numerical greater-equal
 162%   Spec ::= le(Low)                % Numerical less-equal
 163%   Spec ::= Token
 164%   ==
 165%
 166%   sounds(Like) and stem(Like) both map to  a disjunction. First we
 167%   compile the spec to normal form:   a disjunction of conjunctions
 168%   on elementary tokens. Then we execute   all the conjunctions and
 169%   generate the union using ordered-set algorithms.
 170%
 171%   Stopgaps are ignored. If the final result is only a stopgap, the
 172%   predicate fails.
 173%
 174%   @tbd Exploit ordering of numbers and allow for > N, < N, etc.
 175
 176rdf_find_literal(Spec, Literal) :-
 177    rdf_find_literals(Spec, Literals),
 178    member(Literal, Literals).
 179
 180rdf_find_literals(Spec, Literals) :-
 181    compile_spec(Spec, DNF),
 182    DNF \== @(stopgap),
 183    token_index(Map),
 184    lookup(DNF, Map, _, SuperSet),
 185    flatten(SuperSet, Set0),
 186    sort(Set0, Literals).
 187
 188%!  rdf_token_expansions(+Spec, -Extensions)
 189%
 190%   Determine which extensions of  a   token  contribute  to finding
 191%   literals.
 192
 193rdf_token_expansions(prefix(Prefix), [prefix(Prefix, Tokens)]) :-
 194    token_index(Map),
 195    rdf_keys_in_literal_map(Map, prefix(Prefix), Tokens).
 196rdf_token_expansions(sounds(Like), [sounds(Like, Tokens)]) :-
 197    metaphone_index(Map),
 198    rdf_find_literal_map(Map, [Like], Tokens).
 199rdf_token_expansions(stem(Like), [stem(Like, Tokens)]) :-
 200    stem_index(Map),
 201    rdf_find_literal_map(Map, [Like], Tokens).
 202rdf_token_expansions(Spec, Expansions) :-
 203    compile_spec(Spec, DNF),
 204    token_index(Map),
 205    lookup(DNF, Map, SCS, _),
 206    flatten(SCS, CS),
 207    sort(CS, Expansions0),
 208    join_expansions(Expansions0, Expansions).
 209
 210join_expansions([], []).
 211join_expansions([H0|T0], [H|T]) :-
 212    untag(H0, Tag, V0),
 213    Tag =.. L0,
 214    append(L0, [[V0|Values]], L1),
 215    H =.. L1,
 216    join_expansions_by_tag(T0, Tag, T1, Values),
 217    join_expansions(T1, T).
 218
 219join_expansions_by_tag([H|T0], Tag, T, [V0|VT]) :-
 220    untag(H, Tag, V0),
 221    !,
 222    join_expansions_by_tag(T0, Tag, T, VT).
 223join_expansions_by_tag(L, _, L, []).
 224
 225lookup(@(false), _, [], []) :- !.
 226lookup(or(H0,T0), Map, [CH|CT], [H|T]) :-
 227    !,
 228    lookup(H0, Map, CH, H),
 229    lookup(T0, Map, CT, T).
 230lookup(H0, Map, [C], [H]) :-
 231    lookup1(H0, Map, C, H).
 232
 233lookup1(Conj, Map, Cond, Literals) :-
 234    phrase(conj_to_list(Conj), List),
 235    !,
 236    rdf_find_literal_map(Map, List, Literals),
 237    (   Literals \== []
 238    ->  phrase(conj_to_cond(Conj), Cond)
 239    ;   Cond = []
 240    ).
 241lookup1(_, _, _, []).
 242
 243conj_to_list(and(A,B)) -->
 244    !,
 245    conj_to_list(A),
 246    conj_to_list(B).
 247conj_to_list(@(false)) -->
 248    !,
 249    {fail}.
 250conj_to_list(Tagged) -->
 251    { untag(Tagged, L) },
 252    !,
 253    [L].
 254conj_to_list(L) -->
 255    [L].
 256
 257
 258conj_to_cond(and(A,B)) -->
 259    !,
 260    conj_to_cond(A),
 261    conj_to_cond(B).
 262conj_to_cond(Tagged) -->
 263    { untag(Tagged, _) },
 264    !,
 265    [ Tagged ].
 266conj_to_cond(_) -->
 267    [].
 268
 269
 270%!  compile_spec(+Spec, -Compiled)
 271%
 272%   Compile a specification as above into disjunctive normal form
 273
 274compile_spec(Spec, DNF) :-
 275    expand_fuzzy(Spec, Spec2),
 276    nnf(Spec2, NNF),
 277    dnf(NNF, DNF).
 278
 279
 280expand_fuzzy(Var, _) :-
 281    var(Var),
 282    !,
 283    throw(error(instantiation_error, _)).
 284expand_fuzzy(sounds(Like), Or) :-
 285    !,
 286    (   atom(Like)
 287    ->  metaphone_index(Map),
 288        double_metaphone(Like, Key),
 289        rdf_find_literal_map(Map, [Key], Tokens),
 290        list_to_or(Tokens, sounds(Like), Or)
 291    ;   expand_fuzzy(Like, Or)
 292    ).
 293expand_fuzzy(stem(Like), Or) :-
 294    !,
 295    expand_fuzzy(stem(Like, en), Or).
 296expand_fuzzy(stem(Like, Lang), Or) :-
 297    !,
 298    (   atom(Like)
 299    ->  stem_index(Map),
 300        stem(Like, Lang, Key),
 301        rdf_find_literal_map(Map, [Key], Tokens),
 302        list_to_or(Tokens, stem(Like), Or)
 303    ;   expand_fuzzy(Like, Or)
 304    ).
 305expand_fuzzy(prefix(Prefix), Or) :-
 306    !,
 307    (   atom(Prefix)
 308    ->  token_index(Map),
 309        rdf_keys_in_literal_map(Map, prefix(Prefix), Tokens),
 310        list_to_or(Tokens, prefix(Prefix), Or)
 311    ;   expand_fuzzy(Prefix, Or)
 312    ).
 313expand_fuzzy(case(String), Or) :-
 314    !,
 315    (   atom(String)
 316    ->  token_index(Map),
 317        rdf_keys_in_literal_map(Map, case(String), Tokens),
 318        list_to_or(Tokens, case(String), Or)
 319    ;   expand_fuzzy(String, Or)
 320    ).
 321expand_fuzzy(or(A0, B0), E) :-
 322    !,
 323    expand_fuzzy(A0, A),
 324    expand_fuzzy(B0, B),
 325    simplify(or(A,B), E).
 326expand_fuzzy(and(A0, B0), E) :-
 327    !,
 328    expand_fuzzy(A0, A),
 329    expand_fuzzy(B0, B),
 330    simplify(and(A,B), E).
 331expand_fuzzy(not(A0), not(A)) :-
 332    !,
 333    expand_fuzzy(A0, A).
 334expand_fuzzy(between(Low, High), Or) :-
 335    !,
 336    token_index(Map),
 337    rdf_keys_in_literal_map(Map, between(Low, High), Tokens),
 338    list_to_or(Tokens, between(Low, High), Or).
 339expand_fuzzy(le(High), Or) :-
 340    !,
 341    token_index(Map),
 342    rdf_keys_in_literal_map(Map, le(High), Tokens),
 343    list_to_or(Tokens, le(High), Or).
 344expand_fuzzy(ge(Low), Or) :-
 345    !,
 346    token_index(Map),
 347    rdf_keys_in_literal_map(Map, ge(Low), Tokens),
 348    list_to_or(Tokens, ge(Low), Or).
 349expand_fuzzy(Token, Result) :-
 350    atomic(Token),
 351    !,
 352    (   rdf_stopgap_token(Token)
 353    ->  Result = @(stopgap)
 354    ;   Result = Token
 355    ).
 356expand_fuzzy(Token, _) :-
 357    throw(error(type_error(Token, boolean_expression), _)).
 358
 359simplify(Expr0, Expr) :-
 360    simple(Expr0, Expr),
 361    !.
 362simplify(Expr, Expr).
 363
 364simple(and(@(false), _), @(false)).
 365simple(and(_, @(false)), @(false)).
 366simple(and(@(stopgap), Token), Token).
 367simple(and(Token, @(stopgap)), Token).
 368simple(or(@(false), X), X).
 369simple(or(X, @(false)), X).
 370simple(or(@(stopgap), Token), Token).
 371simple(or(Token, @(stopgap)), Token).
 372
 373
 374list_to_or([], _, @(false)) :- !.
 375list_to_or([X], How, One) :-
 376    !,
 377    tag(How, X, One).
 378list_to_or([H0|T0], How, or(H, T)) :-
 379    tag(How, H0, H),
 380    list_to_or(T0, How, T).
 381
 382tag(sounds(X),    Y, sounds(X,Y)).
 383tag(stem(X),      Y, stem(X,Y)).
 384tag(prefix(X),    Y, prefix(X,Y)).
 385tag(case(X),      Y, case(X,Y)).
 386tag(between(L,H), Y, between(L,H,Y)).
 387tag(ge(L),        Y, ge(L,Y)).
 388tag(le(H),        Y, le(H,Y)).
 389
 390untag(sounds(_,Y),    Y).
 391untag(stem(_,Y),      Y).
 392untag(prefix(_,Y),    Y).
 393untag(case(_,Y),      Y).
 394untag(between(_,_,Y), Y).
 395untag(le(_,Y),        Y).
 396untag(ge(_,Y),        Y).
 397
 398untag(sounds(X,Y),    sounds(X),    Y).
 399untag(stem(X,Y),      stem(X),      Y).
 400untag(prefix(X,Y),    prefix(X),    Y).
 401untag(case(X,Y),      case(X),      Y).
 402untag(between(L,H,Y), between(L,H), Y).
 403untag(ge(L,Y),        ge(L),        Y).
 404untag(le(H,Y),        le(H),        Y).
 405
 406
 407%!  nnf(+Formula, -NNF)
 408%
 409%   Rewrite to Negative Normal Form, meaning negations only appear
 410%   around literals.
 411
 412nnf(not(not(A0)), A) :-
 413    !,
 414    nnf(A0, A).
 415nnf(not(and(A0,B0)), or(A,B)) :-
 416    !,
 417    nnf(not(A0), A),
 418    nnf(not(B0), B).
 419nnf(not(or(A0,B0)), and(A,B)) :-
 420    !,
 421    nnf(not(A0), A),
 422    nnf(not(B0), B).
 423nnf(A, A).
 424
 425
 426%!  dnf(+NNF, -DNF)
 427%
 428%   Convert a formula in NNF to Disjunctive Normal Form (DNF)
 429
 430dnf(or(A0,B0), or(A, B)) :-
 431    !,
 432    dnf(A0, A),
 433    dnf(B0, B).
 434dnf(and(A0,B0), DNF):-
 435    !,
 436    dnf(A0, A1),
 437    dnf(B0, B1),
 438    dnf1(and(A1,B1), DNF).
 439dnf(DNF, DNF).
 440
 441dnf1(and(A0, or(B,C)), or(P,Q)) :-
 442    !,
 443    dnf1(and(A0,B), P),
 444    dnf1(and(A0,C), Q).
 445dnf1(and(or(B,C), A0), or(P,Q)) :-
 446    !,
 447    dnf1(and(A0,B), P),
 448    dnf1(and(A0,C), Q).
 449dnf1(DNF, DNF).
 450
 451
 452                 /*******************************
 453                 *          TOKEN INDEX         *
 454                 *******************************/
 455
 456%!  token_index(-Map)
 457%
 458%   Get the index of tokens. If  not   present,  create one from the
 459%   current database. Once created, the map is kept up-to-date using
 460%   a monitor hook.
 461
 462token_index(Map) :-
 463    literal_map(token, Map),
 464    !,
 465    wait_for_map(token).
 466token_index(Map) :-
 467    rdf_new_literal_map(Map),
 468    assert(literal_map(token, Map)),
 469    register_token_updater,
 470    message_queue_create(Queue),
 471    assert(map_building(token, Queue)),
 472    thread_create(make_literal_index(Queue), _,
 473                  [ alias('__rdf_tokenizer'),
 474                    detached(true)
 475                  ]),
 476    wait_for_map(token).
 477
 478register_token_updater :-
 479    Monitor = [ reset,
 480                new_literal,
 481                old_literal
 482              ],
 483    (   setting(index(default))
 484    ->  create_update_literal_thread(1),
 485        rdf_monitor(thread_monitor_literal, Monitor)
 486    ;   setting(index(thread(N)))
 487    ->  create_update_literal_thread(N),
 488        rdf_monitor(thread_monitor_literal, Monitor)
 489    ;   rdf_monitor(monitor_literal, Monitor)
 490    ).
 491
 492make_literal_index(Queue) :-
 493    call_cleanup(
 494        make_literal_index,
 495        ( message_queue_destroy(Queue),
 496          retractall(map_building(token, _)))).
 497
 498%!  make_literal_index
 499%
 500%   Create the initial literal index.
 501
 502make_literal_index :-
 503    setting(index_threads(N)),
 504    !,
 505    threaded_literal_index(N),
 506    verbose('~N', []).
 507make_literal_index :-
 508    current_prolog_flag(cpu_count, X),
 509    threaded_literal_index(X),
 510    verbose('~N', []).
 511
 512threaded_literal_index(N) :-
 513    N > 1,
 514    !,
 515    message_queue_create(Q, [max_size(1000)]),
 516    create_index_threads(N, Q, Ids),
 517    forall(rdf_current_literal(Literal),
 518           thread_send_message(Q, Literal)),
 519    forall(between(1, N, _),
 520           thread_send_message(Q, done(true))),
 521    maplist(thread_join, Ids, _).
 522threaded_literal_index(_) :-
 523    forall(rdf_current_literal(Literal),
 524           register_literal(Literal)).
 525
 526create_index_threads(N, Q, [Id|T]) :-
 527    N > 0,
 528    !,
 529    thread_create(index_worker(Q), Id, []),
 530    N2 is N - 1,
 531    create_index_threads(N2, Q, T).
 532create_index_threads(_, _, []) :- !.
 533
 534index_worker(Queue) :-
 535    repeat,
 536        thread_get_message(Queue, Msg),
 537        work(Msg).
 538
 539work(done(true)) :- !.
 540work(Literal) :-
 541    register_literal(Literal),
 542    fail.
 543
 544
 545%!  clean_token_index
 546%
 547%   Clean after a reset.
 548
 549clean_token_index :-
 550    forall(literal_map(_, Map),
 551           rdf_reset_literal_map(Map)),
 552    retractall(stopgap(_)).
 553
 554%!  rdf_delete_literal_index(+Type)
 555%
 556%   Fully delete a literal index
 557
 558rdf_delete_literal_index(Type) :-
 559    must_be(atom, Type),
 560    (   retract(literal_map(Type, Map))
 561    ->  rdf_reset_literal_map(Map)          % destroy is unsafe
 562    ).
 563
 564                 /*******************************
 565                 *        THREADED UPDATE       *
 566                 *******************************/
 567
 568%!  create_update_literal_thread(+Threads)
 569%
 570%   Setup literal monitoring using threads.  While loading databases
 571%   through rdf_attach_db/2 from  rdf_persistency.pl,   most  of the
 572%   time is spent updating the literal token database. While loading
 573%   the RDF triples, most of the time   is spend in updating the AVL
 574%   tree holding the literals. Updating  the   token  index hangs on
 575%   updating the AVL trees holding the   tokens.  Both tasks however
 576%   can run concurrently.
 577
 578create_update_literal_thread(Threads) :-
 579    message_queue_create(_,
 580                         [ alias(rdf_literal_monitor_queue),
 581                           max_size(50000)
 582                         ]),
 583    forall(between(1, Threads, _),
 584           create_index_worker(initial)).
 585
 586:- dynamic
 587    index_worker_id/1,
 588    extra_worker_count/1.
 589
 590create_index_worker(Status) :-
 591    (   retract(index_worker_id(Id0))
 592    ->  true
 593    ;   Id0 = 1
 594    ),
 595    succ(Id0, Id1),
 596    assertz(index_worker_id(Id1)),
 597    atom_concat(rdf_literal_monitor_, Id0, Alias),
 598    inc_extra_worker_count(Status),
 599    thread_create(monitor_literals(Status), _,
 600                  [ alias(Alias)
 601                  ]).
 602
 603monitor_literals(initial) :-
 604    set_prolog_flag(agc_margin, 0), % we don't create garbage
 605    repeat,
 606        thread_get_message(rdf_literal_monitor_queue, Literal),
 607        register_literal(Literal),
 608    fail.
 609monitor_literals(extra) :-
 610    set_prolog_flag(agc_margin, 0),
 611    repeat,
 612        (   thread_get_message(rdf_literal_monitor_queue, Literal,
 613                               [ timeout(1)
 614                               ])
 615        ->  register_literal(Literal),
 616            fail
 617        ;   !
 618        ),
 619    with_mutex(create_index_worker, dec_extra_worker_count),
 620    thread_self(Me),
 621    thread_detach(Me).
 622
 623thread_monitor_literal(new_literal(Literal)) :-
 624    !,
 625    thread_send_message(rdf_literal_monitor_queue, Literal).
 626thread_monitor_literal(Action) :-
 627    !,
 628    monitor_literal(Action).
 629
 630%!  check_index_workers(+Queue, +Keys)
 631%
 632%   Increase the number of workers indexing   literals sent to Queue
 633%   if the queue gets overful.
 634
 635check_index_workers(Alias, Keys) :-
 636    max_extra_workers(Max),
 637    Max > 0,
 638    message_queue_property(Queue, alias(Alias)),
 639    message_queue_property(Queue, size(Size)),
 640    Size > 10000,
 641    \+ ( extra_worker_count(Extra),
 642         Extra >= Max
 643       ),
 644    !,
 645    debug(rdf_litindex,
 646          'Creating extra literal indexer (Queue=~D, Keys=~D)',
 647          [Size, Keys]),
 648    with_mutex(create_index_worker, create_index_worker(extra)).
 649check_index_workers(_, _).
 650
 651inc_extra_worker_count(extra) :-
 652    !,
 653    (   retract(extra_worker_count(C0))
 654    ->  C is C0+1
 655    ;   C = 1
 656    ),
 657    asserta(extra_worker_count(C)).
 658inc_extra_worker_count(_).
 659
 660dec_extra_worker_count :-
 661    retract(extra_worker_count(C0)),
 662    !,
 663    C is C0-1,
 664    asserta(extra_worker_count(C)).
 665dec_extra_worker_count.
 666
 667max_extra_workers(Max) :-
 668    current_prolog_flag(cpu_count, Count),
 669    Max is Count//2.
 670
 671
 672                 /*******************************
 673                 *       MONITORED UPDATE       *
 674                 *******************************/
 675
 676monitor_literal(new_literal(Literal)) :-
 677    register_literal(Literal).
 678monitor_literal(old_literal(Literal)) :-
 679    unregister_literal(Literal).
 680monitor_literal(transaction(begin, reset)) :-
 681    rdf_monitor(monitor_literal, [-old_literal]),
 682    clean_token_index.
 683monitor_literal(transaction(end, reset)) :-
 684    rdf_monitor(monitor_literal, [+old_literal]).
 685
 686%!  register_literal(+Literal)
 687%
 688%   Associate the tokens of a literal with the literal itself.
 689
 690register_literal(Literal) :-
 691    (   rdf_tokenize_literal(Literal, Tokens0)
 692    ->  sort(Tokens0, Tokens),
 693        text_of(Literal, Lang, Text),
 694        literal_map(token, Map),
 695        add_tokens(Tokens, Lang, Text, Map)
 696    ;   true
 697    ).
 698
 699add_tokens([], _, _, _).
 700add_tokens([H|T], Lang, Literal, Map) :-
 701    rdf_insert_literal_map(Map, H, Literal, Keys),
 702    (   var(Keys)
 703    ->  (   rdf_keys_in_literal_map(Map, key(H), Count),
 704            setting(stopgap_threshold(Threshold)),
 705            Count > Threshold
 706        ->  assert(stopgap(H)),
 707            rdf_delete_literal_map(Map, H)
 708        ;   true
 709        )
 710    ;   forall(new_token(H, Lang), true),
 711        (   Keys mod 1000 =:= 0
 712        ->  progress(Map, 'Tokens'),
 713            (   Keys mod 10000 =:= 0
 714            ->  check_index_workers(rdf_literal_monitor_queue, Keys)
 715            ;   true
 716            )
 717        ;   true
 718        )
 719    ),
 720    add_tokens(T, Lang, Literal, Map).
 721
 722
 723%!  unregister_literal(+Literal)
 724%
 725%   Literal is removed from the database.   As we abstract from lang
 726%   and type qualifiers we first have to  check this is the last one
 727%   that is destroyed.
 728
 729unregister_literal(Literal) :-
 730    text_of(Literal, _Lang, Text),
 731    (   rdf(_,_,literal(Text))
 732    ->  true                        % still something left
 733    ;   rdf_tokenize_literal(Literal, Tokens0),
 734        sort(Tokens0, Tokens),
 735        literal_map(token, Map),
 736        del_tokens(Tokens, Text, Map)
 737    ).
 738
 739del_tokens([], _, _).
 740del_tokens([H|T], Literal, Map) :-
 741    rdf_delete_literal_map(Map, H, Literal),
 742    del_tokens(T, Literal, Map).
 743
 744
 745%!  rdf_tokenize_literal(+Literal, -Tokens) is semidet.
 746%
 747%   Tokenize a literal. We make  this   hookable  as tokenization is
 748%   generally domain dependent.
 749
 750rdf_tokenize_literal(Literal, Tokens) :-
 751    tokenization(Literal, Tokens),
 752    !.               % Hook
 753rdf_tokenize_literal(Literal, Tokens) :-
 754    text_of(Literal, _Lang, Text),
 755    atom(Text),
 756    tokenize_atom(Text, Tokens0),
 757    select_tokens(Tokens0, Tokens).
 758
 759select_tokens([], []).
 760select_tokens([H|T0], T) :-
 761    (   exclude_from_index(token, H)
 762    ->  select_tokens(T0, T)
 763    ;   number(H)
 764    ->  (   integer(H),
 765            between(-1073741824, 1073741823, H)
 766        ->  T = [H|T1],
 767            select_tokens(T0, T1)
 768        ;   select_tokens(T0, T)
 769        )
 770    ;   atom_length(H, 1)
 771    ->  select_tokens(T0, T)
 772    ;   default_stopgap(H)
 773    ->  select_tokens(T0, T)
 774    ;   stopgap(H)
 775    ->  select_tokens(T0, T)
 776    ;   T = [H|T1],
 777        select_tokens(T0, T1)
 778    ).
 779
 780%!  rdf_stopgap_token(-Token) is nondet.
 781%
 782%   True when Token is a stopgap  token. Currently, this implies one
 783%   of:
 784%
 785%     - exclude_from_index(token, Token) is true
 786%     - default_stopgap(Token) is true
 787%     - Token is an atom of length 1
 788%     - Token was added to the dynamic stopgap token set because
 789%       it appeared in more than _stopgap_threshold_ literals.
 790
 791rdf_stopgap_token(Token) :-
 792    (   var(Token)
 793    ->  rdf_stopgap_token2(Token)
 794    ;   rdf_stopgap_token2(Token), !
 795    ).
 796
 797rdf_stopgap_token2(Token) :-
 798    exclude_from_index(token, Token).
 799rdf_stopgap_token2(Token) :-
 800    default_stopgap(Token).
 801rdf_stopgap_token2(Token) :-
 802    atom(Token),
 803    atom_length(Token, 1).
 804rdf_stopgap_token2(Token) :-
 805    stopgap(Token).
 806
 807%!  default_stopgap(?Token)
 808%
 809%   Tokens we do not wish to index,   as  they creat huge amounts of
 810%   data with little or no value.  Is   there  a more general way to
 811%   describe this? Experience shows that simply  word count is not a
 812%   good criterium as it often rules out popular domain terms.
 813
 814default_stopgap(and).
 815default_stopgap(an).
 816default_stopgap(or).
 817default_stopgap(of).
 818default_stopgap(on).
 819default_stopgap(in).
 820default_stopgap(this).
 821default_stopgap(the).
 822
 823
 824%!  text_of(+LiteralArg, -Lang, -Text) is semidet.
 825%
 826%   Get the textual  or  (integer)   numerical  information  from  a
 827%   literal value. Lang  is  the  language   to  use  for  stemming.
 828%   Currently we use English for untyped  plain literals or literals
 829%   typed xsd:string. Formally, these should not be tokenized, but a
 830%   lot of data out there does not tag strings with their language.
 831
 832text_of(type(xsd:string, Text), en, Text) :- !.
 833text_of(type(_, Text), -, Text) :- !.
 834text_of(lang(Lang, Text), Lang, Text) :- !.
 835text_of(Text, en, Text) :- atom(Text), !.
 836text_of(Text, -, Text) :- integer(Text).
 837
 838
 839                 /*******************************
 840                 *         STEM INDEX           *
 841                 *******************************/
 842
 843%!  stem_index(-Map) is det.
 844%
 845%   Get the stemming literal index. This index is created on demand.
 846%   If some thread is creating the index, other threads wait for its
 847%   completion.
 848
 849stem_index(Map) :-
 850    literal_map(stem, Map),
 851    !,
 852    wait_for_map(stem).
 853stem_index(Map) :-
 854    rdf_new_literal_map(Map),
 855    assert(literal_map(stem, Map)),
 856    assert((new_token(Token, Lang) :- add_stem(Token, Lang, Map))),
 857    message_queue_create(Queue),
 858    assert(map_building(stem, Queue)),
 859    thread_create(fill_stem_index(Map, Queue), _,
 860                  [ alias('__rdf_stemmer'),
 861                    detached(true)
 862                  ]),
 863    wait_for_map(stem).
 864
 865wait_for_map(MapName) :-
 866    (   map_building(MapName, Queue)
 867    ->  catch(thread_get_message(Queue, _), _, true),
 868        wait_for_map(MapName)
 869    ;   true
 870    ).
 871
 872fill_stem_index(StemMap, Queue) :-
 873    call_cleanup(
 874        forall(rdf_current_literal(Literal),
 875               stem_literal_tokens(Literal, StemMap)),
 876        ( message_queue_destroy(Queue),
 877          retractall(map_building(stem, _)))).
 878
 879stem_literal_tokens(Literal, StemMap) :-
 880    rdf_tokenize_literal(Literal, Tokens),
 881    !,
 882    sort(Tokens, Tokens1),
 883    text_of(Literal, Lang, _Text),
 884    insert_tokens_stem(Tokens1, Lang, StemMap).
 885stem_literal_tokens(_,_).
 886
 887insert_tokens_stem([], _, _).
 888insert_tokens_stem([Token|T], Lang, Map) :-
 889    (   atom(Token)
 890    ->  (   stem(Token, Lang, Stem)
 891        ->  rdf_insert_literal_map(Map, Stem, Token, Keys),
 892            (   integer(Keys),
 893                Keys mod 1000 =:= 0
 894            ->  progress(Map, 'Stem')
 895            ;   true
 896            )
 897        ;   true
 898        )
 899    ;   true
 900    ),
 901    insert_tokens_stem(T, Lang, Map).
 902
 903
 904add_stem(Token, Lang, Map) :-
 905    stem(Lang, Token, Stem),
 906    rdf_insert_literal_map(Map, Stem, Token, _).
 907
 908:- if(current_predicate(snowball/3)).
 909stem(Token, LangSpec, Stem) :-
 910    main_lang(LangSpec, Lang),
 911    downcase_atom(Token, Lower),
 912    catch(snowball(Lang, Lower, Stem), _, fail).
 913:- else.
 914stem(Token, _Lang, Stem) :-
 915    downcase_atom(Token, Lower),
 916    porter_stem(Lower, Stem).
 917:- endif.
 918
 919main_lang(LangSpec, Lang) :-
 920    sub_atom(LangSpec, Before, _, _, -),
 921    !,
 922    sub_atom(LangSpec, 0, Before, _, Lang).
 923main_lang(LangSpec, Lang) :-
 924    downcase_atom(LangSpec, Lang).
 925
 926
 927                 /*******************************
 928                 *        METAPHONE INDEX       *
 929                 *******************************/
 930
 931
 932metaphone_index(Map) :-
 933    literal_map(metaphone, Map),
 934    !,
 935    wait_for_map(metaphone).
 936metaphone_index(Map) :-
 937    rdf_new_literal_map(Map),
 938    assert(literal_map(metaphone, Map)),
 939    assert((new_token(Token, Lang) :- add_metaphone(Token, Lang, Map))),
 940    message_queue_create(Queue),
 941    assert(map_building(metaphone, Queue)),
 942    thread_create(fill_metaphone_index(Map, Queue), _,
 943                  [ alias('__rdf_metaphone_indexer'),
 944                    detached(true)
 945                  ]),
 946    wait_for_map(metaphone).
 947
 948fill_metaphone_index(MetaphoneMap, Queue) :-
 949    call_cleanup(
 950        fill_metaphone_index(MetaphoneMap),
 951        ( message_queue_destroy(Queue),
 952          retractall(map_building(metaphone, _)))).
 953
 954fill_metaphone_index(MetaphoneMap) :-
 955    token_index(TokenMap),
 956    rdf_keys_in_literal_map(TokenMap, all, Tokens),
 957    metaphone(Tokens, MetaphoneMap).
 958
 959metaphone([], _).
 960metaphone([Token|T], Map) :-
 961    (   atom(Token),
 962        double_metaphone(Token, SoundEx)
 963    ->  rdf_insert_literal_map(Map, SoundEx, Token, Keys),
 964        (   integer(Keys),
 965            Keys mod 1000 =:= 0
 966        ->  progress(Map, 'Metaphone')
 967        ;   true
 968        )
 969    ;   true
 970    ),
 971    metaphone(T, Map).
 972
 973
 974add_metaphone(Token, _Lang, Map) :-
 975    atom(Token),
 976    !,
 977    double_metaphone(Token, SoundEx),
 978    rdf_insert_literal_map(Map, SoundEx, Token).
 979add_metaphone(_, _, _).
 980
 981%!  rdf_literal_index(+Type, -Index) is det.
 982%
 983%   True when Index is a literal map   containing the index of Type.
 984%   Type is one of:
 985%
 986%     - token
 987%     Tokens are basically words of literal values. See
 988%     rdf_tokenize_literal/2.  The `token` map maps tokens to full
 989%     literal texts.
 990%     - stem
 991%     Index of stemmed tokens.  If the language is available, the
 992%     tokens are stemmed using the matching _snowball_ stemmer.
 993%     The `stem` map maps stemmed to full tokens.
 994%     - metaphone
 995%     Phonetic index of tokens.  The `metaphone` map maps phonetic
 996%     keys to tokens.
 997
 998rdf_literal_index(token, Map) :-
 999    !,
1000    token_index(Map).
1001rdf_literal_index(stem, Map) :-
1002    !,
1003    stem_index(Map).
1004rdf_literal_index(metaphone, Map) :-
1005    !,
1006    metaphone_index(Map).
1007rdf_literal_index(Type, _Map) :-
1008    domain_error(literal_index, Type).
1009
1010
1011                 /*******************************
1012                 *             UTIL             *
1013                 *******************************/
1014
1015verbose(Fmt, Args) :-
1016    setting(verbose(true)),
1017    !,
1018    format(user_error, Fmt, Args).
1019verbose(_, _).
1020
1021progress(Map, Which) :-
1022    setting(verbose(true)),
1023    !,
1024    rdf_statistics_literal_map(Map, size(Keys, Values)),
1025    format(user_error,
1026           '\r~t~w: ~12|Keys: ~t~D~15+; Values: ~t~D~20+',
1027           [Which, Keys, Values]).
1028progress(_,_).