北太天元学习44-文本分析之词干提取(porter词干提取算法)

不好意思，我是从网上学习的如何处理英文的文本，如果是中文的文本，我们处理起来有方便的地方，那就是我们实际上是不需要词干提取工作，但是中文相比于英文需要一个额外的工作是分词。 他山之石，可以攻玉。

我也先简单介绍一下词干提取(stemming)和词形还原(lemmatization)。
由于语法原因，文档将使用单词的不同形式，如organize、organizes 和 organizing。此外，还有一些派生相关的单词家族具有相似的含义，如democracy, democratic, and democratization。在许多情况下，搜索其中一个单词以返回包含这个单词其他变形形式或者衍生形式的词，这个让人觉得还是很智能还有用的。

词干提取通常指的是一种粗糙的启发式过程，在大多数情况下，为了正确地实现这一目标，它会去除词的后缀。“词形还原”  不是简单地将前后缀去掉，而是会根据词典将单词进行转换。比如「drove」会转换为「drive」。不同于词干提取（stemming），词形还原后的单词不一定会出现在单词中，比如单词“ate”词形还原后的单词为“eat”。

Porter's stemming 算法可以见Porter20世纪80年代的论文，其主要关注点是删除单词的共同结尾，以便将它们解析为通用形式。他原来的代码是c语言写的，我把他移植到北太天元上。

可以把下面的代码全部copy到名字为 porterStemmer.m 的文件里，然后在北太天元使用。

%北太天元的 词干提取(Stem) 算法
% 输入参数: inString  需要是一个char mat, 需要是小些字符，
%           在调用这个函数之前，先把字符串变成小写，不然
%           不会执行词干提取操作。
% 输出参数: stem 是一个char mat, 是inString的词干
% 例如
%  cars_stem = porterStemmer('cars')
%  cleaning_stem = porterStemmer('cleaning')
    function stem = porterStemmer(inString)
/*
实现Porter-Stemming算法，如下论文所示：
Porter, 1980, An algorithm for suffix stripping, Program, Vol. 14,
no. 3, pp 130-137
原始的代码是C语言写的，可以在下面的链接处下载:
http://www.tartarus.org/~martin/PorterStemmer/c.txt

词干提取算法, 例如cleaning的词干是clean, cars 的词干是car。
*/

if (nargin ~=1)
    help porterStemmer;
    return;
end
if( ~ischar(inString) )
     error("porterStemmer(inString)的输入参数必须是单引号字符串");
end    


global j;
b = inString;
k = length(b);
k0 = 1;
j = k;



/*
使用下面if语句，长度为1或2的字符串不会执行词干提取操作。
如果想去掉这个限制，请删除此条件以匹配你的需求
*/
stem = b;
if k > 2
    % 每个步骤的输出显示被注释掉。
    %disp(sprintf('Word to stem: %s', b));
    x = step1ab(b, k, k0);
    %disp(sprintf('Steps 1A and B yield: %s', x{1}));
    x = step1c(x{1}, x{2}, k0);
    %disp(sprintf('Step 1C yields: %s', x{1}));
    x = step2(x{1}, x{2}, k0);
    %disp(sprintf('Step 2 yields: %s', x{1}));
    x = step3(x{1}, x{2}, k0);
    %disp(sprintf('Step 3 yields: %s', x{1}));
    x = step4(x{1}, x{2}, k0);
    %disp(sprintf('Step 4 yields: %s', x{1}));
    x = step5(x{1}, x{2}, k0);
    %disp(sprintf('Step 5 yields: %s', x{1}));
    stem = x{1};
end

% cons(j) 返回TRUE 当且仅当 b[j] 是个辅音
function c = cons(i, b, k0)
c = true;
switch(b(i))
    case {'a', 'e', 'i', 'o', 'u'}
        c = false;
    case 'y'    %y是个半元音，需要单独判断
        if i == k0
            c = true;
        else
            c = ~cons(i - 1, b, k0);
        end
end

% mseq() 测量k0和j之间的辅音序列的数量。如果c是辅音序列，
% v是元音序列，并且<c>表示任意多个的元音序列
% <v>表示任意多个辅音序列
%      <c><v>       gives 0
%      <c>vc<v>     gives 1
%      <c>vcvc<v>   gives 2
%      <c>vcvcvc<v> gives 3
%      ....
function n = measure(b, k0)
global j;
n = 0;
i = k0;
while true
    if i > j
        return
    end
    if ~cons(i, b, k0)
        break;
    end
    i = i + 1;
end
i = i + 1;
while true
    while true
        if i > j
            return
        end
        if cons(i, b, k0)
            break;
        end
        i = i + 1;
    end
    i = i + 1;
    n = n + 1;
    while true
        if i > j
            return
        end
        if ~cons(i, b, k0)
            break;
        end
        i = i + 1;
    end
    i = i + 1;
