OS/2 Shareware BBS: 10 Tools/10-Tools.zip/sa104os2.zip/SATHR104.ZIP/SATHER/CONTRIB/HUU/PREMATCH.SA

Text File | 1994-10-25 | 6KB | 211 lines

-- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
-- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
-- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
-- the file "Doc/License" of the Sather distribution.  The license is also   --
-- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
--------> Please email comments to "[e-mail]". <----------

-- File: prestrmatch.sa
-- Author: Le van Huu ([e-mail], [e-mail]))
--*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--* FUNCTION: A simple example program for testing the class STRMATCH
--* relating to the main string matching algorithms. It prepares the text
--*    and the pattern string to be compared. The text string is read
--* from a file object while the pattern string is read from the stdin.
--* The file name of the text string is got from stdin.
--*
--*    The algorithms implemented are the naive string matcher algorithm
--*    and the Knuth-Morris-Pratt algorithm. The user can selects the
--*    algorithm to be performed using the stdin.
--* The algorithms come from
--*    Thomas H. Cormen, Charles E., Introduction to Algorithms, MIT Press,1990,
--* pp. 853-885.
--*
--* CLASSES: PATTERN,  TEXT,  FILEOPER, TEMPL_ALGTHM,  PRESTRMATCH
--*
--* RELATED FILES: strmatch.sa
--*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

class PATTERN is
    -- Pattern string class. It gets the pattern string from the stdin

     attr P:STR;                    -- The pattern string
    attr lenstr:INT;            -- length of pattern string

       create:PATTERN is
        res::= new;
        return res;
    end;

    get_own_str is
        -- Gets pattern string and calculates its lenght
        #OUT + "Input pattern string: ";
         lenstr :=0;
        P:= #IN.get_str;
        lenstr:= P.length;
    end;

    print is
        #OUT + "pattern: ";
         i:INT :=0;
        loop until!  (i=lenstr);
            #OUT + P[i];
            i := i +1;
        end;
        #OUT + "\n";
    end;

end; -- class PATTERN

--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

class TEXT is

    -- Text class. The routine "get_own_str" is redefined to read the text
    -- string from a file whose name is read from the stdin.

      attr ftext : FILE;
    attr T: STR;
    attr lenstr : INT;

    create:TEXT is
        res ::= new;
        return res;
    end;

    opentext : FILE is
        fid_text:FILE;
        fname : STR;
           fobj:FILEOPER:= #FILEOPER;

        #OUT + "text file name : ";
        fname:= #IN.get_str;
        fid_text := fobj.openfile (fname);
        if fid_text.error then
            #OUT + "Can't open file text, so ...";
        end;
        return fid_text;
    end;

    get_own_str is
        c:CHAR;

        ftext:= opentext;
        if ftext.error then
            T := "File error";
            lenstr:= 0;
        else
            lenstr := 0;
            T:=ftext.fstr.str;
            lenstr:= T.length;
        end;
    end;
end; -- class TEXT

--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
class FILEOPER is
    -- Class for common file operations. At present time it contains
    -- only the open operation.

    create:FILEOPER is
        res::=new;
        return res;
    end;
    openfile (name:STR) : FILE is
        fileid:FILE := FILE::open_for_read(name);
        return fileid;
    end;
end; -- class FILEOPER

--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

class TEMPL_ALGTHM  is
    -- Template class for dispaching the appropriate algorithm call to
    -- the class STRMATCH.

    const init_size:INT:=50;
    const NAIVE:STR := "1";
    const KMP:STR:= "2";
    const ENDARR:INT := -2;

    attr arr_shift:ARRAY{INT};

    create: TEMPL_ALGTHM is
        res ::= new;
        return res;
    end;

    dispatch (objT:TEXT, objP:PATTERN, alg : STR) is
        -- Dispatchs the call to the proper algorithm routine contained in
        -- the class STRMATCH
        -- Each algorithm routine returns an array (arr_shift) containing
        -- valid shift values, i.e., positions of text substrings
        -- that match the pattern
        i, n:INT;
        arr_shift:=#ARRAY{INT}(init_size);
        strmatch_obj:STRMATCH := #STRMATCH;

        case alg
        when NAIVE then
            arr_shift := strmatch_obj.naive (objT.T , objP.P);
            print ("Naive ", objP.P);

        when KMP then
            arr_shift := strmatch_obj.kmp (objT.T , objP.P);
            print ("KMP ", objP.P);
        else
                #OUT + "Option not implemented. Use: " + "\n";
                #OUT + "   1: Naive algorithm" + "\n";
                #OUT + "   2: KMP algorithm" + "\n";
        end;
    end;

    print (alg, pattern :STR) is
        i : INT := 0;
        loop until! (arr_shift [i] = ENDARR);
            #OUT + alg;
            #OUT + "- Strings matched at: " + arr_shift [i] + "\n";
            i:=i+1;
        end;
        #OUT + "Total occurences of \"" + pattern + "\" : " + i + "\n";
    end;
end; -- class TEMPL_ALGTHM

--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

class PRESTRMATCH is

-- A simple example program for testing the class STRMATCH
-- relating to the main string matching algorithm. It prepares the text
-- and the pattern string to be compared.

       main is
        c:CHAR;
        algorithm: STR := "";

        loop until! (algorithm = "1" or algorithm = "2");
            #OUT + "Select the algorithm. Use: " + "\n";
            #OUT + "   1: Naive algorithm" + "\n";
            #OUT + "   2: KMP algorithm" + "\n";
            algorithm := #IN.get_str;
            if (algorithm /= "1" and algorithm /= "2") then
                #OUT + "Option not implemented." + "\n";
            end;
        end;

           p:PATTERN := #PATTERN;
           t:TEXT := #TEXT;
           pre_algthm:TEMPL_ALGTHM:= #TEMPL_ALGTHM;
        -- template class for preparing the algorithm processing

        p.get_own_str;
        t.get_own_str;
        if t.lenstr = 0 or p.lenstr = 0 then
            #OUT + " can't compare null strings" + "\n";
        else
            pre_algthm.dispatch(t,p, algorithm );
        end;
   end; -- main

end; -- class PRESTRMATCH