:- module(fuzzy_search,
    [
        levenshtein_dist/3,
        damerau_lev_dist/3,
        fuzzy_search/5
    ],[assertions, hiord]).

:- use_module(library(lists), [length/2, last/2]).
:- use_module(library(hiordlib), [minimum/3]).

:- doc(author, "Isabel Garcia-Contreras").

:- doc(title, "A fuzzy search and word metric library").

:- doc(summary, "@lib{fuzzy_search} is a library which provides metrics that
    measure the distances between two words. It also provides generic a
    search method for obtaining similar words given an original one.
    ").

:- doc(module, "The @lib{fuzzy_search} library provides a set of
    predicates which calculate distance between words implementing
    @href{https://en.wikipedia.org/wiki/Levenshtein_distance}{levenshtein} 
    distance and 
    @href{https://en.wikipedia.org/wiki/Damerau%E2%80%93Levenshtein_distance}
    {damerau-levenshtein} distance.

    This is a simple example:

    @begin{verbatim}

?- levenshtein_dist(append, apend, D).

D = 1 ? 

yes
?- levenshtein_dist(append, appedn, D).

D = 2 ? 

yes
?- 

?- damerau_lev_dist(length, lenght, D).

D = 1 ? 

yes
?- 
    @end{verbatim}").

:- meta_predicate fuzzy_search(?, pred(1), pred(3), ?, ?).
:- pred fuzzy_search(Word, Generator, Metric,  MaxDistance, Suggestion) :
    atom * atom * atom * num * var => atom * atom * atom * num * atom
    #"Proposes atoms generated by @var{Generator} which have 
      @var{MaxDistance} differences with @var{Word}".
fuzzy_search(Word, Generator, Metric, MaxD, X) :-
    MaxD >= 0,
    fuzzy_search_(Word, Generator, Metric, 0, MaxD, X).
    
:- meta_predicate fuzzy_search_(?, pred(1), pred(3), ?, ?, ?).
fuzzy_search_(Word, Generator, Metric, N, _, X) :-
    Generator(X),
    Metric(Word, X, Dist),
    Dist =:= N.
fuzzy_search_(Word, Generator, Metric, N, Max, X) :-
    N < Max,
    N1 is N+1,
    fuzzy_search_(Word, Generator, Metric, N1, Max, X).
    
:- pred levenshtein_dist(Word1, Word2, Distance) :
    atom * atom * var => atom * atom * num
   # "Computes the levenshtein @var{Distance} between @var{Word1} and @var{Word2}".
levenshtein_dist(W1, W2, Dist) :-
    levenshtein_matrix_ini(W1, W2, Row),
    last(Row, Dist).

sort_words(W1, W2, W1, W2) :-
    length(W1, L1),
    length(W2, L2),
    L1 < L2, !.
sort_words(W1, W2, W2, W1).

:- pred levenshtein_matrix_ini(W1, W2, Row) :
    atom * atom * var => atom * atom * list(num)
    #"Returns the last @var{Row} of the levenshtein matrix 
      of words @var{W1} and @var{W2}".

levenshtein_matrix_ini(W1, W2, Row) :-
    atom_codes(W1, Ls1),
    atom_codes(W2, Ls2),
    sort_words(Ls1, Ls2, LShort, LLong),
    length(LLong, N),
    count(N, IniRow),
    levenshtein_matrix(LLong, LShort, IniRow, 0, Row).

:- pred levenshtein_matrix(W1, W2, Prev_Row, N, Row) :
    list * list * list(num) * num * var =>
    list * list * list(num) * num * list(num)
    #"Computes the last @var{Row} of the levenshtein matrix 
       of words @var{W1}, @var{W2}".
levenshtein_matrix([], _, Prev_Row, _, Row) :- !,
    Row = Prev_Row.
levenshtein_matrix([L1|W1], W2, Prev_Row, N, Row) :-
    N1 is N+1,
    levenshtein_row(L1, W2, N1, [N|Prev_Row], NewRow),
    levenshtein_matrix(W1, W2, NewRow, N1, Row).

:- pred levenshtein_row(L1, W2, Prev_Elem, Prev_Row, New_Row) :
    list * list * num * list(num) * var =>
    list * list * num * list(num) * list(num)
    #"Computes a @var{NewRow} of a levenstein Matrix given a letter (@var{L1}), 
      the second word (@var{W2}), the previous element computed (@var{Prev_Elem}) 
      and the @var{PrevRow}".
levenshtein_row(L1, [L2|W2], Xi, [Xs, Xd|Prev_Row], [Dist|Row]) :- !,
    calculate_elem(Xs, Xd, Xi, L1, L2, Dist),
    levenshtein_row(L1, W2, Dist, [Xd|Prev_Row], Row).
levenshtein_row(_, [], _, _ , []).

calculate_elem(Xs, Xd, Xi, W1, W2, Dist) :-
    c_substitution(W1, W2, C),
    N1 is Xi+1,
    N2 is Xd+1,
    N3 is Xs+C,
    minimum([N1, N2, N3], min_nums, Dist).

min_nums(N, M) :- N @< M.

c_substitution(C, C, 0) :- !.
c_substitution(_, _, 1).

% TODO: defined somewhere else?
:- pred count(N, Lst) : num * var => num * list(num)
    #"@var{Lst} is the list of the first @var{N} naturals starting from 1".
count(N, Lst) :-
    count_(1, N, Lst).

count_(I, N, []) :-
    I > N, !.
count_(I, N, [I|L]) :-
    I1 is I+1,
    count_(I1, N, L).

% ---------------------------------------------------------------------------
:- doc(section, "Damerau-Levenshtein").

:- pred damerau_lev_dist(Word1, Word2, Distance) :
    atom * atom * var => atom * atom * num
    #"Computes the Damerau-Levenshtein @var{Distance} between @var{Word1} 
      and @var{Word2}".
damerau_lev_dist(W1, W2, Dist) :-
    damerau_lev_matrix_ini(W1, W2, Row),
    last(Row, Dist).

:- pred damerau_lev_matrix_ini(W1, W2, Row) :
    atom * atom * var => atom * atom * list(num)
    #"Returns the last @var{Row} of the damerau-levenshtein matrix 
      of words @var{W1} and @var{W2}".
%NOTE: -1 is a "letter" out of the alphabet
damerau_lev_matrix_ini(W1, W2, Row) :-
    atom_codes(W1, Ls1),
    atom_codes(W2, Ls2),
    sort_words(Ls1, Ls2, LShort, LLong),
    length(LLong, N),
    N1 is N+1,
    count(N1, IniRow),
    N2 is N1+1,
    count(N2, PrevIniRow),
    damerau_lev_matrix([-1|LLong], [-1|LShort], IniRow, PrevIniRow, 0, Row).

:- pred damerau_lev_matrix(W1, W2, Prev_Row, Prev_Row2, N, Row) :
    list * list * list(num) * list(num) * num * var =>
    list * list * list(num) * list(num) * num * list(num)
    #"Computes the last @var{Row} of the levenshtein matrix from 
      words @var{W1}, @var{W2}".

damerau_lev_matrix([_], _, Prev_Row, _, _, Row) :- !,
    Row = Prev_Row.
damerau_lev_matrix([L1_1, L1|W1], W2, Prev_Row, Prev_Row2, N, Row) :-
    N1 is N+1,
    damerau_lev_row([L1_1, L1], W2, N1, [N|Prev_Row], [N|Prev_Row2], NewRow),
    damerau_lev_matrix([L1|W1], W2, NewRow, [N|Prev_Row], N1, Row).

:- pred damerau_lev_row(L1, W2, Prev_Elem, Prev_Row, Prev_Row2, New_Row) :
    list * list * num * list(num) * list(num) * var =>
    list * list * num * list(num) * list(num) * list(num)
     #"Computes a @var{NewRow} of a levenstein Matrix given a letter (@var{L1}), 
      the second word (@var{W2}), the previous element computed (@var{Prev_Elem})
      and the @var{PrevRow}".
damerau_lev_row([L1_1,L1], [L2_1,L2|W2], Xi, [Xs,Xd|Prev_Row], [Xt|Prev_Row2], [Dist|Row]):- !,
    damerau_calculate_elem(Xs, Xd, Xi, Xt, L1, L1_1, L2, L2_1, Dist),
    damerau_lev_row([L1_1, L1], [L2| W2], Dist, [Xd|Prev_Row], Prev_Row2 ,Row).
damerau_lev_row(_, [_], _, _ , _, []).

damerau_calculate_elem(Xs, Xd, Xi, Xt, W1, W1_1, W2, W2_1, Dist) :-
    c_substitution(W1, W2, Cs),
    c_transposition(W1, W2_1, W2, W1_1, Ct),
    N1 is Xi+1,
    N2 is Xd+1,
    N3 is Xs+Cs,
    N4 is Xt+Ct,
    minimum([N1, N2, N3, N4], min_nums, Dist).

c_transposition(W1, W1, W2, W2, 1) :- !.
c_transposition(_, _, _, _, 1000000). % 1000000 should be inf

:- doc(bug, "Using 1000000 as inf limits word size to 1000000-1").