end


% vowelinstem() 返回 TRUE 当切仅当 k0,...j 包含元音
function vis = vowelinstem(b, k0)
global j;
for i = k0:j,
    if ~cons(i, b, k0)
        vis = true;
        return
    end
end
vis = false;

%doublec(i) is TRUE <=> i,(i-1) contain a double consonant.
function dc = doublec(i, b, k0)
if i < k0+1
    dc = false;
    return
end
if b(i) ~= b(i-1)
    dc = false;
    return
end
dc = cons(i, b, k0);


% cvc(j) is TRUE <=> j-2,j-1,j has the form consonant - vowel - consonant
% and also if the second c is not w,x or y. this is used when trying to
% restore an e at the end of a short word. e.g.
%
%      cav(e), lov(e), hop(e), crim(e), but
%      snow, box, tray.

function c1 = cvc(i, b, k0)
if ((i < (k0+2)) || ~cons(i, b, k0) || cons(i-1, b, k0) || ~cons(i-2, b, k0))
    c1 = false;
else
    if (b(i) == 'w' || b(i) == 'x' || b(i) == 'y')
        c1 = false;
        return
    end
    c1 = true;
end

% ends(s) is TRUE <=> k0,...k ends with the string s.
function s = ends(str, b, k)
global j;
if (str(length(str)) ~= b(k))
    s = false;
    return
end % tiny speed-up
if (length(str) > k)
    s = false;
    return
end
if strcmp(b(k-length(str)+1:k), str)
    s = true;
    j = k - length(str);
    return
else
    s = false;
end

% setto(s) sets (j+1),...k to the characters in the string s, readjusting
% k accordingly.

function so = setto(s, b, k)
global j;
for i = j+1:(j+length(s))
    b(i) = s(i-j);
end
if k > j+length(s)
    b((j+length(s)+1):k) = '';
end
k = length(b);
so = {b, k};

% rs(s) is used further down.
% [Note: possible null/value for r if rs is called]
function r = rs(str, b, k, k0)
r = {b, k};
if measure(b, k0) > 0
    r = setto(str, b, k);
end

% step1ab() gets rid of plurals and -ed or -ing. e.g.

%       caresses  ->  caress
%       ponies    ->  poni
%       ties      ->  ti
%       caress    ->  caress
%       cats      ->  cat

%       feed      ->  feed
%       agreed    ->  agree
%       disabled  ->  disable

%       matting   ->  mat
%       mating    ->  mate
%       meeting   ->  meet
%       milling   ->  mill
%       messing   ->  mess

%       meetings  ->  meet

function s1ab = step1ab(b, k, k0)
global j;
if b(k) == 's'
    if ends('sses', b, k)
        k = k-2;
    elseif ends('ies', b, k)
        retVal = setto('i', b, k);
        b = retVal{1};
        k = retVal{2};
    elseif (b(k-1) ~= 's')
        k = k-1;
    end
end
if ends('eed', b, k)
    if measure(b, k0) > 0;
        k = k-1;
    end
elseif (ends('ed', b, k) || ends('ing', b, k)) && vowelinstem(b, k0)
    k = j;
    % 这句话正常情况下应该计算正确的，但是这里的j是在vowelingstem(b,k0)和ends('ing',b,k)
    % 作为全局变量而被修改的，因此k=j的时候并没有使用修改之后的值。
    % 因此，我用了下面的字符串str, 然后使用eval函数重新执行了一遍，可以在北太天元上得到
    % 正确结果了。
    str = [ 'k =', num2str(j)]
    eval(str)
    retVal = {b, k};
    if ends('at', b, k)
        retVal = setto('ate', b(k0:k), k);
    elseif ends('bl', b, k)
        retVal = setto('ble', b(k0:k), k);
    elseif ends('iz', b, k)
        retVal = setto('ize', b(k0:k), k);
    elseif doublec(k, b, k0)
        retVal = {b, k-1};
        if b(retVal{2}) == 'l' || b(retVal{2}) == 's' || ...
                b(retVal{2}) == 'z'
            retVal = {retVal{1}, retVal{2}+1};
        end
    elseif measure(b, k0) == 1 && cvc(k, b, k0)
        retVal = setto('e', b(k0:k), k);
    end
    k = retVal{2};
    b = retVal{1}(k0:k);
end
j = k;
s1ab = {b(k0:k), k};

%  step1c() 当词干中有另一个元音时，将词尾y变为i。
%  playing --> play --> plai 反而是个错误，原来的c代码也是
% 有这个毛病，为了保持原汁原味，这里也没有修改这个毛病。
function s1c = step1c(b, k, k0)
global j;
if ends('y', b, k) && vowelinstem(b, k0)
    b(k) = 'i';
end
j = k;
s1c = {b, k};

