I got this from some other pick source and modified it a bit.

*<PROGRAM.TYPE>UTILITY</PROGRAM.TYPE><LANGUAGE.CONVERT>NO</LANGUAGE.CONVERT><ROLL.TO.DEAD.CODE>NO</ROLL.TO.DEAD.CODE>
$BASICTYPE 'U'
SUBROUTINE GBH.STRING.DISTANCES( SOURCE.STRING, TARGET.STRING, 
CASE.INSENSITIVE, DISTANCE, MISC.IN.OUT, ERROR.MSG )
*<com>-----------------------------------------------------------------
* Written By : George Hammerle                    Date :
*
* Purpose : Determine the number of permutations needed to make the source
*           string match the target string. A permutation may be a 
*           substitution, addition, or deletion of a character. This
*           programs uses Levenshtein's distance algorithm for string 
*           comparisons.
*
* Send In  : SOURCE.STRING
*            TARGET.STRING
*            CASE.INSENSITIVE    1 or 0    
*            MISC.IN.OUT  - future use
*
* Send Out : DISTANCE
*            MISC.IN.OUT - future use
*            ERROR.MSG
*
* Modifications :
*
*</com>----------------------------------------------------------------

MISC.IN.OUT = ''
ERROR.MSG = ''

TESTING = 0
IF @LOGNAME = 'zhammerl' THEN
  TESTING = 1
END
IF TESTING THEN
  CASE.INSENSITIVE = 1
  SOURCE.STRING = "GUMBO"
  TARGET.STRING = "GUMBO"
  TARGET.STRING = "xyz"
  TARGET.STRING = 'OBMUG'
  TARGET.STRING = "GAMBOL"
  TARGET.STRING = 'gumbo'
  TARGET.STRING = 'gambol'
END

IF CASE.INSENSITIVE THEN
  SOURCE.STRING = UPCASE(SOURCE.STRING)
  TARGET.STRING = UPCASE(TARGET.STRING)
END


IF SOURCE.STRING = TARGET.STRING THEN
  DISTANCE = 0
  RETURN
END

LEN.SOURCE = LEN(SOURCE.STRING)
LEN.TARGET = LEN(TARGET.STRING)

IF LEN.SOURCE = 0 THEN
  DISTANCE = LEN.TARGET
  RETURN
END

IF LEN.TARGET = 0 THEN
  DISTANCE = LEN.SOURCE
  RETURN
END


TABLE = ''
FOR SS = 1 TO LEN.SOURCE + 1
  TABLE<SS,1> = SS-1
NEXT SS

FOR TT= 1 TO LEN.TARGET + 1
  TABLE<1,TT> = TT-1
NEXT TT


FOR SS = 2 TO LEN.SOURCE + 1
  SOURCE.CHAR = SOURCE.STRING[SS-1,1]
  FOR TT = 2 TO LEN.TARGET + 1
    TARGET.CHAR = TARGET.STRING[TT-1,1]

    IF SOURCE.CHAR = TARGET.CHAR THEN
      COST = 0
    END ELSE
      COST = 1
    END
 
    MINIMUM.OF = TABLE<(SS-1),TT> + 1

    IF (TABLE<SS,(TT-1)> + 1) < MINIMUM.OF THEN
      MINIMUM.OF = TABLE<SS,(TT-1)> + 1
    END

    IF (TABLE<(SS-1),(TT-1)> + COST ) < MINIMUM.OF THEN
      MINIMUM.OF = TABLE<(SS-1),(TT-1)> + COST 
    END

    TABLE<SS,TT> = MINIMUM.OF

  NEXT SS

NEXT TT  
 
DISTANCE = TABLE<LEN.SOURCE + 1,LEN.TARGET + 1>

IF TESTING THEN
  CRT "SOURCE.STRING = ":SOURCE.STRING
  CRT "TARGET.STRING = ":TARGET.STRING
  FOR TT = 1 TO LEN.TARGET + 1
    FOR SS = 1 TO LEN.SOURCE + 1
      CRT TABLE<SS,TT>:"  ":
    NEXT SS
    CRT
  NEXT TT
  CRT 
  CRT "DISTANCE = ":DISTANCE
  CRT "- DISTANCE indicates the number of substitutions, deletions or additions"
  CRT "  required to make the source and target string match."
END


RETURN
*<com>------------------------------------------------------------------
*----------------------------- G O S U B S -----------------------------
*</com>-----------------------------------------------------------------

                                George Hammerle 
                                Programming Dude 
                                Hubert Company LLC. 
                                9555 Dry Fork Road 
                                Harrison, Ohio 45030 
                                513-367-8974 
                                zhammerle@hubertREMOVE_THIS.com 




This e-mail and any files transmitted with it are confidential and intended
solely for the use of the individual or company to whom they are addressed. If
you have received this e-mail in error, please notify the sender immediately and
delete this e-mail including all attachments from your system. Thank you
_______________________________________________
U2-Users mailing list
U2-Users@listserver.u2ug.org
http://listserver.u2ug.org/mailman/listinfo/u2-users

Reply via email to