% step2() maps double suffices to single ones. so -ization ( = -ize plus
% -ation) maps to -ize etc. note that the string before the suffix must give
% m() > 0.
function s2 = step2(b, k, k0)
global j;
s2 = {b, k};
switch b(k-1)
    case {'a'}
        if ends('ational', b, k); s2 = rs('ate', b, k, k0);
        elseif ends('tional', b, k); s2 = rs('tion', b, k, k0); end;
    case {'c'}
        if ends('enci', b, k); s2 = rs('ence', b, k, k0);
        elseif ends('anci', b, k); s2 = rs('ance', b, k, k0); end;
    case {'e'}
        if ends('izer', b, k); s2 = rs('ize', b, k, k0); end;
    case {'l'}
        if ends('bli', b, k); s2 = rs('ble', b, k, k0);
        elseif ends('alli', b, k); s2 = rs('al', b, k, k0);
        elseif ends('entli', b, k); s2 = rs('ent', b, k, k0);
        elseif ends('eli', b, k); s2 = rs('e', b, k, k0);
        elseif ends('ousli', b, k); s2 = rs('ous', b, k, k0); end;
    case {'o'}
        if ends('ization', b, k); s2 = rs('ize', b, k, k0);
        elseif ends('ation', b, k); s2 = rs('ate', b, k, k0);
        elseif ends('ator', b, k); s2 = rs('ate', b, k, k0); end;
    case {'s'}
        if ends('alism', b, k); s2 = rs('al', b, k, k0);
        elseif ends('iveness', b, k); s2 = rs('ive', b, k, k0);
        elseif ends('fulness', b, k); s2 = rs('ful', b, k, k0);
        elseif ends('ousness', b, k); s2 = rs('ous', b, k, k0); end;
    case {'t'}
        if ends('aliti', b, k); s2 = rs('al', b, k, k0);
        elseif ends('iviti', b, k); s2 = rs('ive', b, k, k0);
        elseif ends('biliti', b, k); s2 = rs('ble', b, k, k0); end;
    case {'g'}
        if ends('logi', b, k); s2 = rs('log', b, k, k0); end;
end
j = s2{2};

% step3() deals with -ic-, -full, -ness etc. similar strategy to step2.
function s3 = step3(b, k, k0)
global j;
s3 = {b, k};
switch b(k)
    case {'e'}
        if ends('icate', b, k); s3 = rs('ic', b, k, k0);
        elseif ends('ative', b, k); s3 = rs('', b, k, k0);
        elseif ends('alize', b, k); s3 = rs('al', b, k, k0); end;
    case {'i'}
        if ends('iciti', b, k); s3 = rs('ic', b, k, k0); end;
    case {'l'}
        if ends('ical', b, k); s3 = rs('ic', b, k, k0);
        elseif ends('ful', b, k); s3 = rs('', b, k, k0); end;
    case {'s'}
        if ends('ness', b, k); s3 = rs('', b, k, k0); end;
end
j = s3{2};

% step4() 脱去 -ant, -ence 等, 如果这些是在<c>vcvc<v>的上下文中.
function s4 = step4(b, k, k0)
global j;
switch b(k-1)
    case {'a'}
        if ends('al', b, k); end;
    case {'c'}
        if ends('ance', b, k)
        elseif ends('ence', b, k); end;
    case {'e'}
        if ends('er', b, k); end;
    case {'i'}
        if ends('ic', b, k); end;
    case {'l'}
        if ends('able', b, k)
        elseif ends('ible', b, k); end;
    case {'n'}
        if ends('ant', b, k)
        elseif ends('ement', b, k)
        elseif ends('ment', b, k)
        elseif ends('ent', b, k); end;
    case {'o'}
        if ends('ion', b, k)
            if j == 0
            elseif ~(strcmp(b(j),'s') || strcmp(b(j),'t'))
                j = k;
            end
        elseif ends('ou', b, k); end;
    case {'s'}
        if ends('ism', b, k); end;
    case {'t'}
        if ends('ate', b, k)
        elseif ends('iti', b, k); end;
    case {'u'}
        if ends('ous', b, k); end;
    case {'v'}
        if ends('ive', b, k); end;
    case {'z'}
        if ends('ize', b, k); end;
end
if measure(b, k0) > 1
    s4 = {b(k0:j), j};
else
    s4 = {b(k0:k), k};
end

% step5() 如果m（）>1，则删除最后一个-e，并且把-ll更改为-l。
function s5 = step5(b, k, k0)
global j;
j = k;
if b(k) == 'e'
    a = measure(b, k0);
    if (a > 1) || ((a == 1) && ~cvc(k-1, b, k0))
        k = k-1;
    end
end
if (b(k) == 'l') && doublec(k, b, k0) && (measure(b, k0) > 1)
    k = k-1;
end
s5 = {b(k0:k), k};